On 4/20/07, Graeme Geldenhuys <[EMAIL PROTECTED]> wrote:
> A quick test revels that clicking fixed cells or empty grid area
> triggers click in lazarus but not in turbo delphi.
>
Ah, never thought of clicking on the fixed cells! This is why multiple
OK, hopefully this patch will do the trick. Below is a list of
changes and bug fixed for TCustomGrid.
* Click event fires when clicking in cells
* Click event fires only once when selecting a range of cells
* Clicking of fixed rows or columns doesn't cause Click event to fire.
* Clicking outside the cell range (grid background) doesn't cause
Click to fire (delphi compatible)
* BUG fix: clicking outside the cell range doesn't cause the cell
focus to change (delphi compatible)
* Using keyboard navigation inside the gird causes Click to fire,
until focus rectangle reaches the grid range limits. No error will be
raised and no Click will fire at that point.
* Setting Row property cause Click to fire (delphi compatible)
* Setting Col property causes Click to fire (delphi compatible)
* Setting Row or Col out of range raises an "Grid index out of range."
error and doesn't change the cell focus. (delphi compatible). See
note below!
* Replaced error strings with resourcesting constants (the localize
script needs to be run to update other language files).
* MouseToGridZone - added Begin..End pairs to improve clarity to you
can actually see what if/else fits where.
Note:
Setting the Row or Col out of range. I believe Delphi has a bug here.
In delphi you can set the Row or Col to a fixed row or column, which
then causes a Click event, but then the focus is screwed. We can
decide at a later date what to do in the LCL - for now Click events
will fire, but the focus cell will be the first non-fixed cell.
--
Graeme Geldenhuys
There's no place like S34° 03.168' E018° 49.342'
Index: lcl/lclstrconsts.pas
===================================================================
--- lcl/lclstrconsts.pas (revision 10987)
+++ lcl/lclstrconsts.pas (working copy)
@@ -165,6 +165,7 @@
rsGridFileDoesNotExists = 'Grid file doesn''t exists';
rsNotAValidGridFile = 'Not a valid grid file';
rsIndexOutOfRange = 'Index Out of range Cell[Col=%d Row=%d]';
+ rsGridIndexOutOfRange = 'Grid index out of range.';
rsERRORInLCL = 'ERROR in LCL: ';
rsCreatingGdbCatchableError = 'Creating gdb catchable error:';
rsAControlCanNotHaveItselfAsParent = 'A control can''t have itself as parent';
Index: lcl/grids.pas
===================================================================
--- lcl/grids.pas (revision 10987)
+++ lcl/grids.pas (working copy)
@@ -570,6 +570,7 @@
FGridFlags: TGridFlags;
FGridPropBackup: TGridPropertyBackup;
FStrictSort: boolean;
+ FIgnoreClick: boolean;
procedure AdjustCount(IsColumn:Boolean; OldValue, NewValue:Integer);
procedure CacheVisibleGrid;
procedure CancelSelection;
@@ -674,6 +675,7 @@
function CanGridAcceptKey(Key: Word; Shift: TShiftState): Boolean; dynamic;
procedure CellClick(const aCol,aRow: Integer); virtual;
procedure CheckLimits(var aCol,aRow: Integer);
+ procedure CheckLimitsWithError(const aCol, aRow: Integer);
procedure ColRowDeleted(IsColumn: Boolean; index: Integer); dynamic;
procedure ColRowExchanged(IsColumn: Boolean; index,WithIndex: Integer); dynamic;
procedure ColRowInserted(IsColumn: boolean; index: integer); dynamic;
@@ -688,6 +690,7 @@
procedure CheckNewCachedSizes(var AGCache:TGridDataCache); virtual;
procedure CreateWnd; override;
procedure CreateParams(var Params: TCreateParams); override;
+ procedure Click; override;
procedure DblClick; override;
procedure DefineProperties(Filer: TFiler); override;
procedure DestroyHandle; override;
@@ -2005,13 +2008,17 @@
procedure TCustomGrid.SetCol(AValue: Integer);
begin
if AValue=FCol then Exit;
+ CheckLimitsWithError(AValue, FRow);
MoveExtend(False, AValue, FRow);
+ Click;
end;
procedure TCustomGrid.SetRow(AValue: Integer);
begin
if AValue=FRow then Exit;
+ CheckLimitsWithError(FCol, AValue);
MoveExtend(False, FCol, AValue);
+ Click;
end;
procedure TCustomGrid.Sort(ColSorting: Boolean; index, IndxFrom, IndxTo: Integer);
@@ -2273,6 +2280,13 @@
end;
end;
+procedure TCustomGrid.Click;
+begin
+ {$IFDEF dbgGrid} writeln('FIgnoreClick=' + BoolToStr(FIgnoreClick, True)); {$ENDIF}
+ if not FIgnoreClick then
+ inherited Click;
+end;
+
procedure TCustomGrid.ScrollBarRange(Which: Integer; aRange,aPage: Integer);
var
ScrollInfo: TScrollInfo;
@@ -3424,7 +3438,7 @@
begin
if (IsColumn and ((Index<0) or (Index>ColCount-1))) or
(not IsColumn and ((Index<0) or (Index>RowCount-1))) then
- raise EGridException.Create('Index out of range');
+ raise EGridException.Create(rsGridIndexOutOfRange);
end;
function TCustomGrid.CheckTopLeft(aCol,aRow: Integer; CheckCols, CheckRows: boolean): boolean;
@@ -4019,33 +4033,67 @@
end;
end;
+// DebugLn()'s are for debugging to indicate which IF statement was selected.
function TCustomGrid.MouseToGridZone(X, Y: Integer): TGridZone;
var
aBorderWidth: Integer;
begin
aBorderWidth := GetBorderWidth;
if X<FGCache.FixedWidth+aBorderWidth then
+ begin
if Y<FGcache.FixedHeight+aBorderWidth then
- Result:=gzFixedCells
+ begin
+// DebugLn('1');
+ Result:=gzFixedCells;
+ end
else
+ begin
if RowCount>FixedRows then
- Result:=gzFixedRows
+ begin
+// DebugLn('2');
+ Result:=gzFixedRows;
+ end
else
- Result:=gzInvalid
- else
- if Y<FGCache.FixedHeight+aBorderWidth then
+ begin
+// DebugLn('3');
+ Result:=gzInvalid;
+ end;
+ end;
+ end
+ else if Y<FGCache.FixedHeight+aBorderWidth then
+ begin
if X<FGCache.FixedWidth+aBorderWidth then
- Result:=gzFixedCells
+ begin
+// DebugLn('4');
+ Result:=gzFixedCells;
+ end
else
+ begin
if ColCount>FixedCols then
- Result:=gzFixedCols
+ begin
+// DebugLn('5');
+ Result:=gzFixedCols;
+ end
else
- Result:=gzInvalid
+ begin
+// DebugLn('6');
+ Result:=gzInvalid;
+ end;
+ end;
+ end
+ else if not FixedGrid then
+ begin
+// DebugLn('7');
+ if (X > FGCache.GridWidth) or (Y > FGCache.GridHeight) then
+ result := gzInvalid
+ else
+ result := gzNormal;
+ end
else
- if not fixedGrid then
- result := gzNormal
- else
- result := gzInvalid;
+ begin
+// DebugLn('8');
+ result := gzInvalid;
+ end;
end;
function TCustomGrid.CellToGridZone(aCol, aRow: Integer): TGridZone;
@@ -4190,8 +4238,20 @@
{$IfDef dbgGrid} DebugLn('MouseDown INIT'); {$Endif}
+ FIgnoreClick := True;
Gz:=MouseToGridZone(X,Y);
+
+ {$IFDEF dbgGrid}
case Gz of
+ gzFixedCells: DebugLn('gzFixedCells');
+ gzFixedCols: DebugLn('gzFixedCols');
+ gzFixedRows: DebugLn('gzFixedRows');
+ gzNormal: DebugLn('gzNormal');
+ gzInvalid: DebugLn('gzInvalid');
+ end;
+ {$ENDIF}
+
+ case Gz of
gzFixedCols:
begin
if (goColSizing in Options)and(Cursor=crHSplit) then begin
@@ -4222,6 +4282,7 @@
gzNormal:
begin
+ FIgnoreClick := False;
WasFocused := Focused;
if not WasFocused then
SetFocus;
@@ -4638,8 +4699,11 @@
FGCache.TLColOff:=0;
FGCache.TLRowOff:=0;
SelectActive:=Sh;
- MoveNextSelectable(Rel, aCol, aRow);
- Key:=0;
+ if MoveNextSelectable(Rel, aCol, aRow) then
+ begin
+ Key := 0;
+ Click;
+ end;
end;
begin
{$ifdef dbgGrid}DebugLn('Grid.KeyDown INIT Key=',IntToStr(Key));{$endif}
@@ -5070,6 +5134,14 @@
if aRow>RowCount-1 then aRow:=RowCount-1;
end;
+// We don't want to do this inside CheckLimits() because keyboard handling
+// shouldn't raise an error whereas setting the Row or Col property it should.
+procedure TCustomGrid.CheckLimitsWithError(const aCol, aRow: Integer);
+begin
+ if (aCol < 0) or (aRow < 0) or (aCol >= ColCount) or (aRow >= RowCount) then
+ raise EGridException.Create(rsGridIndexOutOfRange);
+end;
+
// This procedure checks if cursor cell position is allowed
// if not it tries to find a suitable position based on
// AutoAdvance and SelectCell.
@@ -6159,8 +6231,8 @@
Editor:=nil;
FBorderColor := cl3DDKShadow;
BorderStyle := bsSingle;
+ FIgnoreClick := False;
-
ParentColor := False;
Color:=clWindow;
FAlternateColor := Color;
