mirror of
				https://gitlab.com/freepascal.org/lazarus/lazarus.git
				synced 2025-10-31 02:01:46 +01:00 
			
		
		
		
	LCL, grids, enable FastEditing for TCustomDrawGrid, added AllowOutboundEvents
implementation of Click in delphi compatible way from Graeme (with changes) git-svn-id: trunk@10989 -
This commit is contained in:
		
							parent
							
								
									39eb0d6ab9
								
							
						
					
					
						commit
						0456a590ff
					
				| @ -102,6 +102,7 @@ type | |||||||
|     goSmoothScroll,       // Switch scrolling mode (pixel scroll is by default) |     goSmoothScroll,       // Switch scrolling mode (pixel scroll is by default) | ||||||
|     goFixedRowNumbering,  // Ya |     goFixedRowNumbering,  // Ya | ||||||
|     goScrollKeepVisible   // keeps focused cell visible while scrolling |     goScrollKeepVisible   // keeps focused cell visible while scrolling | ||||||
|  |      | ||||||
|   ); |   ); | ||||||
|   TGridOptions = set of TGridOption; |   TGridOptions = set of TGridOption; | ||||||
| 
 | 
 | ||||||
| @ -570,6 +571,8 @@ type | |||||||
|     FGridFlags: TGridFlags; |     FGridFlags: TGridFlags; | ||||||
|     FGridPropBackup: TGridPropertyBackup; |     FGridPropBackup: TGridPropertyBackup; | ||||||
|     FStrictSort: boolean; |     FStrictSort: boolean; | ||||||
|  |     FIgnoreClick: boolean; | ||||||
|  |     FAllowOutboundEvents: boolean; | ||||||
|     procedure AdjustCount(IsColumn:Boolean; OldValue, NewValue:Integer); |     procedure AdjustCount(IsColumn:Boolean; OldValue, NewValue:Integer); | ||||||
|     procedure CacheVisibleGrid; |     procedure CacheVisibleGrid; | ||||||
|     procedure CancelSelection; |     procedure CancelSelection; | ||||||
| @ -674,6 +677,7 @@ type | |||||||
|     function  CanGridAcceptKey(Key: Word; Shift: TShiftState): Boolean; dynamic; |     function  CanGridAcceptKey(Key: Word; Shift: TShiftState): Boolean; dynamic; | ||||||
|     procedure CellClick(const aCol,aRow: Integer); virtual; |     procedure CellClick(const aCol,aRow: Integer); virtual; | ||||||
|     procedure CheckLimits(var aCol,aRow: Integer); |     procedure CheckLimits(var aCol,aRow: Integer); | ||||||
|  |     procedure CheckLimitsWithError(const aCol, aRow: Integer); | ||||||
|     procedure ColRowDeleted(IsColumn: Boolean; index: Integer); dynamic; |     procedure ColRowDeleted(IsColumn: Boolean; index: Integer); dynamic; | ||||||
|     procedure ColRowExchanged(IsColumn: Boolean; index,WithIndex: Integer); dynamic; |     procedure ColRowExchanged(IsColumn: Boolean; index,WithIndex: Integer); dynamic; | ||||||
|     procedure ColRowInserted(IsColumn: boolean; index: integer); dynamic; |     procedure ColRowInserted(IsColumn: boolean; index: integer); dynamic; | ||||||
| @ -688,6 +692,7 @@ type | |||||||
|     procedure CheckNewCachedSizes(var AGCache:TGridDataCache); virtual; |     procedure CheckNewCachedSizes(var AGCache:TGridDataCache); virtual; | ||||||
|     procedure CreateWnd; override; |     procedure CreateWnd; override; | ||||||
|     procedure CreateParams(var Params: TCreateParams); override; |     procedure CreateParams(var Params: TCreateParams); override; | ||||||
|  |     procedure Click; override; | ||||||
|     procedure DblClick; override; |     procedure DblClick; override; | ||||||
|     procedure DefineProperties(Filer: TFiler); override; |     procedure DefineProperties(Filer: TFiler); override; | ||||||
|     procedure DestroyHandle; override; |     procedure DestroyHandle; override; | ||||||
| @ -815,6 +820,7 @@ type | |||||||
|     procedure WMSetFocus(var message: TLMSetFocus); message LM_SETFOCUS; |     procedure WMSetFocus(var message: TLMSetFocus); message LM_SETFOCUS; | ||||||
|     procedure WndProc(var TheMessage : TLMessage); override; |     procedure WndProc(var TheMessage : TLMessage); override; | ||||||
| 
 | 
 | ||||||
|  |     property AllowOutboundEvents: boolean read FAllowOutboundEvents write FAllowOutboundEvents default true; | ||||||
|     property AlternateColor: TColor read FAlternateColor write SetAlternateColor stored IsAltColorStored; |     property AlternateColor: TColor read FAlternateColor write SetAlternateColor stored IsAltColorStored; | ||||||
|     property AutoAdvance: TAutoAdvance read FAutoAdvance write FAutoAdvance default aaRight; |     property AutoAdvance: TAutoAdvance read FAutoAdvance write FAutoAdvance default aaRight; | ||||||
|     property AutoFillColumns: boolean read FAutoFillColumns write SetAutoFillColumns; |     property AutoFillColumns: boolean read FAutoFillColumns write SetAutoFillColumns; | ||||||
| @ -971,6 +977,7 @@ type | |||||||
| 
 | 
 | ||||||
|     procedure DefaultDrawCell(aCol,aRow: Integer; var aRect: TRect; aState:TGridDrawState); virtual; |     procedure DefaultDrawCell(aCol,aRow: Integer; var aRect: TRect; aState:TGridDrawState); virtual; | ||||||
|     // properties |     // properties | ||||||
|  |     property AllowOutboundEvents; | ||||||
|     property BorderColor; |     property BorderColor; | ||||||
|     property Canvas; |     property Canvas; | ||||||
|     property Col; |     property Col; | ||||||
| @ -980,6 +987,7 @@ type | |||||||
|     property EditorMode; |     property EditorMode; | ||||||
|     property ExtendedColSizing; |     property ExtendedColSizing; | ||||||
|     property AltColorStartNormal; |     property AltColorStartNormal; | ||||||
|  |     property FastEditing; | ||||||
|     property FocusColor; |     property FocusColor; | ||||||
|     property FocusRectVisible; |     property FocusRectVisible; | ||||||
|     property GridHeight; |     property GridHeight; | ||||||
| @ -2005,13 +2013,19 @@ end; | |||||||
| procedure TCustomGrid.SetCol(AValue: Integer); | procedure TCustomGrid.SetCol(AValue: Integer); | ||||||
| begin | begin | ||||||
|   if AValue=FCol then Exit; |   if AValue=FCol then Exit; | ||||||
|  |   if not AllowOutboundEvents then | ||||||
|  |     CheckLimitsWithError(AValue, FRow); | ||||||
|   MoveExtend(False, AValue, FRow); |   MoveExtend(False, AValue, FRow); | ||||||
|  |   Click; | ||||||
| end; | end; | ||||||
| 
 | 
 | ||||||
| procedure TCustomGrid.SetRow(AValue: Integer); | procedure TCustomGrid.SetRow(AValue: Integer); | ||||||
| begin | begin | ||||||
|   if AValue=FRow then Exit; |   if AValue=FRow then Exit; | ||||||
|  |   if not AllowOutBoundEvents then | ||||||
|  |     CheckLimitsWithError(FCol, AValue); | ||||||
|   MoveExtend(False, FCol, AValue); |   MoveExtend(False, FCol, AValue); | ||||||
|  |   Click; | ||||||
| end; | end; | ||||||
| 
 | 
 | ||||||
| procedure TCustomGrid.Sort(ColSorting: Boolean; index, IndxFrom, IndxTo: Integer); | procedure TCustomGrid.Sort(ColSorting: Boolean; index, IndxFrom, IndxTo: Integer); | ||||||
| @ -2273,6 +2287,13 @@ begin | |||||||
|   end; |   end; | ||||||
| end; | end; | ||||||
| 
 | 
 | ||||||
|  | procedure TCustomGrid.Click; | ||||||
|  | begin | ||||||
|  |   {$IFDEF dbgGrid} DebugLn('FIgnoreClick=', dbgs(FIgnoreClick)); {$ENDIF} | ||||||
|  |   if not FIgnoreClick then | ||||||
|  |     inherited Click; | ||||||
|  | end; | ||||||
|  | 
 | ||||||
| procedure TCustomGrid.ScrollBarRange(Which: Integer; aRange,aPage: Integer); | procedure TCustomGrid.ScrollBarRange(Which: Integer; aRange,aPage: Integer); | ||||||
| var | var | ||||||
|   ScrollInfo: TScrollInfo; |   ScrollInfo: TScrollInfo; | ||||||
| @ -3424,7 +3445,7 @@ procedure TCustomGrid.CheckIndex(IsColumn: Boolean; Index: Integer); | |||||||
| begin | begin | ||||||
|   if (IsColumn and ((Index<0) or (Index>ColCount-1))) or |   if (IsColumn and ((Index<0) or (Index>ColCount-1))) or | ||||||
|      (not IsColumn and ((Index<0) or (Index>RowCount-1))) then |      (not IsColumn and ((Index<0) or (Index>RowCount-1))) then | ||||||
|     raise EGridException.Create('Index out of range'); |     raise EGridException.Create(rsGridIndexOutOfRange); | ||||||
| end; | end; | ||||||
| 
 | 
 | ||||||
| function TCustomGrid.CheckTopLeft(aCol,aRow: Integer; CheckCols, CheckRows: boolean): boolean; | function TCustomGrid.CheckTopLeft(aCol,aRow: Integer; CheckCols, CheckRows: boolean): boolean; | ||||||
| @ -4024,16 +4045,18 @@ var | |||||||
|   aBorderWidth: Integer; |   aBorderWidth: Integer; | ||||||
| begin | begin | ||||||
|   aBorderWidth := GetBorderWidth; |   aBorderWidth := GetBorderWidth; | ||||||
|   if X<FGCache.FixedWidth+aBorderWidth then |   if X<FGCache.FixedWidth+aBorderWidth then begin | ||||||
|  |     // in fixedwidth zone | ||||||
|     if Y<FGcache.FixedHeight+aBorderWidth then |     if Y<FGcache.FixedHeight+aBorderWidth then | ||||||
|       Result:=gzFixedCells |       Result:= gzFixedCells | ||||||
|     else |     else | ||||||
|     if RowCount>FixedRows then |     if RowCount>FixedRows then | ||||||
|         Result:=gzFixedRows |       Result:= gzFixedRows | ||||||
|     else |     else | ||||||
|         Result:=gzInvalid |       Result:= gzInvalid | ||||||
|   else |   end | ||||||
|   if Y<FGCache.FixedHeight+aBorderWidth then |   else if Y<FGCache.FixedHeight+aBorderWidth then begin | ||||||
|  |     // if fixedheight zone | ||||||
|     if X<FGCache.FixedWidth+aBorderWidth then |     if X<FGCache.FixedWidth+aBorderWidth then | ||||||
|       Result:=gzFixedCells |       Result:=gzFixedCells | ||||||
|     else |     else | ||||||
| @ -4041,9 +4064,15 @@ begin | |||||||
|       Result:=gzFixedCols |       Result:=gzFixedCols | ||||||
|     else |     else | ||||||
|       Result:=gzInvalid |       Result:=gzInvalid | ||||||
|   else |   end | ||||||
|     if not fixedGrid then |   else if not FixedGrid then begin | ||||||
|  |     // in normal cell zone (though, might be outbounds) | ||||||
|  |     if AllowOutboundEvents or | ||||||
|  |       ((X<=FGCache.GridWidth) and (Y<=FGCache.GridHeight)) then | ||||||
|       result := gzNormal |       result := gzNormal | ||||||
|  |     else | ||||||
|  |       result := gzInvalid | ||||||
|  |   end | ||||||
|   else |   else | ||||||
|     result := gzInvalid; |     result := gzInvalid; | ||||||
| end; | end; | ||||||
| @ -4190,7 +4219,20 @@ begin | |||||||
| 
 | 
 | ||||||
|   {$IfDef dbgGrid} DebugLn('MouseDown INIT'); {$Endif} |   {$IfDef dbgGrid} DebugLn('MouseDown INIT'); {$Endif} | ||||||
| 
 | 
 | ||||||
|  |   FIgnoreClick := True; | ||||||
|   Gz:=MouseToGridZone(X,Y); |   Gz:=MouseToGridZone(X,Y); | ||||||
|  | 
 | ||||||
|  |   {$IFDEF dbgGrid} | ||||||
|  |   DebugOut('Mouse was in '); | ||||||
|  |   case Gz of | ||||||
|  |     gzFixedCells: DebugLn('gzFixedCells'); | ||||||
|  |     gzFixedCols:  DebugLn('gzFixedCols'); | ||||||
|  |     gzFixedRows:  DebugLn('gzFixedRows'); | ||||||
|  |     gzNormal:     DebugLn('gzNormal'); | ||||||
|  |     gzInvalid:    DebugLn('gzInvalid'); | ||||||
|  |   end; | ||||||
|  |   {$ENDIF} | ||||||
|  | 
 | ||||||
|   case Gz of |   case Gz of | ||||||
|     gzFixedCols: |     gzFixedCols: | ||||||
|       begin |       begin | ||||||
| @ -4222,6 +4264,7 @@ begin | |||||||
|        |        | ||||||
|     gzNormal: |     gzNormal: | ||||||
|       begin |       begin | ||||||
|  |         FIgnoreClick := False; | ||||||
|         WasFocused := Focused; |         WasFocused := Focused; | ||||||
|         if not WasFocused then |         if not WasFocused then | ||||||
|           SetFocus; |           SetFocus; | ||||||
| @ -4638,8 +4681,11 @@ var | |||||||
|     FGCache.TLColOff:=0; |     FGCache.TLColOff:=0; | ||||||
|     FGCache.TLRowOff:=0; |     FGCache.TLRowOff:=0; | ||||||
|     SelectActive:=Sh; |     SelectActive:=Sh; | ||||||
|     MoveNextSelectable(Rel, aCol, aRow); |     if MoveNextSelectable(Rel, aCol, aRow) then | ||||||
|     Key:=0; |     begin | ||||||
|  |       Key := 0; | ||||||
|  |       Click; | ||||||
|  |     end; | ||||||
|   end; |   end; | ||||||
| begin | begin | ||||||
|   {$ifdef dbgGrid}DebugLn('Grid.KeyDown INIT Key=',IntToStr(Key));{$endif} |   {$ifdef dbgGrid}DebugLn('Grid.KeyDown INIT Key=',IntToStr(Key));{$endif} | ||||||
| @ -5070,6 +5116,14 @@ begin | |||||||
|   if aRow>RowCount-1 then aRow:=RowCount-1; |   if aRow>RowCount-1 then aRow:=RowCount-1; | ||||||
| end; | 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 | // This procedure checks if cursor cell position is allowed | ||||||
| // if not it tries to find a suitable position based on | // if not it tries to find a suitable position based on | ||||||
| // AutoAdvance and SelectCell. | // AutoAdvance and SelectCell. | ||||||
| @ -6159,7 +6213,7 @@ begin | |||||||
|   Editor:=nil; |   Editor:=nil; | ||||||
|   FBorderColor := cl3DDKShadow; |   FBorderColor := cl3DDKShadow; | ||||||
|   BorderStyle := bsSingle; |   BorderStyle := bsSingle; | ||||||
| 
 |   FIgnoreClick := False; | ||||||
| 
 | 
 | ||||||
|   ParentColor := False; |   ParentColor := False; | ||||||
|   Color:=clWindow; |   Color:=clWindow; | ||||||
| @ -6187,6 +6241,7 @@ begin | |||||||
| 
 | 
 | ||||||
|   FFastEditing := True; |   FFastEditing := True; | ||||||
|   TabStop := True; |   TabStop := True; | ||||||
|  |   FAllowOutboundEvents:=True; | ||||||
| end; | end; | ||||||
| 
 | 
 | ||||||
| destructor TCustomGrid.Destroy; | destructor TCustomGrid.Destroy; | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user
	 jesus
						jesus