paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 00:58:04 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: reset row's top and bottom bounds after drawing cell and fix merge cells example issue #34017

Browse Source 
git-svn-id: trunk@58711 -
This commit is contained in:
jesus 2018-08-15 08:07:10 +00:00
parent f2caf1009a
commit 824d21014a
2 changed files with 60 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -25,10 +25,9 @@ type
protected
procedure CalcCellExtent(ACol, ARow: Integer; var ARect: TRect); override;
procedure DoEditorShow; override;
procedure DrawAllRows; override;
procedure DrawCell(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); override;
procedure DrawCellText(ACol, ARow: Integer; ARect: TRect;
AState: TGridDrawState; AText: String); override;
procedure DrawFocusRect(ACol, ARow:Integer; ARect:TRect); override;
function GetCells(ACol, ARow: Integer): String; override;
function GetEditText(ACol, ARow: Integer): String; override;
function IsMerged(ACol, ARow: Integer): Boolean; overload;
@ -37,6 +36,7 @@ type
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;
published
property OnDrawCelLText: TDrawCellTextEvent read FOnDrawCellText write FOnDrawCellText;
property OnMergeCells: TMergeCellsEvent read FOnMergeCells write FOnMergeCells;
@ -48,15 +48,16 @@ implementation
{ Calculates the size of the merged block }
procedure TMCStringGrid.CalcCellExtent(ACol, ARow: Integer; var ARect: TRect);
var
L, T, R, B: Integer;
L, T, R, B, dummy: Integer;
begin
if IsMerged(ACol, ARow, L, T, R, B) then begin
ARect.TopLeft := CellRect(L, T).TopLeft;
ARect.BottomRight := CellRect(R, B).BottomRight;
end;
// Call the inherited procedure to handle non-merged cells
inherited;
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
@ -73,19 +74,15 @@ begin
end;
end;
{ Redraws the FocusRect after all cells have been painted. Otherwise the
FocusRect might not be complete }
procedure TMCStringGrid.DrawAllRows;
procedure TMCStringGrid.DrawCell(aCol, aRow: Integer; aRect: TRect;
aState: TGridDrawState);
var
L, T, R, B: Integer;
rct: TRect;
begin
inherited;
if FocusRectVisible and IsMerged(Col, Row, L, T, R, B) then begin
rct.TopLeft := CellRect(L, T).TopLeft;
rct.BottomRight := CellRect(R, B).BottomRight;
DrawFocusRect(L, T, rct);
end;
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
@ -102,14 +99,6 @@ begin
inherited;
end;
{ makes sure that the focus rect is drawn to enclose all cells of a
merged block }
procedure TMCStringGrid.DrawFocusRect(ACol, ARow: Integer; ARect: TRect);
begin
CalcCellExtent(ACol, ARow, ARect);
inherited DrawFocusRect(ACol, ARow, ARect);
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 TMCStringGrid.GetCells(ACol, ARow: Integer): String;
@ -173,8 +162,9 @@ end;
painted merged block }
procedure TMCStringGrid.MoveSelection;
begin
if SelectActive then
InvalidateGrid;
inherited;
InvalidateGrid;
end;
{ Makes sure that all cells of the merged block are drawn as selected/focused,
@ -204,6 +194,20 @@ begin
inherited SetEditText(ACol, ARow, Value);
end;
function TMCStringGrid.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;
end.

42
lcl/grids.pas
View File

@ -1098,7 +1098,7 @@ type
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
function MoveExtend(Relative: Boolean; DCol, DRow: Integer; ForceFullyVisible: Boolean = True): Boolean;
function MoveNextAuto(const Inverse: boolean): boolean;
function MoveNextSelectable(Relative:Boolean; DCol, DRow: Integer): Boolean;
function MoveNextSelectable(Relative:Boolean; DCol, DRow: Integer): Boolean; virtual;
procedure MoveSelection; virtual;
function OffsetToColRow(IsCol,Fisical:Boolean; Offset:Integer;
var Index,Rest:Integer): boolean;
@ -3434,13 +3434,12 @@ end;
function TCustomGrid.CellRect(ACol, ARow: Integer): TRect;
var
ok: Boolean;
dummy: Integer;
begin
ok := ColRowToOffset(True, True, ACol, Result.Left, Result.Right);
if ok then begin
if goColSpanning in Options then
CellExtent(ACol, ARow, Result, dummy);
ok := ColRowToOffSet(False,True, ARow, Result.Top, Result.Bottom);
ok := ColRowToOffSet(False, True, ARow, Result.Top, Result.Bottom);
if ok and (goColSpanning in Options) then
CalcCellExtent(ACol, ARow, Result);
end;
if not ok then
@ -4278,7 +4277,7 @@ end;
procedure TCustomGrid.DrawRow(aRow: Integer);
var
gds: TGridDrawState;
aCol, exCol: Integer;
aCol, exCol, orgTop, orgBottom: Integer;
Rs, colSpanning: Boolean;
R: TRect;
ClipArea: Trect;
@ -4307,6 +4306,8 @@ begin
// Upper and Lower bounds for this row
ColRowToOffSet(False, True, aRow, R.Top, R.Bottom);
orgTop := R.Top;
orgBottom := R.Bottom;
// is this row within the ClipRect?
ClipArea := Canvas.ClipRect;
if (R.Top>=R.Bottom) or not VerticalIntersect(R, ClipArea) then begin
@ -4332,8 +4333,11 @@ begin
gds := GetGridDrawState(ACol, ARow);
DoDrawCell;
if colSpanning then
if colSpanning then begin
aCol := exCol;
R.Top := orgTop;
R.Bottom := orgBottom;
end;
end;
inc(aCol);
end;
@ -4364,12 +4368,22 @@ begin
// Draw Fixed Columns
For aCol:=0 to FFixedCols-1 do begin
aCol := 0;
while aCol<=FFixedCols-1 do begin
gds:=[gdFixed];
ColRowToOffset(True, True, aCol, R.Left, R.Right);
// is this column within the ClipRect?
if (R.Left<R.Right) and HorizontalIntersect(R, ClipArea) then
if (R.Left<R.Right) and HorizontalIntersect(R, ClipArea) then begin
if colSpanning then
CellExtent(aCol, aRow, R, exCol);
DoDrawCell;
if colSpanning then begin
aCol := exCol;
R.Top := orgTop;
R.Bottom := orgBottom;
end;
end;
inc(aCol);
end;
end;
@ -7975,18 +7989,18 @@ procedure TCustomGrid.CellClick(const aCol, aRow: Integer; const Button:TMouseBu
begin
end;
procedure TCustomGrid.CellExtent(const aCol, aRow: Integer; var R: TRect;
out exCol: Integer);
procedure TCustomGrid.CellExtent(const aCol, aRow: Integer; var R: TRect; out
exCol: Integer);
var
Extent: TRect;
begin
Extent := R;
exCol := aCol;
CalcCellExtent(aCol, aRow, Extent);
CalcCellExtent(aCol, aRow, R);
// TODO: check RTL
while (exCol<=FGCache.VisibleGrid.Right) and (R.Right<Extent.Right) do begin
while (exCol<=FGCache.VisibleGrid.Right) and (Extent.Right<R.Right) do begin
inc(exCol);
ColRowToOffset(True, True, exCol, Extent.Left, R.Right);
ColRowToOffset(True, True, exCol, Extent.Left, Extent.Right);
end;
end;