delphi: jak mogę umieścić obraz w tytule DBGrid?

Question

Jak mogę umieścić obraz w nagłówku kolumny TDBGrid?

Próbowałem, ale obraz pokazywał się i znikał, gdy umieściłem mysz nad tytułem.

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; 

Answer 1

Można użyć klasy interposer dla TDBGrid i zastąpić procedurę 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, 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;