在 delphi 中向 StringGrid 的列添加功能答案

【问题标题】：Adding functionalities to a column of a StringGrid in delphi在 delphi 中向 StringGrid 的列添加功能
【发布时间】：2014-11-18 13:51:22
【问题描述】：

所以我有一个带有列的字符串网格。但是每一列都可以被删除，如果一列被删除，索引会重新排列。我可以在删除之前使用索引的值，但是在删除几列时，索引根本不一样。例如，如果我删除索引 1 和 2 处的列，则索引 3 处的列将获得一个新索引，即索引 1。

所以我想做的是向我的列添加新方法，我将在其中设置并获取真正的索引，因为它从未被删除。我找到了一个关于如何向 delphi 类添加新方法的教程，它的外观是这样的：

unit columnInterceptor

interface

uses stdCtrls, sysUtils, Classes, dialogs, grids;

type
   TStrings = class(Classes.TStrings)
   private
   public
     procedure hello;
   end;

implementation

procedure TStrings.Hello;
begin
    ShowMessage('hello');
end;
end.

如果我使用它在 StringGrid 上添加方法，这将有效。但我想在 stringGrid 的列上使用它。我已经看到一些方法来自类 TStrings 或 TObject，我都尝试了它们，但是程序 hello 没有显示。

编辑

使用类助手我设法访问了我自己的方法，并且在更改后它是这样的：

unit columnInterceptor

interface
uses stdCtrls, sysUtils, Classes, dialogs, grids;

type
   colIntercept= class helper for TStrings
   public
     procedure setValue(val: integer);
     function getValue: integer;
   end;

implementation
var 
  value : integer;


procedure colIntercept.setValue(val: integer);
begin
    value := integer;;
end;
function colIntercept.getValue: integer;
begin
    Result := value;
end;
end.

事情是，如果我添加一个私有声明，我就不能再使用我在公共声明中声明的方法了。当我设置一个值时，所有列实际上都是相同的。这就是我使用这个类的方式：

//somewhere in the unit where  create all the columns
grid.Cols[aCol].setValue(aCol);

//somewhere in the unit
grid.Cols[aCol].getValue

然后任何列的所有值总是相同的。当我设置我的值时，它们每次都不同。但是得到它们，总是返回我使用 setValue 方法插入的最后一个值。

【问题讨论】：

What are good uses for class helpers
我的单元现在被定义为 TStrings 的类助手。为了访问它，我正在使用 grid.Cols[0].hello 这不起作用，但这是我想要使用它的方式；
与其删除列，不如直接隐藏它们？然后索引不会改变。查看ColWidths[] 属性。
哦好主意哈哈谢谢：P
您是否会接受一个答案，该答案表明可以使用 Cols 存储索引，但由于“内容”正在通过 cols 移动而无济于事？

标签： delphi components extend

【解决方案1】：

问题在于 StringGrid.Cols 不是 TStrings 而是 TStrings 的后代。

你可以试试下面的代码：

ShowMessage(StringGrid1.Cols[0].Classname);

然后你会发现真正的类是一个 TStringGridStrings

所以这导致我们找到解决方案：

为 TStringGridStrings 编写一个类助手

type
  TStringGridStringsHelper = class helper for TStringGridStrings
    procedure SayHello;
  end;

{ TStringGridStringsHelper }

procedure TStringGridStringsHelper.SayHello;
begin
  ShowMessage('Hello from TStringGridStringsHelper');
end;

但你还是不会写

StringGrid1.Cols[0].SayHello;

你必须对它进行类型转换：

TStringGridStrings(StringGrid1.Cols[0]).SayHello;

问题在于 StringGrid 仅将其列公开为 TStrings 而不是正确的数据类型 TStringGridStrings 所以这就是为什么你必须键入它

======================

另一种解决方案可能是使用检查器类 (http://delphi.about.com/od/delphitips2009/qt/interceptor.htm)，但有人说这是糟糕的代码：

示例如下：

unit Unit6;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Grids;

type
  TStringGridStringsHelper = class helper for TStringGridStrings
    procedure SayHello;
  end;

  TStringGrid = class(Grids.TStringGrid)
  strict private
    function GetCols(Index: Integer): TStringGridStrings;
    function GetRows(Index: Integer): TStringGridStrings;
    procedure SetCols(Index: Integer; const Value: TStringGridStrings);
    procedure SetRows(Index: Integer; const Value: TStringGridStrings);
  public
    property Cols[Index: Integer]: TStringGridStrings read GetCols write SetCols;
    property Rows[Index: Integer]: TStringGridStrings read GetRows write SetRows;
  end;

  TForm6 = class(TForm)
    StringGrid1: TStringGrid;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form6: TForm6;

implementation

{$R *.dfm}

uses
  Math;

{ TStringGridStringsHelper }

procedure TStringGridStringsHelper.SayHello;
begin
  ShowMessage('Hello from TStringGridStringsHelper');
end;

procedure TForm6.FormCreate(Sender: TObject);
begin
  StringGrid1.Rows[0].SayHello;
end;

{ TMyStringGrid }

function TStringGrid.GetCols(Index: Integer): TStringGridStrings;
begin
  Result := inherited Cols[Index] as TStringGridStrings;
end;

function TStringGrid.GetRows(Index: Integer): TStringGridStrings;
begin
  Result := inherited Rows[Index] as TStringGridStrings;
end;

procedure TStringGrid.SetCols(Index: Integer; const Value: TStringGridStrings);
begin
  inherited Cols[Index] := Value;
end;

procedure TStringGrid.SetRows(Index: Integer; const Value: TStringGridStrings);
begin
  inherited Rows[Index] := Value;
end;

end.

【讨论】：

这可行，但它为所有列返回相同的值。请在我的问题中检查我的编辑。我认为所有的列都使用我的 TStringGridStringsHelper 和 idk 的完全相同的实例，我该怎么做才能使用他们自己的 TStringGridStringsHelper 实例：/
所以您想要根据 Row 或 Cell 的值获得不同的结果？
是的。对不起，我的第一个解释不够清楚。实际上，当我创建列时，我想在此时设置索引，因此当我删除它时，我可以执行 grid.cell[aCol].getIndex ，这应该返回在任何其他删除之前我的列的索引。
我还是不关注你。 Culyd 你添加了一些伪代码？当您在 TStringGridStringsHelper.SayHello 的实现内部时；您可以访问它的内容
您可以将原始索引保存在对象 Strings.Objects[i]

【解决方案2】：

关于您的编辑，您有一个变量，因此对您的助手的任何访问都将读取/写入此变量。

虽然可以使用辅助类保存 Col 的索引，它并没有真正的帮助，因为一个列的“内容”被“移动”到另一个列。
内部 cols 是指向 TSparseList 的 TSparsePointerArray 中条目的强制指针

以下标准代码并不意味着构建这样的帮助程序作为推荐，而仅用于说明目的。

implementation
uses system.generics.collections;

{$R *.dfm}
type
   THackGrid=Class(TCustomGrid);



  TSLDict=Class(TDictionary<TStrings,Integer>)
  End;

  TStringsHelper = class helper for TStrings
   private
    class var Dict:TSLDict;
    function GetIndex: Integer;
    procedure SetIndex(const Value: Integer);
   public
    CLASS Procedure FreeDict;
    Property Index:Integer Read GetIndex write SetIndex;

  end;



{ TStringsHelper }

CLASS procedure TStringsHelper.FreeDict;
begin
  FreeAndNil(Dict);
end;

function TStringsHelper.GetIndex: Integer;
begin
   if not assigned(Dict) then Dict:=TSLDict.Create;
   if not Dict.TryGetValue(self,Result) then Result := -1;

end;

procedure TStringsHelper.SetIndex(const Value: Integer);
begin
   if not assigned(Dict) then Dict:=TSLDict.Create;
   Dict.AddOrSetValue(self,Value);
end;


procedure TForm7.DeleteAColClick(Sender: TObject);
var
 I:Integer;
begin
  for I := 0 to StringGrid1.ColCount - 1 do
  begin
      StringGrid1.Cells[i,0] := IntToStr(i);
      StringGrid2.Cells[i,0] := IntToStr(i);
      StringGrid1.Cols[i].Index := i;

  end;

  for I := 0 to StringGrid1.ColCount - 1 do
  begin
      StringGrid1.Cells[i,1] := IntToStr(StringGrid1.Cols[i].Index);
      StringGrid1.Cells[i,2] := '$'+IntToHex(Integer(StringGrid1.Cols[i]),8);
      StringGrid2.Cells[i,1] := IntToStr(StringGrid1.Cols[i].Index);
      StringGrid2.Cells[i,2] := '$'+IntToHex(Integer(StringGrid1.Cols[i]),8);

  end;

  THackGrid(StringGrid1).DeleteColumn(2);
  THackGrid(StringGrid1).DeleteColumn(1);
  for I := 0 to StringGrid1.ColCount - 1 do
  begin
      StringGrid1.Cells[i,3] := IntToStr(StringGrid1.Cols[i].Index);
      StringGrid1.Cells[i,4] := '$'+IntToHex(Integer(StringGrid1.Cols[i]),8)
  end;
end;


procedure TForm7.MoveAColClick(Sender: TObject);
var
 I:Integer;
begin
  for I := 0 to StringGrid1.ColCount - 1 do
  begin
      StringGrid1.Cells[i,0] := IntToStr(i);
      StringGrid2.Cells[i,0] := IntToStr(i);
      StringGrid1.Cols[i].Index := i;
  end;

  for I := 0 to StringGrid1.ColCount - 1 do
  begin
      StringGrid1.Cells[i,1] := IntToStr(StringGrid1.Cols[i].Index);
      StringGrid1.Cells[i,2] := '$'+IntToHex(Integer(StringGrid1.Cols[i]),8);
      StringGrid2.Cells[i,1] := IntToStr(StringGrid1.Cols[i].Index);
      StringGrid2.Cells[i,2] := '$'+IntToHex(Integer(StringGrid1.Cols[i]),8);
  end;

 THackGrid(StringGrid1).MoveColumn(0,3);
  for I := 0 to StringGrid1.ColCount - 1 do
  begin
      StringGrid1.Cells[i,3] := IntToStr(StringGrid1.Cols[i].Index);
      StringGrid1.Cells[i,4] := '$'+IntToHex(Integer(StringGrid1.Cols[i]),8)
  end;
end;


procedure TForm7.MoveFirstAndDeleteThenClick(Sender: TObject);
var
 I:Integer;
 // we want to delete Col 1
begin
  for I := 0 to StringGrid1.ColCount - 1 do
  begin
      StringGrid1.Cells[i,0] := IntToStr(i);
      StringGrid1.Cols[i].Index := i;
  end;

  for I := 0 to StringGrid1.ColCount - 1 do
  begin
      StringGrid1.Cells[i,1] := IntToStr(StringGrid1.Cols[i].Index);
  end;

  THackGrid(StringGrid1).MoveColumn(1,StringGrid1.ColCount-1);
  THackGrid(StringGrid1).DeleteColumn(StringGrid1.ColCount-1);
  for I := 0 to StringGrid1.ColCount - 1 do
  begin
      StringGrid1.Cells[i,2] := IntToStr(StringGrid1.Cols[i].Index);
  end;
end;

initialization
finalization
 TStrings.FreeDict;

如果我们删除 Col 1 和 Col 2 的结果：

【讨论】：

它似乎回答了这个问题。唯一的问题是，在我的情况下，我有一个巨大的字符串网格，每次我都必须将 1000 多行从一个列移动到另一个列，然后如果用户单击撤消，我将不得不将其移回并且未删除的列将必须重新填充。现在我使用了评论者的技巧。我隐藏了删除的列，因此索引不会改变。当用户撤消时，我只显示隐藏的列。无论如何，感谢您的时间令牌回答，我会将其标记为答案，因为它回答了问题。谢谢你:)