delphi TListView 中行数不变的情况下把窗口往下拽的话各cell的大小自动变化

Posted 2023-05-12

tags:

篇首语：本文由小常识网(cha138.com)小编为大家整理，主要介绍了delphi TListView 中行数不变的情况下把窗口往下拽的话各cell的大小自动变化相关的知识，希望对你有一定的参考价值。

把Listview的OwnerDraw设置为true,自己去用Windows API画全部Listview的图形文字，其中下列事件可能是需要编写的（远不止这些）:
OnResize
OnCustomDraw
OnCustomDrawItem
OnCustomDrawSubItem
OnAdvancedCustomDraw
OnAdvancedCustomDrawItem
OnAdvancedCustomDrawSubItem
……

你不怕麻烦就自己做吧。

如果不采用上述正宗做法，Listview的默认画法，是格线间距与字体相关，改字体就能改Cell的长和宽，但这个控制不能随拉动精确（字体的大小改变是断续的）。参考技术A 它有个COLUMNS属性，其中有AUTOSIZE，可以设置试试。

另一个对象中的对象不在单元之间保持不变 Delphi

【中文标题】另一个对象中的对象不在单元之间保持不变 Delphi【英文标题】：Object within another Object not persisting between units Delphi 【发布时间】：2020-08-18 20:18:16 【问题描述】：

对不起，如果这个问题是重复的，但我在任何地方都找不到任何解决我的问题的方法...... 下面的代码显示了我如何将列表视图中的值分配给作为另一个对象属性的对象：

主机：

procedure TForm1.SBCadClick(Sender: TObject);
var
  Procedimento: TProcedimento;
  Produto: TItemProcedimento;
  item: TListViewItem;
begin
...
  Procedimento := TProcedimento.Create;
  for item in LVItensProcedimento.Items do
  begin
    Produto := TItemProcedimento.Create;
    Produto.PRO_ID := item.Tag;
    Produto.IPR_Uso := TListItemText(item.Objects.FindDrawable('IPR_Uso'))
      .Text.ToDouble;
    Procedimento.AddPRC_Produtos(Produto);
    Produto.DisposeOf;
  end;

DM.gravaProcedimento(Procedimento); // from here we go into another unit to use its function, passing an object as a parameter

在命令DM.gravaProcedimento(Procedimento); 被正确添加到TProcedimento 的TObjectList 之前，我可以使用Procedimento.GetPRC_Produtos 正确获取其内容。但是当我调试下面显示的下一个单元时，它会获得随机 ID，这意味着它不会从一个单元持续到另一个单元：

单位 DM：

procedure TDM.gravaProcedimento(Procedimento: TProcedimento);
var
  produto: TItemProcedimento;
  dura: string;
begin
...
  produto := TItemProcedimento.Create;
  for produto in Procedimento.GetPRC_Produtos do
  begin
    DM.FDQ.Append;
    DM.FDQ.FieldByName('PRO_ID').AsInteger := produto.PRO_ID; // here the value gets a random ID like 45684 instead of the current item ID
    DM.FDQ.FieldByName('PRC_ID').AsInteger := Procedimento.PRC_ID;
    DM.FDQ.FieldByName('IPR_Uso').AsFloat := produto.IPR_Uso;
    DM.FDQ.Post;
  end;
  produto.DisposeOf;
  DM.FDQ.ApplyUpdates;
  DM.FDQ.Close;
end;

这是我的对象的类定义：

unit uClasses;

interface

uses
  System.SysUtils, System.Types, Generics.Collections;

type
  TItemProcedimento = class
  private
    FPRO_Nome: string;
    FPRO_Tipo: integer;
    FPRO_Custo: double;
    FPRO_ID: integer;
    FPRO_Rendimento: integer;
    FPRO_Potencia: double;
    FIPR_Uso: double;
    procedure SetPRO_Custo(const Value: double);
    procedure SetPRO_ID(const Value: integer);
    procedure SetPRO_Nome(const Value: string);
    procedure SetPRO_Rendimento(const Value: integer);
    procedure SetPRO_Tipo(const Value: integer);
    procedure SetPRO_Potencia(const Value: double);
    procedure SetIPR_Uso(const Value: double);
  public
    constructor Create;
  published
    property PRO_Rendimento: integer read FPRO_Rendimento
      write SetPRO_Rendimento;
    property PRO_ID: integer read FPRO_ID write SetPRO_ID;
    property PRO_Nome: string read FPRO_Nome write SetPRO_Nome;
    property PRO_Tipo: integer read FPRO_Tipo write SetPRO_Tipo;
    property PRO_Custo: double read FPRO_Custo write SetPRO_Custo;
    property PRO_Potencia: double read FPRO_Potencia write SetPRO_Potencia;
    property IPR_Uso: double read FIPR_Uso write SetIPR_Uso;
  end;

  TProcedimento = class
  private
    FPRC_Nome: string;
    FPRC_Duracao: TDateTime;
    FPRC_Preco: double;
    FPRC_ID: integer;
    FPRC_Consumo: double;
    FPRC_Produtos: TObjectList<TItemProcedimento>;
    procedure SetPRC_Consumo(const Value: double);
    procedure SetPRC_Duracao(const Value: TDateTime);
    procedure SetPRC_ID(const Value: integer);
    procedure SetPRC_Nome(const Value: string);
    procedure SetPRC_Preco(const Value: double);
  public
    constructor Create;
    function GetPRC_Produtos: TObjectList<TItemProcedimento>;
    procedure AddPRC_Produtos(const Value: TItemProcedimento);
    procedure DelPRC_Produtos(const Value: TItemProcedimento);
    procedure CleanPRC_Produtos;
  published
    property PRC_Preco: double read FPRC_Preco write SetPRC_Preco;
    property PRC_Consumo: double read FPRC_Consumo write SetPRC_Consumo;
    property PRC_ID: integer read FPRC_ID write SetPRC_ID;
    property PRC_Nome: string read FPRC_Nome write SetPRC_Nome;
    property PRC_Duracao: TDateTime read FPRC_Duracao write SetPRC_Duracao;
  end;

implementation

 TProcedimento 

procedure TProcedimento.CleanPRC_Produtos;
begin
  if not Assigned(FPRC_Produtos) then
    FPRC_Produtos := TObjectList<TItemProcedimento>.Create
  else
    FPRC_Produtos.Clear;
end;

constructor TProcedimento.Create;
begin
  SetPRC_Consumo(0);
  SetPRC_Duracao(0);
  SetPRC_ID(0);
  SetPRC_Nome('');
  SetPRC_Preco(0);
end;

procedure TProcedimento.DelPRC_Produtos(const Value: TItemProcedimento);
begin
  FPRC_Produtos.Delete(FPRC_Produtos.IndexOf(Value));
end;

function TProcedimento.GetPRC_Produtos: TObjectList<TItemProcedimento>;
begin
  if Assigned(FPRC_Produtos) then
    result := FPRC_Produtos
  else
  begin
    CleanPRC_Produtos;
    result := FPRC_Produtos;
  end;
end;

procedure TProcedimento.SetPRC_Consumo(const Value: double);
begin
  FPRC_Consumo := Value;
end;

procedure TProcedimento.SetPRC_Duracao(const Value: TDateTime);
begin
  FPRC_Duracao := Value;
end;

procedure TProcedimento.SetPRC_ID(const Value: integer);
begin
  FPRC_ID := Value;
end;

procedure TProcedimento.SetPRC_Nome(const Value: string);
begin
  FPRC_Nome := Value;
end;

procedure TProcedimento.SetPRC_Preco(const Value: double);
begin
  FPRC_Preco := Value;
end;

procedure TProcedimento.AddPRC_Produtos(const Value: TItemProcedimento);
begin
  FPRC_Produtos.Add(Value);
end;

 TItemProcedimento 

constructor TItemProcedimento.Create;
begin
  SetPRO_Custo(0);
  SetPRO_ID(0);
  SetPRO_Nome('');
  SetPRO_Tipo(0);
  SetPRO_Rendimento(0);
end;

procedure TItemProcedimento.SetIPR_Uso(const Value: double);
begin
  FIPR_Uso := Value;
end;

procedure TItemProcedimento.SetPRO_Custo(const Value: double);
begin
  FPRO_Custo := Value;
end;

procedure TItemProcedimento.SetPRO_ID(const Value: integer);
begin
  FPRO_ID := Value;
end;

procedure TItemProcedimento.SetPRO_Nome(const Value: string);
begin
  FPRO_Nome := Value;
end;

procedure TItemProcedimento.SetPRO_Potencia(const Value: double);
begin
  FPRO_Potencia := Value;
end;

procedure TItemProcedimento.SetPRO_Rendimento(const Value: integer);
begin
  FPRO_Rendimento := Value;
end;

procedure TItemProcedimento.SetPRO_Tipo(const Value: integer);
begin
  FPRO_Tipo := Value;
end;

end.

发生这种情况的任何特定原因？我在这里做错了什么？

【问题讨论】：

【参考方案1】：

问题是您在gravaProcedimento() 有机会使用它们之前销毁 TItemProcedimento 对象。

您在Procedimento.AddPRC_Produtos(Produto) 退出后立即调用Produto.DisposeOf()，也在gravaProcedimento() 中调用。 不要那样做！

AddPRC_Produtos() 将原始的Produto 对象保存到TObjectList 中，该对象拥有该对象的所有权（因为TObjectList 默认设置为OwnsObjects=True）。这意味着对象从列表中移除时会自动销毁，包括列表被清除或销毁的时间。

因此，您需要完全摆脱 DisposeOf() 的调用。

此外，您还需要在 gravaProcedimento() 中摆脱对 TItemProcedimento.Create 的调用。它不属于那里。你所做的只是在非 ARC 系统上造成内存泄漏。

您似乎对 Delphi 对象生命周期的实际工作方式并没有完全掌握。在将对象 instance 分配给它之前，您不需要在对象 variable 上调用 Create。当您使用 variable 时，您不需要在对象 variable 上调用 DisposeOf()，只有在您使用完 object 时才需要> 本身（TObjectList 将为您处理）。

试试这个：

procedure TForm1.SBCadClick(Sender: TObject);
var
  Procedimento: TProcedimento;
  Produto: TItemProcedimento;
  item: TListViewItem;
begin
  ...
  Procedimento := TProcedimento.Create;
  try
    for item in LVItensProcedimento.Items do
    begin
      Produto := TItemProcedimento.Create;
      try
        Produto.PRO_ID := item.Tag;
        Produto.IPR_Uso := TListItemText(item.Objects.FindDrawable('IPR_Uso')).Text.ToDouble;
        Procedimento.AddPRC_Produtos(Produto);
        // Produto.DisposeOf; // <-- DO NOT DO THIS HERE!!!
      except
        Produto.DisposeOf; // <-- DO THIS HERE INSTEAD, if AddPRC_Produtos fails!!!
        raise;
      end;
    end;

    DM.gravaProcedimento(Procedimento);
  finally
    Procedimento.DisposeOf; // <-- ADD THIS, if needed!!!
  end;
end;

procedure TDM.gravaProcedimento(Procedimento: TProcedimento);
var
  produto: TItemProcedimento;
  dura: string;
begin
  ...
  // produto := TItemProcedimento.Create; // <- DO NOT DO THIS!!!
  for produto in Procedimento.GetPRC_Produtos do
  begin
    FDQ.Append;
    try
      FDQ.FieldByName('PRO_ID').AsInteger := produto.PRO_ID;
      FDQ.FieldByName('PRC_ID').AsInteger := Procedimento.PRC_ID;
      FDQ.FieldByName('IPR_Uso').AsFloat := produto.IPR_Uso;
      FDQ.Post;
    except
      FDQ.Cancel; // <-- ADD THIS!!!
      raise;
    end;
  end;
  // produto.DisposeOf; // <-- DO NOT DO THIS!!!
  FDQ.ApplyUpdates;
  FDQ.Close;
end;

【讨论】：

所以它不会将对象添加到对象列表中，而是创建该对象的指针到列表中？我现在明白了。谢谢。类是 Delphi 中的引用类型。它们总是由指针引用。 Create() 在内存中创建对象，Destroy()/Free()/DisposeOf() 销毁并从内存中删除它。在这两者之间，对对象所做的一切都是通过传递一个指向对象的指针来完成的。【参考方案2】：

您不应在过程 TForm1.SBCadClick 中调用 Produto.DisposeOf。你正在破坏你刚刚添加的对象..

【讨论】：

枚举添加对象列表后与gravaProcedimento()相同。

以上是关于delphi TListView 中行数不变的情况下把窗口往下拽的话各cell的大小自动变化的主要内容，如果未能解决你的问题，请参考以下文章

delphi -----TListView的用法（转载）

delphi TListView

Delphi的TListView控件拖放选定行操作

Delphi TListView(TListBox+图标显示)

在 OwnerData 和 OwnerDraw 设置为 True 的 TListView 上显示错误提示

Vista / 7下的本机提示/工具提示与Delphi 7？

delphi TListView 中 行数不变的情况下把窗口往下拽的话各cell的大小自动变化

另一个对象中的对象不在单元之间保持不变 Delphi

delphi TListView 中行数不变的情况下把窗口往下拽的话各cell的大小自动变化