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