1 unit ValEdit;
2 
3 {$mode objfpc}{$H+}
4 
5 interface
6 
7 uses
8   ContNrs, SysUtils, Classes, Variants,
9   LazUtf8, Controls, StdCtrls, Grids, LResources, Dialogs, LCLType, Laz2_XMLCfg,
10   LCLStrConsts;
11 
12 type
13 
14   TValueListEditor = class;    // Forward declaration
15   TValueListStrings = class;
16 
17   TEditStyle = (esSimple, esEllipsis, esPickList);
18   TVleSortCol = (colKey, colValue);
19 
20   { TItemProp }
21 
22   TItemProp = class(TPersistent)
23   private
24     FGrid: TValueListEditor;
25     FEditMask: string;
26     FEditStyle: TEditStyle;
27     FPickList: TStrings;
28     FMaxLength: Integer;
29     FReadOnly: Boolean;
30     FKeyDesc: string;
GetPickListnull31     function GetPickList: TStrings;
32     procedure PickListChange(Sender: TObject);
33     procedure SetEditMask(const AValue: string);
34     procedure SetMaxLength(const AValue: Integer);
35     procedure SetReadOnly(const AValue: Boolean);
36     procedure SetEditStyle(const AValue: TEditStyle);
37     procedure SetPickList(const AValue: TStrings);
38     procedure SetKeyDesc(const AValue: string);
39   protected
40     procedure AssignTo(Dest: TPersistent); override;
41   public
42     constructor Create(AOwner: TValueListEditor);
43     destructor Destroy; override;
HasPickListnull44 //    function HasPickList: Boolean;
45   published
46     property EditMask: string read FEditMask write SetEditMask;
47     property EditStyle: TEditStyle read FEditStyle write SetEditStyle;
48     property KeyDesc: string read FKeyDesc write SetKeyDesc;
49     property PickList: TStrings read GetPickList write SetPickList;
50     property MaxLength: Integer read FMaxLength write SetMaxLength;
51     property ReadOnly: Boolean read FReadOnly write SetReadOnly;
52   end;
53 
54   { TItemPropList }
55 
56   TItemPropList = class
57   private
58     FList: TFPObjectList;
59     FStrings: TValueListStrings;
GetCountnull60     function GetCount: Integer;
GetItemnull61     function GetItem(Index: Integer): TItemProp;
62     procedure SetItem(Index: Integer; AValue: TItemProp);
63   protected
64   public
65     procedure Add(AValue: TItemProp);
66     procedure Assign(Source: TItemPropList);
67     procedure Clear;
68     procedure Delete(Index: Integer);
69     procedure Exchange(Index1, Index2: Integer);
70     procedure Insert(Index: Integer; AValue: TItemProp);
71   public
72     constructor Create(AOwner: TValueListStrings);
73     destructor Destroy; override;
74   public
75     property Count: Integer read GetCount;
76     property Items[Index: Integer]: TItemProp read GetItem write SetItem; default;
77   end;
78 
79   { TValueListStrings }
80 
81   TValueListStrings = class(TStringList)
82   private
83     FGrid: TValueListEditor;
84     FItemProps: TItemPropList;
GetItemPropnull85     function GetItemProp(const AKeyOrIndex: Variant): TItemProp;
86     procedure QuickSortStringsAndItemProps(L, R: Integer; CompareFn: TStringListSortCompare);
CanHideShowingEditorAtIndexnull87     function CanHideShowingEditorAtIndex(Index: Integer): Boolean;
88   protected
89     procedure InsertItem(Index: Integer; const S: string; AObject: TObject); override;
90     procedure InsertItem(Index: Integer; const S: string); override;
91     procedure Put(Index: Integer; const S: String); override;
92   public
93     constructor Create(AOwner: TValueListEditor);
94     destructor Destroy; override;
95     procedure Assign(Source: TPersistent); override;
96     procedure Clear; override;
97     procedure CustomSort(Compare: TStringListSortCompare); override;
98     procedure Delete(Index: Integer); override;
99     procedure Exchange(Index1, Index2: Integer); override;
100   end;
101 
102   TKeyValuePair = record
103     Key, Value: String;
104   end;
105 
106   TDisplayOption = (doColumnTitles, doAutoColResize, doKeyColFixed);
107   TDisplayOptions = set of TDisplayOption;
108 
109   TKeyOption = (keyEdit, keyAdd, keyDelete, keyUnique);
110   TKeyOptions = set of TKeyOption;
111 
112   TGetPickListEvent = procedure(Sender: TObject; const KeyName: string;
113     Values: TStrings) of object;
114 
115   TOnValidateEvent = procedure(Sender: TObject; ACol, ARow: Longint;
116     const KeyName, KeyValue: string) of object;
117 
118   { TValueListEditor }
119 
120   TValueListEditor = class(TCustomStringGrid)
121   private
122     FTitleCaptions: TStrings;
123     FCreating: Boolean;
124     FStrings: TValueListStrings;
125     FKeyOptions: TKeyOptions;
126     FDisplayOptions: TDisplayOptions;
127     FDropDownRows: Integer;
128     FOnGetPickList: TGetPickListEvent;
129     FOnStringsChange: TNotifyEvent;
130     FOnStringsChanging: TNotifyEvent;
131     FOnValidate: TOnValidateEvent;
132     FRowTextOnEnter: TKeyValuePair;
133     FLastEditedRow: Integer;
134     FUpdatingKeyOptions: Boolean;
GetItemPropnull135     function GetItemProp(const AKeyOrIndex: Variant): TItemProp;
136     procedure SetItemProp(const AKeyOrIndex: Variant; AValue: TItemProp);
137     procedure StringsChange(Sender: TObject);
138     procedure StringsChanging(Sender: TObject);
GetOptionsnull139     function GetOptions: TGridOptions;
GetKeynull140     function GetKey(Index: Integer): string;
GetValuenull141     function GetValue(const Key: string): string;
142     procedure SetDisplayOptions(const AValue: TDisplayOptions);
143     procedure SetDropDownRows(const AValue: Integer);
144     procedure SetKeyOptions(AValue: TKeyOptions);
145     procedure SetKey(Index: Integer; const Value: string);
146     procedure SetValue(const Key: string; AValue: string);
147     procedure SetOptions(AValue: TGridOptions);
148     procedure SetStrings(const AValue: TValueListStrings);
149     procedure SetTitleCaptions(const AValue: TStrings);
150     procedure UpdateTitleCaptions(const KeyCap, ValCap: String);
151   protected
152     class procedure WSRegisterClass; override;
153     procedure SetFixedCols(const AValue: Integer); override;
154     procedure ShowColumnTitles;
155     procedure AdjustRowCount; virtual;
156     procedure ColRowExchanged(IsColumn: Boolean; index, WithIndex: Integer); override;
157     procedure ColRowDeleted(IsColumn: Boolean; index: Integer); override;
158     procedure DefineCellsProperty(Filer: TFiler); override;
159     procedure InvalidateCachedRow;
160     procedure GetAutoFillColumnInfo(const Index: Integer; var aMin,aMax,aPriority: Integer); override;
GetEditTextnull161     function GetEditText(ACol, ARow: Integer): string; override;
GetCellsnull162     function GetCells(ACol, ARow: Integer): string; override;
GetDefaultEditornull163     function GetDefaultEditor(Column: Integer): TWinControl; override;
GetRowCountnull164     function GetRowCount: Integer;
165     procedure KeyDown(var Key : Word; Shift : TShiftState); override;
166     procedure KeyPress(var Key: Char); override;
167     procedure LoadContent(cfg: TXMLConfig; Version: Integer); override;
168     procedure ResetDefaultColWidths; override;
169     procedure SaveContent(cfg: TXMLConfig); override;
170     procedure SetCells(ACol, ARow: Integer; const AValue: string); override;
171     procedure SetColCount(AValue: Integer); override;
172     procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
173     procedure SetFixedRows(const AValue: Integer); override;
174     procedure SetRowCount(AValue: Integer);
175     procedure Sort(ColSorting: Boolean; index,IndxFrom,IndxTo:Integer); override;
176     procedure TitlesChanged(Sender: TObject);
ValidateEntrynull177     function ValidateEntry(const ACol,ARow:Integer; const OldValue:string; var NewValue:string): boolean; override;
178   public
179     constructor Create(AOwner: TComponent); override;
180     destructor Destroy; override;
181 
182     procedure Clear;
183     procedure DeleteColRow(IsColumn: Boolean; index: Integer);
184     procedure DeleteRow(Index: Integer); override;
185     procedure DeleteCol(Index: Integer); override;
FindRownull186     function FindRow(const KeyName: string; out aRow: Integer): Boolean;
187     procedure InsertColRow(IsColumn: boolean; index: integer);
InsertRownull188     function InsertRow(const KeyName, Value: string; Append: Boolean): Integer;
189     procedure InsertRowWithValues(Index: Integer; Values: array of String);
190     procedure ExchangeColRow(IsColumn: Boolean; index, WithIndex: Integer); override;
IsEmptyRownull191     function IsEmptyRow: Boolean; {Delphi compatible function}
IsEmptyRownull192     function IsEmptyRow(aRow: Integer): Boolean; {This for makes more sense to me}
193     procedure LoadFromCSVStream(AStream: TStream; ADelimiter: Char=',';
194       UseTitles: boolean=true; FromLine: Integer=0; SkipEmptyLines: Boolean=true); override;
195     procedure MoveColRow(IsColumn: Boolean; FromIndex, ToIndex: Integer);
RestoreCurrentRownull196     function RestoreCurrentRow: Boolean;
197     procedure Sort(Index, IndxFrom, IndxTo: Integer);
198     procedure Sort(ACol: TVleSortCol = colKey);
199 
200     property Modified;
201     property Keys[Index: Integer]: string read GetKey write SetKey;
202     property Values[const Key: string]: string read GetValue write SetValue;
203     property ItemProps[const AKeyOrIndex: Variant]: TItemProp read GetItemProp write SetItemProp;
204   published
205     // Same as in TStringGrid
206     property Align;
207     property AlternateColor;
208     property Anchors;
209     property AutoAdvance;
210     property AutoEdit;
211     property BiDiMode;
212     property BorderSpacing;
213     property BorderStyle;
214     property Color;
215     property Constraints;
216     property DefaultColWidth;
217     property DefaultDrawing;
218     property DefaultRowHeight;
219     property DragCursor;
220     property DragKind;
221     property DragMode;
222     property Enabled;
223     property ExtendedSelect;
224     property FixedColor;
225     property FixedCols;
226     property Flat;
227     property Font;
228     property GridLineWidth;
229     property HeaderHotZones;
230     property HeaderPushZones;
231     property MouseWheelOption;
232     property ParentBiDiMode;
233     property ParentColor default false;
234     property ParentFont;
235     property ParentShowHint;
236     property PopupMenu;
237     property RowCount: Integer read GetRowCount write SetRowCount;
238     property ScrollBars;
239     property ShowHint;
240     property TabOrder;
241     property TabStop;
242     property TitleFont;
243     property TitleImageList;
244     property TitleStyle;
245     property UseXORFeatures;
246     property Visible;
247     property VisibleColCount;
248     property VisibleRowCount;
249 
250     property OnBeforeSelection;
251     property OnButtonClick;
252     property OnChangeBounds;
253     property OnCheckboxToggled;
254     property OnClick;
255     property OnColRowDeleted;
256     property OnColRowExchanged;
257     property OnColRowInserted;
258     property OnColRowMoved;
259     property OnCompareCells;
260     property OnContextPopup;
261     property OnDragDrop;
262     property OnDragOver;
263     property OnDblClick;
264     property OnDrawCell;
265     property OnEditButtonClick; deprecated;
266     property OnEditingDone;
267     property OnEndDock;
268     property OnEndDrag;
269     property OnEnter;
270     property OnExit;
271     property OnGetEditMask;
272     property OnGetEditText;
273     property OnHeaderClick;
274     property OnHeaderSized;
275     property OnHeaderSizing;
276     property OnKeyDown;
277     property OnKeyPress;
278     property OnKeyUp;
279     property OnMouseDown;
280     property OnMouseEnter;
281     property OnMouseLeave;
282     property OnMouseMove;
283     property OnMouseUp;
284     property OnMouseWheel;
285     property OnMouseWheelDown;
286     property OnMouseWheelUp;
287     property OnMouseWheelHorz;
288     property OnMouseWheelLeft;
289     property OnMouseWheelRight;
290     property OnPickListSelect;
291     property OnPrepareCanvas;
292     property OnResize;
293     property OnSelectEditor;
294     property OnSelection;
295     property OnSelectCell;
296     property OnSetEditText;
297     property OnShowHint;
298     property OnStartDock;
299     property OnStartDrag;
300     property OnTopLeftChanged;
301     property OnUserCheckboxBitmap;
302     property OnUTF8KeyPress;
303     property OnValidateEntry;
304 
305     // Compatible with Delphi TValueListEditor:
306     property DisplayOptions: TDisplayOptions read FDisplayOptions
307       write SetDisplayOptions default [doColumnTitles, doAutoColResize, doKeyColFixed];
308     property DoubleBuffered;
309     property DropDownRows: Integer read FDropDownRows write SetDropDownRows default 8;
310     property KeyOptions: TKeyOptions read FKeyOptions write SetKeyOptions default [];
311     property Options: TGridOptions read GetOptions write SetOptions default
312      [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goColSizing,
313       goEditing, goAlwaysShowEditor, goThumbTracking];
314     property Strings: TValueListStrings read FStrings write SetStrings;
315     property TitleCaptions: TStrings read FTitleCaptions write SetTitleCaptions;
316 
317     property OnGetPickList: TGetPickListEvent read FOnGetPickList write FOnGetPickList;
318     property OnStringsChange: TNotifyEvent read FOnStringsChange write FOnStringsChange;
319     property OnStringsChanging: TNotifyEvent read FOnStringsChanging write FOnStringsChanging;
320     property OnValidate: TOnValidateEvent read FOnValidate write FOnValidate;
321 
322   end;
323 
324 const
325   //ToDo: Make this a resourcestring in lclstrconsts unit, once we are satisfied with the implementation of validating
326   rsVLEDuplicateKey = 'Duplicate Key:'+LineEnding+'A key with name "%s" already exists at column %d';
327   //ToDo: Make this a resourcestring in lclstrconsts unit, once we are satisfied with ShowColumnTitles
328   rsVLEKey = 'Key';
329   rsVLEValue = 'Value';
330   rsVLEInvalidRowColOperation = 'The operation %s is not allowed on a TValueListEditor%s.';
331   //LoadContent errors
332   rsVLENoRowCountFound = 'Error reading file "%s":'^m'No value for RowCount found.';
333   rsVLERowIndexOutOfBounds = 'Error reading file "%s":'^m'Row index out of bounds (%d).';
334   rsVLEColIndexOutOfBounds = 'Error reading file "%s":'^m'Column index out of bounds (%d).';
335   rsVLEIllegalColCount = 'ColCount of a TValueListEditor cannot be %d (it can only ever be 2).';
336 
337 procedure Register;
338 
339 implementation
340 
341 type
342   TCompositeCellEditorAccess = class(TCompositeCellEditor);
343 
344 { TItemProp }
345 
346 
347 constructor TItemProp.Create(AOwner: TValueListEditor);
348 begin
349   inherited Create;
350   FGrid := AOwner;
351 end;
352 
353 destructor TItemProp.Destroy;
354 begin
355   FPickList.Free;
356   inherited Destroy;
357 end;
358 
GetPickListnull359 function TItemProp.GetPickList: TStrings;
360 begin
361   if FPickList = Nil then
362   begin
363     FPickList := TStringList.Create;
364     TStringList(FPickList).OnChange := @PickListChange;
365   end;
366   Result := FPickList;
367 end;
368 
369 procedure TItemProp.PickListChange(Sender: TObject);
370 begin
371   if PickList.Count > 0 then begin
372     if EditStyle = esSimple then
373       EditStyle := esPickList;
374   end
375   else begin
376     if EditStyle = esPickList then
377       EditStyle := esSimple;
378   end;
379 end;
380 
381 procedure TItemProp.SetEditMask(const AValue: string);
382 begin
383   FEditMask := AValue;
384   with FGrid do
385     if EditorMode and (FStrings.UpdateCount = 0) then
386       InvalidateCell(Col, Row);
387 end;
388 
389 procedure TItemProp.SetMaxLength(const AValue: Integer);
390 begin
391   FMaxLength := AValue;
392   with FGrid do
393     if EditorMode and (FStrings.UpdateCount = 0) then
394       InvalidateCell(Col, Row);
395 end;
396 
397 procedure TItemProp.SetReadOnly(const AValue: Boolean);
398 begin
399   FReadOnly := AValue;
400   with FGrid do
401     if EditorMode and (FStrings.UpdateCount = 0) then
402       InvalidateCell(Col, Row);
403 end;
404 
405 procedure TItemProp.SetEditStyle(const AValue: TEditStyle);
406 begin
407   FEditStyle := AValue;
408   with FGrid do
409     if EditorMode and (FStrings.UpdateCount = 0) then
410       InvalidateCell(Col, Row);
411 end;
412 
413 procedure TItemProp.SetPickList(const AValue: TStrings);
414 begin
415   GetPickList.Assign(AValue);
416   with FGrid do
417     if EditorMode and (FStrings.UpdateCount = 0) then
418       InvalidateCell(Col, Row);
419 end;
420 
421 procedure TItemProp.SetKeyDesc(const AValue: string);
422 begin
423   FKeyDesc := AValue;
424 end;
425 
426 procedure TItemProp.AssignTo(Dest: TPersistent);
427 begin
428   if not (Dest is TItemProp) then
429     inherited AssignTo(Dest)
430   else
431   begin
432     TItemProp(Dest).EditMask := Self.EditMask;
433     TItemProp(Dest).EditStyle := Self.EditStyle;
434     TItemProp(Dest).KeyDesc := Self.KeyDesc;
435     TItemProp(Dest).PickList.Assign(Self.PickList);
436     TItemProp(Dest).MaxLength := Self.MaxLength;
437     TItemProp(Dest).ReadOnly := Self.ReadOnly;
438   end;
439 end;
440 
441 
442 { TItemPropList }
443 
GetItemnull444 function TItemPropList.GetItem(Index: Integer): TItemProp;
445 begin
446   Result := TItemProp(FList.Items[Index]);
447 end;
448 
GetCountnull449 function TItemPropList.GetCount: Integer;
450 begin
451   Result := FList.Count;
452 end;
453 
454 procedure TItemPropList.SetItem(Index: Integer; AValue: TItemProp);
455 begin
456   FList.Items[Index] := AValue;
457 end;
458 
459 procedure TItemPropList.Insert(Index: Integer; AValue: TItemProp);
460 begin
461   FList.Insert(Index, AValue);
462 end;
463 
464 procedure TItemPropList.Add(AValue: TItemProp);
465 begin
466   FList.Add(AValue);
467 end;
468 
469 procedure TItemPropList.Assign(Source: TItemPropList);
470 var
471   Index: Integer;
472   Prop: TItemProp;
473 begin
474   Clear;
475   if not Assigned(Source) then Exit;
476   for Index := 0 to Source.Count - 1 do
477   begin
478     Prop := TItemProp.Create(FStrings.FGrid);
479     Prop.Assign(Source.Items[Index]);
480     Add(Prop);
481   end;
482 end;
483 
484 procedure TItemPropList.Delete(Index: Integer);
485 begin
486   FList.Delete(Index);
487 end;
488 
489 procedure TItemPropList.Exchange(Index1, Index2: Integer);
490 begin
491   FList.Exchange(Index1, index2);
492 end;
493 
494 procedure TItemPropList.Clear;
495 begin
496   FList.Clear;
497 end;
498 
499 constructor TItemPropList.Create(AOwner: TValueListStrings);
500 begin
501   FStrings := AOwner;
502   FList := TFPObjectList.Create(True);
503 end;
504 
505 destructor TItemPropList.Destroy;
506 begin
507   FList.Free;
508   inherited Destroy;
509 end;
510 
511 
512 { TValueListStrings }
513 
514 procedure TValueListStrings.InsertItem(Index: Integer; const S: string; AObject: TObject);
515 var
516   MustHideShowingEditor: Boolean;
517 begin
518   // ToDo: Check validity of key
519   //debugln('TValueListStrings.InsertItem: Index = ',dbgs(index),' S = "',S,'" AObject = ',dbgs(aobject));
520   FGrid.InvalidateCachedRow;
521   MustHideShowingEditor := CanHideShowingEditorAtIndex(Index);
522   if MustHideShowingEditor then FGrid.Options := FGrid.Options - [goAlwaysShowEditor];
523   inherited InsertItem(Index, S, AObject);
524   FItemProps.Insert(Index, TItemProp.Create(FGrid));
525   //only restore this _after_ FItemProps is updated!
526   if MustHideShowingEditor then FGrid.Options := FGrid.Options + [goAlwaysShowEditor];
527 end;
528 
529 procedure TValueListStrings.InsertItem(Index: Integer; const S: string);
530 begin
531   InsertItem(Index, S, nil);
532 end;
533 
534 procedure TValueListStrings.Put(Index: Integer; const S: String);
535 var
536   MustHideShowingEditor: Boolean;
537 begin
538   // ToDo: Check validity of key
539   MustHideShowingEditor := CanHideShowingEditorAtIndex(Index);
540   //debugln('TValueListStrings.Put: MustHideShowingEditor=',DbgS(MustHideShowingEditor));
541   if MustHideShowingEditor then FGrid.Options := FGrid.Options - [goAlwaysShowEditor];
542   inherited Put(Index, S);
543   if MustHideShowingEditor then FGrid.Options := FGrid.Options + [goAlwaysShowEditor];
544 end;
545 
546 constructor TValueListStrings.Create(AOwner: TValueListEditor);
547 begin
548   inherited Create;
549   FGrid := AOwner;
550   FItemProps := TItemPropList.Create(Self);
551 end;
552 
553 destructor TValueListStrings.Destroy;
554 begin
555   FItemProps.Free;
556   inherited Destroy;
557 end;
558 
559 procedure TValueListStrings.Assign(Source: TPersistent);
560 begin
561   FGrid.InvalidateCachedRow;
562   Clear;  //if this is not done, and a TValueListEditor.Sort() is done and then later a Strings.Assign, an exception will occur.
563   inherited Assign(Source);
564   if (Source is TValueListStrings) then
565     FItemProps.Assign(TValueListStrings(Source).FItemProps);
566 end;
567 
568 procedure TValueListStrings.Clear;
569 var
570   IsShowingEditor: Boolean;
571 begin
572   FGrid.InvalidateCachedRow;
573   IsShowingEditor := goAlwaysShowEditor in FGrid.Options;
574   if IsShowingEditor then FGrid.Options := FGrid.Options - [goAlwaysShowEditor];
575   inherited Clear;
576   FItemProps.Clear;
577   if IsShowingEditor then FGrid.Options := FGrid.Options + [goAlwaysShowEditor];
578 end;
579 
580 
581 {
582  Duplicates the functionality of TStringList.QuickSort, but also
583  sorts the ItemProps.
584 }
585 procedure TValueListStrings.QuickSortStringsAndItemProps(L, R: Integer;
586   CompareFn: TStringListSortCompare);
587 var
588   Pivot, vL, vR: Integer;
589 begin
590   if R - L <= 1 then
591   begin // a little bit of time saver
592     if L < R then
593       if CompareFn(Self, L, R) > 0 then
594         //Exchange also exchanges FItemProps
595         Exchange(L, R);
596     Exit;
597   end;
598 
599   vL := L;
600   vR := R;
601   Pivot := L + Random(R - L); // they say random is best
602   while vL < vR do
603   begin
604     while (vL < Pivot) and (CompareFn(Self, vL, Pivot) <= 0) do
605       Inc(vL);
606     while (vR > Pivot) and (CompareFn(Self, vR, Pivot) > 0) do
607       Dec(vR);
608     //Exchange also exchanges FItemProps
609     Exchange(vL, vR);
610     if Pivot = vL then // swap pivot if we just hit it from one side
611       Pivot := vR
612     else if Pivot = vR then
613       Pivot := vL;
614   end;
615 
616   if Pivot - 1 >= L then
617     QuickSortStringsAndItemProps(L, Pivot - 1, CompareFn);
618   if Pivot + 1 <= R then
619     QuickSortStringsAndItemProps(Pivot + 1, R, CompareFn);
620 end;
621 
CanHideShowingEditorAtIndexnull622 function TValueListStrings.CanHideShowingEditorAtIndex(Index: Integer): Boolean;
623 var
624   IndexToRow: Integer;
625   WC: TWinControl;
626   EditorHasFocus: Boolean;
627 begin
628   IndexToRow := Index + FGrid.FixedRows;
629   if (FGrid.Editor is TCompositeCellEditor) then
630   begin
631     WC := TCompositeCellEditorAccess(FGrid.Editor).GetActiveControl;
632     if (WC is TCustomEdit) then
633       EditorHasFocus := TCustomEdit(WC).Focused
634     else
635       EditorHasFocus := False;
636   end
637   else
638     EditorHasFocus := Assigned(FGrid.Editor) and FGrid.Editor.Focused;
639 
640   //debugln('CanHideShowingEditor:');
641   //debugln(' Assigned(FGrid.Editor) = ',DbgS(Assigned(FGrid.Editor)));
642   //debugln(' (goAlwaysShowEditor in FGrid.Options) = ',DbgS(goAlwaysShowEditor in FGrid.Options));
643   //if Assigned(FGrid.Editor) then
644   //  debugln(' FGrid.Editor.Visible = ',DbgS(FGrid.Editor.Visible));
645   //debugln(' IndexToRow = ',DbgS(IndextoRow));
646   //debugln(' Count = ',DbgS(Count));
647   //debugln(' EditorHasFocus = ',DbgS(EditorHasFocus));
648 
649   Result := Assigned(FGrid.Editor) and
650             (goAlwaysShowEditor in FGrid.Options) and
651             FGrid.Editor.Visible and
652             ((IndexToRow = FGrid.Row) or (Count = 0)) and  //if Count = 0 we still have an editable row
653             //if editor is Focussed, we are editing a cell, so we cannot hide!
654             (not EditorHasFocus);
655   //debugln('CanHideShowingEditor: Result = ',DbgS(Result));
656 end;
657 
658 procedure TValueListStrings.CustomSort(Compare: TStringListSortCompare);
659 {
660  Re-implement it, because we need it to call our own QuickSortStringsAndItemProps
661  and so we cannot use inherited CustomSort
662  Use BeginUpdate/EndUpdate to avoid numerous Changing/Changed calls
663 }
664 begin
665   If not Sorted and (Count>1) then
666   begin
667     try
668       BeginUpdate;
669       FGrid.InvalidateCachedRow;
670       QuickSortStringsAndItemProps(0,Count-1, Compare);
671     finally
672       EndUpdate;
673     end;
674   end;
675 end;
676 
677 procedure TValueListStrings.Delete(Index: Integer);
678 var
679   IsShowingEditor: Boolean;
680 begin
681   FGrid.InvalidateCachedRow;
682   IsShowingEditor := CanHideShowingEditorAtIndex(Index);
683   if IsShowingEditor then FGrid.Options := FGrid.Options - [goAlwaysShowEditor];
684   inherited Delete(Index);
685   // Delete also ItemProps
686   FItemProps.Delete(Index);
687   //only restore this _after_ FItemProps is updated!
688   if IsShowingEditor then FGrid.Options := FGrid.Options + [goAlwaysShowEditor];
689 end;
690 
691 procedure TValueListStrings.Exchange(Index1, Index2: Integer);
692 var
693   MustHideShowingEditor: Boolean;
694 begin
695   FGrid.InvalidateCachedRow;
696   MustHideShowingEditor := CanHideShowingEditorAtIndex(Index1) or CanHideShowingEditorAtIndex(Index2);
697   if MustHideShowingEditor then FGrid.Options := FGrid.Options - [goAlwaysShowEditor];
698   inherited Exchange(Index1, Index2);
699   FItemProps.Exchange(Index1, Index2);
700   if MustHideShowingEditor then FGrid.Options := FGrid.Options + [goAlwaysShowEditor];
701 end;
702 
TValueListStrings.GetItemPropnull703 function TValueListStrings.GetItemProp(const AKeyOrIndex: Variant): TItemProp;
704 var
705   i: Integer;
706   s: string;
707 begin
708   Result := Nil;
709   if (Count > 0) and (UpdateCount = 0) then
710   begin
711     if VarIsOrdinal(AKeyOrIndex) then
712       i := AKeyOrIndex
713     else begin
714       s := AKeyOrIndex;
715       i := IndexOfName(s);
716       if i = -1 then
717         raise Exception.Create('TValueListStrings.GetItemProp: Key not found: '+s);
718     end;
719     if i < FItemProps.Count then
720     begin
721       Result := FItemProps.Items[i];
722       if not Assigned(Result) then
723         Raise Exception.Create(Format('TValueListStrings.GetItemProp: Index=%d Result=Nil',[i]));
724     end;
725   end;
726 end;
727 
728 
729 { TValueListEditor }
730 
731 constructor TValueListEditor.Create(AOwner: TComponent);
732 begin
733   //need FStrings before inherited Create, because they are needed in overridden SelectEditor
734   FCreating := True;
735   FStrings := TValueListStrings.Create(Self);
736   FStrings.NameValueSeparator := '=';
737   FTitleCaptions := TStringList.Create;
738   inherited Create(AOwner);
739   FStrings.OnChange := @StringsChange;
740   FStrings.OnChanging := @StringsChanging;
741   TStringList(FTitleCaptions).OnChange := @TitlesChanged;
742 
743   //Don't use Columns.Add, it interferes with setting FixedCols := 1 (it will then insert an extra column)
744   {
745   with Columns.Add do
746     Title.Caption := 'Key';
747   with Columns.Add do begin
748     Title.Caption := 'Value';
749     DropDownRows := 8;
750   end;
751   }
752 
753   ColCount:=2;
754   {inherited} RowCount := 2;
755   FixedCols := 0;
756 //  DefaultColWidth := 150;
757 //  DefaultRowHeight := 18;
758 //  Width := 306;
759 //  Height := 300;
760   Options := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
761               goColSizing, goEditing, goAlwaysShowEditor, goThumbTracking];
762   FDisplayOptions := [doColumnTitles, doAutoColResize, doKeyColFixed];
763   Col := 1;
764   FLastEditedRow := -1;
765   FDropDownRows := 8;
766   ShowColumnTitles;
767   AutoFillColumns := true;
768   FCreating := False;
769 end;
770 
771 destructor TValueListEditor.Destroy;
772 begin
773   FTitleCaptions.Free;
774   FStrings.Free;
775   inherited Destroy;
776 end;
777 
778 procedure TValueListEditor.Clear;
779 begin
780   Strings.Clear;
781 end;
782 
783 procedure TValueListEditor.DeleteColRow(IsColumn: Boolean; index: Integer);
784 begin
785   if not IsColumn then
786     DeleteRow(Index)
787   else
788     DeleteCol(Index);
789 end;
790 
791 procedure TValueListEditor.DeleteRow(Index: Integer);
792 begin
793   //If we have only one row, it may be empty and we cannot remove
794   if not ((Index - FixedRows = 0) and (Strings.Count = 0)) then inherited DeleteRow(Index) ;
795 end;
796 
797 procedure TValueListEditor.DeleteCol(Index: Integer);
798 begin
799   Raise EGridException.CreateFmt(rsVLEInvalidRowColOperation,['DeleteCol','']);
800 end;
801 
FindRownull802 function TValueListEditor.FindRow(const KeyName: string; out aRow: Integer): Boolean;
803 var
804   Index: Integer;
805 begin
806   Index := Strings.IndexOfName(KeyName);
807   Result := (Index > -1);
808   if Result then aRow := Index + FixedRows;
809 end;
810 
811 procedure TValueListEditor.InsertColRow(IsColumn: boolean; index: integer);
812 begin
813   if not IsColumn then
814     Strings.InsertItem(Index - FixedRows,'')
815   else
816     Raise EGridException.CreateFmt(rsVLEInvalidRowColOperation,['InsertColRow',' on columns']);
817 end;
818 
InsertRownull819 function TValueListEditor.InsertRow(const KeyName, Value: string; Append: Boolean): Integer;
820 var
821   NewInd, NewRow: Integer;
822   Line: String;
823 begin
824   if not ((KeyName = '') and (Value = '')) then
825     Line := KeyName + Strings.NameValueSeparator + Value
826   else
827     Line := '';
828   if (Row > Strings.Count) or ((Row - FixedRows) >= Strings.Count)
829   or (Cells[0, Row] <> '') or (Cells[1, Row] <> '') then
830   begin                                    // Add a new Key=Value pair
831     Strings.BeginUpdate;
832     try
833       if Append then
834       begin
835         if (Strings.Count = 0) then   //empty grid
836           NewInd := 0
837         else
838           NewInd := Row - FixedRows + 1 //append after current row
839       end
840       else
841         NewInd := Row - FixedRows; //insert it at current row
842       Strings.InsertItem(NewInd, Line, Nil);
843     finally
844       Strings.EndUpdate;
845     end;
846   end
847   else begin   // Use an existing row, just update the Key and Value.
848     Cells[0, Row] := KeyName;
849     Cells[1, Row] := Value;
850     NewInd := Row - FixedRows;
851   end;
852   Result := NewInd;
853   NewRow := NewInd + FixedRows;
854   if (NewRow <> Row) then Row := NewRow;
855 end;
856 
857 procedure TValueListEditor.InsertRowWithValues(Index: Integer; Values: array of String);
858 var
859   AKey, AValue: String;
860 begin
861   AKey := '';
862   AValue := '';
863   if (Length(Values) > 1) then
864   begin
865     AKey := Values[0];
866     AValue := Values[1];
867   end
868   else if (Length(Values) = 1) then
869     AKey := Values[0];
870   Strings.InsertItem(Index, AKey + Strings.NameValueSeparator + AValue);
871 end;
872 
873 procedure TValueListEditor.ExchangeColRow(IsColumn: Boolean; index, WithIndex: Integer);
874 begin
875   if not IsColumn then
876     inherited ExchangeColRow(IsColumn, index, WithIndex)
877   else
878     Raise EGridException.CreateFmt(rsVLEInvalidRowColOperation,['ExchangeColRow',' on columns']);
879 end;
880 
IsEmptyRownull881 function TValueListEditor.IsEmptyRow: Boolean;
882 {As per help text on Embarcadero: the function does not have a parameter for row, so assume current one?}
883 begin
884   Result := IsEmptyRow(Row);
885 end;
886 
IsEmptyRownull887 function TValueListEditor.IsEmptyRow(aRow: Integer): Boolean;
888 begin
889   if (Strings.Count = 0) and (aRow - FixedRows = 0) then
890     //special case: we have just one row, and it is empty
891     Result := True
892   else if (aRow = 0) and (FixedRows = 0) then
893     Result := ((inherited GetCells(0,0)) = EmptyStr)  and ((inherited GetCells(1,0)) = EmptyStr)
894   else
895     Result := Strings.Strings[aRow - FixedRows] = EmptyStr;
896 end;
897 
898 procedure TValueListEditor.LoadFromCSVStream(AStream: TStream;
899   ADelimiter: Char; UseTitles: boolean; FromLine: Integer;
900   SkipEmptyLines: Boolean);
901 begin
902   inherited LoadFromCSVStream(AStream, ADelimiter, UseTitles, FromLine,
903     SkipEmptyLines);
904   if UseTitles then UpdateTitleCaptions(Cells[0,0],Cells[1,0]);
905 end;
906 
907 procedure TValueListEditor.MoveColRow(IsColumn: Boolean; FromIndex,
908   ToIndex: Integer);
909 var
910   Line: String;
911 begin
912   if not IsColumn then
913   begin
914     try
915       Strings.BeginUpdate;
916       Line := Strings.Strings[FromIndex - FixedRows];
917       Strings.Delete(FromIndex - FixedRows);
918       Strings.InsertItem(ToIndex - FixedRows, Line);
919     finally
920       Strings.EndUpdate;
921     end;
922   end
923   else
924     Raise EGridException.CreateFmt(rsVLEInvalidRowColOperation,['MoveColRow',' on columns']);
925 end;
926 
927 
RestoreCurrentRownull928 function TValueListEditor.RestoreCurrentRow: Boolean;
929 begin
930   //DbgOut('RestoreCurrentRow: Row=',DbgS(Row),' FLastEditedRow=',DbgS(FLastEditedRow),' SavedKey=',FRowTextOnEnter.Key,' SavedValue=',FRowTextOnEnter.Value);
931   Result := False;
932   if (Row = FLastEditedRow) and Assigned(Editor) and Editor.Focused then
933   begin
934     if (Cells[0,Row] <> FRowTextOnEnter.Key) or (Cells[1,Row] <> FRowTextOnEnter.Value) then
935     begin
936       try
937         EditorHide;
938         if (Cells[0,Row] <> FRowTextOnEnter.Key) then Cells[0,Row] := FRowTextOnEnter.Key;
939         if (Cells[1,Row] <> FRowTextOnEnter.Value) then Cells[1,Row] := FRowTextOnEnter.Value;
940       finally
941         EditorShow(True);
942       end;
943       Result := True;
944     end;
945   end;
946 end;
947 
948 
949 procedure TValueListEditor.Sort(ACol: TVleSortCol = colKey);
950 begin
951   SortColRow(True, Ord(ACol));
952 end;
953 
954 procedure TValueListEditor.Sort(Index, IndxFrom, IndxTo: Integer);
955 begin
956   Sort(True, Index, IndxFrom, IndxTo);
957 end;
958 
959 procedure TValueListEditor.StringsChange(Sender: TObject);
960 begin
961   Modified := True;
962   AdjustRowCount;
963   Invalidate;
964   if Assigned(OnStringsChange) then
965     OnStringsChange(Self);
966 end;
967 
968 procedure TValueListEditor.StringsChanging(Sender: TObject);
969 begin
970   if Assigned(OnStringsChanging) then
971     OnStringsChanging(Self);
972 end;
973 
974 procedure TValueListEditor.SetFixedCols(const AValue: Integer);
975 begin
976   if (AValue in [0,1]) then
977     inherited SetFixedCols(AValue);
978 end;
979 
980 procedure TValueListEditor.SetFixedRows(const AValue: Integer);
981 begin
982   if AValue in [0,1] then begin  // No other values are allowed
983     if AValue = 0 then           // Typically DisplayOptions are changed directly
984       DisplayOptions := DisplayOptions - [doColumnTitles]
985     else
986       DisplayOptions := DisplayOptions + [doColumnTitles]
987   end;
988 end;
989 
GetItemPropnull990 function TValueListEditor.GetItemProp(const AKeyOrIndex: Variant): TItemProp;
991 begin
992   Result := FStrings.GetItemProp(AKeyOrIndex);
993 end;
994 
995 procedure TValueListEditor.SetItemProp(const AKeyOrIndex: Variant; AValue: TItemProp);
996 begin
997   FStrings.GetItemProp(AKeyOrIndex).Assign(AValue);
998 end;
999 
GetOptionsnull1000 function TValueListEditor.GetOptions: TGridOptions;
1001 begin
1002   Result := inherited Options;
1003 end;
1004 
1005 procedure TValueListEditor.SetDisplayOptions(const AValue: TDisplayOptions);
1006 // Set number of fixed rows to 1 if titles are shown (based on DisplayOptions).
1007 // Set the local options value, then Adjust Column Widths and Refresh the display.
1008 begin
1009   BeginUpdate;
1010   if (doColumnTitles in DisplayOptions) <> (doColumnTitles in AValue) then
1011     if doColumnTitles in AValue then begin
1012       if RowCount < 2 then
1013         {inherited} RowCount := 2;
1014       inherited SetFixedRows(1);// don't do FixedRows := 1 here, it wil cause infinite recursion (Issue 0029993)
1015     end else
1016       inherited SetFixedRows(0);
1017 
1018   if (doAutoColResize in DisplayOptions) <> (doAutoColResize in AValue) then
1019     AutoFillColumns := (doAutoColResize in AValue);
1020 
1021   FDisplayOptions := AValue;
1022   ShowColumnTitles;
1023   AdjustRowCount;
1024   EndUpdate;
1025 end;
1026 
1027 procedure TValueListEditor.SetDropDownRows(const AValue: Integer);
1028 begin
1029   FDropDownRows := AValue;
1030   // ToDo: If edit list for inplace editing is implemented, set its handler, too.
1031 end;
1032 
1033 procedure TValueListEditor.SetKeyOptions(AValue: TKeyOptions);
1034 begin
1035   FUpdatingKeyOptions := True;
1036   // KeyAdd requires KeyEdit, KeyAdd oddly enough does not according to Delphi specs
1037   if KeyAdd in AValue then
1038     Include(AValue, keyEdit);
1039   FKeyOptions := AValue;
1040   if (KeyAdd in FKeyOptions) then
1041     Options := Options + [goAutoAddRows]
1042   else
1043     Options := Options - [goAutoAddRows];
1044   FUpdatingKeyOptions := False;
1045 end;
1046 
1047 procedure TValueListEditor.SetOptions(AValue: TGridOptions);
1048 begin
1049   //cannot allow goColMoving
1050   if goColMoving in AValue then
1051     Exclude(AValue, goColMoving);
1052   //temporarily disable this, it causes crashes
1053   if (goAutoAddRowsSkipContentCheck in AValue) then
1054     Exclude(AValue, goAutoAddRowsSkipContentCheck);
1055   inherited Options := AValue;
1056   // Enable also the required KeyOptions for goAutoAddRows
1057   if not FUpdatingKeyOptions and not (csLoading in ComponentState)
1058   and (goAutoAddRows in AValue) then
1059     KeyOptions := KeyOptions + [keyEdit, keyAdd];
1060 end;
1061 
1062 procedure TValueListEditor.SetStrings(const AValue: TValueListStrings);
1063 begin
1064   FStrings.Assign(AValue);
1065 end;
1066 
1067 procedure TValueListEditor.SetTitleCaptions(const AValue: TStrings);
1068 begin
1069   FTitleCaptions.Assign(AValue);
1070 end;
1071 
1072 procedure TValueListEditor.UpdateTitleCaptions(const KeyCap, ValCap: String);
1073 begin
1074   FTitleCaptions.Clear;
1075   FTitleCaptions.Add(KeyCap);
1076   FTitleCaptions.Add(ValCap);
1077 end;
1078 
GetKeynull1079 function TValueListEditor.GetKey(Index: Integer): string;
1080 begin
1081   Result:=Cells[0,Index];
1082 end;
1083 
1084 procedure TValueListEditor.SetKey(Index: Integer; const Value: string);
1085 begin
1086   Cells[0,Index]:=Value;
1087 end;
1088 
TValueListEditor.GetValuenull1089 function TValueListEditor.GetValue(const Key: string): string;
1090 var
1091   I: Integer;
1092 begin
1093   Result := '';
1094   I := Strings.IndexOfName(Key);
1095   if I > -1 then begin
1096     Inc(I, FixedRows);
1097     Result:=Cells[1,I];
1098   end;
1099 end;
1100 
1101 procedure TValueListEditor.SetValue(const Key: string; AValue: string);
1102 var
1103   I: Integer;
1104 begin
1105   I := Strings.IndexOfName(Key);
1106   if I > -1 then begin
1107     Inc(I, FixedRows);
1108     Cells[1,I]:=AValue;
1109   end
1110   else begin
1111     Insert(Strings.NameValueSeparator, AValue, 1);
1112     Insert(Key, AValue, 1);
1113     Strings.Add(AValue);
1114   end;
1115 end;
1116 
1117 procedure TValueListEditor.ShowColumnTitles;
1118 var
1119   KeyCap, ValCap: String;
1120 begin
1121   if (doColumnTitles in DisplayOptions) then
1122   begin
1123     KeyCap := rsVLEKey;
1124     ValCap := rsVLEValue;
1125     if (TitleCaptions.Count > 0) then KeyCap := TitleCaptions[0];
1126     if (TitleCaptions.Count > 1) then ValCap := TitleCaptions[1];
1127     //Columns[0].Title.Caption := KeyCap;
1128     //Columns[1].Title.Caption := ValCap;
1129     //or:
1130     Cells[0,0] := KeyCap;
1131     Cells[1,0] := ValCap;
1132   end;
1133 end;
1134 
1135 procedure TValueListEditor.AdjustRowCount;
1136 // Change the number of rows based on the number of items in Strings collection.
1137 // Sets Row and RowCount of parent TCustomDrawGrid class.
1138 var
1139   NewC: Integer;
1140 begin
1141   NewC:=FixedRows+1;
1142   if Strings.Count>0 then
1143     NewC:=Strings.Count+FixedRows;
1144   if NewC<>RowCount then
1145   begin
1146     if NewC<Row then
1147       Row:=NewC-1;
1148     if Row = 0 then
1149       if doColumnTitles in DisplayOptions then
1150         Row:=1;
1151     inherited RowCount:=NewC;
1152   end;
1153 end;
1154 
1155 procedure TValueListEditor.ColRowExchanged(IsColumn: Boolean; index,
1156   WithIndex: Integer);
1157 begin
1158   Strings.Exchange(Index - FixedRows, WithIndex - FixedRows);
1159   inherited ColRowExchanged(IsColumn, index, WithIndex);
1160 end;
1161 
1162 procedure TValueListEditor.ColRowDeleted(IsColumn: Boolean; index: Integer);
1163 begin
1164   EditorMode := False;
1165   Strings.Delete(Index-FixedRows);
1166   inherited ColRowDeleted(IsColumn, index);
1167 end;
1168 
1169 procedure TValueListEditor.DefineCellsProperty(Filer: TFiler);
1170 begin
1171 end;
1172 
1173 procedure TValueListEditor.InvalidateCachedRow;
1174 begin
1175   if (Strings.Count = 0) then
1176   begin
1177     FLastEditedRow := FixedRows;
1178     FRowTextOnEnter.Key := '';
1179     FRowTextOnEnter.Value := '';
1180   end
1181   else
1182     FLastEditedRow := -1;
1183 end;
1184 
1185 procedure TValueListEditor.GetAutoFillColumnInfo(const Index: Integer;
1186   var aMin, aMax, aPriority: Integer);
1187 begin
1188   if Index=1 then
1189     aPriority := 1
1190   else
1191   begin
1192     if doKeyColFixed in FDisplayOptions then
1193       aPriority := 0
1194     else
1195       aPriority := 1;
1196   end;
1197 end;
1198 
GetCellsnull1199 function TValueListEditor.GetCells(ACol, ARow: Integer): string;
1200 var
1201   I: Integer;
1202 begin
1203   Result:='';
1204   if (ARow=0) and (doColumnTitles in DisplayOptions) then
1205   begin
1206     Result := Inherited GetCells(ACol, ARow);
1207   end
1208   else
1209   begin
1210     I:=ARow-FixedRows;
1211     if (I >= Strings.Count) then
1212       //Either empty grid, or a row has been added and Strings hasn't been update yet
1213       //the latter happens when rows are auto-added (issue #0025166)
1214       Exit;
1215     if ACol=0 then
1216       Result:=Strings.Names[I]
1217     else if ACol=1 then
1218       Result:=Strings.ValueFromIndex[I];
1219   end;
1220 end;
1221 
1222 procedure SetGridEditorReadOnly(Ed: TwinControl; RO: Boolean);
1223 begin
1224   //debugln('SetEditorReadOnly: Ed is ',DbgSName(Ed),' ReadOnly=',DbgS(RO));
1225   if (Ed is TCustomEdit) then
1226     TCustomEdit(Ed).ReadOnly := RO
1227   else if (Ed is TCustomComboBox) then
1228     if RO then
1229       TCustomComboBox(Ed).Style := csDropDownList
1230     else
1231       TCustomComboBox(Ed).Style := csDropDown;
1232 end;
1233 
GetDefaultEditornull1234 function TValueListEditor.GetDefaultEditor(Column: Integer): TWinControl;
1235 var
1236   ItemProp: TItemProp;
1237 begin
1238   if (Row <> FLastEditedRow) then
1239   //save current contents for RestoreCurrentRow
1240   begin
1241     FLastEditedRow := Row;
1242     FRowTextOnEnter.Key := Cells[0,Row];
1243     FRowTextOnEnter.Value := Cells[1,Row];
1244   end;
1245   Result:=inherited GetDefaultEditor(Column);
1246   //Need this to be able to intercept VK_Delete in the editor
1247   if (KeyDelete in KeyOptions) then
1248     EditorOptions := EditorOptions or EO_HOOKKEYDOWN
1249   else
1250     EditorOptions := EditorOptions and (not EO_HOOKKEYDOWN);
1251   if Column=1 then
1252   begin
1253     ItemProp := nil;
1254     //debugln('**** A Col=',dbgs(col),' Row=',dbgs(row),' (',dbgs(itemprop),')');
1255     ItemProp := Strings.GetItemProp(Row-FixedRows);
1256     if Assigned(ItemProp) then
1257     begin
1258       case ItemProp.EditStyle of
1259         esSimple: begin
1260           result := EditorByStyle(cbsAuto);
1261           SetGridEditorReadOnly(result, ItemProp.ReadOnly);
1262         end;
1263         esEllipsis: begin
1264           result := EditorByStyle(cbsEllipsis);
1265           SetGridEditorReadOnly(TCompositeCellEditorAccess(result).GetActiveControl, ItemProp.ReadOnly);
1266         end;
1267         esPickList: begin
1268           result := EditorByStyle(cbsPickList);
1269           (result as TCustomComboBox).Items.Assign(ItemProp.PickList);
1270           (result as TCustomComboBox).DropDownCount := DropDownRows;
1271           SetGridEditorReadOnly(result, ItemProp.ReadOnly);
1272           if Assigned(FOnGetPickList) then
1273             FOnGetPickList(Self, Strings.Names[Row - FixedRows], (result as TCustomComboBox).Items);
1274           //Style := csDropDown, default = csDropDownList;
1275         end;
1276       end; //case
1277     end
1278     else SetGridEditorReadOnly(result, False);
1279   end
1280   else
1281   begin
1282     //First column is only editable if KeyEdit is in KeyOptions
1283     if not (KeyEdit in KeyOptions) then
1284       Result := nil
1285     else
1286       SetGridEditorReadOnly(result, False);
1287   end;
1288 end;
1289 
GetRowCountnull1290 function TValueListEditor.GetRowCount: Integer;
1291 begin
1292   Result := inherited RowCount;
1293 end;
1294 
1295 procedure TValueListEditor.KeyDown(var Key: Word; Shift: TShiftState);
1296 begin
1297   inherited KeyDown(Key, Shift);
1298   if (KeyAdd in KeyOptions) then
1299   begin
1300     if (Key = VK_INSERT) and (Shift = []) then
1301     begin
1302       //Insert a row in the current position
1303       InsertRow('', '', False);
1304       Key := 0;
1305     end;
1306   end;
1307   if (KeyDelete in KeyOptions) then
1308   begin
1309     //Although Delphi help says this happens if user presses Delete, testers report it only happens with Ctrl+Delete
1310     if (Key = VK_DELETE) and (Shift = [ssModifier]) then
1311     begin
1312       DeleteRow(Row);
1313       Key := 0;
1314     end;
1315   end;
1316   if (Key = VK_ESCAPE) and (Shift = []) then
1317     if RestoreCurrentRow then Key := 0;
1318 end;
1319 
1320 procedure TValueListEditor.KeyPress(var Key: Char);
1321 begin
1322   inherited KeyPress(Key);
1323   if (Key = Strings.NameValueSeparator) and (Col = 0) then
1324   begin//move to Value column
1325     Key := #0;
1326     //Modified code from TCustomGrid.KeyDown
1327     GridFlags := GridFlags + [gfEditingDone];
1328     if MoveNextSelectable(True, 1, 0) then
1329       Click;
1330     GridFlags := GridFlags - [gfEditingDone];
1331   end;
1332 end;
1333 
1334 
1335 procedure TValueListEditor.LoadContent(cfg: TXMLConfig; Version: Integer);
1336 var
1337   ContentSaved, HasColumnTitles, AlwaysShowEditor, HasSaveContent: Boolean;
1338   i,j,k, RC: Integer;
1339   KeyCap, ValCap, S: String;
1340 begin
1341   KeyCap := '';
1342   ValCap := '';
1343   BeginUpdate;
1344   try
1345     AlwaysShowEditor := (goAlwaysShowEditor in Options);
1346     if AlwaysShowEditor then Options := Options - [goAlwaysShowEditor];
1347     HasSaveContent := soContent in SaveOptions;
1348     //no need to load content in inherited LoadContent, since we re-implemented that here.
1349     if HasSaveContent then
1350       SaveOptions := SaveOptions - [soContent];
1351     inherited LoadContent(Cfg, Version);
1352     if HasSaveContent then
1353       SaveOptions := SaveOptions + [soContent];
1354     if soContent in SaveOptions then
1355     begin
1356       ContentSaved:=Cfg.GetValue('grid/saveoptions/content', false);
1357       if ContentSaved then
1358       begin
1359         Clean(0,0,ColCount-1,RowCount-1,[]); //needed if the to be loaded grid has no entries
1360         HasColumnTitles := cfg.getValue('grid/content/hascolumntitles', False);
1361         if HasColumnTitles then
1362           DisplayOptions := DisplayOptions + [doColumnTitles]
1363         else
1364           DisplayOptions := DisplayOptions - [doColumnTitles];
1365 
1366         //contrary to other grids we restore the entire saved content,
1367         //so we add/delete rows (not columns of course) as needed.
1368         RC := cfg.GetValue('grid/content/rowcount', -1);
1369         if (RC = -1) then
1370         begin
1371           raise EStreamError.CreateFmt(rsVLENoRowCountFound,[cfg.Filename]);
1372         end;
1373         if (RC < 1) then RC := 1;
1374         if HasColumnTitles and (RC = 1) then
1375           RC := 2;
1376         RowCount := RC;
1377 
1378         k:=cfg.getValue('grid/content/cells/cellcount', 0);
1379         while k>0 do
1380         begin
1381           i := cfg.GetValue('grid/content/cells/cell'+IntToStr(k)+'/column', -1);
1382           j := cfg.GetValue('grid/content/cells/cell'+IntTostr(k)+'/row',-1);
1383           if not IsRowIndexValid(j) then
1384             raise EStreamError.CreateFmt(rsVLERowIndexOutOfBounds,[cfg.Filename,j]);
1385           if not IsColumnIndexValid(i) then
1386             raise EStreamError.CreateFmt(rsVLEColIndexOutOfBounds,[cfg.Filename,i]);
1387           S := cfg.GetValue('grid/content/cells/cell'+IntToStr(k)+'/text','');
1388           Cells[i,j] := S;
1389           if HasColumnTitles and (i = 0) and (j = 0) then
1390             KeyCap := S
1391           else if HasColumnTitles and (i = 1) and (j = 0) then
1392             ValCap := S;
1393           Dec(k);
1394         end;
1395         if HasColumnTitles then UpdateTitleCaptions(KeyCap, ValCap);
1396       end;
1397     end;
1398   finally
1399     if AlwaysShowEditor then Options := Options + [goAlwaysShowEditor];
1400     if HasSaveContent then
1401       SaveOptions := SaveOptions + [soContent];
1402     EndUpdate(True);
1403   end;
1404 end;
1405 
1406 procedure TValueListEditor.ResetDefaultColWidths;
1407 begin
1408   if not AutoFillColumns then
1409     inherited ResetDefaultColWidths
1410   else if doKeyColFixed in DisplayOptions then
1411   begin
1412     SetRawColWidths(0, -1);
1413     VisualChange;
1414   end;
1415 end;
1416 
1417 procedure TValueListEditor.SaveContent(cfg: TXMLConfig);
1418 var
1419   i,j,k: Integer;
1420   Value: String;
1421   HasSaveContent: Boolean;
1422 begin
1423   HasSaveContent := soContent in SaveOptions;
1424   //no need to save content in inherited SaveContent, since we re-implemented that here.
1425   if HasSaveContent then
1426     SaveOptions := SaveOptions - [soContent];
1427   try
1428     inherited SaveContent(cfg);
1429     if HasSaveContent then
1430       SaveOptions := SaveOptions + [soContent];
1431     cfg.SetValue('grid/saveoptions/content', soContent in SaveOptions);
1432     if soContent in SaveOptions then
1433     begin
1434       cfg.SetValue('grid/content/hascolumntitles',(doColumnTitles in FDisplayOptions));
1435       cfg.SetValue('grid/content/rowcount', RowCount);
1436       // Save Cell Contents
1437       k:=0;
1438       For i:=0 to ColCount-1 do
1439         For j:=0 to RowCount-1 do
1440         begin
1441           //fGrid.Celda is unassigned for cells other than the title row, so we neet to query GetCells here
1442           Value := GetCells(i,j);
1443           if (Value <> '') then
1444           begin
1445             Inc(k);
1446             //Cfg.SetValue('grid/content/cells/cellcount',k);
1447             cfg.SetValue('grid/content/cells/cell'+IntToStr(k)+'/column',i);
1448             cfg.SetValue('grid/content/cells/cell'+IntToStr(k)+'/row',j);
1449             cfg.SetValue('grid/content/cells/cell'+IntToStr(k)+'/text', Value);
1450           end;
1451           Cfg.SetValue('grid/content/cells/cellcount',k);
1452         end;
1453      end;
1454   finally
1455     if HasSaveContent then
1456       SaveOptions := SaveOptions + [soContent];
1457   end;
1458 end;
1459 
1460 procedure TValueListEditor.SetCells(ACol, ARow: Integer; const AValue: string);
1461 var
1462   I: Integer;
1463   Key, KeyValue, Line: string;
1464   Sep: Char;
1465 begin
1466   if (ARow = 0) and (doColumnTitles in DisplayOptions) then
1467   begin
1468     Inherited SetCells(ACol, ARow, AValue);
1469   end
1470   else
1471   begin
1472     I:=ARow-FixedRows;
1473     if ACol=0 then
1474     begin
1475       Sep := Strings.NameValueSeparator;
1476       Key := AValue;
1477       {
1478         A Key can never contain NameVlaueSeparator (by default an equal sign ('='))
1479         While we disallow typing '=' inside the Key column
1480         we cannot prevent the user from pasting text that contains a '='
1481         This leads to strange effects since when we insert the Key/Value pair into
1482         the Strings property, in effect the equal sign will be treated (by design) as the separator for the value part.
1483         This in turn updates the Value column, but does not remove the equal sign from Key.
1484         E.g. if both Key and Value celss are empty and you type '=' into an empty Key cell,
1485         the Value cell will become '=='
1486         Reported on forum: https://forum.lazarus.freepascal.org/index.php?topic=51977.0;topicseen
1487       }
1488       if (Pos(Sep, Key) > 0) then
1489       begin
1490         Key := StringReplace(Key, Sep, '', [rfReplaceAll]);
1491         //update the content of the Column cell
1492         inherited SetCells(ACol, ARow, Key);
1493       end;
1494       KeyValue := Cells[1,ARow]
1495     end
1496     else
1497     begin
1498       KeyValue := AValue;
1499       Key := Cells[0,ARow];
1500     end;
1501     //If cells are empty don't store '=' in Strings
1502     if (Key = '') and (KeyValue = '') then
1503       Line := ''
1504     else begin
1505       Line := KeyValue;
1506       system.Insert(Strings.NameValueSeparator, Line, 1);
1507       system.Insert(Key, Line, 1);
1508     end;
1509     // Empty grid: don't add a the line '' to Strings!
1510     if (Strings.Count = 0) and (Line = '') then Exit;
1511     if I>=Strings.Count then
1512       Strings.Insert(I,Line)
1513     else
1514       if (Line <> Strings[I]) then Strings[I]:=Line;
1515   end;
1516 end;
1517 
1518 procedure TValueListEditor.SetColCount(AValue: Integer);
1519 begin
1520   if (not FCreating) and (not (csLoading in ComponentState)) and (AValue <> 2) then
1521     raise EGridException.CreateFmt(rsVLEIllegalColCount,[AValue]);
1522   inherited SetColCount(AValue);
1523 end;
1524 
GetEditTextnull1525 function TValueListEditor.GetEditText(ACol, ARow: Integer): string;
1526 begin
1527   Result:= Cells[ACol, ARow];
1528   if Assigned(OnGetEditText) then
1529     OnGetEditText(Self, ACol, ARow, Result);
1530 end;
1531 
1532 procedure TValueListEditor.SetEditText(ACol, ARow: Longint; const Value: string);
1533 begin
1534   inherited SetEditText(ACol, ARow, Value);
1535   Cells[ACol, ARow] := Value;
1536 end;
1537 
1538 procedure TValueListEditor.SetRowCount(AValue: Integer);
1539 var
1540   OldValue, NewCount: Integer;
1541 begin
1542   //debugln('TValueListEditor.SetRowCount: AValue=',DbgS(AValue));
1543   OldValue := inherited RowCount;
1544   if OldValue = AValue then Exit;
1545   if FixedRows > AValue then
1546     Raise EGridException.Create(rsFixedRowsTooBig);
1547   NewCount := AValue - FixedRows;
1548   if (NewCount > Strings.Count) then
1549   begin
1550     Strings.BeginUpdate;
1551     while (Strings.Count < NewCount) do Strings.Add('');
1552     Strings.EndUpdate;
1553   end
1554   else if (NewCount < Strings.Count) then
1555   begin
1556     Strings.BeginUpdate;
1557     while (NewCount < Strings.Count) do Strings.Delete(Strings.Count - 1);
1558     Strings.EndUpdate;
1559   end;
1560 end;
1561 
1562 procedure TValueListEditor.Sort(ColSorting: Boolean; index, IndxFrom,
1563   IndxTo: Integer);
1564 var
1565   HideEditor: Boolean;
1566 begin
1567   HideEditor := goAlwaysShowEditor in Options;
1568   if HideEditor then Options := Options - [goAlwaysShowEditor];
1569   Strings.BeginUpdate;
1570   try
1571     inherited Sort(True, index, IndxFrom, IndxTo);
1572   finally
1573     Strings.EndUpdate;
1574   end;
1575   if HideEditor then Options := Options + [goAlwaysShowEditor];
1576 end;
1577 
1578 procedure TValueListEditor.TitlesChanged(Sender: TObject);
1579 begin
1580   // Refresh the display.
1581   ShowColumnTitles;
1582   AdjustRowCount;
1583   Invalidate;
1584 end;
1585 
ValidateEntrynull1586 function TValueListEditor.ValidateEntry(const ACol, ARow: Integer;
1587   const OldValue: string; var NewValue: string): boolean;
1588 var
1589   Index, i: Integer;
1590 begin
1591   Result := inherited ValidateEntry(ACol, ARow, OldValue, NewValue);
1592   //Check for duplicate key names (only in "Key" column), if KeyUnique is set
1593   if ((ACol - FixedCols) = 0) and (KeyUnique in KeyOptions) then
1594   begin
1595     Index := ARow - FixedRows;
1596     for i := 0 to FStrings.Count - 1 do
1597     begin
1598       if (Index <> i) and (FStrings.Names[i] <> '') then
1599       begin
1600         if (UTF8CompareLatinTextFast(FStrings.Names[i], NewValue) = 0) then
1601         begin
1602           Result := False;
1603           ShowMessage(Format(rsVLEDuplicateKey,[NewValue, i + FixedRows]));
1604           if Editor is TStringCellEditor then TStringCelleditor(Editor).SelectAll;
1605           Break;
1606         end;
1607       end;
1608     end;
1609   end;
1610 end;
1611 
1612 class procedure TValueListEditor.WSRegisterClass;
1613 begin
1614 //  RegisterPropertyToSkip(Self, 'SomeProperty', 'VCL compatibility property', '');
1615   inherited WSRegisterClass;
1616 end;
1617 
1618 procedure Register;
1619 begin
1620   RegisterComponents('Additional',[TValueListEditor]);
1621 end;
1622 
1623 
1624 end.
1625 
1626