How to create a TDrawGrid where all cells act as buttons (Views: 29)
Problem/Question/Abstract: Is there anybody who knows how to subclass the existing TDrawGrid so that all the cells act as buttons? I would like the OnDrawCell to return the inner rectangle of the button look and set the colors of the bevel so that they look like a button. Answer: unit ButtonDrawGrid; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids; type TPBButtonDrawGrid = class(TDrawGrid) private FCellDown: TGridCoord; protected { Protected declarations } procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; function SelectCell(ACol, ARow: Longint): Boolean; override; public constructor Create(aOwner: TComponent); override; end; procedure Register; implementation procedure Register; begin RegisterComponents('PBGoodies', [TPBButtonDrawGrid]); end; { TButtonDrawGrid } constructor TPBButtonDrawGrid.Create(aOwner: TComponent); begin inherited; FCellDown.X := -1; FCellDown.Y := -1; end; procedure TPBButtonDrawGrid.DrawCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState); var r: TRect; style: DWORD; begin r := ARect; if not (gdFixed in aState) then begin Canvas.Brush.Color := clBtnFace; Canvas.Font.Color := clBtnText; style := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT; if (FCellDown.X = aCol) and (FCellDown.Y = aRow) then style := style or DFCS_PUSHED; DrawFrameControl(Canvas.Handle, r, DFC_BUTTON, style); end; inherited DrawCell(ACol, aRow, r, aState); end; procedure TPBButtonDrawGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var cell: TGridCoord; begin if (Button = mbLeft) and ((Shift - [ssLeft]) = []) then begin MousetoCell(X, Y, cell.X, cell.Y); if (cell.X >= FixedCols) and (cell.Y >= FixedRows) then begin FCellDown := cell; InvalidateCell(cell.X, cell.Y); end; end; inherited; end; procedure TPBButtonDrawGrid.MouseMove(Shift: TShiftState; X, Y: Integer); var cell: TGridCoord; begin if Shift = [ssLeft] then begin MousetoCell(X, Y, cell.X, cell.Y); if not CompareMem(@cell, @FCellDown, Sizeof(cell)) then begin if (FCellDown.X >= 0) and (FCellDown.Y >= 0) then InvalidateCell(FCellDown.X, FCellDown.Y); FCellDown := cell; InvalidateCell(cell.X, cell.Y); end; end; inherited; end; procedure TPBButtonDrawGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (Button = mbLeft) and (Shift = []) then begin InvalidateCell(FCellDown.X, FCellDown.Y); FCellDown.X := -1; FCellDown.Y := -1; end; inherited; end; function TPBButtonDrawGrid.SelectCell(ACol, ARow: Integer): Boolean; begin result := false; end; end. |