~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to lcl/grids.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
{ $Id: grids.pas 32822 2011-10-11 17:49:30Z vincents $}
 
1
{ $Id: grids.pas 37777 2012-06-25 10:26:51Z martin $}
2
2
{
3
3
 /***************************************************************************
4
4
                               Grids.pas
56
56
  GM_SETMASK    = LM_INTERFACELAST + 105;
57
57
  GM_SETPOS     = LM_INTERFACELAST + 106;
58
58
  GM_READY      = LM_INTERFACELAST + 107;
 
59
  GM_GETGRID    = LM_INTERFACELAST + 108;
59
60
 
60
61
 
61
62
const
64
65
  EO_HOOKKEYPRESS =   $4;
65
66
  EO_HOOKKEYUP    =   $8;
66
67
  EO_SELECTALL    =   $10;
 
68
  EO_IMPLEMENTED  =   $20;
67
69
 
68
70
const
69
71
  DEFCOLWIDTH     = 64;
86
88
    goRowMoving,          // Ya
87
89
    goColMoving,          // Ya
88
90
    goEditing,            // Ya
 
91
    goAutoAddRows,        // JuMa
89
92
    goTabs,               // Ya
90
93
    goRowSelect,          // Ya
91
94
    goAlwaysShowEditor,   // Ya
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
102
111
  );
103
112
  TGridOptions = set of TGridOption;
104
113
 
136
145
 
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;
141
150
 
142
151
  TSortOrder = (soAscending, soDescending);
143
152
 
 
153
  TPrefixOption = (poNone, poHeaderClick);
 
154
 
 
155
  TMouseWheelOption = (mwCursor, mwGrid);
 
156
 
 
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.
 
162
 
144
163
const
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;
197
217
  public
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;
214
235
  public
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;
236
258
  public
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);
257
281
  protected
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;
274
300
  end;
275
301
 
276
302
 
319
345
  THeaderSizingEvent = procedure(sender: TObject; const IsColumn: boolean;
320
346
                                    const aIndex, aSize: Integer) of object;
321
347
 
 
348
  TGetCellHintEvent = procedure (Sender: TObject; ACol, ARow: Integer;
 
349
                                 var HintText: String) of object;
 
350
 
322
351
  { TVirtualGrid }
323
352
 
324
353
  TVirtualGrid=class
368
397
    FAlignment: ^TAlignment;
369
398
    FFont: TFont;
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;
392
424
  protected
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;
414
447
  end;
415
448
 
416
449
  { TGridColumn }
432
465
    FPickList: TStrings;
433
466
    FMinSize, FMaxSize, FSizePriority: ^Integer;
434
467
    FValueChecked,FValueUnchecked: PChar;
435
 
 
 
468
    FTag: Integer;
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
611
646
    end;
612
647
 
613
648
type
635
670
    FFlat: Boolean;
636
671
    FOnUserCheckboxBitmap: TUserCheckboxBitmapEvent;
637
672
    FSortOrder: TSortOrder;
 
673
    FSortColumn: Integer;
638
674
    FTitleImageList: TImageList;
639
675
    FTitleStyle: TTitleStyle;
 
676
    FAscImgInd: Integer;
 
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;
 
737
    FSavedHint: String;
 
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;
 
1138
    // Hint-related
 
1139
    property OnGetCellHint : TGetCellHintEvent read FOnGetCellHint write FOnGetCellHint;
1071
1140
 
1072
1141
  public
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);
1116
 
 
1117
1185
 
1118
1186
  { TCustomDrawGrid }
1119
1187
 
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);
1137
1204
  protected
1162
1229
    procedure SizeChanged(OldColCount, OldRowCount: Integer); override;
1163
1230
    procedure ToggleCheckbox; virtual;
1164
1231
 
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
1255
1320
    property VisibleColCount;
1256
1321
    property VisibleRowCount;
1257
1322
 
1258
 
 
1259
1323
    property OnBeforeSelection;
1260
1324
    property OnClick;
1261
1325
    property OnColRowDeleted: TgridOperationEvent read FOnColRowDeleted write FOnColRowDeleted;
1268
1332
    property OnDragDrop;
1269
1333
    property OnDragOver;
1270
1334
    property OnDrawCell;
1271
 
    property OnEditButtonClick;
 
1335
    property OnEditButtonClick; deprecated;
 
1336
    property OnButtonClick;
1272
1337
    property OnEndDock;
1273
1338
    property OnEndDrag;
1274
1339
    property OnEnter;
1315
1380
    property BorderStyle;
1316
1381
    property Color;
1317
1382
    property ColCount;
 
1383
    property ColumnClickSorts;
1318
1384
    property Columns;
1319
1385
    //property Constraints;
1320
1386
    property DefaultColWidth;
1366
1432
    property OnDragDrop;
1367
1433
    property OnDragOver;
1368
1434
    property OnDrawCell;
1369
 
    property OnEditButtonClick;
 
1435
    property OnEditButtonClick; deprecated;
 
1436
    property OnButtonClick;
1370
1437
    property OnEditingDone;
1371
1438
    property OnEndDock;
1372
1439
    property OnEndDrag;
1406
1473
 
1407
1474
  TStringGridStrings = class(TStrings)
1408
1475
  private
 
1476
    FAddedCount: Integer;
1409
1477
    FGrid: TCustomStringGrid;
1410
1478
    FIsCol: Boolean;
1411
1479
    FIndex: Integer;
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;
1511
1582
    property BiDiMode;
1512
1583
    property BorderSpacing;
1513
1584
    property BorderStyle;
 
1585
    property CellHintPriority;
1514
1586
    property Color;
1515
1587
    property ColCount;
 
1588
    property ColumnClickSorts;
1516
1589
    property Columns;
1517
1590
    property Constraints;
1518
1591
    property DefaultColWidth;
1565
1638
    property OnDragOver;
1566
1639
    property OnDblClick;
1567
1640
    property OnDrawCell;
1568
 
    property OnEditButtonClick;
 
1641
    property OnEditButtonClick; deprecated;
 
1642
    property OnButtonClick;
1569
1643
    property OnEditingDone;
1570
1644
    property OnEndDock;
1571
1645
    property OnEndDrag;
1572
1646
    property OnEnter;
1573
1647
    property OnExit;
 
1648
    property OnGetCellHint;
1574
1649
    property OnGetCheckboxState;
1575
1650
    property OnGetEditMask;
1576
1651
    property OnGetEditText;
1616
1691
uses
1617
1692
  WSGrids;
1618
1693
 
 
1694
{$WARN SYMBOL_DEPRECATED OFF}
 
1695
{$IFDEF FPC_HAS_CPSTRING}
 
1696
  {$WARN IMPLICIT_STRING_CAST OFF}
 
1697
  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
 
1698
{$ENDIF}
 
1699
 
1619
1700
function BidiFlipX(X: Integer; const Width: Integer; const Flip: Boolean): Integer;
1620
1701
begin
1621
1702
  if Flip then
1763
1844
end;
1764
1845
{$endif}
1765
1846
 
1766
 
procedure CfgSetFontValue(cfg: TXMLConfig; AKey:string; AFont: TFont);
 
1847
procedure CfgSetFontValue(cfg: TXMLConfig; AKey: WideString; AFont: TFont);
1767
1848
begin
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));
1772
1853
end;
1773
1854
 
1774
 
procedure CfgGetFontValue(cfg: TXMLConfig; AKey:string; AFont: TFont);
 
1855
procedure CfgGetFontValue(cfg: TXMLConfig; AKey: WideString; AFont: TFont);
1775
1856
begin
1776
1857
  AFont.Name := cfg.GetValue(AKey + '/name/value', 'default');
1777
1858
  AFont.Size := cfg.GetValue(AKey + '/size/value', 0);
2046
2127
 
2047
2128
procedure TCustomGrid.InternalSetColWidths(aCol, aValue: Integer);
2048
2129
var
 
2130
  OldSize,NewSize: Integer;
2049
2131
  R: TRect;
2050
2132
  Bigger: boolean;
2051
2133
begin
2052
 
  if AValue<0 then
2053
 
    Avalue:=-1;
2054
 
 
2055
 
  if Avalue<>integer(PtrUInt(FCols[ACol])) then begin
2056
 
    Bigger := AValue>integer(PtrUInt(FCols[ACol]));
2057
 
    SetRawColWidths(ACol, Avalue);
 
2134
  NewSize := AValue;
 
2135
  if NewSize<0 then begin
 
2136
    AValue:=-1;
 
2137
    NewSize := FDefColWidth;
 
2138
  end;
 
2139
 
 
2140
  OldSize := integer(PtrUInt(FCols[ACol]));
 
2141
  if NewSize<>OldSize then begin
 
2142
 
 
2143
    if OldSize<0 then
 
2144
      OldSize := fDefColWidth;
 
2145
 
 
2146
    Bigger := NewSize>OldSize;
 
2147
    SetRawColWidths(ACol, AValue);
2058
2148
 
2059
2149
    if not (csLoading in ComponentState) and HandleAllocated then begin
2060
2150
 
2061
2151
      if FUpdateCount=0 then begin
2062
2152
        UpdateSizes;
2063
 
 
2064
2153
        R := CellRect(aCol, 0);
2065
2154
        R.Bottom := FGCache.MaxClientXY.Y+GetBorderWidth+1;
2066
2155
        if UseRightToLeftAlignment then begin
2206
2295
    Result:=nil;
2207
2296
end;
2208
2297
 
 
2298
function TCustomGrid.MouseButtonAllowed(Button: TMouseButton): boolean;
 
2299
begin
 
2300
  result := (Button=mbLeft);
 
2301
end;
 
2302
 
2209
2303
function TCustomGrid.IsTitleImageListStored: boolean;
2210
2304
begin
2211
2305
  Result := FTitleImageList <> nil;
2275
2369
end;
2276
2370
 
2277
2371
procedure TCustomGrid.SetFixedCols(const AValue: Integer);
2278
 
var
2279
 
  EditorAffected: boolean;
2280
2372
begin
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;
 
2378
    end;
2282
2379
    exit;
 
2380
  end;
2283
2381
  CheckFixedCount(ColCount, RowCount, AValue, FFixedRows);
2284
2382
 
2285
 
  EditorAffected := (AValue>=FCol);
2286
 
  if EditorAffected and EditorMode then
 
2383
  if EditorMode then
2287
2384
    EditorMode:=False;
2288
2385
 
2289
2386
  FFixedCols:=AValue;
2303
2400
    if not (csLoading in componentState) then
2304
2401
      doTopleftChange(true);
2305
2402
 
2306
 
    if EditorAffected then begin
2307
 
      MoveNextSelectable(False, FixedCols, FRow);
2308
 
      UpdateSelectionRange;
2309
 
    end;
 
2403
    MoveNextSelectable(False, FixedCols, FRow);
 
2404
    UpdateSelectionRange;
2310
2405
  end;
2311
2406
end;
2312
2407
 
2313
2408
procedure TCustomGrid.SetFixedRows(const AValue: Integer);
2314
 
var
2315
 
  EditorAffected: boolean;
2316
2409
begin
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;
 
2415
    end;
 
2416
    exit;
 
2417
  end;
2318
2418
  CheckFixedCount(ColCount, RowCount, FFixedCols, AValue);
2319
2419
 
2320
 
  EditorAffected := (AValue>=FRow);
2321
 
  if EditorAffected and EditorMode then
 
2420
  if EditorMode then
2322
2421
    EditorMode:=False;
2323
2422
 
2324
2423
  FFixedRows:=AValue;
2327
2426
  if not (csLoading in ComponentState) then
2328
2427
    doTopleftChange(true);
2329
2428
 
2330
 
  if EditorAffected then begin
2331
 
    MoveNextSelectable(False, FCol, FixedRows);
2332
 
    UpdateSelectionRange;
2333
 
  end;
 
2429
  MoveNextSelectable(False, FCol, FixedRows);
 
2430
  UpdateSelectionRange;
2334
2431
end;
2335
2432
 
2336
2433
procedure TCustomGrid.SetGridLineColor(const AValue: TColor);
2444
2541
    //DeltaOff := OffEnd - FGCache.ClickMouse.X;
2445
2542
    DeltaOff := 0;
2446
2543
 
2447
 
    result := (Index>=FixedCols);
 
2544
    if goFixedColSizing in Options then
 
2545
      result := (Index>=0)
 
2546
    else
 
2547
      result := (Index>=FixedCols);
2448
2548
  end;
2449
2549
 
2450
2550
end;
2461
2561
 
2462
2562
procedure TCustomGrid.Setrowheights(Arow: Integer; Avalue: Integer);
2463
2563
var
 
2564
  OldSize,NewSize: Integer;
2464
2565
  R: TRect;
2465
2566
  Bigger: boolean;
2466
2567
begin
2467
 
  if AValue<0 then
 
2568
 
 
2569
  NewSize := AValue;
 
2570
  if NewSize<0 then begin
2468
2571
    AValue:=-1;
2469
 
 
2470
 
  if AValue<>integer(PtrUInt(FRows[ARow])) then begin
2471
 
 
2472
 
    bigger := aValue > RowHeights[aRow];
 
2572
    NewSize := FDefRowHeight;
 
2573
  end;
 
2574
 
 
2575
  OldSize := integer(PtrUInt(FRows[ARow]));
 
2576
  if AValue<>OldSize then begin
 
2577
 
 
2578
    if OldSize<0 then
 
2579
      OldSize := FDefRowHeight;
 
2580
 
 
2581
    bigger := NewSize > OldSize;
2473
2582
 
2474
2583
    FRows[ARow]:=Pointer(PtrInt(AValue));
2475
2584
 
2781
2890
    until I>=R;
2782
2891
  end;
2783
2892
begin
2784
 
  CheckIndex(ColSorting, Index);
2785
 
  CheckIndex(not ColSorting, IndxFrom);
2786
 
  CheckIndex(not ColSorting, IndxTo);
2787
 
  BeginUpdate;
2788
 
  QuickSort(IndxFrom, IndxTo);
2789
 
  EndUpdate;
 
2893
  if RowCount>FixedRows then begin
 
2894
    CheckIndex(ColSorting, Index);
 
2895
    CheckIndex(not ColSorting, IndxFrom);
 
2896
    CheckIndex(not ColSorting, IndxTo);
 
2897
    BeginUpdate;
 
2898
    QuickSort(IndxFrom, IndxTo);
 
2899
    EndUpdate;
 
2900
  end;
2790
2901
end;
2791
2902
 
2792
2903
procedure TCustomGrid.doTopleftChange(dimChg: Boolean);
2856
2967
end;
2857
2968
 
2858
2969
procedure TCustomGrid.ResetSizes;
2859
 
 
2860
 
  function CalcMaxTopLeft: TPoint;
2861
 
  var
2862
 
    i: Integer;
2863
 
    W,H: Integer;
2864
 
  begin
2865
 
    Result:=Point(ColCount-1, RowCount-1);
2866
 
    W:=0;
2867
 
    for i:=ColCount-1 downto FFixedCols do begin
2868
 
      W:=W+GetColWidths(i);
2869
 
      if W<FGCache.ScrollWidth then Result.x:=i
2870
 
      else         Break;
2871
 
    end;
2872
 
    H:=0;
2873
 
    for i:=RowCount-1 downto FFixedRows do begin
2874
 
      H:=H+GetRowHeights(i);
2875
 
      if H<FGCache.ScrollHeight then Result.y:=i
2876
 
      else         Break;
2877
 
    end;
2878
 
  end;
2879
 
 
2880
 
  procedure CalcScrollbarsRange;
2881
 
  var
2882
 
    HsbVisible, VsbVisible: boolean;
2883
 
    HsbRange,VsbRange: Integer;
2884
 
    HsbPage, VsbPage: Integer;
2885
 
    HsbPos, VsbPos: Integer;
2886
 
  begin
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);
2893
 
      {$ifdef DbgScroll}
2894
 
      DebugLn('VRange=',dbgs(VsbRange),' Visible=',dbgs(VSbVisible));
2895
 
      DebugLn('HRange=',dbgs(HsbRange),' Visible=',dbgs(HSbVisible));
2896
 
      {$endif}
2897
 
    end;
2898
 
  end;
2899
2970
begin
2900
2971
  //DebugLn('TCustomGrid.VisualChange ',DbgSName(Self));
2901
2972
  if (FCols=nil) or ([csLoading,csDestroying]*ComponentState<>[])
2904
2975
 
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;
2913
 
  end;
2914
2978
  CacheVisibleGrid;
2915
2979
  {$Ifdef DbgVisualChange}
2916
2980
  DebugLn('TCustomGrid.ResetSizes %s Width=%d Height=%d',[DbgSName(Self),Width,Height]);
2946
3010
begin
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]);
2950
3015
    {$endif}
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;
2954
3021
    {$ifdef Unix}
2955
3022
    ScrollInfo.fMask := ScrollInfo.fMask or SIF_UPDATEPOLICY;
2956
3023
    if goThumbTracking in Options then
2964
3031
    if APage<0 then
2965
3032
      APage := 0;
2966
3033
    ScrollInfo.nPage := APage;
 
3034
    if (Which=SB_HORZ) and UseRightToLeftAlignment then begin
 
3035
      ScrollInfo.nPos := ScrollInfo.nMax-ScrollInfo.nPage-ScrollInfo.nPos;
 
3036
      {$Ifdef DbgScroll}
 
3037
      DebugLn('ScrollbarRange: RTL nPos=%d',[ScrollInfo.nPos]);
 
3038
      {$endif}
 
3039
    end;
2967
3040
    SetScrollInfo(Handle, Which, ScrollInfo, True);
2968
3041
  end;
2969
3042
end;
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;
 
3062
      {$Ifdef DbgScroll}
 
3063
      DebugLn('ScrollbarPosition: Which=',SbToStr(Which), ' RTL Value= ',IntToStr(Value));
 
3064
      {$endif}
 
3065
    end;
2985
3066
    ScrollInfo.fMask := SIF_POS;
2986
3067
    ScrollInfo.nPos:= Value;
2987
3068
    SetScrollInfo(Handle, Which, ScrollInfo, Vis);
3069
3150
 
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);
3082
3165
 
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
3118
3203
  begin
3119
3204
    RNew:=CellRect(aCol,aRow);
3120
 
    RNew.Left := FlipX(RNew.Left);
3121
 
    RNew.Right := FlipX(RNew.Right);
 
3205
    if UseRightToLeftAlignment then begin
 
3206
      XInc := RNew.Right;
 
3207
      RNew.Right := FlipX(RNew.Left);
 
3208
      RNew.Left := FlipX(XInc);
 
3209
    end;
3122
3210
 
3123
3211
    Xinc := 0;
3124
3212
    if RNew.Right <= FGCache.FixedWidth+GetBorderWidth then
3128
3216
      Xinc := 1               // hidden at the right of clientwidth line
3129
3217
    else
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
3134
3223
    end;
3141
3230
      YInc := 1               // hidden at the bottom of clientheight line
3142
3231
    else
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
3147
3237
    end;
3209
3299
end;
3210
3300
 
3211
3301
procedure TCustomGrid.HeaderClick(IsColumn: Boolean; index: Integer);
 
3302
var
 
3303
  ColOfs: Integer;
3212
3304
begin
 
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');
 
3312
    end;
 
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;
 
3318
      end;
 
3319
    end
 
3320
    else begin
 
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;
 
3327
    end;
 
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;
 
3340
        end;
 
3341
      end;
 
3342
    FSortColumn := index;
 
3343
    Sort(True, index, FFixedRows, RowCount-1);
 
3344
  end;
3213
3345
end;
3214
3346
 
3215
3347
procedure TCustomGrid.HeaderSized(IsColumn: Boolean; index: Integer);
3262
3394
  DebugLn('TCustomGrid.Paint %s Row=%d Clip=%s',[DbgSName(Self),Row,Dbgs(R)]);
3263
3395
  {$endif}
3264
3396
  if gfVisualChange in fGridFlags then begin
 
3397
    {$ifdef DbgVisualChange}
 
3398
    DebugLnEnter('Resetting Sizes in Paint INIT');
 
3399
    {$endif}
 
3400
    FGridFlags := FGridFlags + [gfPainting];
3265
3401
    ResetSizes;
3266
 
    exclude(FGridFlags, gfVisualChange);
 
3402
    FGridFlags := FGridFlags - [gfVisualChange, gfPainting];
 
3403
    {$ifdef DbgVisualChange}
 
3404
    DebugLnExit('Resetting Sizes in Paint DONE');
 
3405
    {$endif}
3267
3406
  end;
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;
3320
3461
  end else begin
3321
3462
    Canvas.TextStyle := DefaultTextStyle;
3326
3467
  DoPrepareCanvas(aCol, aRow, aState);
3327
3468
end;
3328
3469
 
 
3470
procedure TCustomGrid.PrepareCellHints(ACol, ARow: Integer);
 
3471
begin
 
3472
end;
 
3473
 
 
3474
procedure TCustomGrid.UnprepareCellHints;
 
3475
begin
 
3476
end;
 
3477
 
3329
3478
procedure TCustomGrid.ResetEditor;
3330
3479
begin
3331
3480
  EditorGetValue(True);
3336
3485
procedure TCustomGrid.ResetHotCell;
3337
3486
begin
3338
3487
  with FGCache do begin
3339
 
    if HotCellPainted then
 
3488
    if HotCellPainted and (HotCell.x < ColCount) and (HotCell.y < RowCount) then
3340
3489
      InvalidateCell(HotCell.X, HotCell.Y);
3341
3490
    HotCell := Point(-1,-1);
3342
3491
    HotCellPainted := False;
3388
3537
begin
3389
3538
end;
3390
3539
 
 
3540
procedure TCustomGrid.ShowCellHintWindow(APoint: TPoint);
 
3541
var
 
3542
  cell: TPoint;
 
3543
  txt1, txt2, txt: String;
 
3544
  w: Integer;
 
3545
  gds: TGridDrawState;
 
3546
begin
 
3547
  if ([goCellHints, goTruncCellHints]*Options = []) then 
 
3548
    exit;
 
3549
 
 
3550
  cell := MouseToCell(APoint);
 
3551
  if (cell.x = -1) or (cell.y = -1) then
 
3552
    exit;
 
3553
 
 
3554
  txt := '';
 
3555
  txt1 := '';
 
3556
  txt2 := '';
 
3557
  PrepareCellHints(cell.x, cell.y); // in DBGrid, set the active record to cell.y
 
3558
  try
 
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
 
3567
        txt2 := '';
 
3568
    end;
 
3569
  finally
 
3570
    UnprepareCellHints;
 
3571
  end;
 
3572
 
 
3573
  if FCellHintPriority = chpTruncOnly then begin
 
3574
    if (txt2 <> '') then
 
3575
      txt := txt2
 
3576
    else
 
3577
      txt := txt1;
 
3578
  end else begin
 
3579
    if (txt1 <> '') and (txt2 <> '') then
 
3580
      txt := txt1 + #13 + txt2
 
3581
    else if txt1 <> '' then
 
3582
      txt := txt1
 
3583
    else if txt2 <> '' then
 
3584
      txt := txt2;
 
3585
    if (FCellHintPriority = chpAll) and (txt <> '') then
 
3586
      txt := FSavedHint + #13 + txt;
 
3587
  end;
 
3588
  if (txt = '') and (FSavedHint <> '') then
 
3589
    txt := FSavedHint;
 
3590
 
 
3591
  if (txt <> '') and not EditorMode and not (csDesigning in ComponentState) then begin
 
3592
    Hint := txt;
 
3593
    Application.ActivateHint(APoint, true);
 
3594
  end else
 
3595
    HideCellHintWindow;
 
3596
end;
 
3597
 
 
3598
procedure TCustomGrid.HideCellHintWindow;
 
3599
begin
 
3600
  Hint := FSavedHint;
 
3601
  Application.CancelHint;
 
3602
end;
3391
3603
 
3392
3604
function TCustomGrid.SelectCell(ACol, ARow: Integer): Boolean;
3393
3605
begin
3449
3661
    dx := 4;
3450
3662
    dy := 4;
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);
3455
 
    X := R.Left;
3456
 
    Y := R.Bottom - dy;
3457
 
    //TODO need Bidi
3458
 
    Canvas.Polygon([Point(x-dx,y),point(x+dx,y),point(x,y+dy), point(x-dx,y)]);
3459
 
    Y := R.Top + dy;
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;
 
3668
    X := R.Left - 2*dx;
 
3669
    Canvas.Polygon([Point(x,y+dy),point(x,y-dy),point(x+dx,y), point(x,y+dy)]);
 
3670
    X := R.Left + 2*dx;
 
3671
    Canvas.Polygon([Point(x,y+dy),point(x,y-dy),point(x-dx,y), point(x,y+dy)]);
3461
3672
    {$else}
3462
3673
    Canvas.Pen.Width:=3;
3463
3674
    Canvas.Pen.Color:=clRed;
3471
3682
    dx := 4;
3472
3683
    dy := 4;
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);
3477
 
    X := R.Right - dx;
3478
 
    Y := R.Top;
3479
 
    Canvas.Polygon([Point(x,y+dy),point(x,y-dy),point(x+dx,y), point(x,y+dy)]);
3480
 
    X := R.Left + dx;
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;
 
3689
    Y := R.Top - 2*dy;
 
3690
    Canvas.Polygon([Point(x-dx,y),point(x+dx,y),point(x,y+dy), point(x-dx,y)]);
 
3691
    Y := R.Top + 2*dy;
 
3692
    Canvas.Polygon([Point(x-dx,y),point(x+dx,y),point(x,y-dy), point(x-dx,y)]);
3482
3693
    {$else}
3483
3694
    Canvas.Pen.Width:=3;
3484
3695
    Canvas.Pen.Color:=clRed;
3604
3815
 
3605
3816
procedure TCustomGrid.DrawRow(aRow: Integer);
3606
3817
var
3607
 
  Gds: TGridDrawState;
 
3818
  gds: TGridDrawState;
3608
3819
  aCol: Integer;
3609
3820
  Rs: Boolean;
3610
3821
  R: TRect;
3617
3828
    with FGCache do begin
3618
3829
      if (aCol=HotCell.x) and (aRow=HotCell.y) and not IsPushCellActive() then begin
3619
3830
        Include(gds, gdHot);
3620
 
        HotCellPainted:=True;
 
3831
        HotCellPainted := True;
3621
3832
      end;
3622
3833
      if ClickCellPushed and (aCol=PushedCell.x) and (aRow=PushedCell.y) then begin
3623
3834
        Include(gds, gdPushed);
3624
 
       end;
 
3835
      end;
3625
3836
    end;
3626
3837
 
3627
3838
    Canvas.SaveHandleState;
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));
3646
3857
    {$ENDIF}
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
3655
3866
        continue;
3656
 
      gds := [];
3657
3867
      Rs := (goRowSelect in Options);
3658
 
      if ARow<FFixedRows then
3659
 
        include(gds, gdFixed)
3660
 
      else begin
3661
 
        if (aCol=FCol)and(aRow=FRow) then
3662
 
          gds := gds + [gdFocused, gdSelected]
3663
 
        else
3664
 
        if IsCellSelected[aCol, aRow] then
3665
 
          include(gds, gdSelected);
3666
 
      end;
3667
 
 
 
3868
      gds := GetGridDrawState(ACol, ARow);
3668
3869
      DoDrawCell;
3669
3870
    end;
3670
3871
 
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
3695
3896
      DoDrawCell;
3696
3897
  end;
3697
3898
end;
3698
3899
 
3699
3900
procedure TCustomGrid.EditButtonClicked(Sender: TObject);
3700
3901
begin
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)
3704
3905
    else
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);
3807
 
        end else begin
3808
 
          MoveTo(Left, Bottom - 1);
3809
 
          LineTo(Right, Bottom - 1);
3810
 
        end;
 
4005
        MoveTo(Left, Bottom - 1);
 
4006
        LineTo(Right, Bottom - 1);
3811
4007
      end;
3812
4008
      if Dv then begin
3813
4009
        if UseRightToLeftAlignment then begin
3870
4066
 
3871
4067
    if (Left<>Right) and (Top<>Bottom) then
3872
4068
      Canvas.TextRect(aRect,Left,Top, aText);
3873
 
 
3874
4069
  end;
3875
4070
end;
3876
4071
 
3989
4184
 
3990
4185
procedure TCustomGrid.WMHScroll(var message: TLMHScroll);
3991
4186
var
3992
 
  C,TL,CTL: Integer;
 
4187
  C,TL,CTL,aPos: Integer;
3993
4188
  R: TRect;
 
4189
  ScrollInfo: TScrollInfo;
 
4190
  aCode: Smallint;
3994
4191
 
3995
4192
  function NextColWidth(aCol: Integer; Delta: Integer): integer;
3996
4193
  begin
4000
4197
    until (Result<>0) or (aCol>=ColCount) or (aCol<0);
4001
4198
  end;
4002
4199
 
4003
 
  function ThumbPos: Integer;
4004
 
  var
4005
 
    ScrollInfo: TScrollInfo;
4006
 
  begin
4007
 
    ScrollInfo.cbSize := SizeOf(ScrollInfo);
4008
 
    ScrollInfo.fMask := SIF_RANGE or SIF_PAGE;
 
4200
begin
 
4201
 
 
4202
  {$IfDef dbgScroll}
 
4203
  DebugLn('HSCROLL: Code=%d Position=%d',[message.ScrollCode, message.Pos]);
 
4204
  {$Endif}
 
4205
 
 
4206
  if not FGCache.ValidGrid or not HandleAllocated then
 
4207
    exit;
 
4208
 
 
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);
4010
 
    with ScrollInfo do
4011
 
      if not (goSmoothScroll in Options) and (message.Pos>=(nMax-nMin-nPage)) then
4012
 
        result := TL
4013
 
      else
4014
 
        result := message.Pos;
4015
 
  end;
4016
 
begin
4017
 
 
4018
 
  {$IfDef dbgScroll}
4019
 
  DebugLn('HSCROLL: Code=%d Position=%d',[message.ScrollCode, message.Pos]);
4020
 
  {$Endif}
4021
 
 
4022
 
  if not FGCache.ValidGrid or not HandleAllocated then
4023
 
    exit;
 
4214
    aPos := (ScrollInfo.nMax-ScrollInfo.nPage)-Message.Pos;
 
4215
    case aCode of
 
4216
      SB_LINERIGHT: aCode := SB_LINELEFT;
 
4217
      SB_LINELEFT: aCode := SB_LINERIGHT;
 
4218
      SB_PAGERIGHT: aCode := SB_PAGELEFT;
 
4219
      SB_PAGELEFT: aCode := SB_PAGERIGHT;
 
4220
    end;
 
4221
    {$IfDef dbgScroll}
 
4222
    DebugLn('HSCROLL: (RTL) Code=%d Position=%d',[aCode, aPos]);
 
4223
    {$Endif}
 
4224
  end else
 
4225
    aPos := Message.Pos;
4024
4226
 
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;
4028
4230
  end;
4029
4231
 
4030
 
  case message.ScrollCode of
4031
 
      // Scrolls to start / end of the text
 
4232
  case aCode of
4032
4233
    SB_TOP:        C := 0;
4033
 
    SB_BOTTOM:     C := TL;
 
4234
    SB_BOTTOM:
 
4235
    begin
 
4236
      if not (goSmoothScroll in Options) then
 
4237
        TL := TL + 1;
 
4238
      C := TL;
 
4239
    end;
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);
4039
4245
    SB_PAGELEFT:   C := CTL - FGCache.ClientWidth;
4040
4246
      // Scrolls to the current scroll bar position
4041
4247
    SB_THUMBPOSITION:
4042
 
      C := ThumbPos;
 
4248
      C := aPos;
4043
4249
    SB_THUMBTRACK:
4044
4250
      if goThumbTracking in Options then
4045
 
        C := ThumbPos
 
4251
        C := aPos
4046
4252
      else
4047
4253
        Exit;
4048
4254
      // Ends scrolling
4050
4256
      Exit;
4051
4257
  end;
4052
4258
 
 
4259
  {$Ifdef dbgScroll}
 
4260
  DebugLn('HSCROLL: C=%d TL=%d CTL=%d',[C,TL,CTL]);
 
4261
  {$Endif}
 
4262
 
4053
4263
  if C > TL then C := TL else
4054
4264
  if C < 0 then C := 0;
4055
4265
 
4063
4273
  {$Ifdef dbgScroll}
4064
4274
  DebugLn('HSCROLL: NewPosition=%d',[C]);
4065
4275
  {$Endif}
 
4276
  if UseRightToLeftAlignment then
 
4277
    C := FlipX(C);
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]);
4075
4287
  {$Endif}
4076
4288
 
4077
 
  if not (goSmoothScroll in Options) then
4078
 
    FGCache.TLColOff:=0;
4079
4289
 
4080
4290
  if TL<>FTopLeft.X then begin
4081
4291
    TryScrollTo(Tl, FTopLeft.Y);
4082
4292
  end else
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;
 
4301
        R.Left := C + 1;
 
4302
      end;
4090
4303
      InvalidateRect(Handle, @R, false);
 
4304
    end;
4091
4305
  end;
4092
4306
 
4093
4307
  if EditorMode then
4107
4321
    until (Result<>0) or (aRow>=RowCount) or (aRow<0);
4108
4322
  end;
4109
4323
 
4110
 
  function ThumbPos: Integer;
4111
 
  var
4112
 
    ScrollInfo: TScrollInfo;
4113
 
  begin
4114
 
    ScrollInfo.cbSize := SizeOf(ScrollInfo);
4115
 
    ScrollInfo.fMask := SIF_RANGE or SIF_PAGE;
4116
 
    GetScrollInfo(Handle, SB_VERT, ScrollInfo);
4117
 
    with ScrollInfo do
4118
 
      if not (goSmoothScroll in Options) and (message.Pos>=(nMax-nMin-nPage)) then
4119
 
        result := TL
4120
 
      else
4121
 
        result := message.Pos;
4122
 
  end;
4123
 
 
4124
4324
begin
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;
4140
 
    SB_BOTTOM:     C := TL;
 
4340
    SB_BOTTOM:
 
4341
    begin
 
4342
      if not (goSmoothScroll in Options) then
 
4343
        TL := TL + 1;
 
4344
      C := TL;
 
4345
    end;
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);
4146
4351
    SB_PAGEUP:     C := CTL - FGCache.ClientHeight;
4147
4352
      // Scrolls to the current scroll bar position
4148
4353
    SB_THUMBPOSITION:
4149
 
      C := ThumbPos;
 
4354
      C := Message.Pos;
4150
4355
    SB_THUMBTRACK:
4151
4356
      if goThumbTracking in Options then
4152
 
        C := ThumbPos
 
4357
        C := Message.Pos
4153
4358
      else
4154
4359
        Exit;
4155
4360
      // Ends scrolling
4270
4475
    LM_HSCROLL, LM_VSCROLL:
4271
4476
      if csDesigning in ComponentState then
4272
4477
        exit;
 
4478
    {$IFDEF MSWINDOWS}
 
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.
 
4482
    LM_SIZE:
 
4483
      if gfUpdatingSize in FGridFlags then
 
4484
        exit;
 
4485
    {$ENDIF}
4273
4486
  end;
4274
4487
  inherited WndProc(TheMessage);
4275
4488
end;
4340
4553
 
4341
4554
  FGCache.ClientRect := ClientRect;
4342
4555
  FGCache.ClientWidth := ClientWidth;
4343
 
  FGCache.ClientHeight:= ClientHeight;
 
4556
  FGCache.ClientHeight := ClientHeight;
 
4557
 
 
4558
  FGCache.ScrollWidth := FGCache.ClientWidth-FGCache.FixedWidth;
 
4559
  FGCache.ScrollHeight := FGCache.ClientHeight-FGCache.FixedHeight;
 
4560
  FGCache.MaxTopLeft:=CalcMaxTopLeft;
 
4561
 
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]);
4349
4568
  {$endif}
4350
4569
end;
4351
4570
 
4407
4626
 
4408
4627
procedure TCustomGrid.GetSBRanges(const HsbVisible, VsbVisible: boolean; out
4409
4628
  HsbRange,VsbRange,HsbPage,VSbPage,HsbPos,VsbPos: Integer);
4410
 
var
4411
 
  Tw, Th: Integer;
4412
4629
begin
4413
4630
  with FGCache do begin
4414
4631
 
4415
4632
    HsbRange := 0;
4416
4633
    HsbPos := 0;
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;
4422
 
      end;
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
 
4638
      end
 
4639
      else
 
4640
        HsbRange:=GridWidth - GetBorderWidth;
 
4641
      if (FTopLeft.x>=0) and (FTopLeft.x<=ColCount-1) then
 
4642
        HsbPos := integer(PtrUInt(AccumWidth[FTopLeft.x]))+TLColOff-FixedWidth;
4425
4643
    end;
4426
4644
 
4427
4645
    VsbRange := 0;
4428
4646
    VsbPos := 0;
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;
4434
 
      end;
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
 
4651
      end
 
4652
      else
 
4653
        VSbRange:= GridHeight - GetBorderWidth;
 
4654
      if (FTopLeft.y>=0) and (FTopLeft.y<=RowCount-1) then
 
4655
        VsbPos := integer(PtrUInt(AccumHeight[FTopLeft.y]))+TLRowOff-FixedHeight;
4437
4656
    end;
4438
4657
 
4439
4658
    HsbPage := ClientWidth;
4440
4659
    VSbPage := ClientHeight;
 
4660
 
 
4661
    {$ifdef dbgscroll}
 
4662
    DebugLn('GetSBRanges: HRange=%d HPage=%d HPos=%d VRange=%d VPage=%d VPos=%d',
 
4663
      [HSbRange,HsbPage,HsbPos, VsbRange, VsbPage, VsbPos]);
 
4664
    {$endif}
4441
4665
  end;
4442
4666
end;
4443
4667
 
4464
4688
  Include(FGridFlags, gfVisualChange);
4465
4689
  UpdateCachedSizes;
4466
4690
  CacheVisibleGrid;
4467
 
  UpdateSBVisibility;
 
4691
  CalcScrollbarsRange;
4468
4692
end;
4469
4693
 
4470
4694
procedure TCustomGrid.UpdateSelectionRange;
4697
4921
    Invalidate;
4698
4922
end;
4699
4923
 
 
4924
procedure TCustomGrid.SetColumnClickSorts(const AValue: boolean);
 
4925
begin
 
4926
  if FColumnClickSorts=AValue then exit;
 
4927
  FColumnClickSorts:=AValue;
 
4928
end;
 
4929
 
4700
4930
procedure TCustomGrid.SetColumns(const AValue: TGridColumns);
4701
4931
begin
4702
4932
  FColumns.Assign(Avalue);
4829
5059
    FullVisibleGrid := VisibleGrid;
4830
5060
    if ValidGrid then
4831
5061
      with FullVisibleGrid do begin
4832
 
        if TLColOff>0 then
4833
 
          Left := Min(Left+1, Right);
4834
 
        if TLRowOff>0 then
4835
 
          Top  := Min(Top+1, Bottom);
 
5062
        if goSmoothScroll in Options then begin
 
5063
          if TLColOff>0 then
 
5064
            Left := Min(Left+1, Right);
 
5065
          if TLRowOff>0 then
 
5066
            Top  := Min(Top+1, Bottom);
 
5067
        end;
4836
5068
        R := CellRect(Right, Bottom);
4837
5069
        if R.Right>(ClientWidth+GetBorderWidth) then
4838
5070
          Right := Max(Right-1, Left);
4891
5123
end;
4892
5124
 
4893
5125
procedure TCustomGrid.SetSelection(const AValue: TGridRect);
 
5126
var
 
5127
  OldSelectActive: boolean;
4894
5128
begin
4895
5129
  if goRangeSelect in Options then
4896
5130
  with AValue do begin
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;
 
5145
      end;
4903
5146
      Invalidate;
4904
5147
    end;
4905
5148
  end;
4956
5199
    HeaderSizing(true, Index, X - OffIni + DeltaOff);
4957
5200
    exit(true);
4958
5201
  end else
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)))
4962
5205
  then begin
4963
5206
 
4964
5207
    // find closest cell and cell boundaries
4980
5223
        FindPrevColumn;
4981
5224
    end;
4982
5225
 
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
4985
 
      // start resizing
4986
 
      if Cursor<>crHSplit then begin
4987
 
        PrevLine := false;
4988
 
        PrevOffset := -1;
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
 
5229
        Offset := 0
 
5230
      else
 
5231
        Offset := FFixedCols;
 
5232
      if Index>=Offset then begin
 
5233
        // start resizing
 
5234
        if Cursor<>crHSplit then begin
 
5235
          PrevLine := false;
 
5236
          PrevOffset := -1;
 
5237
          ChangeCursor(crHSplit);
 
5238
        end;
 
5239
        exit(true);
4990
5240
      end;
4991
 
      exit(true);
4992
5241
    end;
4993
5242
 
4994
5243
  end;
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;
 
5403
        end;
5152
5404
        if (Index<0) or (Index>=ColCount) or (Offset>GridWidth-1) then begin
5153
5405
          if AllowOutboundEvents then
5154
5406
            Index := ColCount-1
5216
5468
      Exit;
5217
5469
    end;
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;
 
5475
      end;
5221
5476
    end else begin
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;
 
5481
      end;
5224
5482
    end;
5225
5483
    if IsCol and UseRightToLeftAlignment then
5226
5484
    begin
5227
 
      EndPos := FlipX(StartPos);
5228
 
      StartPos := EndPos - Dim + 1;
 
5485
      EndPos := FlipX(StartPos) + 1;
 
5486
      StartPos := EndPos - Dim;
5229
5487
    end
5230
5488
    else
5231
5489
      EndPos:=StartPos + Dim;
5337
5595
    Result := gzNormal;
5338
5596
end;
5339
5597
 
5340
 
procedure TCustomGrid.DoOPExchangeColRow(IsColumn: Boolean; index, WithIndex: Integer
5341
 
  );
 
5598
procedure TCustomGrid.DoOPExchangeColRow(IsColumn: Boolean; index, WithIndex: Integer);
5342
5599
var
5343
5600
  ColRow: integer;
5344
5601
begin
5568
5825
begin
5569
5826
  inherited MouseDown(Button, Shift, X, Y);
5570
5827
 
5571
 
  if (csDesigning in componentState) or not (ssLeft in Shift) then
 
5828
  if (csDesigning in componentState) or not MouseButtonAllowed(Button) then
5572
5829
    Exit;
5573
5830
 
5574
5831
  {$IfDef dbgGrid} DebugLn('MouseDown INIT'); {$Endif}
5579
5836
  DebugLn('Mouse was in ', dbgs(FGCache.HotGridZone));
5580
5837
  {$ENDIF}
5581
5838
 
5582
 
  FGCache.ClickMouse := Point(X,Y);
5583
 
  FGCache.ClickCell  := MouseToCell(FGCache.ClickMouse);
 
5839
  CacheMouseDown(X,Y);
5584
5840
 
5585
5841
  case FGCache.HotGridZone of
5586
5842
 
5587
5843
    gzFixedCells:
5588
5844
      begin
5589
 
        FGridState := gsHeaderClicking;
5590
 
        if ((goHeaderPushedLook in Options) and
5591
 
            (FGCache.HotGridZone in FHeaderPushZones)) then
5592
 
          DoPushCell;
 
5845
        if (goColSizing in Options) and (goFixedColSizing in Options) and
 
5846
           (Cursor=crHSplit) then
 
5847
          fGridState:= gsColSizing
 
5848
        else begin
 
5849
          FGridState := gsHeaderClicking;
 
5850
          if ((goHeaderPushedLook in Options) and
 
5851
              (FGCache.HotGridZone in FHeaderPushZones)) then
 
5852
            DoPushCell;
 
5853
        end;
5593
5854
      end;
5594
5855
 
5595
5856
    gzFixedCols:
5689
5950
procedure TCustomGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
5690
5951
var
5691
5952
  p: TPoint;
 
5953
  obe: boolean;  // stored "AllowOutboundEvents"
5692
5954
begin
5693
5955
  inherited MouseMove(Shift, X, Y);
5694
5956
 
5726
5988
 
5727
5989
        if goRowSizing in Options then
5728
5990
          doRowSizing(X,Y);
 
5991
 
 
5992
        obe := AllowOutboundEvents;
 
5993
        AllowOutboundEvents := false;
 
5994
        try
 
5995
          p := MouseCoord(X, Y);
 
5996
        finally
 
5997
          AllowOutboundEvents := obe;
 
5998
        end;
 
5999
        with FGCache do
 
6000
          if (MouseCell.X <> p.X) or (MouseCell.Y <> p.Y) then begin
 
6001
            Application.CancelHint;
 
6002
            ShowCellHintWindow(Point(X,Y));
 
6003
            MouseCell := p;
 
6004
          end;
5729
6005
      end;
5730
6006
  end;
5731
6007
end;
5747
6023
        if fGridState=gsHeaderClicking then
5748
6024
          HeaderClick(True, FGCache.ClickCell.X)
5749
6025
        else
5750
 
        if Assigned(OnEditButtonClick) then
 
6026
        if Assigned(OnEditButtonClick) or Assigned(OnButtonClick) then
5751
6027
          DoEditButtonClick(Cur.X, Cur.Y);
5752
6028
      end;
5753
6029
 
5784
6060
      begin
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}
 
6065
            InvalidateCol(0);
 
6066
            {$else}
 
6067
            Invalidate;
 
6068
            {$endif}
5787
6069
          DoOPMoveColRow(False, FGCache.ClickCell.Y, FMoveLast.Y);
5788
6070
          ChangeCursor;
5789
6071
        end else
5943
6225
  editorGetValue;
5944
6226
end;
5945
6227
 
 
6228
function TCustomGrid.DialogChar(var Message: TLMKey): boolean;
 
6229
var
 
6230
  i: Integer;
 
6231
begin
 
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
 
6235
        result := true;
 
6236
        HeaderClick(True, GridColumnFromColumnIndex(i));
 
6237
        exit;
 
6238
      end;
 
6239
  result := inherited DialogChar(Message);
 
6240
end;
 
6241
 
5946
6242
function TCustomGrid.DoCompareCells(Acol, ARow, Bcol, BRow: Integer): Integer;
5947
6243
begin
5948
6244
  result := 0;
5967
6263
  try
5968
6264
    FCol:=ACol;
5969
6265
    FRow:=ARow;
5970
 
    OnEditButtonClick(Self);
 
6266
    if Assigned(OnEditButtonClick) then
 
6267
      OnEditButtonClick(Self);
 
6268
    if Assigned(OnButtonClick) then
 
6269
      OnButtonClick(Self, ACol, ARow);
5971
6270
  finally
5972
6271
    if (FCol=ACol) and (FRow=ARow) then
5973
6272
    begin
6012
6311
begin
6013
6312
  inherited DoOnChangeBounds;
6014
6313
 
 
6314
  FGridFlags := FGridFlags + [gfUpdatingSize];
 
6315
 
6015
6316
  AVailSpace.x := ClientWidth - FGCache.MaxClientXY.x;
6016
6317
  AVailSpace.y := ClientHeight - FGCache.MaxClientXY.y;
6017
6318
  NewTopLeft := FTopLeft;
6040
6341
    DoTopLeftChange(True);
6041
6342
  end else
6042
6343
    VisualChange;
 
6344
 
 
6345
  FGridFlags := FGridFlags - [gfUpdatingSize];
6043
6346
end;
6044
6347
 
6045
6348
procedure TCustomGrid.DoPasteFromClipboard;
6128
6431
  {$IfDef dbgGrid}DebugLn('DoEnter - END');{$Endif}
6129
6432
end;
6130
6433
 
 
6434
function TCustomGrid.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
 
6435
  MousePos: TPoint): Boolean;
 
6436
begin
 
6437
  if FMouseWheelOption=mwCursor then
 
6438
    FSelectActive := false;
 
6439
  Result:=inherited DoMouseWheel(Shift, WheelDelta, MousePos);
 
6440
end;
 
6441
 
6131
6442
function TCustomGrid.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint
6132
6443
  ): Boolean;
6133
6444
begin
6305
6616
        end;
6306
6617
      end;
6307
6618
  end;
 
6619
  if FEditorKey then
 
6620
    FRowAutoInserted:=False;
6308
6621
  {$ifdef dbgGrid}DebugLn('Grid.KeyDown END Key=',IntToStr(Key));{$endif}
6309
6622
end;
6310
6623
 
6365
6678
    Result:= (Left<=ACol)and(aCol<=Right)and(Top<=aRow)and(aRow<=Bottom);
6366
6679
end;
6367
6680
 
 
6681
function TCustomGrid.IsFixedCellVisible(aCol, aRow: Integer): boolean;
 
6682
begin
 
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))));
 
6686
end;
 
6687
 
6368
6688
procedure TCustomGrid.InvalidateCol(ACol: Integer);
6369
6689
var
6370
6690
  R: TRect;
6426
6746
  OldRange: TRect;
6427
6747
  ForceReset: boolean;
6428
6748
begin
6429
 
 
6430
6749
  Result:=TryMoveSelection(Relative,DCol,DRow);
6431
6750
  if (not Result) then Exit;
6432
6751
 
6456
6775
  if not ScrollToCell(DCol, DRow, ForceReset) then
6457
6776
    InvalidateMovement(DCol, DRow, OldRange);
6458
6777
 
6459
 
  SwapInt(DCol,FCol);
6460
 
  SwapInt(DRow,FRow);
 
6778
  FCol := DCol;
 
6779
  FRow := DRow;
6461
6780
 
6462
6781
  MoveSelection;
6463
6782
  SelectEditor;
6494
6813
  CInc,RInc: Integer;
6495
6814
  NCol,NRow: Integer;
6496
6815
  SelOk: Boolean;
 
6816
  i: Integer;
6497
6817
begin
6498
6818
  // Reference
6499
6819
  if not Relative then begin
6502
6822
    DCol:=NCol-FCol;
6503
6823
    DRow:=NRow-FRow;
6504
6824
  end else begin
6505
 
    NCol:=FCol + DCol;
6506
 
    NRow:=FRow + DRow;
 
6825
    NCol:=FCol+DCol;
 
6826
    NRow:=FRow+DRow;
 
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;
 
6835
              Break;
 
6836
            end;
 
6837
      end
 
6838
      else if FRowAutoInserted and (DRow=-1) then begin
 
6839
        RowCount:=RowCount-1;
 
6840
        FRowAutoInserted:=False;
 
6841
      end;
 
6842
    end;
6507
6843
  end;
6508
6844
 
6509
6845
  Checklimits(NCol, NRow);
6545
6881
  if FixedGrid then
6546
6882
    exit;
6547
6883
 
6548
 
  dCol:=FCol*(1-Byte(not Relative))+DCol;
6549
 
  dRow:=FRow*(1-Byte(not Relative))+DRow;
 
6884
  if Relative then begin
 
6885
    Inc(DCol, FCol);
 
6886
    Inc(DRow, FRow);
 
6887
  end;
6550
6888
 
6551
6889
  CheckLimits(DCol, DRow);
6552
6890
 
6553
6891
  // Change on Focused cell?
6554
 
  if (Dcol=FCol) and (DRow=FRow) then begin
6555
 
    SelectCell(DCol,DRow);
6556
 
  end else begin
 
6892
  if (DCol=FCol) and (DRow=FRow) then
 
6893
    SelectCell(DCol,DRow)
 
6894
  else
6557
6895
    Result:=SelectCell(DCol,DRow);
6558
 
  end;
6559
6896
end;
6560
6897
 
6561
6898
procedure TCustomGrid.UnLockEditor;
6568
6905
  const aRange,aPage,aPos: Integer);
6569
6906
begin
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]);
6573
6910
  {$endif}
6574
6911
  ScrollBarShow(SB_HORZ, aVisible);
6575
6912
  if aVisible then
6580
6917
  const aRange,aPage,aPos: Integer);
6581
6918
begin
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]);
6585
6922
  {$endif}
6586
6923
  ScrollBarShow(SB_VERT, aVisible);
6587
6924
  if aVisible then
6663
7000
  }
6664
7001
end;
6665
7002
 
 
7003
procedure TCustomGrid.CalcScrollbarsRange;
 
7004
var
 
7005
  HsbVisible, VsbVisible: boolean;
 
7006
  HsbRange,VsbRange: Integer;
 
7007
  HsbPage, VsbPage: Integer;
 
7008
  HsbPos, VsbPos: Integer;
 
7009
begin
 
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);
 
7015
    {$ifdef DbgScroll}
 
7016
    DebugLn('VRange=',dbgs(VsbRange),' Visible=',dbgs(VSbVisible));
 
7017
    DebugLn('HRange=',dbgs(HsbRange),' Visible=',dbgs(HSbVisible));
 
7018
    {$endif}
 
7019
  end;
 
7020
end;
 
7021
 
 
7022
function TCustomGrid.CalcMaxTopLeft: TPoint;
 
7023
var
 
7024
  i: Integer;
 
7025
  W,H: Integer;
 
7026
begin
 
7027
  Result:=Point(ColCount-1, RowCount-1);
 
7028
  W:=0;
 
7029
  for i:=ColCount-1 downto FFixedCols do begin
 
7030
    W:=W+GetColWidths(i);
 
7031
    if W<=FGCache.ScrollWidth then
 
7032
      Result.x:=i
 
7033
    else
 
7034
      Break;
 
7035
  end;
 
7036
  H:=0;
 
7037
  for i:=RowCount-1 downto FFixedRows do begin
 
7038
    H:=H+GetRowHeights(i);
 
7039
    if H<=FGCache.ScrollHeight then
 
7040
      Result.y:=i
 
7041
    else
 
7042
      Break;
 
7043
  end;
 
7044
end;
 
7045
 
6666
7046
procedure TCustomGrid.CellClick(const aCol, aRow: Integer; const Button:TMouseButton);
6667
7047
begin
6668
7048
end;
6683
7063
    raise EGridException.Create(rsGridIndexOutOfRange);
6684
7064
end;
6685
7065
 
 
7066
procedure TCustomGrid.CMBiDiModeChanged(var Message: TLMessage);
 
7067
begin
 
7068
  VisualChange;
 
7069
  inherited CMBidiModeChanged(Message);
 
7070
end;
 
7071
 
 
7072
procedure TCustomGrid.CMMouseEnter(var Message: TLMessage);
 
7073
begin
 
7074
  inherited;
 
7075
  FSavedHint := Hint;
 
7076
end;
 
7077
 
6686
7078
procedure TCustomGrid.CMMouseLeave(var Message: TLMessage);
6687
7079
begin
 
7080
  if [goCellHints, goTruncCellHints] * Options <> [] then
 
7081
    Hint := FSavedHint;
6688
7082
  ResetHotCell;
6689
7083
  inherited CMMouseLeave(Message);
6690
7084
end;
6760
7154
  IntersectRect(Result, Result, FGCache.VisibleGrid);
6761
7155
end;
6762
7156
 
 
7157
procedure TCustomGrid.CacheMouseDown(const X, Y: Integer);
 
7158
begin
 
7159
  FGCache.ClickMouse := Point(X,Y);
 
7160
  FGCache.ClickCell  := MouseToCell(FGCache.ClickMouse);
 
7161
end;
 
7162
 
6763
7163
procedure TCustomGrid.EndUpdate(aRefresh: boolean = true);
6764
7164
begin
6765
7165
  Dec(FUpdateCount);
6785
7185
    DebugLn(['InvalidateCell  Col=',aCol,
6786
7186
      ' Row=',aRow,' Redraw=', Redraw]);
6787
7187
  {$Endif}
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);
 
7191
  end;
6791
7192
end;
6792
7193
 
6793
7194
procedure TCustomGrid.InvalidateRange(const aRange: TRect);
6798
7199
    exit;
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
 
7204
  else
 
7205
    RIni.Right := RFin.Right;
6802
7206
  RIni.Bottom:= RFin.Bottom;
6803
7207
  InvalidateRect(Handle, @RIni, False);
6804
7208
end;
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
6992
7397
    begin
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;
7089
7494
end;
7090
7495
 
 
7496
function TCustomGrid.GetCellHintText(ACol, ARow: Integer): string;
 
7497
begin
 
7498
  Result := '';
 
7499
  if Assigned(FOnGetCellHint) then
 
7500
    FOnGetCellHint(self, ACol, ARow, result);
 
7501
end;
 
7502
 
 
7503
function TCustomGrid.GetTruncCellHintText(ACol, ARow: Integer): String;
 
7504
begin
 
7505
  Result := GetCells(ACol, ARow);
 
7506
end;
 
7507
 
7091
7508
function TCustomGrid.GetCells(ACol, ARow: Integer): string;
7092
7509
begin
7093
7510
  result := '';
7148
7565
  case Key of
7149
7566
    ^C,^V,^X:;
7150
7567
    ^M, #27: Key:=#0; // key is already handled in KeyDown
7151
 
    #8:
7152
 
      if EditorIsReadOnly then
7153
 
        Key := #0;
7154
7568
    else begin
7155
7569
      AChar := Key;
7156
 
      EditorCanProcessKey(AChar);
7157
 
      if AChar='' then
 
7570
      if not EditorCanAcceptKey(AChar) or EditorIsReadOnly then
7158
7571
        Key := #0
7159
7572
      else
7160
7573
        Key := AChar[1];
7281
7694
begin
7282
7695
  SelectEditor;
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);
7287
7700
    end;
7303
7716
  Result:=FSelectedColor;
7304
7717
end;
7305
7718
 
 
7719
function TCustomGrid.GetTitleShowPrefix(Column: Integer): boolean;
 
7720
var
 
7721
  C: TGridColumn;
 
7722
begin
 
7723
  C := ColumnFromGridColumn(Column);
 
7724
  if C<>nil then
 
7725
    result := C.Title.PrefixOption<>poNone
 
7726
  else
 
7727
    result := false;
 
7728
end;
 
7729
 
7306
7730
function TCustomGrid.GridColumnFromColumnIndex(ColumnIndex: Integer): Integer;
7307
7731
begin
7308
7732
  {$ifdef NewCols}
7447
7871
    DeltaCol := 0;
7448
7872
    DeltaRow := 0;
7449
7873
 
7450
 
    // invert direction if necessary
7451
 
    //
7452
7874
    aa := FAutoAdvance;
7453
 
    if Inverse then
 
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;
 
7883
      end;
 
7884
    // invert direction if necessary
 
7885
    if Inverse then
 
7886
      case aa of
7455
7887
        aaRight:      aa := aaLeft;
7456
7888
        aaLeft:       aa := aaRight;
7457
7889
        aaRightDown:  aa := aaLeftUp;
7594
8026
    FreeWorkingCanvas(tmpCanvas);
7595
8027
end;
7596
8028
 
 
8029
function TCustomGrid.GetGridDrawState(ACol, ARow: Integer): TGridDrawState;
 
8030
begin
 
8031
  Result := [];
 
8032
  if ARow < FFixedRows then
 
8033
    include(Result, gdFixed)
 
8034
  else begin
 
8035
    if (aCol = FCol) and (aRow = FRow) then
 
8036
      Result := Result + [gdFocused, gdSelected]
 
8037
    else
 
8038
    if IsCellSelected[aCol, aRow] then
 
8039
      include(Result, gdSelected);
 
8040
  end;
 
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);
 
8046
  end;
 
8047
end;
 
8048
 
7597
8049
function TCustomGrid.GetScrollBarPosition(Which: integer): Integer;
7598
8050
var
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;
8037
8491
 
 
8492
  FCellHintPriority := chpTruncOnly;
 
8493
 
8038
8494
  FButtonEditor := TButtonCellEditor.Create(nil);
8039
8495
  FButtonEditor.Name:='ButtonEditor';
8040
8496
  FButtonEditor.Caption:='...';
8069
8525
  ResetHotCell;
8070
8526
  ResetPushedCell;
8071
8527
  FSortOrder := soAscending;
 
8528
  FSortColumn:=-1;
 
8529
  FAscImgInd:=-1;
 
8530
  FDescImgInd:=-1;
8072
8531
 
8073
8532
  // Default bitmaps for cbsCheckedColumn
8074
8533
  FUnCheckedBitmap := LoadResBitmapImage('dbgriduncheckedcb');
8411
8870
  end;
8412
8871
end;
8413
8872
 
8414
 
procedure TVirtualGrid.MoveColRow(IsColumn: Boolean; FromIndex, ToIndex: Integer
8415
 
  );
 
8873
procedure TVirtualGrid.MoveColRow(IsColumn: Boolean; FromIndex, ToIndex: Integer);
8416
8874
begin
8417
8875
  FCells.MoveColRow(IsColumn, FromIndex, ToIndex);
8418
8876
  if IsColumn then FCols.MoveColRow(True, FromIndex, ToIndex)
8525
8983
        SelLength := 0;
8526
8984
        SelStart := Length(Text);
8527
8985
      end;
8528
 
    VK_DELETE:
 
8986
    VK_DELETE, VK_BACK:
8529
8987
      CheckEditingKey;
8530
8988
    VK_UP, VK_DOWN:
8531
8989
      doGridKeyDown;
8585
9043
  FRow := Msg.Row;
8586
9044
end;
8587
9045
 
 
9046
procedure TStringCellEditor.msg_GetGrid(var Msg: TGridMessage);
 
9047
begin
 
9048
  Msg.Grid := FGrid;
 
9049
  Msg.Options:= EO_IMPLEMENTED;
 
9050
end;
 
9051
 
8588
9052
constructor TStringCellEditor.Create(Aowner: TComponent);
8589
9053
begin
8590
9054
  inherited Create(Aowner);
8596
9060
function TStringGridStrings.ConvertIndexLineCol(Index: Integer; var Line, Col: Integer): boolean;
8597
9061
begin
8598
9062
  if FIsCol then
8599
 
    if (Index < 0) or (Index > FGrid.RowCount) then
 
9063
    if (Index < 0) or (Index >= FGrid.RowCount) then
8600
9064
      Result := False
8601
9065
    else begin
8602
9066
      Line := FIndex;
8604
9068
      Result := True;
8605
9069
    end
8606
9070
  else
8607
 
    if (Index < 0) or (Index > FGrid.ColCount) then
 
9071
    if (Index < 0) or (Index >= FGrid.ColCount) then
8608
9072
      Result := False
8609
9073
    else begin
8610
9074
      Line := Index;
8628
9092
      FGrid.Objects[I, FIndex] := nil;
8629
9093
    end;
8630
9094
  end;
 
9095
  FAddedCount := 0;
8631
9096
end;
8632
9097
 
8633
9098
function TStringGridStrings.Add(const S: string): Integer;
8634
9099
var
8635
 
  I: Integer;
 
9100
  Line, Col: Integer;
8636
9101
begin
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;
8641
 
        Result := I;
8642
 
        Exit;
8643
 
      end;
8644
 
    end;
8645
 
  end else begin
8646
 
    for I := 0 to FGrid.ColCount - 1 do begin
8647
 
      if FGrid.Cells[I, FIndex] = '' then begin
8648
 
        FGrid.Cells[I, FIndex] := S;
8649
 
        Result := I;
8650
 
        Exit;
8651
 
      end;
8652
 
    end;
8653
 
  end;
8654
 
  Result := -1;
 
9102
  if ConvertIndexLineCol(FAddedCount, Line, Col) then begin
 
9103
    FGrid.Cells[Line, Col] := S;
 
9104
    Result := FAddedCount;
 
9105
    Inc(FAddedCount);
 
9106
  end else
 
9107
    Result := -1;
8655
9108
end;
8656
9109
 
8657
9110
function TStringGridStrings.Get(Index: Integer): string;
8958
9411
  end;
8959
9412
 
8960
9413
begin
8961
 
  if FMouseWheelOption=mwCursor then
 
9414
  if MouseWheelOption=mwCursor then
8962
9415
    inherited GridMouseWheel(shift, Delta)
8963
9416
  else
8964
9417
  if Delta<>0 then begin
8989
9442
begin
8990
9443
  if Assigned(OnSetEditText) then
8991
9444
    OnSetEditText(Self, aCol, aRow, Value);
 
9445
  inherited SetEditText(aCol, aRow, Value);
8992
9446
end;
8993
9447
 
8994
9448
procedure TCustomDrawGrid.SizeChanged(OldColCount, OldRowCount: Integer);
9039
9493
procedure TCustomDrawGrid.DrawCellAutonumbering(aCol, aRow: Integer;
9040
9494
  aRect: TRect; const aValue: string);
9041
9495
begin
9042
 
  Canvas.TextRect(aRect,ARect.Left+3,ARect.Top+3, aValue);
 
9496
  DrawCellText(aCol, aRow, aRect, [], aValue);
9043
9497
end;
9044
9498
 
9045
9499
function TCustomDrawGrid.SelectCell(aCol, aRow: Integer): boolean;
9131
9585
 
9132
9586
procedure TCustomDrawGrid.DefaultDrawCell(aCol, aRow: Integer; var aRect: TRect;
9133
9587
  aState: TGridDrawState);
9134
 
 
9135
 
  procedure DrawText;
9136
 
  begin
9137
 
    if GetIsCellTitle(aCol, aRow) then
9138
 
      DrawColumnText(aCol, aRow, aRect, aState)
9139
 
    else
9140
 
      DrawTextInCell(aCol,aRow, aRect,aState);
9141
 
  end;
9142
 
 
9143
9588
begin
9144
9589
  if goColSpanning in Options then CalcCellExtent(acol, arow, aRect);
9145
9590
 
9151
9596
  if CellNeedsCheckboxBitmaps(aCol,aRow) then
9152
9597
    DrawCellCheckboxBitmaps(aCol,aRow,aRect)
9153
9598
  else
9154
 
  if IsCellButtonColumn(Point(aCol,aRow)) then begin
9155
 
    DrawButtonCell(aCol,aRow,aRect,aState);
9156
 
    DrawText;
9157
 
  end
9158
 
  else begin
9159
 
 
9160
 
    if (goFixedRowNumbering in Options) and (ARow>=FixedRows) and (aCol=0) and
9161
 
       (FixedCols>0)
9162
 
    then
9163
 
      DrawCellAutonumbering(aCol, aRow, aRect, IntToStr(aRow-FixedRows+1));
9164
 
 
9165
 
    DrawText;
 
9599
  begin
 
9600
    if IsCellButtonColumn(Point(aCol,aRow)) then begin
 
9601
      DrawButtonCell(aCol,aRow,aRect,aState);
 
9602
    end
 
9603
    else begin
 
9604
      if (goFixedRowNumbering in Options) and (ARow>=FixedRows) and (aCol=0) and
 
9605
         (FixedCols>0)
 
9606
      then
 
9607
        DrawCellAutonumbering(aCol, aRow, aRect, IntToStr(aRow-FixedRows+1));
 
9608
    end;
 
9609
    //draw text
 
9610
    if GetIsCellTitle(aCol, aRow) then
 
9611
      DrawColumnText(aCol, aRow, aRect, aState)
 
9612
    else
 
9613
      DrawTextInCell(aCol,aRow, aRect,aState);
9166
9614
  end;
9167
9615
end;
9168
9616
 
9469
9917
end;
9470
9918
 
9471
9919
procedure TCustomStringGrid.DefineProperties(Filer: TFiler);
 
9920
begin
 
9921
  inherited DefineProperties(Filer);
 
9922
  DefineCellsProperty(Filer);
 
9923
end;
 
9924
 
 
9925
procedure TCustomStringGrid.DefineCellsProperty(Filer: TFiler);
9472
9926
  function NeedCells: boolean;
9473
9927
  var
9474
9928
    i,j: integer;
9494
9948
          end;
9495
9949
  end;
9496
9950
begin
9497
 
  inherited DefineProperties(Filer);
9498
9951
  with Filer do begin
9499
9952
    DefineProperty('Cells',  @ReadCells,  @WriteCells,  NeedCells);
9500
9953
  end;
9506
9959
  if Assigned(OnCompareCells) then
9507
9960
    Result:=inherited DoCompareCells(Acol, ARow, Bcol, BRow)
9508
9961
  else begin
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;
9512
9965
  end;
9625
10078
  try
9626
10079
    L.Text := TheText;
9627
10080
    for j:=0 to L.Count-1 do begin
 
10081
      if j+StartRow >= RowCount then
 
10082
        break;
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];
9631
10087
    end;
9632
10088
  finally
9633
10089
    SubL.Free;
9768
10224
    CopyCellRectToClipboard(Rect(0,0,ColCount-1,RowCount-1));
9769
10225
end;
9770
10226
 
 
10227
procedure TCustomStringGrid.LoadFromCSVFile(AFilename: string;
 
10228
  ADelimiter:Char=','; WithHeader:boolean=true);
 
10229
var
 
10230
  L,SubL: TStringList;
 
10231
  i,j,StartRow: Integer;
 
10232
begin
 
10233
  L := TStringList.Create;
 
10234
  SubL := TStringList.Create;
 
10235
  BeginUpdate;
 
10236
  try
 
10237
    L.LoadFromFile(AFilename);
 
10238
 
 
10239
    // check for empty lines
 
10240
    for i:=L.Count-1 downto 0 do
 
10241
      if Trim(L[i])='' then
 
10242
        L.Delete(i);
 
10243
 
 
10244
    if L.Count>0 then begin
 
10245
 
 
10246
      SubL.Delimiter:=ADelimiter;
 
10247
      SubL.DelimitedText:=L[0];
 
10248
 
 
10249
      if Columns.Enabled then begin
 
10250
        while Columns.VisibleCount<>SubL.Count do
 
10251
          if Columns.VisibleCount<SubL.Count then
 
10252
            Columns.Add
 
10253
          else
 
10254
            Columns.Delete(Columns.Count-1);
 
10255
      end else
 
10256
        ColCount := SubL.Count;
 
10257
 
 
10258
      if WithHeader and (FixedRows=0) then
 
10259
        RowCount := L.Count
 
10260
      else
 
10261
        RowCount := FixedRows + L.Count-1;
 
10262
 
 
10263
      if WithHeader then begin
 
10264
        // load header
 
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]
 
10269
          end;
 
10270
        StartRow := Max(FixedRows-1, 0);
 
10271
        j := 0;
 
10272
      end else begin
 
10273
        StartRow := FixedRows;
 
10274
        j := 1;
 
10275
      end;
 
10276
 
 
10277
      for i:=StartRow to RowCount-1 do begin
 
10278
        Rows[i].Delimiter := ADelimiter;
 
10279
        Rows[i].DelimitedText:=L[i-StartRow+j];
 
10280
      end;
 
10281
    end;
 
10282
  finally
 
10283
    SubL.Free;
 
10284
    L.Free;
 
10285
    EndUpdate;
 
10286
  end;
 
10287
end;
 
10288
 
 
10289
procedure TCustomStringGrid.SaveToCSVFile(AFileName: string; ADelimiter:Char=','; WithHeader:boolean=true);
 
10290
var
 
10291
  F: TextFile;
 
10292
  i,StartRow: Integer;
 
10293
  L: TStringList;
 
10294
  C: TGridColumn;
 
10295
begin
 
10296
  if (RowCount=0) or (ColCount=0) then
 
10297
    exit;
 
10298
  AssignFile(F, AFilename);
 
10299
  try
 
10300
    Rewrite(F);
 
10301
    if WithHeader then begin
 
10302
      if Columns.Enabled then begin
 
10303
        if FixedRows>0 then begin
 
10304
          L := TStringList.Create;
 
10305
          try
 
10306
            for i := 0 to ColCount-1 do begin
 
10307
              c := ColumnFromGridColumn(i);
 
10308
              if c=nil then
 
10309
                L.Add(Cells[i, 0])
 
10310
              else
 
10311
                L.Add(c.Title.Caption);
 
10312
            end;
 
10313
            L.Delimiter:=ADelimiter;
 
10314
            WriteLn(F, L.DelimitedText);
 
10315
          finally
 
10316
            L.Free;
 
10317
          end;
 
10318
        end;
 
10319
        StartRow := FixedRows;
 
10320
      end else
 
10321
      if FixedRows>0 then
 
10322
        StartRow := FixedRows-1
 
10323
      else
 
10324
        StartRow := 0;
 
10325
    end else
 
10326
      StartRow := FixedRows;
 
10327
    for i:=StartRow to RowCount-1 do begin
 
10328
      Rows[i].Delimiter:=ADelimiter;
 
10329
      WriteLn(F, Rows[i].DelimitedText);
 
10330
    end;
 
10331
  finally
 
10332
    CloseFile(F);
 
10333
  end;
 
10334
end;
 
10335
 
9771
10336
 
9772
10337
procedure Register;
9773
10338
begin
9923
10488
  FColumn.ColumnChanged;
9924
10489
end;
9925
10490
 
 
10491
procedure TGridColumnTitle.SetPrefixOption(const AValue: TPrefixOption);
 
10492
begin
 
10493
  if FPrefixOption=AValue then exit;
 
10494
  FPrefixOption:=AValue;
 
10495
  FColumn.ColumnChanged;
 
10496
end;
 
10497
 
9926
10498
procedure TGridColumnTitle.Assign(Source: TPersistent);
9927
10499
begin
9928
10500
  if Source is TGridColumnTitle then begin
9972
10544
  FFont := TFont.Create;
9973
10545
  FillTitleDefaultFont;
9974
10546
  FFont.OnChange := @FontChanged;
 
10547
  FImageIndex := -1;
 
10548
  FOldImageIndex := -1;
9975
10549
  FImageLayout := blGlyphRight;
9976
10550
end;
9977
10551
 
10557
11131
  result := VisibleCount > 0;
10558
11132
end;
10559
11133
 
10560
 
procedure TGridColumns.SetColumn(Index: Integer; Value: TGridColumn
10561
 
  );
 
11134
procedure TGridColumns.SetColumn(Index: Integer; Value: TGridColumn);
10562
11135
begin
10563
11136
  Items[Index].Assign( Value );
10564
11137
end;
10651
11224
 
10652
11225
procedure TGridColumns.InsertColumn(Index: Integer);
10653
11226
begin
10654
 
  BeginUpdate;
 
11227
  FGrid.BeginUpdate;
10655
11228
  Add;
10656
11229
  MoveColumn(Count-1, Index);
10657
 
  EndUpdate;
 
11230
  FGrid.EndUpdate;
10658
11231
end;
10659
11232
 
10660
11233
constructor TGridColumns.Create(AGrid: TCustomGrid;
10767
11340
  Width := DEFBUTTONWIDTH;
10768
11341
end;
10769
11342
 
 
11343
procedure TButtonCellEditor.msg_GetGrid(var Msg: TGridMessage);
 
11344
begin
 
11345
  Msg.Grid := FGrid;
 
11346
  Msg.Options:= EO_IMPLEMENTED;
 
11347
end;
 
11348
 
10770
11349
{ TPickListCellEditor }
10771
11350
procedure TPickListCellEditor.WndProc(var TheMessage: TLMessage);
10772
11351
begin
10938
11517
  FRow := Msg.Row;
10939
11518
end;
10940
11519
 
 
11520
procedure TPickListCellEditor.msg_GetGrid(var Msg: TGridMessage);
 
11521
begin
 
11522
  Msg.Grid := FGrid;
 
11523
  Msg.Options:= EO_IMPLEMENTED;
 
11524
end;
 
11525
 
10941
11526
{ TCompositeCellEditor }
10942
11527
 
10943
11528
procedure TCompositeCellEditor.DispatchMsg(msg: TGridMessage);
10949
11534
      Feditors[i].Editor.Dispatch(msg);
10950
11535
end;
10951
11536
 
 
11537
function TCompositeCellEditor.GetMaxLength: Integer;
 
11538
var
 
11539
  AEditor: TWinControl;
 
11540
begin
 
11541
  result := 0;
 
11542
  AEditor := GetActiveControl;
 
11543
  if AEditor is TCustomEdit then
 
11544
    result := TCustomEdit(AEditor).MaxLength;
 
11545
end;
 
11546
 
 
11547
procedure TCompositeCellEditor.SetMaxLength(AValue: Integer);
 
11548
var
 
11549
  AEditor: TWinControl;
 
11550
begin
 
11551
  AEditor := GetActiveControl;
 
11552
  if AEditor is TCustomEdit then
 
11553
    TCustomEdit(AEditor).MaxLength := AValue;
 
11554
end;
 
11555
 
10952
11556
function TCompositeCellEditor.GetActiveControl: TWinControl;
10953
11557
var
10954
11558
  i: Integer;
11050
11654
  DispatchMsg(Msg);
11051
11655
end;
11052
11656
 
 
11657
procedure TCompositeCellEditor.msg_GetGrid(var Msg: TGridMessage);
 
11658
begin
 
11659
  Msg.Grid := FGrid;
 
11660
  Msg.Options:= EO_IMPLEMENTED;
 
11661
end;
 
11662
 
11053
11663
procedure TCompositeCellEditor.VisibleChanging;
11054
11664
var
11055
11665
  i: Integer;
11126
11736
  end;
11127
11737
end;
11128
11738
 
11129
 
destructor TCompositeCellEditor.destroy;
 
11739
destructor TCompositeCellEditor.Destroy;
11130
11740
begin
11131
11741
  SetLength(FEditors, 0);
11132
11742
  inherited destroy;
11160
11770
  Done := True;
11161
11771
end;
11162
11772
 
 
11773
initialization
 
11774
  {$I lcl_grid_images.lrs}
 
11775
 
11163
11776
end.