Where can I intercept the row change in a derivative TDBGrid? - delphi

I want to know on an overriding of DrawColumnCell if the grid is drawing its active row.
I thought of keeping an ActiveRecno private variable to check if the DrawColumnCell is drawing that row. I tried intercepting the DataChange of the Datasource to keep track of that ActiveRecno.
TMyDBGrid = class(TDBGrid)
protected
OnDataChange_Original: TDataChangeEvent;
procedure TrackPosition(Sender: TObject; Field: TField);
procedure DrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); override;
public
ActiveRecno: integer;
constructor Create(AOwner: TComponent): override;
...
...
implementation
constructor TMyDBGrid.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
OnDataChange_Original := nil;
if Assigned(DataSource) then begin
OnDataChange_Original := Datasource.OnDataChange;
Datasource.OnDataChange := TrackPosition;
end;
end;
procedure TMyDBGrid.TrackPosition(Sender: TObject; Field: TField);
begin
ActiveRecno := Datasource.DataSet.RecNo;
if Assigned(OnDataChange_Original) then OnDataChange_Original(Sender, Field);
end;
procedure TMyDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
var ActiveRow: boolean;
begin
ActiveRow := (Self.ActiveRecno = Self.DataSource.Dataset.Recno);
...
...
inherited DrawColumnCell(Rect, DataCol, Column, State);
end;
But ActiveRecno remains always 0, making ActiveRow always False. That's because in the constructor Datasource is still nil, so I never set TrackPosition to keep the ActiveRecno.
Where can I set my handler for that event ?, the SetDataSource procedure is private, so I can't override it.
Do you recommend me another way to keep track of the active row, or detect in DrawColumnCell if the row to draw is the active row ?.
Thank you.

I think that what you want would be straightforward except for the fact that neither the current row
of the DBGrid nor the row being drawn in the OnDrawrDataCell event is readily accessible inside the event.
Fortunately, it is fairly straightforward to overcome these problems using an interposer TDBGrid class as shown below.
THe interposer TDBGrid class simply exposes the Row property of TCustomGrid as the ActiveRow
The OnDrawDataCell event is called from TCustomDBGrid.DrawCell, which is virtual and so can be overridden
in the interposer class. As you can see below, the overridden version first copies the row number (the ARow argument) used
in TCustomDBGrid.DrawCell into the FRowBeingDrawn field and then calls the inherited DrawDataCell, which in turn calls the OnDrawDataCell handler. Since this handler
sees the interposer class, both the grid's ActiveRow and RowBeingDrawn are accessible inside the
OnDrawDataCell event.
type
TDBGrid = class(DBGrids.TDBGrid)
private ,
FRowBeingDrawn : Integer;
function GetActiveRow: Integer;
protected
procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
property RowBeingDrawn : Integer read FRowBeingDrawn write FRowBeingDrawn;
property ActiveRow : Integer read GetActiveRow;
end;
TForm1 = class(TForm)
DBGrid1: TDBGrid;
ClientDataSet1: TClientDataSet;
DataSource1: TDataSource;
ComboBox1: TComboBox;
DBNavigator1: TDBNavigator;
procedure FormCreate(Sender: TObject);
procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
end;
[...]
procedure TForm1.FormCreate(Sender: TObject);
var
AField : TField;
begin
AField := TIntegerField.Create(Self);
AField.FieldKind := fkData;
AField.FieldName := 'ID';
AField.DataSet := ClientDataSet1;
AField := TStringField.Create(Self);
AField.FieldKind := fkData;
AField.FieldName := 'AValue';
AField.DataSet := ClientDataSet1;
ClientDataSet1.CreateDataSet;
ClientDataSet1.InsertRecord([1, 'One']);
ClientDataSet1.InsertRecord([2, 'Two']);
ClientDataSet1.InsertRecord([3, 'Three']);
ClientDataSet1.InsertRecord([4, 'Four']);
ClientDataSet1.InsertRecord([5, 'Five']);
DBGrid1.DefaultDrawing := True;
end;
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
if (Sender as TDBGrid).RowBeingDrawn = (Sender as TDBGrid).Row then
Caption := IntToStr((Sender as TDBGrid).RowBeingDrawn);
DBGrid1.DefaultDrawDataCell(Rect, Column.Field, State);
end;
procedure TDBGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
AState: TGridDrawState);
begin
RowBeingDrawn := ARow;
try
inherited;
finally
RowBeingDrawn := -1;
end;
end;
function TDBGrid.GetActiveRow: Integer;
begin
Result := Row;
end;
end.
The interposer class can, of course, be contained in a separate unit provided, of course, that it appears in the using unit's Uses list after DBGrids.
One minor point to beware of is that the code above does not take account of whether the title row of the grid is visble or not, and make require minor tweaking if it is not.

Related

I can't set the text formatting on my own derivative of a TDBGrid

I'm creating a derivative of the TDBGrid, and I want to implement a nicer way to define its text formatting, something similar to the GetContentStyle of the QuantumGrid.
The problem is that the DBGrid ignores the font and colors that my new event sets on its Canvas.
type TSetCellStyle = procedure(const Sender: TObject; const AColumn: TColumn; const ARow: TDataset; const AField: TField; const State: TGridDrawState; var TextFont: TFont; var BackgroundColor: TColor) of object;
TMyDBGrid = class(TDBGrid)
private
FSetCellStyle: TSetCellStyle;
protected
procedure DrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); override;
published
property OnSetCellstyle: TSetCellStyle read FSetCellStyle write FSetCellStyle;
...
...
implementation
procedure TMyDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
BeginUpdate;
Canvas.Lock; // Prevents other threads from drawing on the canvas.
if Assigned(FSetCellStyle) then begin
var TextFont: TFont;
var BackgroundColor: TColor;
TextFont := Canvas.Font;
BackgroundColor := Canvas.Brush.Color;
FSetCellStyle(Self, Column, Self.DataSource.DataSet, Self.DataSource.DataSet.FindField(Column.FieldName), State, TextFont, BackgroundColor);
Canvas.Font := TextFont;
Canvas.Brush.Color := BackgroundColor;
end;
Canvas.Unlock;
inherited DrawColumnCell(Rect, DataCol, Column, State);
EndUpdate;
end;
This is an exemple of how the application uses the new event to customize the formatting of a grid:
procedure TFInspira.GridInspiraSetCellStyle(const Sender: TObject; const AColumn: TColumn; const ARow: TDataSet; const AField: TField; const State: TGridDrawState; var TextFont: TFont; var BackgroundColor: TColor);
begin
if (AColumn.FieldName = 'ReferenciaGrup') and (ARow.FieldByName('PrimerDeGrup').AsBoolean) then begin
BackgroundColor := clYellow;
end;
if ARow.FieldByName('Selected').AsBoolean then begin
TextFont.Style := TextFont.Style + [fsItalic];
end;
end;
I can debug my grid and see that the overriden DrawColumnCell sets the canvas in yellow and italic for some cells, but the Grid never shows them. Looks like the call to inherit DrawColumnCell resets the Canvas' formats.
If I can't hook my formatting event in DrawColumnCell where can I do so ?.
Thank you.
I think that your DrawColumnCell is just missing a call to DefaultDrawDataCell to get the grid to actually draw the cell. F.i.in my answer to your other q,
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
AGrid : TDBGrid;
begin
AGrid := (Sender as TDBGrid);
if Odd(AGrid.RowBeingDrawn) then begin
AGrid.Canvas.Brush.Color := clGreen;
end;
AGrid.DefaultDrawDataCell(Rect, Column.Field, State);
end;
Obviously, this paints the cells of alternate rows green.
I've used the interposer class of my other answer just so I could refer to the added RowBeingDrawn property, but code similar to the above will work just as well with the standard TDBGrid (provided its DefaultDrawing property is set to True).

Delphi 7: How can I change the colors of individual cells on a StringGrid via clicking on them?

I am trying to make an app where the cells of a TStringGrid will change color when I click on them. Each time I click on a cell, it should switch over to the next color and stay that color, until I click on that cell again, in order:
white ==> red ==> orange ==> green ==> white (like a traffic light).
The error(s) I am getting is a bit hard to explain, but I'll try.
The application runs, but when I click on one cell and then on another, sometimes the first cell I clicked on changes color, but the second one doesn't. Other times, both cells change color. Other times, both cells just reset to their white state.
type
TForm1 = class(TForm)
StringGrid: TStringGrid;
procedure StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
private
arrState: array[1..4, 1..4] of Integer;
end;
procedure TForm1.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
iRow, iCol: Integer;
arrk: array[1..4, 1..4] of Integer;
begin
for iCol := 4 downto 1 do
begin
for iRow := 4 downto 1 do
begin
if (gdSelected in State) then
begin
case arrState[ARow, aCol] of
0: begin
StringGrid.Canvas.Brush.Color := clWhite;
Rect := StringGrid.CellRect(iCol, iRow);
StringGrid.Canvas.FillRect(Rect);
Inc(arrState[iRow, iCol]);
end;
1: begin
StringGrid.Canvas.Brush.Color := clRed;
Rect := StringGrid.CellRect(iCol, iRow);
StringGrid.Canvas.FillRect(Rect);
Inc(arrState[iRow, iCol]);
end;
2: begin
StringGrid.Canvas.Brush.Color := $008CFF;
Rect := StringGrid.CellRect(iCol, iRow);
StringGrid.Canvas.FillRect(Rect);
Inc(arrState[iRow, iCol]);
end;
3: begin
StringGrid.Canvas.Brush.Color := clGreen;
Rect := StringGrid.CellRect(iCol, iRow);
StringGrid.Canvas.FillRect(Rect);
arrState[iRow, iCol] := 0;
end;
end;
end;
end;
end;
end;
The problem is that you are using the OnDrawCell event to update your state machine. NEVER use a drawing event to drive state changes! A UI control gets painted often and for many reasons, so any drawing events should be painting only the current state, for the specific item that is currently being drawn. You should be using the OnSelectCell or OnClick event to update your state machine and then trigger a repaint of the updated cell.
Try this:
type
TForm1 = class(TForm)
StringGrid: TStringGrid;
procedure StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure StringGridSelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
private
arrState: array[1..4, 1..4] of Integer;
end;
procedure TForm1.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
const
clOrange = TColor($008CFF);
CellColors: array[0..3] of TColor = (clWhite, clRed, clOrange, clGreen);
begin
if (ACol in [1..4]) and (ARow in [1..4]) then
begin
StringGrid.Canvas.Brush.Color := CellColors[arrState[ARow, ACol]];
StringGrid.Canvas.FillRect(Rect);
end;
end;
// TStringGrid.InvalidateCell() is protected,
// but can be reached using an accessor class..
type
TStringGridAccess = class(TStringGrid)
end;
procedure TForm1.StringGridSelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
begin
if (ACol in [1..4]) and (ARow in [1..4]) then
begin
arrState[ARow, ACol] := (arrState[ARow, ACol] + 1) mod 4;
TStringGridAccess(StringGrid).InvalidateCell(ACol, ARow);
end;
end;
Alternatively:
type
TForm1 = class(TForm)
StringGrid: TStringGrid;
procedure StringGridClick(Sender: TObject);
procedure StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
private
arrState: array[1..4, 1..4] of Integer;
end;
// TStringGrid.InvalidateCell() is protected,
// but can be reached using an accessor class..
type
TStringGridAccess = class(TStringGrid)
end;
procedure TForm1.StringGridClick(Sender: TObject);
type
POINTS = packed record
x: SHORT;
y: SHORT;
end;
var
dwPos: DWORD;
pts: POINTS absolute dwPos;
pt: TPoint;
iCol, iRow: Integer;
begin
dwPos := GetMessagePos();
pt := StringGrid.ScreenToClient(Point(pts.x, pts.y));
StringGrid.MouseToCell(pt.X, pt.Y, iCol, iRow);
if (iCol in [1..4]) and (iRow in [1..4]) then
begin
arrState[iRow, iCol] := (arrState[iRow, iCol] + 1) mod 4;
TStringGridAccess(StringGrid).InvalidateCell(iCol, iRow);
end;
end;
procedure TForm1.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
const
clOrange = TColor($008CFF);
CellColors: array[0..3] of TColor = (clWhite, clRed, clOrange, clGreen);
begin
if (ACol in [1..4]) and (ARow in [1..4]) then
begin
StringGrid.Canvas.Brush.Color := CellColors[arrState[ARow, ACol]];
StringGrid.Canvas.FillRect(Rect);
end;
end;

After searching data, make DBGrid cell change color

I'm building a function: after searching a value in DBGrid, it can count how many value and mark those cells (change cells' color).But I only made column change color.How can I do in one procedure?
procedure TfmMain.N_SearchClick(Sender: TObject);
var
searchname : String;
i: integer;
frmSearch : Tfrmsearch;
data_count : integer;
begin
searchData := '';
searchRow:=self.DBGrid.DataSource.DataSet.RecNo;
searchname:= DBGrid.DataSource.DataSet.fieldbyname('FIELD').AsString;
frmSearch:=Tfrmsearch.Create(self);
try
frmSearch.ShowModal;
frmSearch.Visible:=true;
for i := 0 to DBGrid.FieldCount do
begin
if ((Pos(searchData,DBGrid.DataSource.DataSet.Fields[i].AsString)>0) AND (CompareStr(searchData,'') <> 0)
AND (Pos('VALUE_',DBGrid.DataSource.DataSet.Fields[i].FieldName)>0)
AND (searchRow=DBGrid.DataSource.DataSet.RecNo)) then
begin
data_count:=data_count+1;
//DBGrid[DBGrid.Row,i-2].Color:=clLime;
end;
end;
showmessage('countTotal: '+IntToStr(data_count));
finally
frmSearch.Free;
end;
end;
All you need is something like this in the OnDrawColumnCell event of the grid:
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
// Change font- and grid-color if showing search results
if ShowingSearchResult then begin
TDBGrid(Sender).Canvas.Brush.Color := clSilver;
TDBGrid(Sender).Canvas.Font.Color := clBlue;
end;
TDBGrid(Sender).DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;
What you can do in the OnDrawColumnCell event is a bit limited, but should suffice for this case. Iirc, at some point the OnDrawDataCell was added to allow for greater flexibility.
Of course, you would declare the ShowingSearchResult (boolean) variable as a field of your TfrmSearch and set it to True in your N_SearchClick procedure. However, since that procedure shows the form modally and then frees it, you can possibly omit that variable entirely, so the DBGrid1DrawColumnCell could be just
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
TDBGrid(Sender).Canvas.Brush.Color := clSilver;
TDBGrid(Sender).Canvas.Font.Color := clBlue;
TDBGrid(Sender).DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;
Thanks a lot, this is final code that I wrote.
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
if (DBGrid.DataSource.DataSet.FieldByName(Column.FieldName).AsString = searchData)
and (searchRow=DBGrid.DataSource.DataSet.RecNo) then
begin
TDBGrid(Sender).Canvas.Brush.Color := $000080FF;
DBGrid.DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;
end;

How to correctly free a DragObject

I got a memory leak error after drag & drop.
TMyDragObject = class(TDragObject)
public
MyInfo : string;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
System.ReportMemoryLeaksOnShutdown := True;
Button1.DragMode := dmAutomatic;
end;
procedure TForm1.Button1StartDrag(Sender: TObject; var DragObject: TDragObject);
begin
DragObject := TMyDragObject.Create;
TMyDragObject(DragObject).MyInfo := 'hi!';
end;
Where should DragObject be freed?
Thanks to all.
Free the object in the OnDragDrop handler for the control accepting the drop. Here's the event for a TMemo:
procedure TForm4.Memo1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
if IsDragObject(Source) then
begin
Memo1.Lines.Add(TMyDragObject(Source).MyInfo);
Source.Free;
end;
end;
Here's a more complete (and very trivial) example. Drop a TButton and TMemo on the form, set Button1.DragMode to dmAutomatic, add the variable Ctr: Integer to the form's private section, and wire up the event handlers; it allows you to drag the button into the memo, adding the text Item + the current value of Ctr to the memo's lines.
type
TMyDragObject=class(TDragObject)
Info: string;
end;
procedure TForm4.Button1StartDrag(Sender: TObject; var DragObject: TDragObject);
begin
Inc(Ctr);
DragObject := TMyDragObject.Create;
TMyDragObject(DragObject).Info := 'Item ' + IntToStr(Ctr);
end;
procedure TForm4.Memo1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
if IsDragObject(Source) then
begin
Memo1.Lines.Add(TMyDragObject(Source).Info);
Source.Free;
end;
end;
procedure TForm4.Memo1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept := IsDragObject(Source);
end;
As an alternative, inherit from TDragObjectEx, which is automatically freed at the end of the drop operation, according to the documentation.
Note: TDragObject is not automatically freed at the end of a drag
operation. To work with a drag object that is freed at the end of the
drag operation, use TDragObjectEx instead

right justify delphi stringgrid column but keep themed drawingstyle

I am using delphi 2010 for a project with a stringgrid. I want some columns of the grid to be right justified. I understand how I can do this with defaultdrawing set to false.
I would like, however, to keep the runtime theme shading for the grid, if possible. Is there a way to right justify a column with defaultdrawing enabled, or at least duplicate the code in the onDrawCell event to imitate the runtime theme shading?
you can use an interposer class and override the DrawCell method, check this sample
type
TStringGrid = class(Grids.TStringGrid)
protected
procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
end;
TForm79 = class(TForm)
StringGrid1: TStringGrid;
procedure FormCreate(Sender: TObject);
private
end;
var
Form79: TForm79;
implementation
{$R *.dfm}
{ TStringGrid }
procedure TStringGrid.DrawCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState);
var
s : string;
LDelta : integer;
begin
if (ACol=1) and (ARow>0) then
begin
s := Cells[ACol, ARow];
LDelta := ColWidths[ACol] - Canvas.TextWidth(s);
Canvas.TextRect(ARect, ARect.Left+LDelta, ARect.Top+2, s);
end
else
Canvas.TextRect(ARect, ARect.Left+2, ARect.Top+2, Cells[ACol, ARow]);
end;
procedure TForm79.FormCreate(Sender: TObject);
begin
StringGrid1.Cells[0,0]:='title 1';
StringGrid1.Cells[1,0]:='title 2';
StringGrid1.Cells[2,0]:='title 3';
StringGrid1.Cells[0,1]:='normal text';
StringGrid1.Cells[1,1]:='right text';
StringGrid1.Cells[2,1]:='normal text';
end;
And the result

Resources