98
101
goFixedRowNumbering, // Ya
99
102
goScrollKeepVisible, // keeps focused cell visible while scrolling
100
103
goHeaderHotTracking, // Header cells change look when mouse is over them
101
goHeaderPushedLook // Header cells looks pushed when clicked
104
goHeaderPushedLook, // Header cells looks pushed when clicked
105
goSelectionActive, // Setting grid.Selection moves also cell cursor
106
goFixedColSizing, // Allow to resize fixed columns
107
goDontScrollPartCell, // clicking partially visible cells will not scroll
108
goCellHints, // show individual cell hints
109
goTruncCellHints, // show cell hints if cell text is too long
110
goCellEllipsis // show "..." if cell text is too long
103
112
TGridOptions = set of TGridOption;
137
146
TGridFlagsOption = (gfEditorUpdateLock, gfNeedsSelectActive, gfEditorTab,
138
147
gfRevEditorTab, gfVisualChange, gfDefRowHeightChanged, gfColumnsLocked,
139
gfEditingDone, gfSizingStarted);
148
gfEditingDone, gfSizingStarted, gfPainting, gfUpdatingSize);
140
149
TGridFlags = set of TGridFlagsOption;
142
151
TSortOrder = (soAscending, soDescending);
153
TPrefixOption = (poNone, poHeaderClick);
155
TMouseWheelOption = (mwCursor, mwGrid);
157
TCellHintPriority = (chpAll, chpAllNoDefault, chpTruncOnly);
158
// The grid can display three types of hint: the default hint (Hint property),
159
// individual cell hints (OnCellHint event), and hints for truncated cells.
160
// TCellHintPriority determines how the overall hint is combined when more
161
// multiple hint texts are to be displayed.
145
164
soAll: TSaveOptions = [soDesign, soAttributes, soContent, soPosition];
146
165
constRubberSpace: byte = 2;
194
213
procedure msg_SetGrid(var Msg: TGridMessage); message GM_SETGRID;
195
214
procedure msg_SelectAll(var Msg: TGridMessage); message GM_SELECTALL;
196
215
procedure msg_SetPos(var Msg: TGridMessage); message GM_SETPOS;
216
procedure msg_GetGrid(var Msg: TGridMessage); message GM_GETGRID;
198
218
constructor Create(Aowner : TComponent); override;
199
219
procedure EditingDone; override;
211
231
procedure msg_SetBounds(var Msg: TGridMessage); message GM_SETBOUNDS;
212
232
procedure msg_SetPos(var Msg: TGridMessage); message GM_SETPOS;
213
233
procedure msg_Ready(var Msg: TGridMessage); message GM_READY;
234
procedure msg_GetGrid(var Msg: TGridMessage); message GM_GETGRID;
215
236
property Col: Integer read FCol;
216
237
property Row: Integer read FRow;
233
254
procedure msg_SetGrid(var Msg: TGridMessage); message GM_SETGRID;
234
255
procedure msg_SetValue(var Msg: TGridMessage); message GM_SETVALUE;
235
256
procedure msg_SetPos(var Msg: TGridMessage); message GM_SETPOS;
257
procedure msg_GetGrid(var Msg: TGridMessage); message GM_GETGRID;
237
259
procedure EditingDone; override;
238
260
property BorderStyle;
254
276
FEditors: array of TEditorItem;
255
277
procedure DispatchMsg(msg: TGridMessage);
256
278
function GetActiveControl: TWinControl;
279
function GetMaxLength: Integer;
280
procedure SetMaxLength(AValue: Integer);
258
282
function DoUTF8KeyPress(var UTF8Key: TUTF8Char): boolean; override;
259
283
procedure msg_GetValue(var Msg: TGridMessage); message GM_GETVALUE;
264
288
procedure msg_SelectAll(var Msg: TGridMessage); message GM_SELECTALL;
265
289
procedure CMControlChange(var Message: TLMEssage); message CM_CONTROLCHANGE;
266
290
procedure msg_SetPos(var Msg: TGridMessage); message GM_SETPOS;
291
procedure msg_GetGrid(var Msg: TGridMessage); message GM_GETGRID;
267
292
procedure VisibleChanging; override;
268
293
function SendChar(AChar: TUTF8Char): Integer;
269
294
procedure WndProc(var TheMessage : TLMessage); override;
271
296
destructor Destroy; override;
272
297
procedure AddEditor(aEditor: TWinControl; aAlign: TAlign; ActiveCtrl:boolean);
273
298
procedure SetFocus; override;
299
property MaxLength: Integer read GetMaxLength write SetMaxLength;
319
345
THeaderSizingEvent = procedure(sender: TObject; const IsColumn: boolean;
320
346
const aIndex, aSize: Integer) of object;
348
TGetCellHintEvent = procedure (Sender: TObject; ACol, ARow: Integer;
349
var HintText: String) of object;
324
353
TVirtualGrid=class
368
397
FAlignment: ^TAlignment;
370
399
FImageIndex: Integer;
400
FOldImageIndex: Integer;
371
401
FImageLayout: TButtonLayout;
372
402
FIsDefaultTitleFont: boolean;
373
403
FLayout: ^TTextLayout;
404
FPrefixOption: TPrefixOption;
374
405
procedure FontChanged(Sender: TObject);
375
406
function GetAlignment: TAlignment;
376
407
function GetCaption: string;
388
419
procedure SetImageIndex(const AValue: Integer);
389
420
procedure SetImageLayout(const AValue: TButtonLayout);
390
421
procedure SetLayout(const AValue: TTextLayout);
422
procedure SetPrefixOption(const AValue: TPrefixOption);
391
423
property IsDefaultFont: boolean read FIsDefaultTitleFont;
393
425
function GetDefaultCaption: string; virtual;
408
440
property Caption: TCaption read GetCaption write SetCaption stored IsCaptionStored;
409
441
property Color: TColor read GetColor write SetColor stored IsColorStored;
410
442
property Font: TFont read GetFont write SetFont stored IsFontStored;
411
property ImageIndex: Integer read FImageIndex write SetImageIndex default 0;
443
property ImageIndex: Integer read FImageIndex write SetImageIndex default -1;
412
444
property ImageLayout: TButtonLayout read FImageLayout write SetImageLayout default blGlyphRight;
413
445
property Layout: TTextLayout read GetLayout write SetLayout stored IsLayoutStored;
446
property PrefixOption: TPrefixOption read FPrefixOption write SetPrefixOption default poNone;
432
465
FPickList: TStrings;
433
466
FMinSize, FMaxSize, FSizePriority: ^Integer;
434
467
FValueChecked,FValueUnchecked: PChar;
436
469
procedure FontChanged(Sender: TObject);
437
470
function GetAlignment: TAlignment;
438
471
function GetColor: TColor;
518
551
property PickList: TStrings read GetPickList write SetPickList;
519
552
property ReadOnly: Boolean read GetReadOnly write SetReadOnly stored IsReadOnlyStored;
520
553
property SizePriority: Integer read GetSizePriority write SetSizePriority stored IsSizePriorityStored default 1;
554
property Tag: Integer read FTag write FTag default 0;
521
555
property Title: TGridColumnTitle read FTitle write SetTitle;
522
556
property Width: Integer read GetWidth write SetWidth stored IsWidthStored default DEFCOLWIDTH;
523
557
property Visible: Boolean read GetVisible write SetVisible stored IsVisibleStored default true;
608
642
PushedMouse: TPoint; // mouse Coords of the cell being pushed
609
643
ClickCellPushed: boolean; // Header Cell is currently pushed?
610
644
FullVisibleGrid: TRect; // visible cells excluding partially visible cells
645
MouseCell: TPoint; // Cell which contains the mouse
636
671
FOnUserCheckboxBitmap: TUserCheckboxBitmapEvent;
637
672
FSortOrder: TSortOrder;
673
FSortColumn: Integer;
638
674
FTitleImageList: TImageList;
639
675
FTitleStyle: TTitleStyle;
677
FDescImgInd: Integer;
640
678
FOnCompareCells: TOnCompareCells;
641
679
FGridLineStyle: TPenStyle;
642
680
FGridLineWidth: Integer;
643
681
FDefColWidth, FDefRowHeight: Integer;
644
682
FCol,FRow, FFixedCols, FFixedRows: Integer;
645
683
FOnEditButtonClick: TNotifyEvent;
684
FOnButtonClick: TOnSelectEvent;
646
685
FOnPickListSelect: TNotifyEvent;
647
686
FOnCheckboxToggled: TToggledCheckboxEvent;
648
687
FOnPrepareCanvas: TOnPrepareCanvasEvent;
687
726
FStrictSort: boolean;
688
727
FIgnoreClick: boolean;
689
728
FAllowOutboundEvents: boolean;
729
FColumnClickSorts: boolean;
690
730
FHeaderHotZones: TGridZoneSet;
691
731
FHeaderPushZones: TGridZoneSet;
692
732
FCheckedBitmap, FUnCheckedBitmap, FGrayedBitmap: TBitmap;
693
733
FSavedCursor: TCursor;
694
734
FSizing: TSizingRec;
735
FRowAutoInserted: Boolean;
736
FMouseWheelOption: TMouseWheelOption;
738
FCellHintPriority: TCellHintPriority;
739
FOnGetCellHint: TGetCellHintEvent;
695
740
procedure AdjustCount(IsColumn:Boolean; OldValue, NewValue:Integer);
696
741
procedure CacheVisibleGrid;
697
742
procedure CancelSelection;
706
751
procedure SetAlternateColor(const AValue: TColor);
707
752
procedure SetAutoFillColumns(const AValue: boolean);
708
753
procedure SetBorderColor(const AValue: TColor);
754
procedure SetColumnClickSorts(const AValue: boolean);
709
755
procedure SetColumns(const AValue: TGridColumns);
710
756
procedure SetEditorOptions(const AValue: Integer);
711
757
procedure SetEditorBorderStyle(const AValue: TBorderStyle);
806
852
procedure AutoAdjustColumn(aCol: Integer); virtual;
807
853
procedure BeforeMoveSelection(const DCol,DRow: Integer); virtual;
808
854
function BoxRect(ALeft,ATop,ARight,ABottom: Longint): TRect;
855
procedure CacheMouseDown(const X,Y:Integer);
809
856
procedure CalcAutoSizeColumn(const Index: Integer; var AMin,AMax,APriority: Integer); virtual;
810
857
procedure CalcFocusRect(var ARect: TRect);
858
function CalcMaxTopLeft: TPoint;
859
procedure CalcScrollbarsRange;
811
860
function CanEditShow: Boolean; virtual;
812
861
function CanGridAcceptKey(Key: Word; Shift: TShiftState): Boolean; virtual;
813
862
procedure CellClick(const aCol,aRow: Integer; const Button:TMouseButton); virtual;
814
863
procedure CheckLimits(var aCol,aRow: Integer);
815
864
procedure CheckLimitsWithError(const aCol, aRow: Integer);
865
procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED;
866
procedure CMMouseEnter(var Message: TLMessage); message CM_MOUSEENTER;
816
867
procedure CMMouseLeave(var Message :TLMessage); message CM_MouseLeave;
817
868
procedure ColRowDeleted(IsColumn: Boolean; index: Integer); virtual;
818
869
procedure ColRowExchanged(IsColumn: Boolean; index,WithIndex: Integer); virtual;
832
883
procedure DblClick; override;
833
884
procedure DefineProperties(Filer: TFiler); override;
834
885
procedure DestroyHandle; override;
886
function DialogChar(var Message: TLMKey): boolean; override;
835
887
function DoCompareCells(Acol,ARow,Bcol,BRow: Integer): Integer; virtual;
836
888
procedure DoCopyToClipboard; virtual;
837
889
procedure DoCutToClipboard; virtual;
840
892
procedure DoEditorShow; virtual;
841
893
procedure DoExit; override;
842
894
procedure DoEnter; override;
895
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
843
896
function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
844
897
function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
845
898
procedure DoOnChangeBounds; override;
885
938
function FixedGrid: boolean;
886
939
procedure FontChanged(Sender: TObject); override;
887
940
procedure GetAutoFillColumnInfo(const Index: Integer; var aMin,aMax,aPriority: Integer); virtual;
941
function GetCellHintText(ACol, ARow: Integer): string; virtual;
888
942
function GetCells(ACol, ARow: Integer): string; virtual;
889
943
function GetColumnAlignment(Column: Integer; ForTitle: Boolean): TAlignment;
890
944
function GetColumnColor(Column: Integer; ForTitle: Boolean): TColor;
901
955
function GetDefaultColumnTitle(Column: Integer): string; virtual;
902
956
function GetDefaultEditor(Column: Integer): TWinControl; virtual;
903
957
function GetDefaultRowHeight: integer; virtual;
958
function GetGridDrawState(ACol, ARow: Integer): TGridDrawState;
904
959
function GetImageForCheckBox(const aCol,aRow: Integer;
905
960
CheckBoxView: TCheckBoxState): TBitmap; virtual;
906
961
function GetScrollBarPosition(Which: integer): Integer;
916
971
function GetLastVisibleColumn: Integer;
917
972
function GetLastVisibleRow: Integer;
918
973
function GetSelectedColor: TColor; virtual;
974
function GetTitleShowPrefix(Column: Integer): boolean;
975
function GetTruncCellHintText(ACol, ARow: Integer): string; virtual;
919
976
function GridColumnFromColumnIndex(ColumnIndex: Integer): Integer;
920
977
procedure GridMouseWheel(shift: TShiftState; Delta: Integer); virtual;
921
978
procedure HeaderClick(IsColumn: Boolean; index: Integer); virtual;
922
979
procedure HeaderSized(IsColumn: Boolean; index: Integer); virtual;
923
980
procedure HeaderSizing(const IsColumn:boolean; const AIndex,ASize:Integer); virtual;
981
procedure HideCellHintWindow;
924
982
procedure InternalSetColCount(ACount: Integer);
925
983
procedure InvalidateCell(aCol, aRow: Integer; Redraw: Boolean); overload;
926
984
procedure InvalidateFromCol(ACol: Integer);
933
991
procedure LoadContent(cfg: TXMLConfig; Version: Integer); virtual;
934
992
procedure Loaded; override;
935
993
procedure LockEditor;
994
function MouseButtonAllowed(Button: TMouseButton): boolean; virtual;
936
995
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
937
procedure MouseMove(Shift: TShiftState; X,Y: Integer);override;
996
procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
938
997
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
939
998
function MoveExtend(Relative: Boolean; DCol, DRow: Integer): Boolean;
940
999
function MoveNextAuto(const Inverse: boolean): boolean;
945
1004
procedure Paint; override;
946
1005
procedure PickListItemSelected(Sender: TObject);
947
1006
procedure PrepareCanvas(aCol,aRow: Integer; aState:TGridDrawState); virtual;
1007
procedure PrepareCellHints(ACol, ARow: Integer); virtual;
948
1008
procedure ResetEditor;
949
1009
procedure ResetOffset(chkCol, ChkRow: Boolean);
950
1010
procedure ResetSizes; virtual;
968
1028
procedure SetFixedcolor(const AValue: TColor); virtual;
969
1029
procedure SetFixedCols(const AValue: Integer); virtual;
970
1030
procedure SetSelectedColor(const AValue: TColor); virtual;
1031
procedure ShowCellHintWindow(APoint: TPoint);
971
1032
procedure SizeChanged(OldColCount, OldRowCount: Integer); virtual;
972
1033
procedure Sort(ColSorting: Boolean; index,IndxFrom,IndxTo:Integer); virtual;
973
1034
procedure TopLeftChanged; virtual;
974
1035
function TryMoveSelection(Relative: Boolean; var DCol, DRow: Integer): Boolean;
975
1036
procedure UnLockEditor;
1037
procedure UnprepareCellHints; virtual;
976
1038
procedure UpdateHorzScrollBar(const aVisible: boolean; const aRange,aPage,aPos: Integer); virtual;
977
1039
procedure UpdateSelectionRange;
978
1040
procedure UpdateVertScrollbar(const aVisible: boolean; const aRange,aPage,aPos: Integer); virtual;
992
1054
property AutoFillColumns: boolean read FAutoFillColumns write SetAutoFillColumns default false;
993
1055
property BorderStyle:TBorderStyle read FGridBorderStyle write SetBorderStyle default bsSingle;
994
1056
property BorderColor: TColor read FBorderColor write SetBorderColor default cl3DDKShadow;
1057
property CellHintPriority: TCellHintPriority read FCellHintPriority write FCellHintPriority default chpTruncOnly;
995
1058
property Col: Integer read FCol write SetCol;
996
1059
property ColCount: Integer read GetColCount write SetColCount default 5;
1060
property ColumnClickSorts: boolean read FColumnClickSorts write SetColumnClickSorts default false;
997
1061
property Columns: TGridColumns read GetColumns write SetColumns stored IsColumnsStored;
998
1062
property ColWidths[aCol: Integer]: Integer read GetColWidths write SetColWidths;
999
1063
property DefaultColWidth: Integer read FDefColWidth write SetDefColWidth default DEFCOLWIDTH;
1032
1096
property InplaceEditor: TWinControl read FEditor;
1033
1097
property IsCellSelected[aCol,aRow: Integer]: boolean read GetIsCellSelected;
1034
1098
property LeftCol:Integer read GetLeftCol write SetLeftCol;
1099
property MouseWheelOption: TMouseWheelOption read FMouseWheelOption write FMouseWheelOption default mwCursor;
1035
1100
property Options: TGridOptions read FOptions write SetOptions default
1036
1101
[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect,
1037
1102
goSmoothScroll ];
1057
1122
property OnCompareCells: TOnCompareCells read FOnCompareCells write FOnCompareCells;
1058
1123
property OnPrepareCanvas: TOnPrepareCanvasEvent read FOnPrepareCanvas write FOnPrepareCanvas;
1059
1124
property OnDrawCell: TOnDrawCell read FOnDrawCell write FOnDrawCell;
1060
property OnEditButtonClick: TNotifyEvent read FOnEditButtonClick write FOnEditButtonClick;
1125
// Deprecated in favor of OnButtonClick.
1126
property OnEditButtonClick: TNotifyEvent read FOnEditButtonClick write FOnEditButtonClick; deprecated;
1127
property OnButtonClick: TOnSelectEvent read FOnButtonClick write FOnButtonClick;
1061
1128
property OnPickListSelect: TNotifyEvent read FOnPickListSelect write FOnPickListSelect;
1062
1129
property OnSelection: TOnSelectEvent read fOnSelection write fOnSelection;
1063
1130
property OnSelectEditor: TSelectEditorEvent read FOnSelectEditor write FOnSelectEditor;
1068
1135
function FlipRect(ARect: TRect): TRect;
1069
1136
function FlipPoint(P: TPoint): TPoint;
1070
1137
function FlipX(X: Integer): Integer;
1139
property OnGetCellHint : TGetCellHintEvent read FOnGetCellHint write FOnGetCellHint;
1073
1142
constructor Create(AOwner: TComponent); override;
1095
1164
procedure InvalidateRange(const aRange: TRect);
1096
1165
procedure InvalidateRow(ARow: Integer);
1097
1166
function IscellVisible(aCol, aRow: Integer): Boolean;
1167
function IsFixedCellVisible(aCol, aRow: Integer): boolean;
1098
1168
procedure LoadFromFile(FileName: string);
1099
1169
function MouseCoord(X,Y: Integer): TGridCoord;
1100
1170
function MouseToCell(const Mouse: TPoint): TPoint; overload;
1112
1182
TSetEditEvent = procedure (Sender: TObject; ACol, ARow: Integer; const Value: string) of object;
1113
1183
TGetCheckboxStateEvent = procedure (Sender: TObject; ACol, ARow: Integer; var Value: TCheckboxState) of object;
1114
1184
TSetCheckboxStateEvent = procedure (Sender: TObject; ACol, ARow: Integer; const Value: TCheckboxState) of object;
1115
TMouseWheelOption = (mwCursor, mwGrid);
1118
1186
{ TCustomDrawGrid }
1131
1199
FOnSelectCell: TOnSelectcellEvent;
1132
1200
FOnSetCheckboxState: TSetCheckboxStateEvent;
1133
1201
FOnSetEditText: TSetEditEvent;
1134
FMouseWheelOption: TMouseWheelOption;
1135
1202
function CellNeedsCheckboxBitmaps(const aCol,aRow: Integer): boolean;
1136
1203
procedure DrawCellCheckboxBitmaps(const aCol,aRow: Integer; const aRect: TRect);
1162
1229
procedure SizeChanged(OldColCount, OldRowCount: Integer); override;
1163
1230
procedure ToggleCheckbox; virtual;
1165
property MouseWheelOption: TMouseWheelOption read FMouseWheelOption
1166
write FMouseWheelOption default mwCursor;
1167
1232
property OnGetCheckboxState: TGetCheckboxStateEvent
1168
1233
read FOnGetCheckboxState write FOnGetCheckboxState;
1169
1234
property OnSetCheckboxState: TSetCheckboxStateEvent
1450
1518
procedure AutoAdjustColumn(aCol: Integer); override;
1451
1519
procedure CalcCellExtent(acol, aRow: Integer; var aRect: TRect); override;
1452
1520
procedure DefineProperties(Filer: TFiler); override;
1521
procedure DefineCellsProperty(Filer: TFiler); virtual;
1453
1522
function DoCompareCells(Acol,ARow,Bcol,BRow: Integer): Integer; override;
1454
1523
procedure DoCopyToClipboard; override;
1455
1524
procedure DoCutToClipboard; override;
1483
1552
procedure Clean(aRect: TRect; CleanOptions: TGridZoneSet); overload;
1484
1553
procedure Clean(StartCol,StartRow,EndCol,EndRow: integer; CleanOptions: TGridZoneSet); overload;
1485
1554
procedure CopyToClipboard(AUseSelection: boolean = false);
1555
procedure LoadFromCSVFile(AFilename: string; ADelimiter:Char=','; WithHeader:boolean=true);
1556
procedure SaveToCSVFile(AFileName: string; ADelimiter:Char=','; WithHeader:boolean=true);
1486
1557
property Cells[ACol, ARow: Integer]: string read GetCells write SetCells;
1487
1558
property Cols[index: Integer]: TStrings read GetCols write SetCols;
1488
1559
property DefaultTextStyle;
1694
{$WARN SYMBOL_DEPRECATED OFF}
1695
{$IFDEF FPC_HAS_CPSTRING}
1696
{$WARN IMPLICIT_STRING_CAST OFF}
1697
{$WARN IMPLICIT_STRING_CAST_LOSS OFF}
1619
1700
function BidiFlipX(X: Integer; const Width: Integer; const Flip: Boolean): Integer;
1766
procedure CfgSetFontValue(cfg: TXMLConfig; AKey:string; AFont: TFont);
1847
procedure CfgSetFontValue(cfg: TXMLConfig; AKey: WideString; AFont: TFont);
1768
1849
cfg.SetValue(AKey + '/name/value', AFont.Name);
1769
1850
cfg.SetValue(AKey + '/size/value', AFont.Size);
1771
1852
cfg.SetValue(AKey + '/style/value', Integer(AFont.Style));
1774
procedure CfgGetFontValue(cfg: TXMLConfig; AKey:string; AFont: TFont);
1855
procedure CfgGetFontValue(cfg: TXMLConfig; AKey: WideString; AFont: TFont);
1776
1857
AFont.Name := cfg.GetValue(AKey + '/name/value', 'default');
1777
1858
AFont.Size := cfg.GetValue(AKey + '/size/value', 0);
2047
2128
procedure TCustomGrid.InternalSetColWidths(aCol, aValue: Integer);
2130
OldSize,NewSize: Integer;
2050
2132
Bigger: boolean;
2055
if Avalue<>integer(PtrUInt(FCols[ACol])) then begin
2056
Bigger := AValue>integer(PtrUInt(FCols[ACol]));
2057
SetRawColWidths(ACol, Avalue);
2135
if NewSize<0 then begin
2137
NewSize := FDefColWidth;
2140
OldSize := integer(PtrUInt(FCols[ACol]));
2141
if NewSize<>OldSize then begin
2144
OldSize := fDefColWidth;
2146
Bigger := NewSize>OldSize;
2147
SetRawColWidths(ACol, AValue);
2059
2149
if not (csLoading in ComponentState) and HandleAllocated then begin
2061
2151
if FUpdateCount=0 then begin
2064
2153
R := CellRect(aCol, 0);
2065
2154
R.Bottom := FGCache.MaxClientXY.Y+GetBorderWidth+1;
2066
2155
if UseRightToLeftAlignment then begin
2277
2371
procedure TCustomGrid.SetFixedCols(const AValue: Integer);
2279
EditorAffected: boolean;
2281
if FFixedCols=AValue then
2373
if FFixedCols=AValue then begin
2374
if FixedGrid and FGridPropBackup.ValidData then begin
2375
// user modified fixed properties in fixed grid
2376
// update stored values
2377
FGridPropBackup.FixedColCount := AValue;
2283
2381
CheckFixedCount(ColCount, RowCount, AValue, FFixedRows);
2285
EditorAffected := (AValue>=FCol);
2286
if EditorAffected and EditorMode then
2287
2384
EditorMode:=False;
2289
2386
FFixedCols:=AValue;
2303
2400
if not (csLoading in componentState) then
2304
2401
doTopleftChange(true);
2306
if EditorAffected then begin
2307
MoveNextSelectable(False, FixedCols, FRow);
2308
UpdateSelectionRange;
2403
MoveNextSelectable(False, FixedCols, FRow);
2404
UpdateSelectionRange;
2313
2408
procedure TCustomGrid.SetFixedRows(const AValue: Integer);
2315
EditorAffected: boolean;
2317
if FFixedRows=AValue then exit;
2410
if FFixedRows=AValue then begin
2411
if FixedGrid and FGridPropBackup.ValidData then begin
2412
// user modified fixed properties in fixed grid
2413
// update stored values
2414
FGridPropBackup.FixedRowCount := AValue;
2318
2418
CheckFixedCount(ColCount, RowCount, FFixedCols, AValue);
2320
EditorAffected := (AValue>=FRow);
2321
if EditorAffected and EditorMode then
2322
2421
EditorMode:=False;
2324
2423
FFixedRows:=AValue;
2327
2426
if not (csLoading in ComponentState) then
2328
2427
doTopleftChange(true);
2330
if EditorAffected then begin
2331
MoveNextSelectable(False, FCol, FixedRows);
2332
UpdateSelectionRange;
2429
MoveNextSelectable(False, FCol, FixedRows);
2430
UpdateSelectionRange;
2336
2433
procedure TCustomGrid.SetGridLineColor(const AValue: TColor);
2462
2562
procedure TCustomGrid.Setrowheights(Arow: Integer; Avalue: Integer);
2564
OldSize,NewSize: Integer;
2465
2566
Bigger: boolean;
2570
if NewSize<0 then begin
2470
if AValue<>integer(PtrUInt(FRows[ARow])) then begin
2472
bigger := aValue > RowHeights[aRow];
2572
NewSize := FDefRowHeight;
2575
OldSize := integer(PtrUInt(FRows[ARow]));
2576
if AValue<>OldSize then begin
2579
OldSize := FDefRowHeight;
2581
bigger := NewSize > OldSize;
2474
2583
FRows[ARow]:=Pointer(PtrInt(AValue));
2784
CheckIndex(ColSorting, Index);
2785
CheckIndex(not ColSorting, IndxFrom);
2786
CheckIndex(not ColSorting, IndxTo);
2788
QuickSort(IndxFrom, IndxTo);
2893
if RowCount>FixedRows then begin
2894
CheckIndex(ColSorting, Index);
2895
CheckIndex(not ColSorting, IndxFrom);
2896
CheckIndex(not ColSorting, IndxTo);
2898
QuickSort(IndxFrom, IndxTo);
2792
2903
procedure TCustomGrid.doTopleftChange(dimChg: Boolean);
2858
2969
procedure TCustomGrid.ResetSizes;
2860
function CalcMaxTopLeft: TPoint;
2865
Result:=Point(ColCount-1, RowCount-1);
2867
for i:=ColCount-1 downto FFixedCols do begin
2868
W:=W+GetColWidths(i);
2869
if W<FGCache.ScrollWidth then Result.x:=i
2873
for i:=RowCount-1 downto FFixedRows do begin
2874
H:=H+GetRowHeights(i);
2875
if H<FGCache.ScrollHeight then Result.y:=i
2880
procedure CalcScrollbarsRange;
2882
HsbVisible, VsbVisible: boolean;
2883
HsbRange,VsbRange: Integer;
2884
HsbPage, VsbPage: Integer;
2885
HsbPos, VsbPos: Integer;
2887
with FGCache do begin
2888
// Horizontal scrollbar
2889
GetSBVisibility(HsbVisible, VsbVisible);
2890
GetSBRanges(HsbVisible,VsbVisible,HsbRange,VsbRange,HsbPage,VsbPage,HsbPos,VsbPos);
2891
UpdateVertScrollBar(VsbVisible, VsbRange, VsbPage, VsbPos);
2892
UpdateHorzScrollBar(HsbVisible, HsbRange, HsbPage, HsbPos);
2894
DebugLn('VRange=',dbgs(VsbRange),' Visible=',dbgs(VSbVisible));
2895
DebugLn('HRange=',dbgs(HsbRange),' Visible=',dbgs(HSbVisible));
2900
2971
//DebugLn('TCustomGrid.VisualChange ',DbgSName(Self));
2901
2972
if (FCols=nil) or ([csLoading,csDestroying]*ComponentState<>[])
2905
2976
UpdateCachedSizes;
2906
2977
CheckNewCachedSizes(FGCache);
2907
FGCache.ScrollWidth:=FGCache.ClientWidth-FGCache.FixedWidth;
2908
FGCache.ScrollHeight:=FGCache.ClientHeight-FGCache.FixedHeight;
2909
FGCache.MaxTopLeft:=CalcMaxTopLeft;
2910
if not(goSmoothScroll in Options) then begin
2911
FGCache.TLColOff:=0;
2912
FGCache.TLRowOff:=0;
2914
2978
CacheVisibleGrid;
2915
2979
{$Ifdef DbgVisualChange}
2916
2980
DebugLn('TCustomGrid.ResetSizes %s Width=%d Height=%d',[DbgSName(Self),Width,Height]);
2947
3011
if HandleAllocated then begin
2948
3012
{$Ifdef DbgScroll}
2949
DebugLn('ScrollbarRange: Which=',SbToStr(Which),' Range=',IntToStr(aRange));
3013
DebugLn('ScrollbarRange: Which=%s Range=%d Page=%d Pos=%d',
3014
[SbToStr(Which),aRange,aPage,aPos]);
2951
3016
FillChar(ScrollInfo, SizeOf(ScrollInfo), 0);
2952
3017
ScrollInfo.cbSize := SizeOf(ScrollInfo);
2953
ScrollInfo.fMask := SIF_RANGE or SIF_POS or SIF_PAGE or SIF_DISABLENOSCROLL;
3018
ScrollInfo.fMask := SIF_RANGE or SIF_PAGE or SIF_DISABLENOSCROLL;
3019
if not (gfPainting in FGridFlags) then
3020
ScrollInfo.fMask := ScrollInfo.fMask or SIF_POS;
2955
3022
ScrollInfo.fMask := ScrollInfo.fMask or SIF_UPDATEPOLICY;
2956
3023
if goThumbTracking in Options then
2964
3031
if APage<0 then
2966
3033
ScrollInfo.nPage := APage;
3034
if (Which=SB_HORZ) and UseRightToLeftAlignment then begin
3035
ScrollInfo.nPos := ScrollInfo.nMax-ScrollInfo.nPage-ScrollInfo.nPos;
3037
DebugLn('ScrollbarRange: RTL nPos=%d',[ScrollInfo.nPos]);
2967
3040
SetScrollInfo(Handle, Which, ScrollInfo, True);
2982
3055
else vis := false;
2983
3056
FillChar(ScrollInfo, SizeOf(ScrollInfo), 0);
2984
3057
ScrollInfo.cbSize := SizeOf(ScrollInfo);
3058
if (Which=SB_HORZ) and Vis and UseRightToLeftAlignment then begin
3059
ScrollInfo.fMask := SIF_PAGE or SIF_RANGE;
3060
GetScrollInfo(Handle, SB_HORZ, ScrollInfo);
3061
Value := (ScrollInfo.nMax-ScrollInfo.nPage)-Value;
3063
DebugLn('ScrollbarPosition: Which=',SbToStr(Which), ' RTL Value= ',IntToStr(Value));
2985
3066
ScrollInfo.fMask := SIF_POS;
2986
3067
ScrollInfo.nPos:= Value;
2987
3068
SetScrollInfo(Handle, Which, ScrollInfo, Vis);
3070
3151
// Left Margin of next visible Column and Rightmost visible cell
3071
3152
if ColCount>FixedCols then begin
3072
W:=GetColWidths(Result.Left) + FGCache.FixedWidth- FGCache.TLColOff;
3153
W:=GetColWidths(Result.Left) + FGCache.FixedWidth;
3154
if goSmoothScroll in Options then
3155
W := W - FGCache.TLColOff;
3073
3156
while (Result.Right<ColCount-1)and(W<FGCache.ClientWidth) do begin
3074
3157
Inc(Result.Right);
3075
3158
W:=W+GetColWidths(Result.Right);
3083
3166
// Top Margin of next visible Row and Bottom most visible cell
3084
3167
if RowCount>FixedRows then begin
3085
w:=GetRowheights(Result.Top) + FGCache.FixedHeight - FGCache.TLRowOff;
3168
W:=GetRowheights(Result.Top) + FGCache.FixedHeight;
3169
if goSmoothScroll in Options then
3170
W := W - FGCache.TLRowOff;
3086
3171
while (Result.Bottom<RowCount-1)and(W<FGCache.ClientHeight) do begin
3087
3172
Inc(Result.Bottom);
3088
3173
W:=W+GetRowHeights(Result.Bottom);
3117
3202
(fTopLeft.y<RowCount) do
3119
3204
RNew:=CellRect(aCol,aRow);
3120
RNew.Left := FlipX(RNew.Left);
3121
RNew.Right := FlipX(RNew.Right);
3205
if UseRightToLeftAlignment then begin
3207
RNew.Right := FlipX(RNew.Left);
3208
RNew.Left := FlipX(XInc);
3124
3212
if RNew.Right <= FGCache.FixedWidth+GetBorderWidth then
3128
3216
Xinc := 1 // hidden at the right of clientwidth line
3130
3218
if (RNew.Left > FGCache.FixedWidth+GetBorderWidth) and
3131
(RNew.Left < CWidth) and (CWidth < RNew.Right) then begin
3219
(RNew.Left < CWidth) and (CWidth < RNew.Right) and
3220
(not (goDontScrollPartCell in Options)) then begin
3132
3221
Xinc := 1; // partially visible at the right
3133
3222
FGCache.TLColOff := 0; // cancel col-offset for next calcs
3141
3230
YInc := 1 // hidden at the bottom of clientheight line
3143
3232
if (RNew.Top > FGCache.FixedHeight+GetBorderWidth) and
3144
(RNew.Top < CHeight) and (CHeight < RNew.Bottom) then begin
3233
(RNew.Top < CHeight) and (CHeight < RNew.Bottom) and
3234
(not (goDontScrollPartCell in Options)) then begin
3145
3235
Yinc := 1; // partially visible at bottom
3146
3236
FGCache.TLRowOff := 0; // cancel row-offset for next calcs
3211
3301
procedure TCustomGrid.HeaderClick(IsColumn: Boolean; index: Integer);
3305
if IsColumn and FColumnClickSorts then begin
3306
// Prepare glyph images if not done already.
3307
if FTitleImageList = nil then
3308
FTitleImageList := TImageList.Create(Self);
3309
if FAscImgInd = -1 then begin
3310
FAscImgInd := TitleImageList.AddLazarusResource('sortasc');
3311
FDescImgInd := TitleImageList.AddLazarusResource('sortdesc');
3313
// Determine the sort order.
3314
if index = FSortColumn then begin
3315
case FSortOrder of // Same column clicked again -> invert the order.
3316
soAscending: FSortOrder:=soDescending;
3317
soDescending: FSortOrder:=soAscending;
3321
FSortOrder := soAscending; // Ascending order to start with.
3322
// Remove glyph from previous column.
3323
ColOfs := FSortColumn - FFixedCols;
3324
if (ColOfs > -1) and (ColOfs < FColumns.Count ) then
3325
with FColumns[ColOfs].Title do
3326
ImageIndex := FOldImageIndex;
3328
// Show the sort glyph only if clicked column has a TGridColumn defined.
3329
ColOfs := index - FFixedCols;
3330
if (ColOfs > -1) and (ColOfs < FColumns.Count)
3331
and (FAscImgInd < TitleImageList.Count)
3332
and (FDescImgInd < TitleImageList.Count) then
3333
with FColumns[ColOfs].Title do begin
3334
// Save previous ImageIndex of the clicked column.
3335
if (index <> FSortColumn) then
3336
FOldImageIndex := ImageIndex;
3337
case FSortOrder of // Show the right sort glyph.
3338
soAscending: ImageIndex := FAscImgInd;
3339
soDescending: ImageIndex := FDescImgInd;
3342
FSortColumn := index;
3343
Sort(True, index, FFixedRows, RowCount-1);
3215
3347
procedure TCustomGrid.HeaderSized(IsColumn: Boolean; index: Integer);
3262
3394
DebugLn('TCustomGrid.Paint %s Row=%d Clip=%s',[DbgSName(Self),Row,Dbgs(R)]);
3264
3396
if gfVisualChange in fGridFlags then begin
3397
{$ifdef DbgVisualChange}
3398
DebugLnEnter('Resetting Sizes in Paint INIT');
3400
FGridFlags := FGridFlags + [gfPainting];
3266
exclude(FGridFlags, gfVisualChange);
3402
FGridFlags := FGridFlags - [gfVisualChange, gfPainting];
3403
{$ifdef DbgVisualChange}
3404
DebugLnExit('Resetting Sizes in Paint DONE');
3268
3407
inherited Paint;
3269
3408
if FUpdateCount=0 then begin
3315
3454
CurrentTextStyle := DefaultTextStyle;
3316
3455
CurrentTextStyle.Alignment := BidiFlipAlignment(GetColumnAlignment(aCol, gdFixed in AState), UseRightToLeftAlignment);
3317
3456
CurrentTextStyle.Layout := GetColumnLayout(aCol, gdFixed in AState);
3457
CurrentTextStyle.ShowPrefix := ((gdFixed in aState) and (aRow < FFixedRows)) and GetTitleShowPrefix(aCol);
3318
3458
CurrentTextStyle.RightToLeft := UseRightToLeftReading;
3459
CurrentTextStyle.EndEllipsis := (goCellEllipsis in Options);
3319
3460
Canvas.TextStyle := CurrentTextStyle;
3321
3462
Canvas.TextStyle := DefaultTextStyle;
3326
3467
DoPrepareCanvas(aCol, aRow, aState);
3470
procedure TCustomGrid.PrepareCellHints(ACol, ARow: Integer);
3474
procedure TCustomGrid.UnprepareCellHints;
3329
3478
procedure TCustomGrid.ResetEditor;
3331
3480
EditorGetValue(True);
3540
procedure TCustomGrid.ShowCellHintWindow(APoint: TPoint);
3543
txt1, txt2, txt: String;
3545
gds: TGridDrawState;
3547
if ([goCellHints, goTruncCellHints]*Options = []) then
3550
cell := MouseToCell(APoint);
3551
if (cell.x = -1) or (cell.y = -1) then
3557
PrepareCellHints(cell.x, cell.y); // in DBGrid, set the active record to cell.y
3559
if (goCellHints in Options) then
3560
txt1 := GetCellHintText(cell.x, cell.y);
3561
if (goTruncCellHints in Options) then begin
3562
txt2 := GetTruncCellHintText(cell.x, cell.y);
3563
gds := GetGridDrawState(cell.x, cell.y);
3564
PrepareCanvas(cell.x, cell.y, gds);
3565
w := Canvas.TextWidth(txt2) + constCellPadding*2;
3566
if w < ColWidths[cell.x] then
3573
if FCellHintPriority = chpTruncOnly then begin
3574
if (txt2 <> '') then
3579
if (txt1 <> '') and (txt2 <> '') then
3580
txt := txt1 + #13 + txt2
3581
else if txt1 <> '' then
3583
else if txt2 <> '' then
3585
if (FCellHintPriority = chpAll) and (txt <> '') then
3586
txt := FSavedHint + #13 + txt;
3588
if (txt = '') and (FSavedHint <> '') then
3591
if (txt <> '') and not EditorMode and not (csDesigning in ComponentState) then begin
3593
Application.ActivateHint(APoint, true);
3598
procedure TCustomGrid.HideCellHintWindow;
3601
Application.CancelHint;
3392
3604
function TCustomGrid.SelectCell(ACol, ARow: Integer): Boolean;
3451
3663
Canvas.pen.Width := 1;
3452
Canvas.Pen.Color := clHighlight;
3453
Canvas.Brush.Color := clHighlight;
3664
Canvas.Pen.Color := clBlack;
3665
Canvas.Brush.Color := clWhite;
3454
3666
R := CellRect(FMoveLast.X, 0);
3458
Canvas.Polygon([Point(x-dx,y),point(x+dx,y),point(x,y+dy), point(x-dx,y)]);
3460
Canvas.Polygon([Point(x-dx,y),point(x+dx,y),point(x,y-dy), point(x-dx,y)]);
3667
Y := R.Top + (R.Bottom-R.Top) div 2;
3669
Canvas.Polygon([Point(x,y+dy),point(x,y-dy),point(x+dx,y), point(x,y+dy)]);
3671
Canvas.Polygon([Point(x,y+dy),point(x,y-dy),point(x-dx,y), point(x,y+dy)]);
3462
3673
Canvas.Pen.Width:=3;
3463
3674
Canvas.Pen.Color:=clRed;
3473
3684
Canvas.pen.Width := 1;
3474
Canvas.Pen.Color := clHighlight;
3475
Canvas.Brush.Color := clHighlight;
3685
Canvas.Pen.Color := clBlack;
3686
Canvas.Brush.Color := clWhite;
3476
3687
R := CellRect(0, FMoveLast.Y);
3479
Canvas.Polygon([Point(x,y+dy),point(x,y-dy),point(x+dx,y), point(x,y+dy)]);
3481
Canvas.Polygon([Point(x,y+dy),point(x,y-dy),point(x-dx,y), point(x,y+dy)]);
3688
X := R.Left + (R.Right-R.Left) div 2;
3690
Canvas.Polygon([Point(x-dx,y),point(x+dx,y),point(x,y+dy), point(x-dx,y)]);
3692
Canvas.Polygon([Point(x-dx,y),point(x+dx,y),point(x,y-dy), point(x-dx,y)]);
3483
3694
Canvas.Pen.Width:=3;
3484
3695
Canvas.Pen.Color:=clRed;
3640
3851
ColRowToOffSet(False, True, aRow, R.Top, R.Bottom);
3641
3852
// is this row within the ClipRect?
3642
3853
ClipArea := Canvas.ClipRect;
3643
if not VerticalIntersect(R, ClipArea) then begin
3854
if (R.Top>=R.Bottom) or not VerticalIntersect(R, ClipArea) then begin
3644
3855
{$IFDEF DbgVisualChange}
3645
3856
DebugLn('Drawrow: Skipped row: ', IntToStr(aRow));
3651
3862
with FGCache.VisibleGrid do begin
3652
3863
for aCol:=left to Right do begin
3653
3864
ColRowToOffset(True, True, aCol, R.Left, R.Right);
3654
if not HorizontalIntersect(R, ClipArea) then
3865
if (R.Left>=R.Right) or not HorizontalIntersect(R, ClipArea) then
3657
3867
Rs := (goRowSelect in Options);
3658
if ARow<FFixedRows then
3659
include(gds, gdFixed)
3661
if (aCol=FCol)and(aRow=FRow) then
3662
gds := gds + [gdFocused, gdSelected]
3664
if IsCellSelected[aCol, aRow] then
3665
include(gds, gdSelected);
3868
gds := GetGridDrawState(ACol, ARow);
3691
3892
gds:=[gdFixed];
3692
3893
ColRowToOffset(True, True, aCol, R.Left, R.Right);
3693
3894
// is this column within the ClipRect?
3694
if HorizontalIntersect(R, ClipArea) then
3895
if (R.Left<R.Right) and HorizontalIntersect(R, ClipArea) then
3699
3900
procedure TCustomGrid.EditButtonClicked(Sender: TObject);
3701
if Assigned(OnEditButtonClick) then begin
3902
if Assigned(OnEditButtonClick) or Assigned(OnButtonClick) then begin
3702
3903
if Sender=FButtonEditor then
3703
3904
DoEditButtonClick(FButtonEditor.Col, FButtonEditor.Row)
3801
4002
// non-fixed cells
3802
4003
if fGridLineWidth > 0 then begin
3803
4004
if Dh then begin
3804
if UseRightToLeftAlignment then begin
3805
MoveTo(Right, Bottom - 1);
3806
LineTo(Left, Bottom - 1);
3808
MoveTo(Left, Bottom - 1);
3809
LineTo(Right, Bottom - 1);
4005
MoveTo(Left, Bottom - 1);
4006
LineTo(Right, Bottom - 1);
3812
4008
if Dv then begin
3813
4009
if UseRightToLeftAlignment then begin
4000
4197
until (Result<>0) or (aCol>=ColCount) or (aCol<0);
4003
function ThumbPos: Integer;
4005
ScrollInfo: TScrollInfo;
4007
ScrollInfo.cbSize := SizeOf(ScrollInfo);
4008
ScrollInfo.fMask := SIF_RANGE or SIF_PAGE;
4203
DebugLn('HSCROLL: Code=%d Position=%d',[message.ScrollCode, message.Pos]);
4206
if not FGCache.ValidGrid or not HandleAllocated then
4209
aCode := message.ScrollCode;
4210
if UseRightToLeftAlignment then begin
4211
ScrollInfo.cbSize:=SizeOf(ScrollInfo);
4212
ScrollInfo.fMask:= SIF_PAGE or SIF_RANGE;
4009
4213
GetScrollInfo(Handle, SB_HORZ, ScrollInfo);
4011
if not (goSmoothScroll in Options) and (message.Pos>=(nMax-nMin-nPage)) then
4014
result := message.Pos;
4019
DebugLn('HSCROLL: Code=%d Position=%d',[message.ScrollCode, message.Pos]);
4022
if not FGCache.ValidGrid or not HandleAllocated then
4214
aPos := (ScrollInfo.nMax-ScrollInfo.nPage)-Message.Pos;
4216
SB_LINERIGHT: aCode := SB_LINELEFT;
4217
SB_LINELEFT: aCode := SB_LINERIGHT;
4218
SB_PAGERIGHT: aCode := SB_PAGELEFT;
4219
SB_PAGELEFT: aCode := SB_PAGERIGHT;
4222
DebugLn('HSCROLL: (RTL) Code=%d Position=%d',[aCode, aPos]);
4225
aPos := Message.Pos;
4025
4227
with FGCache do begin
4026
4228
TL:= integer(PtrUInt(AccumWidth[ MaxTopLeft.X ])) - FixedWidth;
4027
4229
CTL:= integer(PtrUInt(AccumWidth[ FTopLeft.X ])) - FixedWidth + TLColOff;
4030
case message.ScrollCode of
4031
// Scrolls to start / end of the text
4032
4233
SB_TOP: C := 0;
4236
if not (goSmoothScroll in Options) then
4034
4240
// Scrolls one line left / right
4035
4241
SB_LINERIGHT: C := CTL + NextColWidth( FTopLeft.X, 1);
4036
4242
SB_LINELEFT: C := CTL - NextColWidth( FTopLeft.X - 1, -1);
4063
4273
{$Ifdef dbgScroll}
4064
4274
DebugLn('HSCROLL: NewPosition=%d',[C]);
4276
if UseRightToLeftAlignment then
4066
4278
//TL:=OffsetToColRow(True, False, C, FGCache.TLColOff);
4067
4279
if not OffsetToColRow(True, False, C, TL, FGCache.TLColOff) then begin
4068
4280
{$Ifdef dbgScroll}
4074
4286
DebugLn('HSCROLL: Offset=%d TL=%d TLColOff=%d',[C,TL,FGCache.TLColOff]);
4077
if not (goSmoothScroll in Options) then
4078
FGCache.TLColOff:=0;
4080
4290
if TL<>FTopLeft.X then begin
4081
4291
TryScrollTo(Tl, FTopLeft.Y);
4083
4293
if goSmoothScroll in Options then begin
4084
4294
CacheVisibleGrid;
4085
R.Topleft:=Point(FGCache.FixedWidth, 0);
4086
R.BottomRight:= FGCache.MaxClientXY;
4087
if FGcache.MaxClientXY.X<FGCache.ClientWidth then
4088
R.BottomRight.x := FGCache.ClientWidth;
4089
if not (csCustomPaint in ControlState) then
4295
R.Topleft := Point(FGCache.FixedWidth, 0);
4296
R.BottomRight := Point(FGCache.ClientWidth, FGCache.ClientHeight);
4297
if not (csCustomPaint in ControlState) then begin
4298
if UseRightToLeftAlignment then begin
4299
C := FlipX(R.Right);
4300
R.Right := FlipX(R.Left)+ 1;
4090
4303
InvalidateRect(Handle, @R, false);
4093
4307
if EditorMode then
4107
4321
until (Result<>0) or (aRow>=RowCount) or (aRow<0);
4110
function ThumbPos: Integer;
4112
ScrollInfo: TScrollInfo;
4114
ScrollInfo.cbSize := SizeOf(ScrollInfo);
4115
ScrollInfo.fMask := SIF_RANGE or SIF_PAGE;
4116
GetScrollInfo(Handle, SB_VERT, ScrollInfo);
4118
if not (goSmoothScroll in Options) and (message.Pos>=(nMax-nMin-nPage)) then
4121
result := message.Pos;
4125
4325
{$IfDef dbgScroll}
4126
4326
DebugLn('VSCROLL: Code=%d Position=%d',[message.ScrollCode, message.Pos]);
4137
4337
case message.ScrollCode of
4138
4338
// Scrolls to start / end of the text
4139
4339
SB_TOP: C := 0;
4342
if not (goSmoothScroll in Options) then
4141
4346
// Scrolls one line up / down
4142
4347
SB_LINEDOWN: C := CTL + NextRowHeight(FTopleft.Y, 1);
4143
4348
SB_LINEUP: C := CTL - NextRowHeight(FTopleft.Y-1, -1);
4270
4475
LM_HSCROLL, LM_VSCROLL:
4271
4476
if csDesigning in ComponentState then
4479
// Ignore LM_SIZE while another sizing is being processed.
4480
// Windows sends WM_SIZE when showing/hiding scrollbars.
4481
// Scrollbars can be shown/hidden when processing DoOnChangeBounds.
4483
if gfUpdatingSize in FGridFlags then
4274
4487
inherited WndProc(TheMessage);
4341
4554
FGCache.ClientRect := ClientRect;
4342
4555
FGCache.ClientWidth := ClientWidth;
4343
FGCache.ClientHeight:= ClientHeight;
4556
FGCache.ClientHeight := ClientHeight;
4558
FGCache.ScrollWidth := FGCache.ClientWidth-FGCache.FixedWidth;
4559
FGCache.ScrollHeight := FGCache.ClientHeight-FGCache.FixedHeight;
4560
FGCache.MaxTopLeft:=CalcMaxTopLeft;
4344
4562
{$ifdef dbgVisualChange}
4345
4563
DebugLn('TCustomGrid.updateCachedSizes: ');
4346
4564
with FGCache do
4347
DebugLn(' GWidth=%d GHeight=%d FixWidth=%d FixHeight=%d CWidth=%d CHeight=%d',
4348
[GridWidth,GridHeight,FixedWidth,FixedHeight,ClientWidth,ClientHeight]);
4565
DebugLn(' GWidth=%d GHeight=%d FWidth=%d FHeight=%d CWidth=%d CHeight=%d MTL.X=%d MTL.Y=%d',
4566
[GridWidth,GridHeight,FixedWidth,FixedHeight,ClientWidth,ClientHeight,
4567
MaxTopLeft.X, MaxTopLeft.Y]);
4408
4627
procedure TCustomGrid.GetSBRanges(const HsbVisible, VsbVisible: boolean; out
4409
4628
HsbRange,VsbRange,HsbPage,VSbPage,HsbPos,VsbPos: Integer);
4413
4630
with FGCache do begin
4417
4634
if HsbVisible then begin
4418
HsbRange:=GridWidth + 2 - GetBorderWidth;
4419
4635
if not (goSmoothScroll in Options) then begin
4420
TW:= integer(PtrUInt(AccumWidth[MaxTopLeft.X]))-(HsbRange-ClientWidth);
4421
HsbRange:=HsbRange + TW - FixedWidth + 1;
4423
if FTopLeft.x<=ColCount-1 then
4424
HsbPos := integer(PtrUInt(AccumWidth[FTopLeft.x]))-TLColOff-FixedWidth;
4636
if (MaxTopLeft.x>=0) and (MaxTopLeft.x<=ColCount-1) then
4637
HsbRange := integer(PtrUInt(AccumWidth[MaxTopLeft.x]))+ClientWidth-FixedWidth
4640
HsbRange:=GridWidth - GetBorderWidth;
4641
if (FTopLeft.x>=0) and (FTopLeft.x<=ColCount-1) then
4642
HsbPos := integer(PtrUInt(AccumWidth[FTopLeft.x]))+TLColOff-FixedWidth;
4429
4647
if VsbVisible then begin
4430
VSbRange:= GridHeight + 2 - GetBorderWidth;
4431
4648
if not (goSmoothScroll in Options) then begin
4432
TH:= integer(PtrUInt(accumHeight[MaxTopLeft.Y]))-(VsbRange-ClientHeight);
4433
VsbRange:=VsbRange + TH -FixedHeight + 1;
4435
if FTopLeft.Y<=RowCount-1 then
4436
VsbPos := integer(PtrUInt(AccumHeight[FTopLeft.y]))-TLRowOff-FixedHeight;
4649
if (MaxTopLeft.y>=0) and (MaxTopLeft.y<=RowCount-1) then
4650
VsbRange := integer(PtrUInt(AccumHeight[MaxTopLeft.y]))+ClientHeight-FixedHeight
4653
VSbRange:= GridHeight - GetBorderWidth;
4654
if (FTopLeft.y>=0) and (FTopLeft.y<=RowCount-1) then
4655
VsbPos := integer(PtrUInt(AccumHeight[FTopLeft.y]))+TLRowOff-FixedHeight;
4439
4658
HsbPage := ClientWidth;
4440
4659
VSbPage := ClientHeight;
4662
DebugLn('GetSBRanges: HRange=%d HPage=%d HPos=%d VRange=%d VPage=%d VPos=%d',
4663
[HSbRange,HsbPage,HsbPos, VsbRange, VsbPage, VsbPos]);
4829
5059
FullVisibleGrid := VisibleGrid;
4830
5060
if ValidGrid then
4831
5061
with FullVisibleGrid do begin
4833
Left := Min(Left+1, Right);
4835
Top := Min(Top+1, Bottom);
5062
if goSmoothScroll in Options then begin
5064
Left := Min(Left+1, Right);
5066
Top := Min(Top+1, Bottom);
4836
5068
R := CellRect(Right, Bottom);
4837
5069
if R.Right>(ClientWidth+GetBorderWidth) then
4838
5070
Right := Max(Right-1, Left);
4900
5134
fRange:=NormalizarRect(aValue);
4901
5135
if fRange.Right>=ColCount then fRange.Right:=ColCount-1;
4902
5136
if fRange.Bottom>=RowCount then fRange.Bottom:=RowCount-1;
5137
if fRange.Left<FixedCols then fRange.Left := FixedCols;
5138
if fRange.Top<FixedRows then fRange.Top := FixedRows;
5139
if goSelectionActive in Options then begin
5140
OldSelectActive := FSelectActive;
5141
FPivot := FRange.TopLeft;
5142
FSelectActive := True;
5143
MoveExtend(false, FRange.Right, FRange.Bottom);
5144
FSelectActive := OldSelectActive;
4956
5199
HeaderSizing(true, Index, X - OffIni + DeltaOff);
4959
if (fGridState=gsNormal) and (ColCount>FixedCols) and
5202
if (fGridState=gsNormal) and
4960
5203
((Y<FGCache.FixedHeight) or (FExtendedColSizing and (Y<FGCache.MaxClientXY.Y))) and
4961
(FlipX(X)>FGCache.FixedWidth)
5204
((goFixedColSizing in Options) or ((ColCount>FixedCols) and (FlipX(X)>FGCache.FixedWidth)))
4964
5207
// find closest cell and cell boundaries
4980
5223
FindPrevColumn;
4983
// check if it's not fixed col and if cursor is close enough to sel boundary
4984
if (Index>=FFixedCols)and(Abs(Offset-x)<=2) then begin
4986
if Cursor<>crHSplit then begin
4989
ChangeCursor(crHSplit);
5226
// check if cursor is near boundary and it's a valid column
5227
if (Abs(Offset-x)<=2) then begin
5228
if goFixedColSizing in Options then
5231
Offset := FFixedCols;
5232
if Index>=Offset then begin
5234
if Cursor<>crHSplit then begin
5237
ChangeCursor(crHSplit);
5147
5396
// begin to count Cols from 0 but ...
5148
5397
if Fisical and (Offset>FixedWidth-1) then begin
5149
5398
Index := FTopLeft.X; // In scrolled view, then begin from FTopLeft col
5150
if (Index>=0) and (Index<ColCount) then
5151
Offset:=Offset-FixedWidth+integer(PtrUInt(AccumWidth[Index]))+TLColOff;
5399
if (Index>=0) and (Index<ColCount) then begin
5400
Offset:=Offset-FixedWidth+integer(PtrUInt(AccumWidth[Index]));
5401
if goSmoothScroll in Options then
5402
Offset:=Offset+TLColOff;
5152
5404
if (Index<0) or (Index>=ColCount) or (Offset>GridWidth-1) then begin
5153
5405
if AllowOutboundEvents then
5154
5406
Index := ColCount-1
5218
5470
if IsCol then begin
5219
if index>=FFixedCols then
5220
StartPos:=StartPos-integer(PtrUInt(AccumWidth[FTopLeft.X])) + FixedWidth - TLColOff;
5471
if index>=FFixedCols then begin
5472
StartPos:=StartPos-integer(PtrUInt(AccumWidth[FTopLeft.X])) + FixedWidth;
5473
if goSmoothScroll in Options then
5474
StartPos := StartPos - TLColOff;
5222
if index>=FFixedRows then
5223
StartPos:=StartPos-integer(PtrUInt(AccumHeight[FTopLeft.Y])) + FixedHeight - TLRowOff;
5477
if index>=FFixedRows then begin
5478
StartPos:=StartPos-integer(PtrUInt(AccumHeight[FTopLeft.Y])) + FixedHeight;
5479
if goSmoothScroll in Options then
5480
StartPos := StartPos - TLRowOff;
5225
5483
if IsCol and UseRightToLeftAlignment then
5227
EndPos := FlipX(StartPos);
5228
StartPos := EndPos - Dim + 1;
5485
EndPos := FlipX(StartPos) + 1;
5486
StartPos := EndPos - Dim;
5231
5489
EndPos:=StartPos + Dim;
5569
5826
inherited MouseDown(Button, Shift, X, Y);
5571
if (csDesigning in componentState) or not (ssLeft in Shift) then
5828
if (csDesigning in componentState) or not MouseButtonAllowed(Button) then
5574
5831
{$IfDef dbgGrid} DebugLn('MouseDown INIT'); {$Endif}
5579
5836
DebugLn('Mouse was in ', dbgs(FGCache.HotGridZone));
5582
FGCache.ClickMouse := Point(X,Y);
5583
FGCache.ClickCell := MouseToCell(FGCache.ClickMouse);
5839
CacheMouseDown(X,Y);
5585
5841
case FGCache.HotGridZone of
5589
FGridState := gsHeaderClicking;
5590
if ((goHeaderPushedLook in Options) and
5591
(FGCache.HotGridZone in FHeaderPushZones)) then
5845
if (goColSizing in Options) and (goFixedColSizing in Options) and
5846
(Cursor=crHSplit) then
5847
fGridState:= gsColSizing
5849
FGridState := gsHeaderClicking;
5850
if ((goHeaderPushedLook in Options) and
5851
(FGCache.HotGridZone in FHeaderPushZones)) then
5689
5950
procedure TCustomGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
5953
obe: boolean; // stored "AllowOutboundEvents"
5693
5955
inherited MouseMove(Shift, X, Y);
5727
5989
if goRowSizing in Options then
5728
5990
doRowSizing(X,Y);
5992
obe := AllowOutboundEvents;
5993
AllowOutboundEvents := false;
5995
p := MouseCoord(X, Y);
5997
AllowOutboundEvents := obe;
6000
if (MouseCell.X <> p.X) or (MouseCell.Y <> p.Y) then begin
6001
Application.CancelHint;
6002
ShowCellHintWindow(Point(X,Y));
5747
6023
if fGridState=gsHeaderClicking then
5748
6024
HeaderClick(True, FGCache.ClickCell.X)
5750
if Assigned(OnEditButtonClick) then
6026
if Assigned(OnEditButtonClick) or Assigned(OnButtonClick) then
5751
6027
DoEditButtonClick(Cur.X, Cur.Y);
5785
6061
//DebugLn('Move Row From ',Fsplitter.Y,' to ', FMoveLast.Y);
5786
6062
if FMoveLast.Y>=0 then begin
6063
if FMoveLast.Y=FGCache.ClickCell.Y then
6064
{$ifdef AlternativeMoveIndicator}
5787
6069
DoOPMoveColRow(False, FGCache.ClickCell.Y, FMoveLast.Y);
5943
6225
editorGetValue;
6228
function TCustomGrid.DialogChar(var Message: TLMKey): boolean;
6232
for i:=0 to Columns.Count-1 do
6233
if Columns[i].Visible and (Columns[i].Title.PrefixOption<>poNone) then
6234
if IsAccel(Message.CharCode, Columns[i].Title.Caption) then begin
6236
HeaderClick(True, GridColumnFromColumnIndex(i));
6239
result := inherited DialogChar(Message);
5946
6242
function TCustomGrid.DoCompareCells(Acol, ARow, Bcol, BRow: Integer): Integer;
5970
OnEditButtonClick(Self);
6266
if Assigned(OnEditButtonClick) then
6267
OnEditButtonClick(Self);
6268
if Assigned(OnButtonClick) then
6269
OnButtonClick(Self, ACol, ARow);
5972
6271
if (FCol=ACol) and (FRow=ARow) then
6128
6431
{$IfDef dbgGrid}DebugLn('DoEnter - END');{$Endif}
6434
function TCustomGrid.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
6435
MousePos: TPoint): Boolean;
6437
if FMouseWheelOption=mwCursor then
6438
FSelectActive := false;
6439
Result:=inherited DoMouseWheel(Shift, WheelDelta, MousePos);
6131
6442
function TCustomGrid.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint
6365
6678
Result:= (Left<=ACol)and(aCol<=Right)and(Top<=aRow)and(aRow<=Bottom);
6681
function TCustomGrid.IsFixedCellVisible(aCol, aRow: Integer): boolean;
6683
with FGCache.VisibleGrid do
6684
result := ((aCol<FixedCols) and ((aRow<FixedRows) or ((aRow>=Top)and(aRow<=Bottom)))) or
6685
((aRow<FixedRows) and ((aCol<FixedCols) or ((aCol>=Left)and(aCol<=Right))));
6368
6688
procedure TCustomGrid.InvalidateCol(ACol: Integer);
6502
6822
DCol:=NCol-FCol;
6503
6823
DRow:=NRow-FRow;
6827
if (goEditing in options) and (goAutoAddRows in options) then begin
6828
if (DRow=1) and (NRow>=RowCount) then begin
6829
// If the last row has data, add a new row.
6830
if not FRowAutoInserted then
6831
for i:=FixedCols to ColCount-1 do
6832
if GetCells(i, FRow)<>'' then begin
6833
RowCount:=RowCount+1;
6834
FRowAutoInserted:=True;
6838
else if FRowAutoInserted and (DRow=-1) then begin
6839
RowCount:=RowCount-1;
6840
FRowAutoInserted:=False;
6509
6845
Checklimits(NCol, NRow);
6545
6881
if FixedGrid then
6548
dCol:=FCol*(1-Byte(not Relative))+DCol;
6549
dRow:=FRow*(1-Byte(not Relative))+DRow;
6884
if Relative then begin
6551
6889
CheckLimits(DCol, DRow);
6553
6891
// Change on Focused cell?
6554
if (Dcol=FCol) and (DRow=FRow) then begin
6555
SelectCell(DCol,DRow);
6892
if (DCol=FCol) and (DRow=FRow) then
6893
SelectCell(DCol,DRow)
6557
6895
Result:=SelectCell(DCol,DRow);
6561
6898
procedure TCustomGrid.UnLockEditor;
6568
6905
const aRange,aPage,aPos: Integer);
6570
6907
{$ifdef DbgScroll}
6571
DebugLn('TCustomGrid.UpdateHorzScrollbar: Vis=',dbgs(aVisible),
6572
' Range=',dbgs(aRange),' Page=',dbgs(aPage));
6908
DebugLn('TCustomGrid.UpdateHorzScrollbar: Vis=%s Range=%d Page=%d aPos=%d',
6909
[dbgs(aVisible),aRange, aPage, aPos]);
6574
6911
ScrollBarShow(SB_HORZ, aVisible);
6575
6912
if aVisible then
6580
6917
const aRange,aPage,aPos: Integer);
6582
6919
{$ifdef DbgScroll}
6583
DebugLn('TCustomGrid.UpdateVertScrollbar: Vis=',dbgs(aVisible),
6584
' Range=',dbgs(aRange),' Page=',dbgs(aPage));
6920
DebugLn('TCustomGrid.UpdateVertScrollbar: Vis=%s Range=%d Page=%d aPos=%d',
6921
[dbgs(aVisible),aRange, aPage, aPos]);
6586
6923
ScrollBarShow(SB_VERT, aVisible);
6587
6924
if aVisible then
7003
procedure TCustomGrid.CalcScrollbarsRange;
7005
HsbVisible, VsbVisible: boolean;
7006
HsbRange,VsbRange: Integer;
7007
HsbPage, VsbPage: Integer;
7008
HsbPos, VsbPos: Integer;
7010
with FGCache do begin
7011
GetSBVisibility(HsbVisible, VsbVisible);
7012
GetSBRanges(HsbVisible,VsbVisible,HsbRange,VsbRange,HsbPage,VsbPage,HsbPos,VsbPos);
7013
UpdateVertScrollBar(VsbVisible, VsbRange, VsbPage, VsbPos);
7014
UpdateHorzScrollBar(HsbVisible, HsbRange, HsbPage, HsbPos);
7016
DebugLn('VRange=',dbgs(VsbRange),' Visible=',dbgs(VSbVisible));
7017
DebugLn('HRange=',dbgs(HsbRange),' Visible=',dbgs(HSbVisible));
7022
function TCustomGrid.CalcMaxTopLeft: TPoint;
7027
Result:=Point(ColCount-1, RowCount-1);
7029
for i:=ColCount-1 downto FFixedCols do begin
7030
W:=W+GetColWidths(i);
7031
if W<=FGCache.ScrollWidth then
7037
for i:=RowCount-1 downto FFixedRows do begin
7038
H:=H+GetRowHeights(i);
7039
if H<=FGCache.ScrollHeight then
6666
7046
procedure TCustomGrid.CellClick(const aCol, aRow: Integer; const Button:TMouseButton);
6683
7063
raise EGridException.Create(rsGridIndexOutOfRange);
7066
procedure TCustomGrid.CMBiDiModeChanged(var Message: TLMessage);
7069
inherited CMBidiModeChanged(Message);
7072
procedure TCustomGrid.CMMouseEnter(var Message: TLMessage);
6686
7078
procedure TCustomGrid.CMMouseLeave(var Message: TLMessage);
7080
if [goCellHints, goTruncCellHints] * Options <> [] then
6689
7083
inherited CMMouseLeave(Message);
6760
7154
IntersectRect(Result, Result, FGCache.VisibleGrid);
7157
procedure TCustomGrid.CacheMouseDown(const X, Y: Integer);
7159
FGCache.ClickMouse := Point(X,Y);
7160
FGCache.ClickCell := MouseToCell(FGCache.ClickMouse);
6763
7163
procedure TCustomGrid.EndUpdate(aRefresh: boolean = true);
6765
7165
Dec(FUpdateCount);
6785
7185
DebugLn(['InvalidateCell Col=',aCol,
6786
7186
' Row=',aRow,' Redraw=', Redraw]);
6788
if not HandleAllocated then Exit;
6789
R:=CellRect(aCol, aRow);
6790
InvalidateRect(Handle, @R, Redraw);
7188
if HandleAllocated and (IsCellVisible(aCol, aRow) or IsFixedCellVisible(aCol, aRow)) then begin
7189
R:=CellRect(aCol, aRow);
7190
InvalidateRect(Handle, @R, Redraw);
6793
7194
procedure TCustomGrid.InvalidateRange(const aRange: TRect);
6799
7200
RIni := CellRect(aRange.Left, aRange.Top);
6800
7201
RFin := CellRect(aRange.Right, aRange.Bottom);
6801
RIni.Right := RFin.Right;
7202
if UseRightToLeftAlignment then
7203
RIni.Left := RFin.Left
7205
RIni.Right := RFin.Right;
6802
7206
RIni.Bottom:= RFin.Bottom;
6803
7207
InvalidateRect(Handle, @RIni, False);
6988
7392
// send editor bounds
6989
7393
Msg.CellRect:=CellRect(FCol,FRow);
6990
7394
if (Msg.CellRect.Top<FGCache.FixedHeight) or
6991
(Msg.CellRect.Left<FGCache.FixedWidth) then
7395
(UseRightToLeftAlignment and (Msg.CellRect.Right-1>FlipX(FGCache.FixedWidth))) or
7396
(not UseRightToLeftAlignment and (Msg.CellRect.Left<FGCache.FixedWidth)) then
6993
7398
// editor is not in visible area, hide it complety
6994
7399
// to avoid showing it in fixed cell area
7088
7493
APriority := 1;
7496
function TCustomGrid.GetCellHintText(ACol, ARow: Integer): string;
7499
if Assigned(FOnGetCellHint) then
7500
FOnGetCellHint(self, ACol, ARow, result);
7503
function TCustomGrid.GetTruncCellHintText(ACol, ARow: Integer): String;
7505
Result := GetCells(ACol, ARow);
7091
7508
function TCustomGrid.GetCells(ACol, ARow: Integer): string;
7283
7696
if FEDitor<>nil then begin
7284
if EditorCanProcessKey(Ch) and not EditorIsReadOnly then begin
7697
if EditorCanAcceptKey(ch) and not EditorIsReadOnly then begin
7285
7698
EditorShow(true);
7286
7699
TWSCustomGridClass(WidgetSetClass).SendCharToEditor(Editor, Ch);
7303
7716
Result:=FSelectedColor;
7719
function TCustomGrid.GetTitleShowPrefix(Column: Integer): boolean;
7723
C := ColumnFromGridColumn(Column);
7725
result := C.Title.PrefixOption<>poNone
7306
7730
function TCustomGrid.GridColumnFromColumnIndex(ColumnIndex: Integer): Integer;
7308
7732
{$ifdef NewCols}
7450
// invert direction if necessary
7452
7874
aa := FAutoAdvance;
7875
if UseRightToLeftAlignment then
7454
7876
case FAutoAdvance of
7877
aaLeftUp: aa := aaRightUp;
7878
aaLeftDown: aa := aaRightDown;
7879
aaLeft: aa := aaRight;
7880
aaRightUp: aa := aaLeftUp;
7881
aaRightDown: aa := aaLeftDown;
7882
aaRight: aa := aaLeft;
7884
// invert direction if necessary
7455
7887
aaRight: aa := aaLeft;
7456
7888
aaLeft: aa := aaRight;
7457
7889
aaRightDown: aa := aaLeftUp;
7594
8026
FreeWorkingCanvas(tmpCanvas);
8029
function TCustomGrid.GetGridDrawState(ACol, ARow: Integer): TGridDrawState;
8032
if ARow < FFixedRows then
8033
include(Result, gdFixed)
8035
if (aCol = FCol) and (aRow = FRow) then
8036
Result := Result + [gdFocused, gdSelected]
8038
if IsCellSelected[aCol, aRow] then
8039
include(Result, gdSelected);
8041
with FGCache do begin
8042
if (ACol = HotCell.x) and (ARow = HotCell.y) and not IsPushCellActive()
8043
then Include(Result, gdHot);
8044
if ClickCellPushed and (ACol = PushedCell.x) and (ARow = PushedCell.y)
8045
then Include(Result, gdPushed);
7597
8049
function TCustomGrid.GetScrollBarPosition(Which: integer): Integer;
7599
8051
ScrollInfo: TScrollInfo;
7786
8238
Cfg.SetValue(Path+'goRowMoving/value', goRowMoving in options);
7787
8239
Cfg.SetValue(Path+'goColMoving/value', goColMoving in options);
7788
8240
Cfg.SetValue(Path+'goEditing/value', goEditing in options);
8241
Cfg.SetValue(Path+'goAutoAddRows/value', goAutoAddRows in options);
7789
8242
Cfg.SetValue(Path+'goTabs/value', goTabs in options);
7790
8243
Cfg.SetValue(Path+'goRowSelect/value', goRowSelect in options);
7791
8244
Cfg.SetValue(Path+'goAlwaysShowEditor/value', goAlwaysShowEditor in options);
7929
8382
GetValue('goRowMoving',goRowMoving);
7930
8383
GetValue('goColMoving',goColMoving);
7931
8384
GetValue('goEditing',goEditing);
8385
GetValue('goAutoAddRows',goAutoAddRows);
7932
8386
GetValue('goRowSelect',goRowSelect);
7933
8387
GetValue('goTabs',goTabs);
7934
8388
GetValue('goAlwaysShowEditor',goAlwaysShowEditor);
8035
8489
FDefaultTextStyle.Wordbreak := False;
8036
8490
FDefaultTextStyle.SingleLine:= True;
8492
FCellHintPriority := chpTruncOnly;
8038
8494
FButtonEditor := TButtonCellEditor.Create(nil);
8039
8495
FButtonEditor.Name:='ButtonEditor';
8040
8496
FButtonEditor.Caption:='...';
8414
procedure TVirtualGrid.MoveColRow(IsColumn: Boolean; FromIndex, ToIndex: Integer
8873
procedure TVirtualGrid.MoveColRow(IsColumn: Boolean; FromIndex, ToIndex: Integer);
8417
8875
FCells.MoveColRow(IsColumn, FromIndex, ToIndex);
8418
8876
if IsColumn then FCols.MoveColRow(True, FromIndex, ToIndex)
8628
9092
FGrid.Objects[I, FIndex] := nil;
8633
9098
function TStringGridStrings.Add(const S: string): Integer;
8637
if FIsCol then begin
8638
for I := 0 to FGrid.RowCount - 1 do begin
8639
if FGrid.Cells[FIndex, I] = '' then begin
8640
FGrid.Cells[FIndex, I] := S;
8646
for I := 0 to FGrid.ColCount - 1 do begin
8647
if FGrid.Cells[I, FIndex] = '' then begin
8648
FGrid.Cells[I, FIndex] := S;
9102
if ConvertIndexLineCol(FAddedCount, Line, Col) then begin
9103
FGrid.Cells[Line, Col] := S;
9104
Result := FAddedCount;
8657
9110
function TStringGridStrings.Get(Index: Integer): string;
8990
9443
if Assigned(OnSetEditText) then
8991
9444
OnSetEditText(Self, aCol, aRow, Value);
9445
inherited SetEditText(aCol, aRow, Value);
8994
9448
procedure TCustomDrawGrid.SizeChanged(OldColCount, OldRowCount: Integer);
9039
9493
procedure TCustomDrawGrid.DrawCellAutonumbering(aCol, aRow: Integer;
9040
9494
aRect: TRect; const aValue: string);
9042
Canvas.TextRect(aRect,ARect.Left+3,ARect.Top+3, aValue);
9496
DrawCellText(aCol, aRow, aRect, [], aValue);
9045
9499
function TCustomDrawGrid.SelectCell(aCol, aRow: Integer): boolean;
9132
9586
procedure TCustomDrawGrid.DefaultDrawCell(aCol, aRow: Integer; var aRect: TRect;
9133
9587
aState: TGridDrawState);
9137
if GetIsCellTitle(aCol, aRow) then
9138
DrawColumnText(aCol, aRow, aRect, aState)
9140
DrawTextInCell(aCol,aRow, aRect,aState);
9144
9589
if goColSpanning in Options then CalcCellExtent(acol, arow, aRect);
9151
9596
if CellNeedsCheckboxBitmaps(aCol,aRow) then
9152
9597
DrawCellCheckboxBitmaps(aCol,aRow,aRect)
9154
if IsCellButtonColumn(Point(aCol,aRow)) then begin
9155
DrawButtonCell(aCol,aRow,aRect,aState);
9160
if (goFixedRowNumbering in Options) and (ARow>=FixedRows) and (aCol=0) and
9163
DrawCellAutonumbering(aCol, aRow, aRect, IntToStr(aRow-FixedRows+1));
9600
if IsCellButtonColumn(Point(aCol,aRow)) then begin
9601
DrawButtonCell(aCol,aRow,aRect,aState);
9604
if (goFixedRowNumbering in Options) and (ARow>=FixedRows) and (aCol=0) and
9607
DrawCellAutonumbering(aCol, aRow, aRect, IntToStr(aRow-FixedRows+1));
9610
if GetIsCellTitle(aCol, aRow) then
9611
DrawColumnText(aCol, aRow, aRect, aState)
9613
DrawTextInCell(aCol,aRow, aRect,aState);
9471
9919
procedure TCustomStringGrid.DefineProperties(Filer: TFiler);
9921
inherited DefineProperties(Filer);
9922
DefineCellsProperty(Filer);
9925
procedure TCustomStringGrid.DefineCellsProperty(Filer: TFiler);
9472
9926
function NeedCells: boolean;
9506
9959
if Assigned(OnCompareCells) then
9507
9960
Result:=inherited DoCompareCells(Acol, ARow, Bcol, BRow)
9509
Result:=AnsiCompareText(Cells[ACol,ARow], Cells[BCol,BRow]);
9962
Result:=UTF8CompareText(Cells[ACol,ARow], Cells[BCol,BRow]);
9510
9963
if SortOrder=soDescending then
9511
9964
result:=-result;
9626
10079
L.Text := TheText;
9627
10080
for j:=0 to L.Count-1 do begin
10081
if j+StartRow >= RowCount then
9628
10083
CollectCols(L[j]);
9629
10084
for i:=0 to SubL.Count-1 do
9630
Cells[i + StartCol, j + StartRow] := SubL[i];
10085
if (i+StartCol<ColCount) and (not GetColumnReadonly(i+StartCol)) then
10086
Cells[i + StartCol, j + StartRow] := SubL[i];
9768
10224
CopyCellRectToClipboard(Rect(0,0,ColCount-1,RowCount-1));
10227
procedure TCustomStringGrid.LoadFromCSVFile(AFilename: string;
10228
ADelimiter:Char=','; WithHeader:boolean=true);
10230
L,SubL: TStringList;
10231
i,j,StartRow: Integer;
10233
L := TStringList.Create;
10234
SubL := TStringList.Create;
10237
L.LoadFromFile(AFilename);
10239
// check for empty lines
10240
for i:=L.Count-1 downto 0 do
10241
if Trim(L[i])='' then
10244
if L.Count>0 then begin
10246
SubL.Delimiter:=ADelimiter;
10247
SubL.DelimitedText:=L[0];
10249
if Columns.Enabled then begin
10250
while Columns.VisibleCount<>SubL.Count do
10251
if Columns.VisibleCount<SubL.Count then
10254
Columns.Delete(Columns.Count-1);
10256
ColCount := SubL.Count;
10258
if WithHeader and (FixedRows=0) then
10259
RowCount := L.Count
10261
RowCount := FixedRows + L.Count-1;
10263
if WithHeader then begin
10265
if FixedRows>0 then
10266
if Columns.Enabled then begin
10267
for i:=0 to Columns.Count-1 do
10268
Columns[i].Title.Caption:=SubL[i]
10270
StartRow := Max(FixedRows-1, 0);
10273
StartRow := FixedRows;
10277
for i:=StartRow to RowCount-1 do begin
10278
Rows[i].Delimiter := ADelimiter;
10279
Rows[i].DelimitedText:=L[i-StartRow+j];
10289
procedure TCustomStringGrid.SaveToCSVFile(AFileName: string; ADelimiter:Char=','; WithHeader:boolean=true);
10292
i,StartRow: Integer;
10296
if (RowCount=0) or (ColCount=0) then
10298
AssignFile(F, AFilename);
10301
if WithHeader then begin
10302
if Columns.Enabled then begin
10303
if FixedRows>0 then begin
10304
L := TStringList.Create;
10306
for i := 0 to ColCount-1 do begin
10307
c := ColumnFromGridColumn(i);
10311
L.Add(c.Title.Caption);
10313
L.Delimiter:=ADelimiter;
10314
WriteLn(F, L.DelimitedText);
10319
StartRow := FixedRows;
10321
if FixedRows>0 then
10322
StartRow := FixedRows-1
10326
StartRow := FixedRows;
10327
for i:=StartRow to RowCount-1 do begin
10328
Rows[i].Delimiter:=ADelimiter;
10329
WriteLn(F, Rows[i].DelimitedText);
9772
10337
procedure Register;
9923
10488
FColumn.ColumnChanged;
10491
procedure TGridColumnTitle.SetPrefixOption(const AValue: TPrefixOption);
10493
if FPrefixOption=AValue then exit;
10494
FPrefixOption:=AValue;
10495
FColumn.ColumnChanged;
9926
10498
procedure TGridColumnTitle.Assign(Source: TPersistent);
9928
10500
if Source is TGridColumnTitle then begin
10949
11534
Feditors[i].Editor.Dispatch(msg);
11537
function TCompositeCellEditor.GetMaxLength: Integer;
11539
AEditor: TWinControl;
11542
AEditor := GetActiveControl;
11543
if AEditor is TCustomEdit then
11544
result := TCustomEdit(AEditor).MaxLength;
11547
procedure TCompositeCellEditor.SetMaxLength(AValue: Integer);
11549
AEditor: TWinControl;
11551
AEditor := GetActiveControl;
11552
if AEditor is TCustomEdit then
11553
TCustomEdit(AEditor).MaxLength := AValue;
10952
11556
function TCompositeCellEditor.GetActiveControl: TWinControl;