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