Search code examples
imagedelphititlelazarusdbgrid

delphi: how can I put Image in DBGrid Title?


How can I put Image in TDBGrid column heading?

I tried, but the image kept showing and kept disappearing when i put the mouse over the title.

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;

Solution

  • You can use a interposer class for TDBGrid and override the DrawCell procedure.

    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, ARect.Bottom - 18,0); // would cause more flickering
      end;
    end;
    
    procedure TForm2.FormCreate(Sender: TObject);
    begin
      DBGrid1.DoubleBuffered := true;
      DBGrid1.Imagelist := ImageList1;
      ReportMemoryLeaksOnShutDown := true;
    end;