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,
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     FStrings: TValueListStrings;
124     FKeyOptions: TKeyOptions;
125     FDisplayOptions: TDisplayOptions;
126     FDropDownRows: Integer;
127     FOnGetPickList: TGetPickListEvent;
128     FOnStringsChange: TNotifyEvent;
129     FOnStringsChanging: TNotifyEvent;
130     FOnValidate: TOnValidateEvent;
131     FRowTextOnEnter: TKeyValuePair;
132     FLastEditedRow: Integer;
133     FUpdatingKeyOptions: Boolean;
GetItemPropnull134     function GetItemProp(const AKeyOrIndex: Variant): TItemProp;
135     procedure SetItemProp(const AKeyOrIndex: Variant; AValue: TItemProp);
136     procedure StringsChange(Sender: TObject);
137     procedure StringsChanging(Sender: TObject);
GetOptionsnull138     function GetOptions: TGridOptions;
GetKeynull139     function GetKey(Index: Integer): string;
GetValuenull140     function GetValue(const Key: string): string;
141     procedure SetDisplayOptions(const AValue: TDisplayOptions);
142     procedure SetDropDownRows(const AValue: Integer);
143     procedure SetKeyOptions(AValue: TKeyOptions);
144     procedure SetKey(Index: Integer; const Value: string);
145     procedure SetValue(const Key: string; AValue: string);
146     procedure SetOptions(AValue: TGridOptions);
147     procedure SetStrings(const AValue: TValueListStrings);
148     procedure SetTitleCaptions(const AValue: TStrings);
149   protected
150     class procedure WSRegisterClass; override;
151     procedure SetFixedCols(const AValue: Integer); override;
152     procedure ShowColumnTitles;
153     procedure AdjustRowCount; virtual;
154     procedure ColRowExchanged(IsColumn: Boolean; index, WithIndex: Integer); override;
155     procedure ColRowDeleted(IsColumn: Boolean; index: Integer); override;
156     procedure DefineCellsProperty(Filer: TFiler); override;
157     procedure InvalidateCachedRow;
158     procedure GetAutoFillColumnInfo(const Index: Integer; var aMin,aMax,aPriority: Integer); override;
GetEditTextnull159     function GetEditText(ACol, ARow: Integer): string; override;
GetCellsnull160     function GetCells(ACol, ARow: Integer): string; override;
GetDefaultEditornull161     function GetDefaultEditor(Column: Integer): TWinControl; override;
GetRowCountnull162     function GetRowCount: Integer;
163     procedure KeyDown(var Key : Word; Shift : TShiftState); override;
164     procedure ResetDefaultColWidths; override;
165     procedure SetCells(ACol, ARow: Integer; const AValue: string); override;
166     procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
167     procedure SetFixedRows(const AValue: Integer); override;
168     procedure SetRowCount(AValue: Integer);
169     procedure Sort(ColSorting: Boolean; index,IndxFrom,IndxTo:Integer); override;
170     procedure TitlesChanged(Sender: TObject);
ValidateEntrynull171     function ValidateEntry(const ACol,ARow:Integer; const OldValue:string; var NewValue:string): boolean; override;
172   public
173     constructor Create(AOwner: TComponent); override;
174     destructor Destroy; override;
175 
176     procedure Clear;
177     procedure DeleteColRow(IsColumn: Boolean; index: Integer);
178     procedure DeleteRow(Index: Integer); override;
179     procedure DeleteCol(Index: Integer); override;
FindRownull180     function FindRow(const KeyName: string; out aRow: Integer): Boolean;
181     procedure InsertColRow(IsColumn: boolean; index: integer);
InsertRownull182     function InsertRow(const KeyName, Value: string; Append: Boolean): Integer;
183     procedure InsertRowWithValues(Index: Integer; Values: array of String);
184     procedure ExchangeColRow(IsColumn: Boolean; index, WithIndex: Integer); override;
IsEmptyRownull185     function IsEmptyRow: Boolean; {Delphi compatible function}
IsEmptyRownull186     function IsEmptyRow(aRow: Integer): Boolean; {This for makes more sense to me}
187     procedure MoveColRow(IsColumn: Boolean; FromIndex, ToIndex: Integer);
RestoreCurrentRownull188     function RestoreCurrentRow: Boolean;
189     procedure Sort(Index, IndxFrom, IndxTo: Integer);
190     procedure Sort(ACol: TVleSortCol = colKey);
191 
192     property Modified;
193     property Keys[Index: Integer]: string read GetKey write SetKey;
194     property Values[const Key: string]: string read GetValue write SetValue;
195     property ItemProps[const AKeyOrIndex: Variant]: TItemProp read GetItemProp write SetItemProp;
196   published
197     // Same as in TStringGrid
198     property Align;
199     property AlternateColor;
200     property Anchors;
201     property AutoAdvance;
202     property AutoEdit;
203     property BiDiMode;
204     property BorderSpacing;
205     property BorderStyle;
206     property Color;
207     property Constraints;
208     property DefaultColWidth;
209     property DefaultDrawing;
210     property DefaultRowHeight;
211     property DragCursor;
212     property DragKind;
213     property DragMode;
214     property Enabled;
215     property ExtendedSelect;
216     property FixedColor;
217     property FixedCols;
218     property Flat;
219     property Font;
220     property GridLineWidth;
221     property HeaderHotZones;
222     property HeaderPushZones;
223     property MouseWheelOption;
224     property ParentBiDiMode;
225     property ParentColor default false;
226     property ParentFont;
227     property ParentShowHint;
228     property PopupMenu;
229     property RowCount: Integer read GetRowCount write SetRowCount;
230     property ScrollBars;
231     property ShowHint;
232     property TabOrder;
233     property TabStop;
234     property TitleFont;
235     property TitleImageList;
236     property TitleStyle;
237     property UseXORFeatures;
238     property Visible;
239     property VisibleColCount;
240     property VisibleRowCount;
241 
242     property OnBeforeSelection;
243     property OnButtonClick;
244     property OnChangeBounds;
245     property OnCheckboxToggled;
246     property OnClick;
247     property OnColRowDeleted;
248     property OnColRowExchanged;
249     property OnColRowInserted;
250     property OnColRowMoved;
251     property OnCompareCells;
252     property OnContextPopup;
253     property OnDragDrop;
254     property OnDragOver;
255     property OnDblClick;
256     property OnDrawCell;
257     property OnEditButtonClick; deprecated;
258     property OnEditingDone;
259     property OnEndDock;
260     property OnEndDrag;
261     property OnEnter;
262     property OnExit;
263     property OnGetEditMask;
264     property OnGetEditText;
265     property OnHeaderClick;
266     property OnHeaderSized;
267     property OnHeaderSizing;
268     property OnKeyDown;
269     property OnKeyPress;
270     property OnKeyUp;
271     property OnMouseDown;
272     property OnMouseEnter;
273     property OnMouseLeave;
274     property OnMouseMove;
275     property OnMouseUp;
276     property OnMouseWheel;
277     property OnMouseWheelDown;
278     property OnMouseWheelUp;
279     property OnPickListSelect;
280     property OnPrepareCanvas;
281     property OnResize;
282     property OnSelectEditor;
283     property OnSelection;
284     property OnSelectCell;
285     property OnSetEditText;
286     property OnShowHint;
287     property OnStartDock;
288     property OnStartDrag;
289     property OnTopLeftChanged;
290     property OnUserCheckboxBitmap;
291     property OnUTF8KeyPress;
292     property OnValidateEntry;
293 
294     // Compatible with Delphi TValueListEditor:
295     property DisplayOptions: TDisplayOptions read FDisplayOptions
296       write SetDisplayOptions default [doColumnTitles, doAutoColResize, doKeyColFixed];
297     property DoubleBuffered;
298     property DropDownRows: Integer read FDropDownRows write SetDropDownRows default 8;
299     property KeyOptions: TKeyOptions read FKeyOptions write SetKeyOptions default [];
300     property Options: TGridOptions read GetOptions write SetOptions default
301      [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goColSizing,
302       goEditing, goAlwaysShowEditor, goThumbTracking];
303     property Strings: TValueListStrings read FStrings write SetStrings;
304     property TitleCaptions: TStrings read FTitleCaptions write SetTitleCaptions;
305 
306     property OnGetPickList: TGetPickListEvent read FOnGetPickList write FOnGetPickList;
307     property OnStringsChange: TNotifyEvent read FOnStringsChange write FOnStringsChange;
308     property OnStringsChanging: TNotifyEvent read FOnStringsChanging write FOnStringsChanging;
309     property OnValidate: TOnValidateEvent read FOnValidate write FOnValidate;
310 
311   end;
312 
313 const
314   //ToDo: Make this a resourcestring in lclstrconsts unit, once we are satisfied with the implementation of validating
315   rsVLEDuplicateKey = 'Duplicate Key:'+LineEnding+'A key with name "%s" already exists at column %d';
316   //ToDo: Make this a resourcestring in lclstrconsts unit, once we are satisfied with ShowColumnTitles
317   rsVLEKey = 'Key';
318   rsVLEValue = 'Value';
319   rsVLEInvalidRowColOperation = 'The operation %s is not allowed on a TValueListEditor%s.';
320 
321 procedure Register;
322 
323 implementation
324 
325 type
326   TCompositeCellEditorAccess = class(TCompositeCellEditor);
327 
328 { TItemProp }
329 
330 
331 constructor TItemProp.Create(AOwner: TValueListEditor);
332 begin
333   inherited Create;
334   FGrid := AOwner;
335 end;
336 
337 destructor TItemProp.Destroy;
338 begin
339   FPickList.Free;
340   inherited Destroy;
341 end;
342 
GetPickListnull343 function TItemProp.GetPickList: TStrings;
344 begin
345   if FPickList = Nil then
346   begin
347     FPickList := TStringList.Create;
348     TStringList(FPickList).OnChange := @PickListChange;
349   end;
350   Result := FPickList;
351 end;
352 
353 procedure TItemProp.PickListChange(Sender: TObject);
354 begin
355   if PickList.Count > 0 then begin
356     if EditStyle = esSimple then
357       EditStyle := esPickList;
358   end
359   else begin
360     if EditStyle = esPickList then
361       EditStyle := esSimple;
362   end;
363 end;
364 
365 procedure TItemProp.SetEditMask(const AValue: string);
366 begin
367   FEditMask := AValue;
368   with FGrid do
369     if EditorMode and (FStrings.UpdateCount = 0) then
370       InvalidateCell(Col, Row);
371 end;
372 
373 procedure TItemProp.SetMaxLength(const AValue: Integer);
374 begin
375   FMaxLength := AValue;
376   with FGrid do
377     if EditorMode and (FStrings.UpdateCount = 0) then
378       InvalidateCell(Col, Row);
379 end;
380 
381 procedure TItemProp.SetReadOnly(const AValue: Boolean);
382 begin
383   FReadOnly := AValue;
384   with FGrid do
385     if EditorMode and (FStrings.UpdateCount = 0) then
386       InvalidateCell(Col, Row);
387 end;
388 
389 procedure TItemProp.SetEditStyle(const AValue: TEditStyle);
390 begin
391   FEditStyle := AValue;
392   with FGrid do
393     if EditorMode and (FStrings.UpdateCount = 0) then
394       InvalidateCell(Col, Row);
395 end;
396 
397 procedure TItemProp.SetPickList(const AValue: TStrings);
398 begin
399   GetPickList.Assign(AValue);
400   with FGrid do
401     if EditorMode and (FStrings.UpdateCount = 0) then
402       InvalidateCell(Col, Row);
403 end;
404 
405 procedure TItemProp.SetKeyDesc(const AValue: string);
406 begin
407   FKeyDesc := AValue;
408 end;
409 
410 procedure TItemProp.AssignTo(Dest: TPersistent);
411 begin
412   if not (Dest is TItemProp) then
413     inherited AssignTo(Dest)
414   else
415   begin
416     TItemProp(Dest).EditMask := Self.EditMask;
417     TItemProp(Dest).EditStyle := Self.EditStyle;
418     TItemProp(Dest).KeyDesc := Self.KeyDesc;
419     TItemProp(Dest).PickList.Assign(Self.PickList);
420     TItemProp(Dest).MaxLength := Self.MaxLength;
421     TItemProp(Dest).ReadOnly := Self.ReadOnly;
422   end;
423 end;
424 
425 
426 { TItemPropList }
427 
GetItemnull428 function TItemPropList.GetItem(Index: Integer): TItemProp;
429 begin
430   Result := TItemProp(FList.Items[Index]);
431 end;
432 
GetCountnull433 function TItemPropList.GetCount: Integer;
434 begin
435   Result := FList.Count;
436 end;
437 
438 procedure TItemPropList.SetItem(Index: Integer; AValue: TItemProp);
439 begin
440   FList.Items[Index] := AValue;
441 end;
442 
443 procedure TItemPropList.Insert(Index: Integer; AValue: TItemProp);
444 begin
445   FList.Insert(Index, AValue);
446 end;
447 
448 procedure TItemPropList.Add(AValue: TItemProp);
449 begin
450   FList.Add(AValue);
451 end;
452 
453 procedure TItemPropList.Assign(Source: TItemPropList);
454 var
455   Index: Integer;
456   Prop: TItemProp;
457 begin
458   Clear;
459   if not Assigned(Source) then Exit;
460   for Index := 0 to Source.Count - 1 do
461   begin
462     Prop := TItemProp.Create(FStrings.FGrid);
463     Prop.Assign(Source.Items[Index]);
464     Add(Prop);
465   end;
466 end;
467 
468 procedure TItemPropList.Delete(Index: Integer);
469 begin
470   FList.Delete(Index);
471 end;
472 
473 procedure TItemPropList.Exchange(Index1, Index2: Integer);
474 begin
475   FList.Exchange(Index1, index2);
476 end;
477 
478 procedure TItemPropList.Clear;
479 begin
480   FList.Clear;
481 end;
482 
483 constructor TItemPropList.Create(AOwner: TValueListStrings);
484 begin
485   FStrings := AOwner;
486   FList := TFPObjectList.Create(True);
487 end;
488 
489 destructor TItemPropList.Destroy;
490 begin
491   FList.Free;
492   inherited Destroy;
493 end;
494 
495 
496 { TValueListStrings }
497 
498 procedure TValueListStrings.InsertItem(Index: Integer; const S: string; AObject: TObject);
499 var
500   MustHideShowingEditor: Boolean;
501 begin
502   // ToDo: Check validity of key
503   //debugln('TValueListStrings.InsertItem: Index = ',dbgs(index),' S = "',S,'" AObject = ',dbgs(aobject));
504   FGrid.InvalidateCachedRow;
505   MustHideShowingEditor := CanHideShowingEditorAtIndex(Index);
506   if MustHideShowingEditor then FGrid.Options := FGrid.Options - [goAlwaysShowEditor];
507   inherited InsertItem(Index, S, AObject);
508   FItemProps.Insert(Index, TItemProp.Create(FGrid));
509   //only restore this _after_ FItemProps is updated!
510   if MustHideShowingEditor then FGrid.Options := FGrid.Options + [goAlwaysShowEditor];
511 end;
512 
513 procedure TValueListStrings.InsertItem(Index: Integer; const S: string);
514 begin
515   InsertItem(Index, S, nil);
516 end;
517 
518 procedure TValueListStrings.Put(Index: Integer; const S: String);
519 var
520   MustHideShowingEditor: Boolean;
521 begin
522   // ToDo: Check validity of key
523   MustHideShowingEditor := CanHideShowingEditorAtIndex(Index);
524   //debugln('TValueListStrings.Put: MustHideShowingEditor=',DbgS(MustHideShowingEditor));
525   if MustHideShowingEditor then FGrid.Options := FGrid.Options - [goAlwaysShowEditor];
526   inherited Put(Index, S);
527   if MustHideShowingEditor then FGrid.Options := FGrid.Options + [goAlwaysShowEditor];
528 end;
529 
530 constructor TValueListStrings.Create(AOwner: TValueListEditor);
531 begin
532   inherited Create;
533   FGrid := AOwner;
534   FItemProps := TItemPropList.Create(Self);
535 end;
536 
537 destructor TValueListStrings.Destroy;
538 begin
539   FItemProps.Free;
540   inherited Destroy;
541 end;
542 
543 procedure TValueListStrings.Assign(Source: TPersistent);
544 begin
545   FGrid.InvalidateCachedRow;
546   Clear;  //if this is not done, and a TValueListEditor.Sort() is done and then later a Strings.Assign, an exception will occur.
547   inherited Assign(Source);
548   if (Source is TValueListStrings) then
549     FItemProps.Assign(TValueListStrings(Source).FItemProps);
550 end;
551 
552 procedure TValueListStrings.Clear;
553 var
554   IsShowingEditor: Boolean;
555 begin
556   FGrid.InvalidateCachedRow;
557   IsShowingEditor := goAlwaysShowEditor in FGrid.Options;
558   if IsShowingEditor then FGrid.Options := FGrid.Options - [goAlwaysShowEditor];
559   inherited Clear;
560   FItemProps.Clear;
561   if IsShowingEditor then FGrid.Options := FGrid.Options + [goAlwaysShowEditor];
562 end;
563 
564 
565 {
566  Duplicates the functionality of TStringList.QuickSort, but also
567  sorts the ItemProps.
568 }
569 procedure TValueListStrings.QuickSortStringsAndItemProps(L, R: Integer;
570   CompareFn: TStringListSortCompare);
571 var
572   Pivot, vL, vR: Integer;
573 begin
574   if R - L <= 1 then
575   begin // a little bit of time saver
576     if L < R then
577       if CompareFn(Self, L, R) > 0 then
578         //Exchange also exchanges FItemProps
579         Exchange(L, R);
580     Exit;
581   end;
582 
583   vL := L;
584   vR := R;
585   Pivot := L + Random(R - L); // they say random is best
586   while vL < vR do
587   begin
588     while (vL < Pivot) and (CompareFn(Self, vL, Pivot) <= 0) do
589       Inc(vL);
590     while (vR > Pivot) and (CompareFn(Self, vR, Pivot) > 0) do
591       Dec(vR);
592     //Exchange also exchanges FItemProps
593     Exchange(vL, vR);
594     if Pivot = vL then // swap pivot if we just hit it from one side
595       Pivot := vR
596     else if Pivot = vR then
597       Pivot := vL;
598   end;
599 
600   if Pivot - 1 >= L then
601     QuickSortStringsAndItemProps(L, Pivot - 1, CompareFn);
602   if Pivot + 1 <= R then
603     QuickSortStringsAndItemProps(Pivot + 1, R, CompareFn);
604 end;
605 
CanHideShowingEditorAtIndexnull606 function TValueListStrings.CanHideShowingEditorAtIndex(Index: Integer): Boolean;
607 var
608   IndexToRow: Integer;
609   WC: TWinControl;
610   EditorHasFocus: Boolean;
611 begin
612   IndexToRow := Index + FGrid.FixedRows;
613   if (FGrid.Editor is TCompositeCellEditor) then
614   begin
615     WC := TCompositeCellEditorAccess(FGrid.Editor).GetActiveControl;
616     if (WC is TCustomEdit) then
617       EditorHasFocus := TCustomEdit(WC).Focused
618     else
619       EditorHasFocus := False;
620   end
621   else
622     EditorHasFocus := Assigned(FGrid.Editor) and FGrid.Editor.Focused;
623 
624   //debugln('CanHideShowingEditor:');
625   //debugln(' Assigned(FGrid.Editor) = ',DbgS(Assigned(FGrid.Editor)));
626   //debugln(' (goAlwaysShowEditor in FGrid.Options) = ',DbgS(goAlwaysShowEditor in FGrid.Options));
627   //if Assigned(FGrid.Editor) then
628   //  debugln(' FGrid.Editor.Visible = ',DbgS(FGrid.Editor.Visible));
629   //debugln(' IndexToRow = ',DbgS(IndextoRow));
630   //debugln(' Count = ',DbgS(Count));
631   //debugln(' EditorHasFocus = ',DbgS(EditorHasFocus));
632 
633   Result := Assigned(FGrid.Editor) and
634             (goAlwaysShowEditor in FGrid.Options) and
635             FGrid.Editor.Visible and
636             ((IndexToRow = FGrid.Row) or (Count = 0)) and  //if Count = 0 we still have an editable row
637             //if editor is Focussed, we are editing a cell, so we cannot hide!
638             (not EditorHasFocus);
639   //debugln('CanHideShowingEditor: Result = ',DbgS(Result));
640 end;
641 
642 procedure TValueListStrings.CustomSort(Compare: TStringListSortCompare);
643 {
644  Re-implement it, because we need it to call our own QuickSortStringsAndItemProps
645  and so we cannot use inherited CustomSort
646  Use BeginUpdate/EndUpdate to avoid numerous Changing/Changed calls
647 }
648 begin
649   If not Sorted and (Count>1) then
650   begin
651     try
652       BeginUpdate;
653       FGrid.InvalidateCachedRow;
654       QuickSortStringsAndItemProps(0,Count-1, Compare);
655     finally
656       EndUpdate;
657     end;
658   end;
659 end;
660 
661 procedure TValueListStrings.Delete(Index: Integer);
662 var
663   IsShowingEditor: Boolean;
664 begin
665   FGrid.InvalidateCachedRow;
666   IsShowingEditor := CanHideShowingEditorAtIndex(Index);
667   if IsShowingEditor then FGrid.Options := FGrid.Options - [goAlwaysShowEditor];
668   inherited Delete(Index);
669   // Delete also ItemProps
670   FItemProps.Delete(Index);
671   //only restore this _after_ FItemProps is updated!
672   if IsShowingEditor then FGrid.Options := FGrid.Options + [goAlwaysShowEditor];
673 end;
674 
675 procedure TValueListStrings.Exchange(Index1, Index2: Integer);
676 var
677   MustHideShowingEditor: Boolean;
678 begin
679   FGrid.InvalidateCachedRow;
680   MustHideShowingEditor := CanHideShowingEditorAtIndex(Index1) or CanHideShowingEditorAtIndex(Index2);
681   if MustHideShowingEditor then FGrid.Options := FGrid.Options - [goAlwaysShowEditor];
682   inherited Exchange(Index1, Index2);
683   FItemProps.Exchange(Index1, Index2);
684   if MustHideShowingEditor then FGrid.Options := FGrid.Options + [goAlwaysShowEditor];
685 end;
686 
TValueListStrings.GetItemPropnull687 function TValueListStrings.GetItemProp(const AKeyOrIndex: Variant): TItemProp;
688 var
689   i: Integer;
690   s: string;
691 begin
692   Result := Nil;
693   if (Count > 0) and (UpdateCount = 0) then
694   begin
695     if VarIsOrdinal(AKeyOrIndex) then
696       i := AKeyOrIndex
697     else begin
698       s := AKeyOrIndex;
699       i := IndexOfName(s);
700       if i = -1 then
701         raise Exception.Create('TValueListStrings.GetItemProp: Key not found: '+s);
702     end;
703     if i < FItemProps.Count then
704     begin
705       Result := FItemProps.Items[i];
706       if not Assigned(Result) then
707         Raise Exception.Create(Format('TValueListStrings.GetItemProp: Index=%d Result=Nil',[i]));
708     end;
709   end;
710 end;
711 
712 
713 { TValueListEditor }
714 
715 constructor TValueListEditor.Create(AOwner: TComponent);
716 begin
717   //need FStrings before inherited Create, because they are needed in overridden SelectEditor
718   FStrings := TValueListStrings.Create(Self);
719   FStrings.NameValueSeparator := '=';
720   FTitleCaptions := TStringList.Create;
721   inherited Create(AOwner);
722   FStrings.OnChange := @StringsChange;
723   FStrings.OnChanging := @StringsChanging;
724   TStringList(FTitleCaptions).OnChange := @TitlesChanged;
725 
726   //Don't use Columns.Add, it interferes with setting FixedCols := 1 (it will then insert an extra column)
727   {
728   with Columns.Add do
729     Title.Caption := 'Key';
730   with Columns.Add do begin
731     Title.Caption := 'Value';
732     DropDownRows := 8;
733   end;
734   }
735 
736   ColCount:=2;
737   {inherited} RowCount := 2;
738   FixedCols := 0;
739 //  DefaultColWidth := 150;
740 //  DefaultRowHeight := 18;
741 //  Width := 306;
742 //  Height := 300;
743   Options := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
744               goColSizing, goEditing, goAlwaysShowEditor, goThumbTracking];
745   FDisplayOptions := [doColumnTitles, doAutoColResize, doKeyColFixed];
746   Col := 1;
747   FLastEditedRow := -1;
748   FDropDownRows := 8;
749   ShowColumnTitles;
750   AutoFillColumns := true;
751 end;
752 
753 destructor TValueListEditor.Destroy;
754 begin
755   FTitleCaptions.Free;
756   FStrings.Free;
757   inherited Destroy;
758 end;
759 
760 procedure TValueListEditor.Clear;
761 begin
762   Strings.Clear;
763 end;
764 
765 procedure TValueListEditor.DeleteColRow(IsColumn: Boolean; index: Integer);
766 begin
767   if not IsColumn then
768     DeleteRow(Index)
769   else
770     DeleteCol(Index);
771 end;
772 
773 procedure TValueListEditor.DeleteRow(Index: Integer);
774 begin
775   //If we have only one row, it may be empty and we cannot remove
776   if not ((Index - FixedRows = 0) and (Strings.Count = 0)) then inherited DeleteRow(Index) ;
777 end;
778 
779 procedure TValueListEditor.DeleteCol(Index: Integer);
780 begin
781   Raise EGridException.CreateFmt(rsVLEInvalidRowColOperation,['DeleteCol','']);
782 end;
783 
FindRownull784 function TValueListEditor.FindRow(const KeyName: string; out aRow: Integer): Boolean;
785 var
786   Index: Integer;
787 begin
788   Index := Strings.IndexOfName(KeyName);
789   Result := (Index > -1);
790   if Result then aRow := Index + FixedRows;
791 end;
792 
793 procedure TValueListEditor.InsertColRow(IsColumn: boolean; index: integer);
794 begin
795   if not IsColumn then
796     Strings.InsertItem(Index - FixedRows,'')
797   else
798     Raise EGridException.CreateFmt(rsVLEInvalidRowColOperation,['InsertColRow',' on columns']);
799 end;
800 
InsertRownull801 function TValueListEditor.InsertRow(const KeyName, Value: string; Append: Boolean): Integer;
802 var
803   NewInd, NewRow: Integer;
804   Line: String;
805 begin
806   if not ((KeyName = '') and (Value = '')) then
807     Line := KeyName + Strings.NameValueSeparator + Value
808   else
809     Line := '';
810   if (Row > Strings.Count) or ((Row - FixedRows) >= Strings.Count)
811   or (Cells[0, Row] <> '') or (Cells[1, Row] <> '') then
812   begin                                    // Add a new Key=Value pair
813     Strings.BeginUpdate;
814     try
815       if Append then
816       begin
817         if (Strings.Count = 0) then   //empty grid
818           NewInd := 0
819         else
820           NewInd := Row - FixedRows + 1 //append after current row
821       end
822       else
823         NewInd := Row - FixedRows; //insert it at current row
824       Strings.InsertItem(NewInd, Line, Nil);
825     finally
826       Strings.EndUpdate;
827     end;
828   end
829   else begin   // Use an existing row, just update the Key and Value.
830     Cells[0, Row] := KeyName;
831     Cells[1, Row] := Value;
832     NewInd := Row - FixedRows;
833   end;
834   Result := NewInd;
835   NewRow := NewInd + FixedRows;
836   if (NewRow <> Row) then Row := NewRow;
837 end;
838 
839 procedure TValueListEditor.InsertRowWithValues(Index: Integer; Values: array of String);
840 var
841   AKey, AValue: String;
842 begin
843   AKey := '';
844   AValue := '';
845   if (Length(Values) > 1) then
846   begin
847     AKey := Values[0];
848     AValue := Values[1];
849   end
850   else if (Length(Values) = 1) then
851     AKey := Values[0];
852   Strings.InsertItem(Index, AKey + Strings.NameValueSeparator + AValue);
853 end;
854 
855 procedure TValueListEditor.ExchangeColRow(IsColumn: Boolean; index, WithIndex: Integer);
856 begin
857   if not IsColumn then
858     inherited ExchangeColRow(IsColumn, index, WithIndex)
859   else
860     Raise EGridException.CreateFmt(rsVLEInvalidRowColOperation,['ExchangeColRow',' on columns']);
861 end;
862 
IsEmptyRownull863 function TValueListEditor.IsEmptyRow: Boolean;
864 {As per help text on Embarcadero: the function does not have a parameter for row, so assume current one?}
865 begin
866   Result := IsEmptyRow(Row);
867 end;
868 
IsEmptyRownull869 function TValueListEditor.IsEmptyRow(aRow: Integer): Boolean;
870 begin
871   if (Strings.Count = 0) and (aRow - FixedRows = 0) then
872     //special case: we have just one row, and it is empty
873     Result := True
874   else if (aRow = 0) and (FixedRows = 0) then
875     Result := ((inherited GetCells(0,0)) = EmptyStr)  and ((inherited GetCells(1,0)) = EmptyStr)
876   else
877     Result := Strings.Strings[aRow - FixedRows] = EmptyStr;
878 end;
879 
880 procedure TValueListEditor.MoveColRow(IsColumn: Boolean; FromIndex,
881   ToIndex: Integer);
882 var
883   Line: String;
884 begin
885   if not IsColumn then
886   begin
887     try
888       Strings.BeginUpdate;
889       Line := Strings.Strings[FromIndex - FixedRows];
890       Strings.Delete(FromIndex - FixedRows);
891       Strings.InsertItem(ToIndex - FixedRows, Line);
892     finally
893       Strings.EndUpdate;
894     end;
895   end
896   else
897     Raise EGridException.CreateFmt(rsVLEInvalidRowColOperation,['MoveColRow',' on columns']);
898 end;
899 
RestoreCurrentRownull900 function TValueListEditor.RestoreCurrentRow: Boolean;
901 begin
902   //DbgOut('RestoreCurrentRow: Row=',DbgS(Row),' FLastEditedRow=',DbgS(FLastEditedRow),' SavedKey=',FRowTextOnEnter.Key,' SavedValue=',FRowTextOnEnter.Value);
903   Result := False;
904   if (Row = FLastEditedRow) and Assigned(Editor) and Editor.Focused then
905   begin
906     if (Cells[0,Row] <> FRowTextOnEnter.Key) or (Cells[1,Row] <> FRowTextOnEnter.Value) then
907     begin
908       try
909         EditorHide;
910         if (Cells[0,Row] <> FRowTextOnEnter.Key) then Cells[0,Row] := FRowTextOnEnter.Key;
911         if (Cells[1,Row] <> FRowTextOnEnter.Value) then Cells[1,Row] := FRowTextOnEnter.Value;
912       finally
913         EditorShow(True);
914       end;
915       Result := True;
916     end;
917   end;
918 end;
919 
920 procedure TValueListEditor.Sort(ACol: TVleSortCol = colKey);
921 begin
922   SortColRow(True, Ord(ACol));
923 end;
924 
925 procedure TValueListEditor.Sort(Index, IndxFrom, IndxTo: Integer);
926 begin
927   Sort(True, Index, IndxFrom, IndxTo);
928 end;
929 
930 procedure TValueListEditor.StringsChange(Sender: TObject);
931 begin
932   Modified := True;
933   AdjustRowCount;
934   Invalidate;
935   if Assigned(OnStringsChange) then
936     OnStringsChange(Self);
937 end;
938 
939 procedure TValueListEditor.StringsChanging(Sender: TObject);
940 begin
941   if Assigned(OnStringsChanging) then
942     OnStringsChanging(Self);
943 end;
944 
945 procedure TValueListEditor.SetFixedCols(const AValue: Integer);
946 begin
947   if (AValue in [0,1]) then
948     inherited SetFixedCols(AValue);
949 end;
950 
951 procedure TValueListEditor.SetFixedRows(const AValue: Integer);
952 begin
953   if AValue in [0,1] then begin  // No other values are allowed
954     if AValue = 0 then           // Typically DisplayOptions are changed directly
955       DisplayOptions := DisplayOptions - [doColumnTitles]
956     else
957       DisplayOptions := DisplayOptions + [doColumnTitles]
958   end;
959 end;
960 
GetItemPropnull961 function TValueListEditor.GetItemProp(const AKeyOrIndex: Variant): TItemProp;
962 begin
963   Result := FStrings.GetItemProp(AKeyOrIndex);
964 end;
965 
966 procedure TValueListEditor.SetItemProp(const AKeyOrIndex: Variant; AValue: TItemProp);
967 begin
968   FStrings.GetItemProp(AKeyOrIndex).Assign(AValue);
969 end;
970 
GetOptionsnull971 function TValueListEditor.GetOptions: TGridOptions;
972 begin
973   Result := inherited Options;
974 end;
975 
976 procedure TValueListEditor.SetDisplayOptions(const AValue: TDisplayOptions);
977 // Set number of fixed rows to 1 if titles are shown (based on DisplayOptions).
978 // Set the local options value, then Adjust Column Widths and Refresh the display.
979 begin
980   BeginUpdate;
981   if (doColumnTitles in DisplayOptions) <> (doColumnTitles in AValue) then
982     if doColumnTitles in AValue then begin
983       if RowCount < 2 then
984         {inherited} RowCount := 2;
985       inherited SetFixedRows(1);// don't do FixedRows := 1 here, it wil cause infinite recursion (Issue 0029993)
986     end else
987       inherited SetFixedRows(0);
988 
989   if (doAutoColResize in DisplayOptions) <> (doAutoColResize in AValue) then
990     AutoFillColumns := (doAutoColResize in AValue);
991 
992   FDisplayOptions := AValue;
993   ShowColumnTitles;
994   AdjustRowCount;
995   EndUpdate;
996 end;
997 
998 procedure TValueListEditor.SetDropDownRows(const AValue: Integer);
999 begin
1000   FDropDownRows := AValue;
1001   // ToDo: If edit list for inplace editing is implemented, set its handler, too.
1002 end;
1003 
1004 procedure TValueListEditor.SetKeyOptions(AValue: TKeyOptions);
1005 begin
1006   FUpdatingKeyOptions := True;
1007   // KeyAdd requires KeyEdit, KeyAdd oddly enough does not according to Delphi specs
1008   if KeyAdd in AValue then
1009     Include(AValue, keyEdit);
1010   FKeyOptions := AValue;
1011   if (KeyAdd in FKeyOptions) then
1012     Options := Options + [goAutoAddRows]
1013   else
1014     Options := Options - [goAutoAddRows];
1015   FUpdatingKeyOptions := False;
1016 end;
1017 
1018 procedure TValueListEditor.SetOptions(AValue: TGridOptions);
1019 begin
1020   //cannot allow goColMoving
1021   if goColMoving in AValue then
1022     Exclude(AValue, goColMoving);
1023   //temporarily disable this, it causes crashes
1024   if (goAutoAddRowsSkipContentCheck in AValue) then
1025     Exclude(AValue, goAutoAddRowsSkipContentCheck);
1026   inherited Options := AValue;
1027   // Enable also the required KeyOptions for goAutoAddRows
1028   if not FUpdatingKeyOptions and not (csLoading in ComponentState)
1029   and (goAutoAddRows in AValue) then
1030     KeyOptions := KeyOptions + [keyEdit, keyAdd];
1031 end;
1032 
1033 procedure TValueListEditor.SetStrings(const AValue: TValueListStrings);
1034 begin
1035   FStrings.Assign(AValue);
1036 end;
1037 
1038 procedure TValueListEditor.SetTitleCaptions(const AValue: TStrings);
1039 begin
1040   FTitleCaptions.Assign(AValue);
1041 end;
1042 
GetKeynull1043 function TValueListEditor.GetKey(Index: Integer): string;
1044 begin
1045   Result:=Cells[0,Index];
1046 end;
1047 
1048 procedure TValueListEditor.SetKey(Index: Integer; const Value: string);
1049 begin
1050   Cells[0,Index]:=Value;
1051 end;
1052 
TValueListEditor.GetValuenull1053 function TValueListEditor.GetValue(const Key: string): string;
1054 var
1055   I: Integer;
1056 begin
1057   Result := '';
1058   I := Strings.IndexOfName(Key);
1059   if I > -1 then begin
1060     Inc(I, FixedRows);
1061     Result:=Cells[1,I];
1062   end;
1063 end;
1064 
1065 procedure TValueListEditor.SetValue(const Key: string; AValue: string);
1066 var
1067   I: Integer;
1068 begin
1069   I := Strings.IndexOfName(Key);
1070   if I > -1 then begin
1071     Inc(I, FixedRows);
1072     Cells[1,I]:=AValue;
1073   end
1074   else begin
1075     Insert(Strings.NameValueSeparator, AValue, 1);
1076     Insert(Key, AValue, 1);
1077     Strings.Add(AValue);
1078   end;
1079 end;
1080 
1081 procedure TValueListEditor.ShowColumnTitles;
1082 var
1083   KeyCap, ValCap: String;
1084 begin
1085   if (doColumnTitles in DisplayOptions) then
1086   begin
1087     KeyCap := rsVLEKey;
1088     ValCap := rsVLEValue;
1089     if (TitleCaptions.Count > 0) then KeyCap := TitleCaptions[0];
1090     if (TitleCaptions.Count > 1) then ValCap := TitleCaptions[1];
1091     //Columns[0].Title.Caption := KeyCap;
1092     //Columns[1].Title.Caption := ValCap;
1093     //or:
1094     Cells[0,0] := KeyCap;
1095     Cells[1,0] := ValCap;
1096   end;
1097 end;
1098 
1099 procedure TValueListEditor.AdjustRowCount;
1100 // Change the number of rows based on the number of items in Strings collection.
1101 // Sets Row and RowCount of parent TCustomDrawGrid class.
1102 var
1103   NewC: Integer;
1104 begin
1105   NewC:=FixedRows+1;
1106   if Strings.Count>0 then
1107     NewC:=Strings.Count+FixedRows;
1108   if NewC<>RowCount then
1109   begin
1110     if NewC<Row then
1111       Row:=NewC-1;
1112     if Row = 0 then
1113       if doColumnTitles in DisplayOptions then
1114         Row:=1;
1115     inherited RowCount:=NewC;
1116   end;
1117 end;
1118 
1119 procedure TValueListEditor.ColRowExchanged(IsColumn: Boolean; index,
1120   WithIndex: Integer);
1121 begin
1122   Strings.Exchange(Index - FixedRows, WithIndex - FixedRows);
1123   inherited ColRowExchanged(IsColumn, index, WithIndex);
1124 end;
1125 
1126 procedure TValueListEditor.ColRowDeleted(IsColumn: Boolean; index: Integer);
1127 begin
1128   EditorMode := False;
1129   Strings.Delete(Index-FixedRows);
1130   inherited ColRowDeleted(IsColumn, index);
1131 end;
1132 
1133 procedure TValueListEditor.DefineCellsProperty(Filer: TFiler);
1134 begin
1135 end;
1136 
1137 procedure TValueListEditor.InvalidateCachedRow;
1138 begin
1139   if (Strings.Count = 0) then
1140   begin
1141     FLastEditedRow := FixedRows;
1142     FRowTextOnEnter.Key := '';
1143     FRowTextOnEnter.Value := '';
1144   end
1145   else
1146     FLastEditedRow := -1;
1147 end;
1148 
1149 procedure TValueListEditor.GetAutoFillColumnInfo(const Index: Integer;
1150   var aMin, aMax, aPriority: Integer);
1151 begin
1152   if Index=1 then
1153     aPriority := 1
1154   else
1155   begin
1156     if doKeyColFixed in FDisplayOptions then
1157       aPriority := 0
1158     else
1159       aPriority := 1;
1160   end;
1161 end;
1162 
GetCellsnull1163 function TValueListEditor.GetCells(ACol, ARow: Integer): string;
1164 var
1165   I: Integer;
1166 begin
1167   Result:='';
1168   if (ARow=0) and (doColumnTitles in DisplayOptions) then
1169   begin
1170     Result := Inherited GetCells(ACol, ARow);
1171   end
1172   else
1173   begin
1174     I:=ARow-FixedRows;
1175     if (I >= Strings.Count) then
1176       //Either empty grid, or a row has been added and Strings hasn't been update yet
1177       //the latter happens when rows are auto-added (issue #0025166)
1178       Exit;
1179     if ACol=0 then
1180       Result:=Strings.Names[I]
1181     else if ACol=1 then
1182       Result:=Strings.ValueFromIndex[I];
1183   end;
1184 end;
1185 
1186 procedure SetGridEditorReadOnly(Ed: TwinControl; RO: Boolean);
1187 begin
1188   //debugln('SetEditorReadOnly: Ed is ',DbgSName(Ed),' ReadOnly=',DbgS(RO));
1189   if (Ed is TCustomEdit) then
1190     TCustomEdit(Ed).ReadOnly := RO
1191   else if (Ed is TCustomComboBox) then
1192     if RO then
1193       TCustomComboBox(Ed).Style := csDropDownList
1194     else
1195       TCustomComboBox(Ed).Style := csDropDown;
1196 end;
1197 
GetDefaultEditornull1198 function TValueListEditor.GetDefaultEditor(Column: Integer): TWinControl;
1199 var
1200   ItemProp: TItemProp;
1201 begin
1202   if (Row <> FLastEditedRow) then
1203   //save current contents for RestoreCurrentRow
1204   begin
1205     FLastEditedRow := Row;
1206     FRowTextOnEnter.Key := Cells[0,Row];
1207     FRowTextOnEnter.Value := Cells[1,Row];
1208   end;
1209   Result:=inherited GetDefaultEditor(Column);
1210   //Need this to be able to intercept VK_Delete in the editor
1211   if (KeyDelete in KeyOptions) then
1212     EditorOptions := EditorOptions or EO_HOOKKEYDOWN
1213   else
1214     EditorOptions := EditorOptions and (not EO_HOOKKEYDOWN);
1215   if Column=1 then
1216   begin
1217     ItemProp := nil;
1218     //debugln('**** A Col=',dbgs(col),' Row=',dbgs(row),' (',dbgs(itemprop),')');
1219     ItemProp := Strings.GetItemProp(Row-FixedRows);
1220     if Assigned(ItemProp) then
1221     begin
1222       case ItemProp.EditStyle of
1223         esSimple: begin
1224           result := EditorByStyle(cbsAuto);
1225           SetGridEditorReadOnly(result, ItemProp.ReadOnly);
1226         end;
1227         esEllipsis: begin
1228           result := EditorByStyle(cbsEllipsis);
1229           SetGridEditorReadOnly(TCompositeCellEditorAccess(result).GetActiveControl, ItemProp.ReadOnly);
1230         end;
1231         esPickList: begin
1232           result := EditorByStyle(cbsPickList);
1233           (result as TCustomComboBox).Items.Assign(ItemProp.PickList);
1234           (result as TCustomComboBox).DropDownCount := DropDownRows;
1235           SetGridEditorReadOnly(result, ItemProp.ReadOnly);
1236           if Assigned(FOnGetPickList) then
1237             FOnGetPickList(Self, Strings.Names[Row - FixedRows], (result as TCustomComboBox).Items);
1238           //Style := csDropDown, default = csDropDownList;
1239         end;
1240       end; //case
1241     end
1242     else SetGridEditorReadOnly(result, False);
1243   end
1244   else
1245   begin
1246     //First column is only editable if KeyEdit is in KeyOptions
1247     if not (KeyEdit in KeyOptions) then
1248       Result := nil
1249     else
1250       SetGridEditorReadOnly(result, False);
1251   end;
1252 end;
1253 
GetRowCountnull1254 function TValueListEditor.GetRowCount: Integer;
1255 begin
1256   Result := inherited RowCount;
1257 end;
1258 
1259 procedure TValueListEditor.KeyDown(var Key: Word; Shift: TShiftState);
1260 begin
1261   inherited KeyDown(Key, Shift);
1262   if (KeyAdd in KeyOptions) then
1263   begin
1264     if (Key = VK_INSERT) and (Shift = []) then
1265     begin
1266       //Insert a row in the current position
1267       InsertRow('', '', False);
1268       Key := 0;
1269     end;
1270   end;
1271   if (KeyDelete in KeyOptions) then
1272   begin
1273     //Although Delphi help says this happens if user presses Delete, testers report it only happens with Ctrl+Delete
1274     if (Key = VK_DELETE) and (Shift = [ssModifier]) then
1275     begin
1276       DeleteRow(Row);
1277       Key := 0;
1278     end;
1279   end;
1280   if (Key = VK_ESCAPE) and (Shift = []) then
1281     if RestoreCurrentRow then Key := 0;
1282 end;
1283 
1284 procedure TValueListEditor.ResetDefaultColWidths;
1285 begin
1286   if not AutoFillColumns then
1287     inherited ResetDefaultColWidths
1288   else if doKeyColFixed in DisplayOptions then
1289   begin
1290     SetRawColWidths(0, -1);
1291     VisualChange;
1292   end;
1293 end;
1294 
1295 procedure TValueListEditor.SetCells(ACol, ARow: Integer; const AValue: string);
1296 var
1297   I: Integer;
1298   Key, KeyValue, Line: string;
1299 begin
1300   if (ARow = 0) and (doColumnTitles in DisplayOptions) then
1301   begin
1302     Inherited SetCells(ACol, ARow, AValue);
1303   end
1304   else
1305   begin
1306     I:=ARow-FixedRows;
1307     if ACol=0 then
1308     begin
1309       Key := AValue;
1310       KeyValue := Cells[1,ARow]
1311     end
1312     else
1313     begin
1314       KeyValue := AValue;
1315       Key := Cells[0,ARow];
1316     end;
1317     //If cells are empty don't store '=' in Strings
1318     if (Key = '') and (KeyValue = '') then
1319       Line := ''
1320     else begin
1321       Line := KeyValue;
1322       system.Insert(Strings.NameValueSeparator, Line, 1);
1323       system.Insert(Key, Line, 1);
1324     end;
1325     // Empty grid: don't add a the line '' to Strings!
1326     if (Strings.Count = 0) and (Line = '') then Exit;
1327     if I>=Strings.Count then
1328       Strings.Insert(I,Line)
1329     else
1330       if (Line <> Strings[I]) then Strings[I]:=Line;
1331   end;
1332 end;
1333 
GetEditTextnull1334 function TValueListEditor.GetEditText(ACol, ARow: Integer): string;
1335 begin
1336   Result:= Cells[ACol, ARow];
1337   if Assigned(OnGetEditText) then
1338     OnGetEditText(Self, ACol, ARow, Result);
1339 end;
1340 
1341 procedure TValueListEditor.SetEditText(ACol, ARow: Longint; const Value: string);
1342 begin
1343   inherited SetEditText(ACol, ARow, Value);
1344   Cells[ACol, ARow] := Value;
1345 end;
1346 
1347 procedure TValueListEditor.SetRowCount(AValue: Integer);
1348 var
1349   OldValue, NewCount: Integer;
1350 begin
1351   //debugln('TValueListEditor.SetRowCount: AValue=',DbgS(AValue));
1352   OldValue := inherited RowCount;
1353   if OldValue = AValue then Exit;
1354   if FixedRows > AValue then
1355     Raise EGridException.Create(rsFixedRowsTooBig);
1356   NewCount := AValue - FixedRows;
1357   if (NewCount > Strings.Count) then
1358   begin
1359     Strings.BeginUpdate;
1360     while (Strings.Count < NewCount) do Strings.Add('');
1361     Strings.EndUpdate;
1362   end
1363   else if (NewCount < Strings.Count) then
1364   begin
1365     Strings.BeginUpdate;
1366     while (NewCount < Strings.Count) do Strings.Delete(Strings.Count - 1);
1367     Strings.EndUpdate;
1368   end;
1369 end;
1370 
1371 procedure TValueListEditor.Sort(ColSorting: Boolean; index, IndxFrom,
1372   IndxTo: Integer);
1373 var
1374   HideEditor: Boolean;
1375 begin
1376   HideEditor := goAlwaysShowEditor in Options;
1377   if HideEditor then Options := Options - [goAlwaysShowEditor];
1378   Strings.BeginUpdate;
1379   try
1380     inherited Sort(True, index, IndxFrom, IndxTo);
1381   finally
1382     Strings.EndUpdate;
1383   end;
1384   if HideEditor then Options := Options + [goAlwaysShowEditor];
1385 end;
1386 
1387 procedure TValueListEditor.TitlesChanged(Sender: TObject);
1388 begin
1389   // Refresh the display.
1390   ShowColumnTitles;
1391   AdjustRowCount;
1392   Invalidate;
1393 end;
1394 
ValidateEntrynull1395 function TValueListEditor.ValidateEntry(const ACol, ARow: Integer;
1396   const OldValue: string; var NewValue: string): boolean;
1397 var
1398   Index, i: Integer;
1399 begin
1400   Result := inherited ValidateEntry(ACol, ARow, OldValue, NewValue);
1401   //Check for duplicate key names (only in "Key" column), if KeyUnique is set
1402   if ((ACol - FixedCols) = 0) and (KeyUnique in KeyOptions) then
1403   begin
1404     Index := ARow - FixedRows;
1405     for i := 0 to FStrings.Count - 1 do
1406     begin
1407       if (Index <> i) and (FStrings.Names[i] <> '') then
1408       begin
1409         if (Utf8CompareText(FStrings.Names[i], NewValue) = 0) then
1410         begin
1411           Result := False;
1412           ShowMessage(Format(rsVLEDuplicateKey,[NewValue, i + FixedRows]));
1413           if Editor is TStringCellEditor then TStringCelleditor(Editor).SelectAll;
1414           Break;
1415         end;
1416       end;
1417     end;
1418   end;
1419 end;
1420 
1421 class procedure TValueListEditor.WSRegisterClass;
1422 begin
1423 //  RegisterPropertyToSkip(Self, 'SomeProperty', 'VCL compatibility property', '');
1424   inherited WSRegisterClass;
1425 end;
1426 
1427 procedure Register;
1428 begin
1429   RegisterComponents('Additional',[TValueListEditor]);
1430 end;
1431 
1432 
1433 end.
1434 
1435