paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-10 14:36:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

Examples: Fix merged_cells grid example crashing if OnMergeCells event handler needs cell content (Cells[]).

Browse Source 
git-svn-id: trunk@53086 -
This commit is contained in:
wp 2016-10-09 17:46:47 +00:00
parent 821eb9c465
commit 738cf3bc30
3 changed files with 14 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
examples/gridexamples/merged_cells/mainform.pas
View File

@ -48,6 +48,7 @@ begin
Grid.Cells[3, 1] := 'abc'; Grid.Cells[3, 1] := 'abc';
Grid.Cells[4, 1] := 'bold'; Grid.Cells[4, 1] := 'bold';
Grid.Cells[5, 1] := 'Image'; Grid.Cells[5, 1] := 'Image';
Grid.Cells[2, 7] := 'Image';
Grid.Cells[2, 3] := 'This is a long text' + LineEnding + 'with line break.'; Grid.Cells[2, 3] := 'This is a long text' + LineEnding + 'with line break.';
Grid.Cells[0, 2] := 'Vertical text'; Grid.Cells[0, 2] := 'Vertical text';
Grid.Cells[0, 6] := 'Centered'; Grid.Cells[0, 6] := 'Centered';
@ -152,6 +153,15 @@ begin
if (ACol = 0) and (ARow in [2..5]) then begin if (ACol = 0) and (ARow in [2..5]) then begin
ATop := 2; ATop := 2;
ABottom := 5; ABottom := 5;
end else
// Merge the next two cells adjacent to cell with text 'Image'
if (ACol > 1) and (Grid.Cells[ACol-1, ARow] = 'Image') then begin
ALeft := ACol;
ARight := ALeft + 1;
end else
if (ACol > 2) and (Grid.Cells[ACol-2, ARow] = 'Image') then begin
ALeft := ACol - 1;
ARight := ALeft + 1;
end; end;
end; end;

5
examples/gridexamples/merged_cells/mcgrid.pas
View File

@ -19,6 +19,7 @@ type
TMCStringGrid = class(TStringGrid) TMCStringGrid = class(TStringGrid)
private private
FMergeLock: Integer;
FOnMergeCells: TMergeCellsEvent; FOnMergeCells: TMergeCellsEvent;
FOnDrawCellText: TDrawCellTextEvent; FOnDrawCellText: TDrawCellTextEvent;
protected protected
@ -114,7 +115,7 @@ function TMCStringGrid.GetCells(ACol, ARow: Integer): String;
var var
L, T, R, B: Integer; L, T, R, B: Integer;
begin begin
if IsMerged(ACol, ARow, L, T, R, B) then if (FMergeLock = 0) and IsMerged(ACol, ARow, L, T, R, B) then
Result := inherited GetCells(L, T) Result := inherited GetCells(L, T)
else else
Result := inherited GetCells(ACol, ARow); Result := inherited GetCells(ACol, ARow);
@ -145,6 +146,7 @@ begin
Result := false; Result := false;
if not (goColSpanning in Options) then exit; if not (goColSpanning in Options) then exit;
if not Assigned(FOnMergeCells) then exit; if not Assigned(FOnMergeCells) then exit;
inc(FMergeLock);
ALeft := ACol; ALeft := ACol;
ARight := ACol; ARight := ACol;
@ -162,6 +164,7 @@ begin
ABottom := tmp; ABottom := tmp;
end; end;
Result := (ALeft <> ARight) or (ATop <> ABottom); Result := (ALeft <> ARight) or (ATop <> ABottom);
dec(FMergeLock);
end; end;
{ Repaints the entire grid after the selection is moved because normally only { Repaints the entire grid after the selection is moved because normally only

1
examples/gridexamples/merged_cells/mergedcells_project.lpi
View File

@ -9,7 +9,6 @@
<Title Value="mergedcells_project"/> <Title Value="mergedcells_project"/>
<ResourceType Value="res"/> <ResourceType Value="res"/>
<UseXPManifest Value="True"/> <UseXPManifest Value="True"/>
<Icon Value="0"/>
</General> </General>
<BuildModes Count="1"> <BuildModes Count="1">
<Item1 Name="Default" Default="True"/> <Item1 Name="Default" Default="True"/>