delphi：如何将Image放入DBGrid Title？

发布时间：2020-12-15 09:30:10 所属栏目：大数据来源：网络整理

导读：如何将 Image放在TDBGrid列标题中？我试过了,但是当我把鼠标放在标题上时,图像一直显示并且不断消失. procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);begin if C

如何将 Image放在TDBGrid列标题中？

我试过了,但是当我把鼠标放在标题上时,图像一直显示并且不断消失.

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
  if Column.FieldName = order then
  Begin
    Column.Title.Font.Color := clBlue;

    //if gdFixed in State then // didn't work..  I don't know why!!!

    if Rect.Top < 30 then 
      ImageList1.Draw(DBGrid1.Canvas,Rect.Right-18,Rect.Top-18,0);

  end
  else 
    Column.Title.Font.Color := clWindowText;
end;

解决方法

您可以为TDBGrid使用插入器类并覆盖DrawCell过程.

type
  TDBGrid = Class(DBGrids.TDBGrid)
  private
    FIcon:TIcon;
    FImageList: TImageList;
    procedure SetImageList(const Value: TImageList);
    Destructor Destroy;override;
  published
    procedure DrawCell(ACol,ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
    Property Imagelist: TImageList read FImageList Write SetImageList;
  End;

  TForm2 = class(TForm)
    .......

implementation


{$R *.dfm}
{ TDBGrid }

destructor TDBGrid.Destroy;
begin
  if Assigned(FIcon) then FIcon.Free;
  inherited;
end;

procedure TDBGrid.SetImageList(const Value: TImageList);
begin
  FImageList := Value;
  FreeAndNil(FIcon);
  if Assigned(FImageList) then
    begin
    FIcon := TIcon.Create;
    FImageList.GetIcon(0,FIcon);
    end;
end;

procedure TDBGrid.DrawCell(ACol,ARow: Integer; ARect: TRect; AState: TGridDrawState);
var
  L_Col: Integer;
begin
  if dgIndicator in Options then
    L_Col := ACol - 1
  else
    L_Col := ACol;

  inherited;
  if Assigned(FIcon) and (L_Col > -1) and (ARow = 0) and (Columns[L_Col].FieldName = 'ID') and (gdFixed in AState) then
  begin
      Canvas.Draw(ARect.Right - 18,ARect.Bottom - 18,FIcon);
      //FImagelist.Draw(Canvas,ARect.Right - 18,0); // would cause more flickering
  end;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  DBGrid1.DoubleBuffered := true;
  DBGrid1.Imagelist := ImageList1;
  ReportMemoryLeaksOnShutDown := true;
end;

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!