delphi - 如何为 TStringGrid 创建自定义编辑器？ (TStringGrid 作为其他控件的父级)

Question

我正在尝试为 TStringGrid 创建一个列编辑器(显示/隐藏列)。编辑器是一个包含列表框、标签和按钮的面板。我想直接在我的 TStringGrid 控件中创建此编辑器。

网格:

type 
 TAvaGrid= class(TStringGrid;

constructor TAvaGrid.Create(AOwner: TComponent);  
begin
 inherited Create(AOwner);
 ColEditor:= TColEditor.Create(Self);
end;

procedure TAvaGrid.CreateWnd;
begin
 inherited CreateWnd;   
 ColEditor.Parent  := Self;        
 ColEditor.Visible := FALSE; 
end;

<小时/>

编辑:

constructor TColEditor.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);

 Self.Top     := 60;                       { DO NOT move this in CreateWnd because controls based on this won't size properly during Create }
 Self.Left    := 60;
 Self.Width   := 220;
 Self.Height  := 280;

 TopBar      := TLabel.Create(Self);    
 CloseButton := TButton.Create(Self);     
 VisChkBox   := TCheckListBox.Create(Self);

 DoubleBuffered:= FALSE;                   { Mandatory! }
 Visible := FALSE;

 { Blue caption }
 TopBar.Parent       := Self;
 TopBar.AutoSize     := FALSE;
 TopBar.Height       := 21;
 TopBar.Align        := alTop;
 TopBar.Caption      := ' Visible columns';
 TopBar.ParentColor  := FALSE;
 TopBar.Transparent  := FALSE;
 TopBar.Cursor       := crHandPoint;
 TopBar.Font.Name    := 'Tahoma';
 TopBar.Font.Style   := [System.UITypes.TFontStyle.fsBold];
 TopBar.ParentFont   := FALSE;
 TopBar.Layout       := tlCenter;
 TopBar.Visible      := TRUE;
 TopBar.Color        := TColors.Navy;
 TopBar.Font.Color   := TColors.White;
 TopBar.OnMouseDown  := TopBarMouseDown;
 TopBar.OnMouseMove  := TopBarMouseMove;
 TopBar.OnMouseUp    := TopBarMouseUp;

 { The Close button }
 CloseButton.Parent  := Self;
 CloseButton.Width   := 22;
 CloseButton.Height  := 20;
 CloseButton.Top     := 1;
 CloseButton.Anchors := [akRight, akBottom];
 CloseButton.Hint    := 'Close';
 CloseButton.Caption := 'X';
 CloseButton.Visible := TRUE;
 CloseButton.OnClick := CloseButtonClick;

 { The listbox }
 VisChkBox.Parent          := Self;
 VisChkBox.AlignWithMargins:= TRUE;
 VisChkBox.Align           := alClient;
 VisChkBox.ItemHeight      := 13;
 VisChkBox.Visible         := TRUE;
end;


{THIS is not called until when the user presses F4 to show the 'Column Visibility' (this) panel ! }
procedure TColEditor.CreateWnd;    
begin
 inherited CreateWnd;
 CloseButton.Left:= Self.ClientWidth- CloseButton.Width- 1;
end;

我的编辑器出现刷新问题:当网格更新时(例如添加新列)，编辑器会出现乱码: 我必须单击它才能使其看起来正确。

我已经尝试过WMCommand trick但这行不通。

Answer 1

问题出在TCustomPanel(的绘制代码)中。这两个控件(Panel 和 StringGrid)都将自己完全绘制在同一个 Canvas 上，但不知何故彼此发生了冲突。无论如何，我没有成功地通过使用覆盖(任意组合)及其属性设置来使用此面板获得满意的结果。显然 - 至少可能 - 不适合在此设置中使用。

但是，当您从 TCustomControl 甚至 TWinControl 派生您的编辑器时，就不再存在绘画问题，并且代码变得像这样这个:

type
  TColEditor = class(TWinControl)
  private
    FTopBar: TLabel;
    FCloseButton: TButton;
    FVisChkBox: TCheckListBox;
    procedure CloseButtonClick(Sender: TObject);
    procedure TopBarMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TopBarMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure TopBarMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TStringGrid = class(Grids.TStringGrid)
  private
    FColEditor: TColEditor;
  public
    constructor Create(AOwner: TComponent); override;
  end;

constructor TColEditor.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SetBounds(60, 60, 220, 280);
  BevelKind := bkTile;
  BevelInner := bvLowered;
  BevelOuter := bvRaised;
  FTopBar := TLabel.Create(Self);
  FTopBar.AutoSize := False;
  FTopBar.Height := 21;
  FTopBar.Align := alTop;
  FTopBar.Caption := ' Visible columns';
  FTopBar.Transparent := False;
  FTopBar.Color := TColors.Navy;
  FTopBar.Cursor := crHandPoint;
  FTopBar.Font.Name := 'Tahoma';
  FTopBar.Font.Style := [System.UITypes.TFontStyle.fsBold];
  FTopBar.Font.Color := TColors.White;
  FTopBar.Layout := tlCenter;
  FTopBar.OnMouseDown := TopBarMouseDown;
  FTopBar.OnMouseMove := TopBarMouseMove;
  FTopBar.OnMouseUp := TopBarMouseUp;
  FTopBar.Parent := Self;
  FCloseButton := TButton.Create(Self);
  FCloseButton.SetBounds(Width - 22, 0, 22, 20);
  FCloseButton.Anchors := [akTop, akRight];
  FCloseButton.Hint := 'Close';
  FCloseButton.Caption := 'X';
  FCloseButton.OnClick := CloseButtonClick;
  FCloseButton.Parent := Self;
  FVisChkBox := TCheckListBox.Create(Self);
  FVisChkBox.AlignWithMargins := True;
  FVisChkBox.Align := alClient;
  FVisChkBox.ItemHeight := 13;
  FVisChkBox.Parent := Self;
end;

constructor TStringGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FColEditor := TColEditor.Create(Self);
  FColEditor.Parent := Self;
  FColEditor.Visible := False;
end;

我想这就是你问题的答案。但我可以说这个解决方案远非最佳。因为 editor 控件是 StringGrid 的子控件，并且 StringGrid 内部使用 ScrollWindow当使用它的滚动条时，您的编辑器的表示会被复制到各处。这是一个问题，可能还有其他问题。

解决方案是将编辑器作为子级与 StringGrid 分离，并将其 Parent 属性设置为 StringGrid 的 Parent 属性。 StringGrid 根本不意味着包含子控件，设计器中的 StringGrid 无法接受子控件就证明了这一点。当您将编辑器置于父级链中时，您甚至可以依靠面板解决方案。

显然，还有许多其他可能的设计来制作可见的列选择编辑器。其中之一是使用 PopupMenu，其实现可能如下所示:

type
  TStringGrid = class(Vcl.Grids.TStringGrid)
  private
    FColumsMenu: TMenuItem;
    procedure ColumnItemClick(Sender: TObject);
    procedure InitializePopupMenu;
  protected
    procedure SizeChanged(OldColCount, OldRowCount: Integer); override;
    procedure Loaded; override;
  end;

procedure TStringGrid.ColumnItemClick(Sender: TObject);
var
  Item: TMenuItem absolute Sender;
begin
  Item.Checked := not Item.Checked;
  if Item.Checked then
    ColWidths[Item.Tag] := DefaultColWidth
  else
    ColWidths[Item.Tag] := -GridLineWidth;
end;

procedure TStringGrid.InitializePopupMenu;
var
  MenuItem: TMenuItem;
begin
  if PopupMenu = nil then
  begin
    PopupMenu := TPopupMenu.Create(Self);
    FColumsMenu := PopupMenu.Items;
  end
  else
  begin
    MenuItem := TMenuItem.Create(Self);
    MenuItem.Caption := 'Visible columns...';
    PopupMenu.Items.Insert(0, MenuItem);
    FColumsMenu := MenuItem;
  end;
  SizeChanged(0, 0);
end;

procedure TStringGrid.Loaded;
begin
  inherited Loaded;
  InitializePopupMenu;
end;

procedure TStringGrid.SizeChanged(OldColCount, OldRowCount: Integer);
var
  Checked: array of Boolean;
  I: Integer;
  MenuItem: TMenuItem;
begin
  inherited SizeChanged(OldColCount, OldRowCount);
  if not (csDesigning in ComponentState) and (ColCount <> OldColCount) then
  begin
    SetLength(Checked, ColCount);
    for I := FixedCols to OldColCount - 1 do
      Checked[I] := ColWidths[I] > 0;
    for I := OldColCount to ColCount - 1 do
      Checked[I] := True;
    FColumsMenu.Clear;
    for I := FixedCols to ColCount - 1 do
    begin
      MenuItem := TMenuItem.Create(Self);
      MenuItem.Checked := Checked[I];
      MenuItem.Tag := I;
      MenuItem.Caption := Format('Column %d', [I]);
      MenuItem.OnClick := ColumnItemClick;
      FColumsMenu.Add(MenuItem);
    end;
  end;
end;