Recent

Author Topic: [CLOSED] Component invalidate  (Read 2889 times)

pcurtis

  • Hero Member
  • *****
  • Posts: 857
[CLOSED] Component invalidate
« on: December 04, 2021, 03:54:23 pm »
How can I make my simple stringgrid descendant auto invalidate when a cells value changes?

Code: Pascal  [Select][+][-]
  1. unit MyStringGrid;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, LResources, Forms, Windows, Controls, Graphics, StdCtrls, ExtCtrls,
  9.   Dialogs, Grids;
  10.  
  11. type
  12.   TMyStringGrid = class(TStringGrid)
  13.   private
  14.     fLeftColWidth : Integer;
  15.     procedure SetLeftColWidth(aValue : Integer);
  16.   protected
  17.  
  18.   public
  19.     constructor Create(AOwner : TComponent); override;
  20.     destructor Destroy; override;
  21.   published
  22.     property LeftColWidth : Integer read fLeftColWidth write SetLeftColWidth;
  23.   end;
  24.  
  25. procedure Register;
  26.  
  27. implementation
  28.  
  29. {$R mystringgrid.res}
  30.  
  31. constructor TMyStringGrid.Create(AOwner : TComponent);
  32. begin
  33.   inherited Create(AOwner);
  34.   AlternateColor := clMoneyGreen;
  35.   Color := clCream;
  36.   fLeftColWidth := 20;
  37.   ColWidths[0] := fLeftColWidth;
  38.   RowCount := 1;
  39.   ColCount := 3;
  40.   AutoFillColumns := True;
  41. end;
  42.  
  43. destructor TMyStringGrid.Destroy;
  44. begin
  45.   inherited Destroy;
  46. end;
  47.  
  48. procedure TMyStringGrid.SetLeftColWidth(aValue : Integer);
  49. begin
  50.   if fLeftColWidth <> aValue then
  51.     begin
  52.       fLeftColWidth := aValue;
  53.       ColWidths[0] := fLeftColWidth;
  54.     end;
  55.   Invalidate;
  56. end;
  57.  
  58. procedure Register;
  59. begin
  60.   RegisterComponents('Misc',[TMyStringGrid]);
  61. end;
  62.  
  63. end.
  64.  
  65.  
« Last Edit: December 08, 2021, 10:50:24 am by pcurtis »
Windows 10 20H2
Laz 2.2.0
FPC 3.2.2

Handoko

  • Hero Member
  • *****
  • Posts: 4431
  • My goal: build my own game engine using Lazarus
Re: Component invalidate
« Reply #1 on: December 08, 2021, 09:48:39 am »
This is how I will do it:

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, StdCtrls, Grids;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     Button1: TButton;
  16.     procedure Button1Click(Sender: TObject);
  17.     procedure FormCreate(Sender: TObject);
  18.   private
  19.     FStringGrid: TStringGrid;
  20.   end;
  21.  
  22. type
  23.  
  24.   { TMyStringGrid }
  25.  
  26.   TMyStringGrid = class(TStringGrid)
  27.   private
  28.     fLeftColWidth: Integer;
  29.     fOrgEditingDown: TNotifyEvent;
  30.     procedure SetLeftColWidth(aValue: Integer);
  31.     procedure NewEditingDown(Sender: TObject);
  32.   public
  33.     constructor Create(AOwner : TComponent); override;
  34.     destructor Destroy; override;
  35.   published
  36.     property LeftColWidth : Integer read fLeftColWidth write SetLeftColWidth;
  37.   end;
  38.  
  39. var
  40.   Form1: TForm1;
  41.  
  42. implementation
  43.  
  44. {$R *.lfm}
  45.  
  46. { TForm1 }
  47.  
  48. procedure TForm1.Button1Click(Sender: TObject);
  49. begin
  50.   if Assigned(FStringGrid) then Exit;
  51.   Button1.Visible := False;
  52.   FStringGrid     := TMyStringGrid.Create(Self);
  53.   with FStringGrid do
  54.   begin
  55.     Parent   := Self;
  56.     Anchors  := [akLeft, akRight, akTop, akBottom];
  57.     Options  := Options + [goEditing];
  58.     RowCount := 5;
  59.     SetBounds(10, 10, Form1.Width - 20, Form1.Height - 20);
  60.   end;
  61. end;
  62.  
  63. procedure TForm1.FormCreate(Sender: TObject);
  64. begin
  65.   FStringGrid := nil;
  66. end;
  67.  
  68. { TMyStringGrid }
  69.  
  70. procedure TMyStringGrid.SetLeftColWidth(aValue: Integer);
  71. begin
  72.   if fLeftColWidth <> aValue then
  73.   begin
  74.     fLeftColWidth := aValue;
  75.     ColWidths[0]  := fLeftColWidth;
  76.   end;
  77.   Invalidate;
  78. end;
  79.  
  80. procedure TMyStringGrid.NewEditingDown(Sender: TObject);
  81. begin
  82.   AlternateColor := Random($FFFFFF);
  83.   Invalidate;
  84.   if Assigned(fOrgEditingDown) then
  85.     fOrgEditingDown(Sender);
  86. end;
  87.  
  88. constructor TMyStringGrid.Create(AOwner: TComponent);
  89. begin
  90.   inherited Create(AOwner);
  91.   fOrgEditingDown := OnEditingDone;
  92.   OnEditingDone   := @NewEditingDown;
  93.   AlternateColor  := clMoneyGreen;
  94.   Color           := clCream;
  95.   fLeftColWidth   := 20;
  96.   ColWidths[0]    := fLeftColWidth;
  97.   RowCount        := 1;
  98.   ColCount        := 3;
  99.   AutoFillColumns := True;
  100. end;
  101.  
  102. destructor TMyStringGrid.Destroy;
  103. begin
  104.   inherited Destroy;
  105. end;
  106.  
  107. end.
  • Set the OnEditingDown event, see line #92 and #80
  • But store the original OnEditingDown event first, see line #91
  • Call invalidate inside the NewEditingDown, see line #83
In the example above, I change the alternate color randomly if user change any cell's value, see line #82.

pcurtis

  • Hero Member
  • *****
  • Posts: 857
Re: Component invalidate
« Reply #2 on: December 08, 2021, 10:17:31 am »
OK, that's clear but I want to invalidate if a cell is changed programmatically.
Windows 10 20H2
Laz 2.2.0
FPC 3.2.2

pcurtis

  • Hero Member
  • *****
  • Posts: 857
Re: Component invalidate
« Reply #3 on: December 08, 2021, 10:40:13 am »
OK. Problem solved. Just needed to override invalidate.
I don't understand why, but it works.

Code: Pascal  [Select][+][-]
  1. unit MyStringGrid;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Graphics, Grids;
  9.  
  10. type
  11.   TDrawCellTextEvent = procedure (Sender : TObject; aCol, aRow : Integer;
  12.     aRect : TRect; aState : TGridDrawState; aText : String;
  13.     var Handled: Boolean) of object;
  14.  
  15.   TMergeCellsEvent = procedure (Sender: TObject; aCol, aRow : Integer;
  16.     var aLeft, aTop, aRight, aBottom: Integer) of object;
  17.  
  18.   TMyStringGrid = class(TStringGrid)
  19.   private
  20.     fLeftColWidth : Integer;
  21.     fMergeLock : Integer;
  22.     fOnMergeCells : TMergeCellsEvent;
  23.     fOnDrawCellText : TDrawCellTextEvent;
  24.     procedure SetLeftColWidth(aValue : Integer);
  25.   protected
  26.     procedure CalcCellExtent(aCol, aRow : Integer; var aRect : TRect); override;
  27.     procedure DoEditorShow; override;
  28.     procedure DrawCell(aCol, aRow : Integer; aRect : TRect; aState : TGridDrawState); override;
  29.     procedure DrawCellText(aCol, aRow : Integer; aRect : TRect;
  30.       aState : TGridDrawState; aText : String); override;
  31.     function GetCells(aCol, aRow : Integer) : String; override;
  32.     function GetEditText(aCol, aRow : Integer) : String; override;
  33.     function IsMerged(aCol, aRow : Integer) : Boolean; overload;
  34.     function IsMerged(aCol, aRow : Integer;
  35.       out ALeft, ATop, ARight, ABottom: Integer): Boolean; overload;
  36.     procedure MoveSelection; override;
  37.     procedure PrepareCanvas(aCol, aRow: Integer; AState: TGridDrawState); override;
  38.     procedure SetEditText(aCol, aRow : LongInt; const Value : String); override;
  39.     function  MoveNextSelectable(Relative : Boolean; dCol, dRow : Integer) : Boolean; override;
  40.   public
  41.     procedure Invalidate; override;
  42.     constructor Create(AOwner : TComponent); override;
  43.   published
  44.     property LeftColWidth : Integer read fLeftColWidth write SetLeftColWidth;
  45.     property OnDrawCelLText : TDrawCellTextEvent read fOnDrawCellText write fOnDrawCellText;
  46.     property OnMergeCells : TMergeCellsEvent read fOnMergeCells write fOnMergeCells;
  47.   end;
  48.  
  49. procedure Register;
  50.  
  51. implementation
  52.  
  53. {$R mystringgrid.res}
  54.  
  55. constructor TMyStringGrid.Create(AOwner : TComponent);
  56. begin
  57.   inherited Create(AOwner);
  58.   AlternateColor := clMoneyGreen;
  59.   Color := clCream;
  60.   fLeftColWidth := 20;
  61.   ColWidths[0] := fLeftColWidth;
  62.   RowCount := 5;
  63.   ColCount := 3;
  64.   AutoFillColumns := True;  
  65. end;
  66.  
  67. procedure TMyStringGrid.Invalidate;
  68. begin
  69.   inherited;
  70. end;
  71.  
  72. procedure TMyStringGrid.SetLeftColWidth(aValue : Integer);
  73. begin
  74.   if fLeftColWidth <> aValue then
  75.     begin
  76.       fLeftColWidth := aValue;
  77.       ColWidths[0] := fLeftColWidth;
  78.     end;
  79.   Invalidate;
  80. end;
  81.  
  82. { Calculates the size of the merged block }
  83. procedure TMyStringGrid.CalcCellExtent(aCol, aRow : Integer; var aRect: TRect);
  84. var
  85.   L, T, R, B, dummy: Integer;
  86. begin
  87.   if IsMerged(aCol, aRow, L, T, R, B) then
  88.     begin
  89.       ColRowToOffset(True, True, L, aRect.Left, dummy);
  90.       ColRowToOffset(True, True, R, dummy, aRect.Right);
  91.       ColRowToOffset(False, True, T, aRect.Top, dummy);
  92.       ColRowToOffset(False, True, B, dummy, aRect.Bottom);
  93.     end
  94.   else
  95.     // Call the inherited procedure to handle non-merged cells
  96.     inherited;
  97. end;
  98.  
  99. { Make sure that the cell editor of a merged block is the same size as the
  100.   merged block }
  101. procedure TMyStringGrid.DoEditorShow;
  102. var
  103.   R : TRect;
  104. begin
  105.   inherited;
  106.   if (goColSpanning in Options) and Assigned(Editor) then
  107.     begin
  108.       R := CellRect(Col, Row);
  109.       CalcCellExtent(Col, Row, R);
  110.       Editor.SetBounds(R.Left, R.Top, R.Right - R.Left - 1, R.Bottom - R.Top - 1);
  111.   end;
  112. end;
  113.  
  114. procedure TMyStringGrid.DrawCell(aCol, aRow : Integer; aRect : TRect;
  115.   aState : TGridDrawState);
  116. var
  117.   L, T, R, B : Integer;
  118. begin
  119.   if IsMerged(aCol, aRow, L, T, R, B) and ((aCol <> L) or (aRow <> T)) then
  120.     // nothing to draw
  121.   else
  122.     inherited DrawCell(aCol, aRow, aRect, aState);
  123. end;
  124.  
  125. { Draws the cell text. Allows to hook in an external painting routine which
  126.   will replace the built-in painting routine if it sets "Handled" to true. }
  127. procedure TMyStringGrid.DrawCellText(aCol, aRow : Integer; aRect : TRect;
  128.   aState: TGridDrawState; aText: String);
  129. var
  130.   Handled: Boolean;
  131. begin
  132.   Handled := False;
  133.   if Assigned(fOnDrawCellText) then
  134.     fOnDrawCellText(Self, aCol, aRow, aRect, aState, aText, Handled);
  135.   if not Handled then
  136.     inherited;
  137. end;
  138.  
  139. { Returns the string to be displayed in the specified cell. In case of a merged
  140.   block only the text assigned to the top-left cell of the block is used. }
  141. function TMyStringGrid.GetCells(aCol, aRow: Integer) : String;
  142. var
  143.   L, T, R, B: Integer;
  144. begin
  145.   if (fMergeLock = 0) and IsMerged(aCol, aRow, L, T, R, B) then
  146.     Result := inherited GetCells(L, T)
  147.   else
  148.     Result := inherited GetCells(aCol, aRow);
  149. end;
  150.  
  151. { Make sure to use only the topleft cell of a merged block for editing }
  152. function TMyStringGrid.GetEditText(aCol, aRow: Integer) : String;
  153. begin
  154.   Result := GetCells(aCol, aRow);
  155.   if Assigned(OnGetEditText) then
  156.     OnGetEditText(Self, aCol, aRow, Result);
  157. end;
  158.  
  159. { Check whether the specified cell belongs to a merged block}
  160. function TMyStringGrid.IsMerged(aCol, aRow : Integer) : Boolean;
  161. var
  162.   L, T, R, B: Integer;
  163. begin
  164.   Result := IsMerged(ACol, ARow, L, T, R, B);
  165. end;
  166.  
  167. { Checks whether the specified cell belongs to a merged block and returns the
  168.   cell coordinate of the block extent }
  169. function TMyStringGrid.IsMerged(aCol, aRow : Integer;
  170.   out aLeft, aTop, aRight, aBottom: Integer) : Boolean;
  171. var
  172.   tmp: Integer;
  173. begin
  174.   Result := False;
  175.   if not (goColSpanning in Options) then
  176.     Exit;
  177.   if not Assigned(fOnMergeCells) then
  178.     Exit;
  179.   inc(fMergeLock);
  180.  
  181.   aLeft := aCol;
  182.   aRight := aCol;
  183.   aTop := aRow;
  184.   aBottom := aRow;
  185.   fOnMergeCells(Self, aCol, aRow, aLeft, aTop, aRight, aBottom);
  186.   if aLeft > aRight then
  187.     begin
  188.       tmp := aLeft;
  189.       aLeft := aRight;
  190.       aRight := tmp;
  191.   end;
  192.   if aTop > aBottom then
  193.     begin
  194.       tmp := aTop;
  195.       aTop := aBottom;
  196.       aBottom := tmp;
  197.   end;
  198.   Result := (aLeft <> aRight) or (aTop <> aBottom);
  199.   dec(fMergeLock);
  200. end;
  201.  
  202. { Repaints the entire grid after the selection is moved because normally only
  203.   the selected cell would be painted, and this would result in an imcompletely
  204.   painted merged block }
  205. procedure TMyStringGrid.MoveSelection;
  206. begin
  207.   if SelectActive then
  208.     InvalidateGrid;
  209.   inherited;
  210. end;
  211.  
  212. { Makes sure that all cells of the merged block are drawn as selected/focused,
  213.   not just the active cell }
  214. procedure TMyStringGrid.PrepareCanvas(aCol, aRow : Integer;
  215.   aState : TGridDrawState);
  216. var
  217.   L, T, R, B : Integer;
  218. begin
  219.   if IsMerged(aCol, aRow, L, T, R, B) and
  220.     (Col >= L) and (Col <= R) and (Row >= T) and (Row <= B) and
  221.     not ((aCol = Col) and (aRow = Row)) then
  222.       aState := aState + [gdSelected, gdFocused];
  223.   inherited;
  224.  
  225.   if aCol = 0 then
  226.     begin
  227.       Canvas.Font.Color := clPurple;
  228.       Canvas.Font.Style := [fsBold];
  229.     end;
  230. end;
  231.  
  232. { Writes the edited text back into the grid. Makes sure that, in case of a
  233.   merged block, the edited text is assigned to the top/left cell }
  234. procedure TMyStringGrid.SetEditText(aCol, aRow : LongInt; const Value : String);
  235. var
  236.   L, T, R, B: Integer;
  237. begin
  238.   if IsMerged(aCol, aRow, L, T, R, B) then
  239.     inherited SetEditText(L, T, Value)
  240.   else
  241.     inherited SetEditText(aCol, aRow, Value);
  242. end;
  243.  
  244. function TMyStringGrid.MoveNextSelectable(Relative : Boolean; dCol, dRow : Integer
  245.   ): Boolean;
  246. var
  247.   L, T, R, B: Integer;
  248. begin
  249.   if Relative and IsMerged(Col, Row, L, T, R, B) then
  250.     begin
  251.       // we are only interested on relative movement (basically by keyboard)
  252.       if dCol > 0 then dCol := R - Col + 1 else
  253.       if dCol < 0 then dCol := L - Col - 1 else
  254.       if dRow > 0 then dRow := B - Row + 1 else
  255.       if dRow < 0 then dRow := T - Row - 1;
  256.   end;
  257.   Result := inherited MoveNextSelectable(Relative, dCol, dRow);
  258. end;
  259.  
  260. procedure Register;
  261. begin
  262.   RegisterComponents('Misc',[TMyStringGrid]);
  263. end;
  264.  
  265. end.
  266.  
  267.  
Windows 10 20H2
Laz 2.2.0
FPC 3.2.2

wp

  • Hero Member
  • *****
  • Posts: 9175
Re: Component invalidate
« Reply #4 on: December 08, 2021, 10:58:12 am »
OK. Problem solved. Just needed to override invalidate.
I don't understand why, but it works.
I am rather sure that this was not the solution, and it just hides the real cause of the issue. Please prepare a simple demo project and upload it here along with the unit of the new grid. The grid should be created at runtime so that I would not be forced to install your component.
Mainly Lazarus trunk / fpc 3.2.0 / all 32-bit on Win-10, but many more...

pcurtis

  • Hero Member
  • *****
  • Posts: 857
Re: [CLOSED] Component invalidate
« Reply #5 on: December 08, 2021, 11:18:52 am »
Your right, something else has changed. I'll look.
Windows 10 20H2
Laz 2.2.0
FPC 3.2.2

 

TinyPortal © 2005-2018