Forum > LCL

[CLOSED] Component invalidate

(1/2) > >>

pcurtis:
How can I make my simple stringgrid descendant auto invalidate when a cells value changes?


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit MyStringGrid; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, LResources, Forms, Windows, Controls, Graphics, StdCtrls, ExtCtrls,  Dialogs, Grids; type  TMyStringGrid = class(TStringGrid)  private    fLeftColWidth : Integer;    procedure SetLeftColWidth(aValue : Integer);  protected   public    constructor Create(AOwner : TComponent); override;    destructor Destroy; override;  published    property LeftColWidth : Integer read fLeftColWidth write SetLeftColWidth;  end; procedure Register; implementation {$R mystringgrid.res} constructor TMyStringGrid.Create(AOwner : TComponent);begin  inherited Create(AOwner);  AlternateColor := clMoneyGreen;  Color := clCream;  fLeftColWidth := 20;  ColWidths[0] := fLeftColWidth;  RowCount := 1;  ColCount := 3;  AutoFillColumns := True;end; destructor TMyStringGrid.Destroy;begin  inherited Destroy;end; procedure TMyStringGrid.SetLeftColWidth(aValue : Integer);begin  if fLeftColWidth <> aValue then    begin      fLeftColWidth := aValue;      ColWidths[0] := fLeftColWidth;    end;  Invalidate;end; procedure Register;begin  RegisterComponents('Misc',[TMyStringGrid]);end; end.  

Handoko:
This is how I will do it:


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, StdCtrls, Grids; type   { TForm1 }   TForm1 = class(TForm)    Button1: TButton;    procedure Button1Click(Sender: TObject);    procedure FormCreate(Sender: TObject);  private    FStringGrid: TStringGrid;  end; type   { TMyStringGrid }   TMyStringGrid = class(TStringGrid)  private    fLeftColWidth: Integer;    fOrgEditingDown: TNotifyEvent;    procedure SetLeftColWidth(aValue: Integer);    procedure NewEditingDown(Sender: TObject);  public    constructor Create(AOwner : TComponent); override;    destructor Destroy; override;  published    property LeftColWidth : Integer read fLeftColWidth write SetLeftColWidth;  end; var  Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.Button1Click(Sender: TObject);begin  if Assigned(FStringGrid) then Exit;  Button1.Visible := False;  FStringGrid     := TMyStringGrid.Create(Self);  with FStringGrid do  begin    Parent   := Self;    Anchors  := [akLeft, akRight, akTop, akBottom];    Options  := Options + [goEditing];    RowCount := 5;    SetBounds(10, 10, Form1.Width - 20, Form1.Height - 20);  end;end; procedure TForm1.FormCreate(Sender: TObject);begin  FStringGrid := nil;end; { TMyStringGrid } procedure TMyStringGrid.SetLeftColWidth(aValue: Integer);begin  if fLeftColWidth <> aValue then  begin    fLeftColWidth := aValue;    ColWidths[0]  := fLeftColWidth;  end;  Invalidate;end; procedure TMyStringGrid.NewEditingDown(Sender: TObject);begin  AlternateColor := Random($FFFFFF);  Invalidate;  if Assigned(fOrgEditingDown) then    fOrgEditingDown(Sender);end; constructor TMyStringGrid.Create(AOwner: TComponent);begin  inherited Create(AOwner);  fOrgEditingDown := OnEditingDone;  OnEditingDone   := @NewEditingDown;  AlternateColor  := clMoneyGreen;  Color           := clCream;  fLeftColWidth   := 20;  ColWidths[0]    := fLeftColWidth;  RowCount        := 1;  ColCount        := 3;  AutoFillColumns := True;end; destructor TMyStringGrid.Destroy;begin  inherited Destroy;end; 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 #83In the example above, I change the alternate color randomly if user change any cell's value, see line #82.

pcurtis:
OK, that's clear but I want to invalidate if a cell is changed programmatically.

pcurtis:
OK. Problem solved. Just needed to override invalidate.
I don't understand why, but it works.


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit MyStringGrid; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Graphics, Grids; type  TDrawCellTextEvent = procedure (Sender : TObject; aCol, aRow : Integer;    aRect : TRect; aState : TGridDrawState; aText : String;    var Handled: Boolean) of object;   TMergeCellsEvent = procedure (Sender: TObject; aCol, aRow : Integer;    var aLeft, aTop, aRight, aBottom: Integer) of object;   TMyStringGrid = class(TStringGrid)  private    fLeftColWidth : Integer;    fMergeLock : Integer;    fOnMergeCells : TMergeCellsEvent;    fOnDrawCellText : TDrawCellTextEvent;    procedure SetLeftColWidth(aValue : Integer);  protected    procedure CalcCellExtent(aCol, aRow : Integer; var aRect : TRect); override;    procedure DoEditorShow; override;    procedure DrawCell(aCol, aRow : Integer; aRect : TRect; aState : TGridDrawState); override;    procedure DrawCellText(aCol, aRow : Integer; aRect : TRect;      aState : TGridDrawState; aText : String); override;    function GetCells(aCol, aRow : Integer) : String; override;    function GetEditText(aCol, aRow : Integer) : String; override;    function IsMerged(aCol, aRow : Integer) : Boolean; overload;    function IsMerged(aCol, aRow : Integer;      out ALeft, ATop, ARight, ABottom: Integer): Boolean; overload;    procedure MoveSelection; override;    procedure PrepareCanvas(aCol, aRow: Integer; AState: TGridDrawState); override;    procedure SetEditText(aCol, aRow : LongInt; const Value : String); override;    function  MoveNextSelectable(Relative : Boolean; dCol, dRow : Integer) : Boolean; override;  public    procedure Invalidate; override;    constructor Create(AOwner : TComponent); override;  published    property LeftColWidth : Integer read fLeftColWidth write SetLeftColWidth;    property OnDrawCelLText : TDrawCellTextEvent read fOnDrawCellText write fOnDrawCellText;    property OnMergeCells : TMergeCellsEvent read fOnMergeCells write fOnMergeCells;  end; procedure Register; implementation {$R mystringgrid.res} constructor TMyStringGrid.Create(AOwner : TComponent);begin  inherited Create(AOwner);  AlternateColor := clMoneyGreen;  Color := clCream;  fLeftColWidth := 20;  ColWidths[0] := fLeftColWidth;  RowCount := 5;  ColCount := 3;  AutoFillColumns := True;  end; procedure TMyStringGrid.Invalidate;begin  inherited;end; procedure TMyStringGrid.SetLeftColWidth(aValue : Integer);begin  if fLeftColWidth <> aValue then    begin      fLeftColWidth := aValue;      ColWidths[0] := fLeftColWidth;    end;  Invalidate;end; { Calculates the size of the merged block }procedure TMyStringGrid.CalcCellExtent(aCol, aRow : Integer; var aRect: TRect);var  L, T, R, B, dummy: Integer;begin  if IsMerged(aCol, aRow, L, T, R, B) then    begin      ColRowToOffset(True, True, L, aRect.Left, dummy);      ColRowToOffset(True, True, R, dummy, aRect.Right);      ColRowToOffset(False, True, T, aRect.Top, dummy);      ColRowToOffset(False, True, B, dummy, aRect.Bottom);    end  else    // Call the inherited procedure to handle non-merged cells    inherited;end; { Make sure that the cell editor of a merged block is the same size as the  merged block }procedure TMyStringGrid.DoEditorShow;var  R : TRect;begin  inherited;  if (goColSpanning in Options) and Assigned(Editor) then    begin      R := CellRect(Col, Row);      CalcCellExtent(Col, Row, R);      Editor.SetBounds(R.Left, R.Top, R.Right - R.Left - 1, R.Bottom - R.Top - 1);  end;end; procedure TMyStringGrid.DrawCell(aCol, aRow : Integer; aRect : TRect;  aState : TGridDrawState);var  L, T, R, B : Integer;begin  if IsMerged(aCol, aRow, L, T, R, B) and ((aCol <> L) or (aRow <> T)) then    // nothing to draw  else    inherited DrawCell(aCol, aRow, aRect, aState);end; { Draws the cell text. Allows to hook in an external painting routine which  will replace the built-in painting routine if it sets "Handled" to true. }procedure TMyStringGrid.DrawCellText(aCol, aRow : Integer; aRect : TRect;  aState: TGridDrawState; aText: String);var  Handled: Boolean;begin  Handled := False;  if Assigned(fOnDrawCellText) then    fOnDrawCellText(Self, aCol, aRow, aRect, aState, aText, Handled);  if not Handled then    inherited;end; { Returns the string to be displayed in the specified cell. In case of a merged  block only the text assigned to the top-left cell of the block is used. }function TMyStringGrid.GetCells(aCol, aRow: Integer) : String;var  L, T, R, B: Integer;begin  if (fMergeLock = 0) and IsMerged(aCol, aRow, L, T, R, B) then    Result := inherited GetCells(L, T)  else    Result := inherited GetCells(aCol, aRow);end; { Make sure to use only the topleft cell of a merged block for editing }function TMyStringGrid.GetEditText(aCol, aRow: Integer) : String;begin  Result := GetCells(aCol, aRow);  if Assigned(OnGetEditText) then    OnGetEditText(Self, aCol, aRow, Result);end; { Check whether the specified cell belongs to a merged block}function TMyStringGrid.IsMerged(aCol, aRow : Integer) : Boolean;var  L, T, R, B: Integer;begin  Result := IsMerged(ACol, ARow, L, T, R, B);end; { Checks whether the specified cell belongs to a merged block and returns the  cell coordinate of the block extent }function TMyStringGrid.IsMerged(aCol, aRow : Integer;  out aLeft, aTop, aRight, aBottom: Integer) : Boolean;var  tmp: Integer;begin  Result := False;  if not (goColSpanning in Options) then    Exit;  if not Assigned(fOnMergeCells) then    Exit;  inc(fMergeLock);   aLeft := aCol;  aRight := aCol;  aTop := aRow;  aBottom := aRow;  fOnMergeCells(Self, aCol, aRow, aLeft, aTop, aRight, aBottom);  if aLeft > aRight then    begin      tmp := aLeft;      aLeft := aRight;      aRight := tmp;  end;  if aTop > aBottom then    begin      tmp := aTop;      aTop := aBottom;      aBottom := tmp;  end;  Result := (aLeft <> aRight) or (aTop <> aBottom);  dec(fMergeLock);end; { Repaints the entire grid after the selection is moved because normally only  the selected cell would be painted, and this would result in an imcompletely  painted merged block }procedure TMyStringGrid.MoveSelection;begin  if SelectActive then    InvalidateGrid;  inherited;end; { Makes sure that all cells of the merged block are drawn as selected/focused,  not just the active cell }procedure TMyStringGrid.PrepareCanvas(aCol, aRow : Integer;  aState : TGridDrawState);var  L, T, R, B : Integer;begin  if IsMerged(aCol, aRow, L, T, R, B) and    (Col >= L) and (Col <= R) and (Row >= T) and (Row <= B) and    not ((aCol = Col) and (aRow = Row)) then      aState := aState + [gdSelected, gdFocused];  inherited;   if aCol = 0 then    begin      Canvas.Font.Color := clPurple;      Canvas.Font.Style := [fsBold];    end;end; { Writes the edited text back into the grid. Makes sure that, in case of a  merged block, the edited text is assigned to the top/left cell }procedure TMyStringGrid.SetEditText(aCol, aRow : LongInt; const Value : String);var  L, T, R, B: Integer;begin  if IsMerged(aCol, aRow, L, T, R, B) then    inherited SetEditText(L, T, Value)  else    inherited SetEditText(aCol, aRow, Value);end; function TMyStringGrid.MoveNextSelectable(Relative : Boolean; dCol, dRow : Integer  ): Boolean;var  L, T, R, B: Integer;begin  if Relative and IsMerged(Col, Row, L, T, R, B) then    begin      // we are only interested on relative movement (basically by keyboard)      if dCol > 0 then dCol := R - Col + 1 else      if dCol < 0 then dCol := L - Col - 1 else      if dRow > 0 then dRow := B - Row + 1 else      if dRow < 0 then dRow := T - Row - 1;  end;  Result := inherited MoveNextSelectable(Relative, dCol, dRow);end; procedure Register;begin  RegisterComponents('Misc',[TMyStringGrid]);end; end.  

wp:

--- Quote from: pcurtis on December 08, 2021, 10:40:13 am ---OK. Problem solved. Just needed to override invalidate.
I don't understand why, but it works.

--- End quote ---
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.

Navigation

[0] Message Index

[#] Next page

Go to full version