/lcl/valedit.pas

https://github.com/maillen/lazarus · Pascal · 883 lines · 730 code · 93 blank · 60 comment · 60 complexity · e30078b4ac61ef7361482959bbcebeb6 MD5 · raw file

  1. unit ValEdit;
  2. {$mode objfpc}{$H+}
  3. interface
  4. uses
  5. Classes, Controls, StdCtrls, SysUtils, Grids, LResources, Dialogs, LazUtf8, variants;
  6. type
  7. TValueListEditor = class; // Forward declaration
  8. TEditStyle = (esSimple, esEllipsis, esPickList);
  9. { TItemProp }
  10. TItemProp = class(TPersistent)
  11. private
  12. FOwner: TValueListEditor;
  13. FEditMask: string;
  14. FEditStyle: TEditStyle;
  15. FPickList: TStrings;
  16. FMaxLength: Integer;
  17. FReadOnly: Boolean;
  18. FKeyDesc: string;
  19. function GetPickList: TStrings;
  20. procedure PickListChange(Sender: TObject);
  21. procedure SetEditMask(const AValue: string);
  22. procedure SetMaxLength(const AValue: Integer);
  23. procedure SetReadOnly(const AValue: Boolean);
  24. procedure SetEditStyle(const AValue: TEditStyle);
  25. procedure SetPickList(const AValue: TStrings);
  26. procedure SetKeyDesc(const AValue: string);
  27. protected
  28. // procedure AssignTo(Dest: TPersistent); override;
  29. public
  30. constructor Create(AOwner: TValueListEditor);
  31. destructor Destroy; override;
  32. // function HasPickList: Boolean;
  33. published
  34. property EditMask: string read FEditMask write SetEditMask;
  35. property EditStyle: TEditStyle read FEditStyle write SetEditStyle;
  36. property KeyDesc: string read FKeyDesc write SetKeyDesc;
  37. property PickList: TStrings read GetPickList write SetPickList;
  38. property MaxLength: Integer read FMaxLength write SetMaxLength;
  39. property ReadOnly: Boolean read FReadOnly write SetReadOnly;
  40. end;
  41. TItemProps = array of TItemProp;
  42. { TValueListStrings }
  43. TValueListStrings = class(TStringList)
  44. private
  45. FOwner: TValueListEditor;
  46. FItemProps: TItemProps;
  47. function GetItemProp(const AKeyOrIndex: Variant): TItemProp;
  48. protected
  49. procedure SetTextStr(const Value: string); override;
  50. procedure InsertItem(Index: Integer; const S: string; AObject: TObject); override;
  51. procedure Put(Index: Integer; const S: String); override;
  52. public
  53. constructor Create(AOwner: TValueListEditor);
  54. destructor Destroy; override;
  55. procedure Assign(Source: TPersistent); override;
  56. procedure Clear; override;
  57. procedure CustomSort(Compare: TStringListSortCompare); override;
  58. procedure Delete(Index: Integer); override;
  59. procedure Exchange(Index1, Index2: Integer); override;
  60. end;
  61. TDisplayOption = (doColumnTitles, doAutoColResize, doKeyColFixed);
  62. TDisplayOptions = set of TDisplayOption;
  63. TKeyOption = (keyEdit, keyAdd, keyDelete, keyUnique);
  64. TKeyOptions = set of TKeyOption;
  65. TGetPickListEvent = procedure(Sender: TObject; const KeyName: string;
  66. Values: TStrings) of object;
  67. TOnValidateEvent = procedure(Sender: TObject; ACol, ARow: Longint;
  68. const KeyName, KeyValue: string) of object;
  69. { TValueListEditor }
  70. TValueListEditor = class(TCustomStringGrid)
  71. private
  72. FTitleCaptions: TStrings;
  73. FStrings: TValueListStrings;
  74. FKeyOptions: TKeyOptions;
  75. FDisplayOptions: TDisplayOptions;
  76. FDropDownRows: Integer;
  77. FOnGetPickList: TGetPickListEvent;
  78. FOnEditButtonClick: TNotifyEvent;
  79. FOnStringsChange: TNotifyEvent;
  80. FOnStringsChanging: TNotifyEvent;
  81. FOnValidate: TOnValidateEvent;
  82. function GetFixedRows: Integer;
  83. function GetItemProp(const AKeyOrIndex: Variant): TItemProp;
  84. procedure SetFixedRows(AValue: Integer);
  85. procedure SetItemProp(const AKeyOrIndex: Variant; AValue: TItemProp);
  86. procedure StringsChange(Sender: TObject);
  87. procedure StringsChanging(Sender: TObject);
  88. procedure SelectValueEditor(Sender: TObject; aCol, aRow: Integer; var aEditor: TWinControl);
  89. // procedure EditButtonClick(Sender: TObject);
  90. function GetOptions: TGridOptions;
  91. function GetKey(Index: Integer): string;
  92. function GetValue(const Key: string): string;
  93. procedure SetDisplayOptions(const AValue: TDisplayOptions);
  94. procedure SetDropDownRows(const AValue: Integer);
  95. procedure SetKeyOptions({const} AValue: TKeyOptions);
  96. procedure SetKey(Index: Integer; const Value: string);
  97. procedure SetValue(const Key: string; AValue: string);
  98. procedure SetOnEditButtonClick(const AValue: TNotifyEvent);
  99. procedure SetOptions(const AValue: TGridOptions);
  100. procedure SetStrings(const AValue: TValueListStrings);
  101. procedure SetTitleCaptions(const AValue: TStrings);
  102. protected
  103. class procedure WSRegisterClass; override;
  104. procedure DoOnResize; override;
  105. procedure SetFixedCols(const AValue: Integer); override;
  106. procedure ShowColumnTitles;
  107. procedure AdjustColumnWidths; virtual;
  108. procedure AdjustRowCount; virtual;
  109. procedure ColWidthsChanged; override;
  110. procedure DefineCellsProperty(Filer: TFiler); override;
  111. function GetEditText(ACol, ARow: Integer): string; override;
  112. function GetCells(ACol, ARow: Integer): string; override;
  113. procedure SetCells(ACol, ARow: Integer; const AValue: string); override;
  114. procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
  115. procedure TitlesChanged(Sender: TObject);
  116. function ValidateEntry(const ACol,ARow:Integer; const OldValue:string; var NewValue:string): boolean; override;
  117. public
  118. constructor Create(AOwner: TComponent); override;
  119. destructor Destroy; override;
  120. function InsertRow(const KeyName, Value: string; Append: Boolean): Integer;
  121. property FixedRows: Integer read GetFixedRows write SetFixedRows default 1;
  122. property Modified;
  123. property Keys[Index: Integer]: string read GetKey write SetKey;
  124. property Values[const Key: string]: string read GetValue write SetValue;
  125. property ItemProps[const AKeyOrIndex: Variant]: TItemProp read GetItemProp write SetItemProp;
  126. published
  127. // Same as in TStringGrid
  128. property Align;
  129. property AlternateColor;
  130. property Anchors;
  131. property AutoAdvance;
  132. property AutoEdit;
  133. property AutoFillColumns;
  134. property BiDiMode;
  135. property BorderSpacing;
  136. property BorderStyle;
  137. property Color;
  138. property Constraints;
  139. property DefaultColWidth;
  140. property DefaultDrawing;
  141. property DefaultRowHeight;
  142. property DragCursor;
  143. property DragKind;
  144. property DragMode;
  145. property Enabled;
  146. property ExtendedSelect;
  147. property FixedColor;
  148. property FixedCols;
  149. property Flat;
  150. property Font;
  151. property GridLineWidth;
  152. property HeaderHotZones;
  153. property HeaderPushZones;
  154. property MouseWheelOption;
  155. property ParentBiDiMode;
  156. property ParentColor default false;
  157. property ParentFont;
  158. property ParentShowHint;
  159. property PopupMenu;
  160. property RowCount;
  161. property ScrollBars;
  162. property ShowHint;
  163. property TabOrder;
  164. property TabStop;
  165. property TitleFont;
  166. property TitleImageList;
  167. property TitleStyle;
  168. property UseXORFeatures;
  169. property Visible;
  170. property VisibleColCount;
  171. property VisibleRowCount;
  172. property OnBeforeSelection;
  173. property OnChangeBounds;
  174. property OnCheckboxToggled;
  175. property OnClick;
  176. property OnColRowDeleted;
  177. property OnColRowExchanged;
  178. property OnColRowInserted;
  179. property OnColRowMoved;
  180. property OnCompareCells;
  181. property OnContextPopup;
  182. property OnDragDrop;
  183. property OnDragOver;
  184. property OnDblClick;
  185. property OnDrawCell;
  186. property OnEditingDone;
  187. property OnEndDock;
  188. property OnEndDrag;
  189. property OnEnter;
  190. property OnExit;
  191. property OnGetEditMask;
  192. property OnGetEditText;
  193. property OnHeaderClick;
  194. property OnHeaderSized;
  195. property OnHeaderSizing;
  196. property OnKeyDown;
  197. property OnKeyPress;
  198. property OnKeyUp;
  199. property OnMouseDown;
  200. property OnMouseMove;
  201. property OnMouseUp;
  202. property OnMouseWheel;
  203. property OnMouseWheelDown;
  204. property OnMouseWheelUp;
  205. property OnPickListSelect;
  206. property OnPrepareCanvas;
  207. property OnResize;
  208. property OnSelectEditor;
  209. property OnSelection;
  210. property OnSelectCell;
  211. property OnSetEditText;
  212. property OnShowHint;
  213. property OnStartDock;
  214. property OnStartDrag;
  215. property OnTopLeftChanged;
  216. property OnUserCheckboxBitmap;
  217. property OnUTF8KeyPress;
  218. property OnValidateEntry;
  219. // Compatible with Delphi TValueListEditor:
  220. property DisplayOptions: TDisplayOptions read FDisplayOptions
  221. write SetDisplayOptions default [doColumnTitles, doAutoColResize, doKeyColFixed];
  222. property DoubleBuffered;
  223. property DropDownRows: Integer read FDropDownRows write SetDropDownRows default 8;
  224. property KeyOptions: TKeyOptions read FKeyOptions write SetKeyOptions default [];
  225. property Options: TGridOptions read GetOptions write SetOptions default
  226. [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goColSizing,
  227. goEditing, goAlwaysShowEditor, goThumbTracking];
  228. property Strings: TValueListStrings read FStrings write SetStrings;
  229. property TitleCaptions: TStrings read FTitleCaptions write SetTitleCaptions;
  230. property OnEditButtonClick: TNotifyEvent read FOnEditButtonClick write SetOnEditButtonClick;
  231. property OnGetPickList: TGetPickListEvent read FOnGetPickList write FOnGetPickList;
  232. property OnMouseEnter;
  233. property OnMouseLeave;
  234. property OnStringsChange: TNotifyEvent read FOnStringsChange write FOnStringsChange;
  235. property OnStringsChanging: TNotifyEvent read FOnStringsChanging write FOnStringsChanging;
  236. property OnValidate: TOnValidateEvent read FOnValidate write FOnValidate;
  237. end;
  238. const
  239. //ToDo: Make this a resourcestring in lclstrconsts unit, once we are satisfied with the implementation of validating
  240. rsVLEDuplicateKey = 'Duplicate Key:'+LineEnding+'A key with name "%s" already exists at column %d';
  241. //ToDo: Make this a resourcestring in lclstrconsts unit, once we are satisfied with ShowColumnTitles
  242. rsVLEKey = 'Key';
  243. rsVLEName = 'Name';
  244. procedure Register;
  245. implementation
  246. { TItemProp }
  247. constructor TItemProp.Create(AOwner: TValueListEditor);
  248. begin
  249. inherited Create;
  250. FOwner := AOwner;
  251. end;
  252. destructor TItemProp.Destroy;
  253. begin
  254. FPickList.Free;
  255. inherited Destroy;
  256. end;
  257. function TItemProp.GetPickList: TStrings;
  258. begin
  259. if FPickList = Nil then
  260. begin
  261. FPickList := TStringList.Create;
  262. TStringList(FPickList).OnChange := @PickListChange;
  263. end;
  264. Result := FPickList;
  265. end;
  266. procedure TItemProp.PickListChange(Sender: TObject);
  267. begin
  268. if PickList.Count > 0 then begin
  269. if EditStyle = esSimple then
  270. EditStyle := esPickList;
  271. end
  272. else begin
  273. if EditStyle = esPickList then
  274. EditStyle := esSimple;
  275. end;
  276. end;
  277. procedure TItemProp.SetEditMask(const AValue: string);
  278. begin
  279. FEditMask := AValue;
  280. with FOwner do
  281. if EditorMode and (FStrings.UpdateCount = 0) then
  282. InvalidateCell(Col, Row);
  283. end;
  284. procedure TItemProp.SetMaxLength(const AValue: Integer);
  285. begin
  286. FMaxLength := AValue;
  287. with FOwner do
  288. if EditorMode and (FStrings.UpdateCount = 0) then
  289. InvalidateCell(Col, Row);
  290. end;
  291. procedure TItemProp.SetReadOnly(const AValue: Boolean);
  292. begin
  293. FReadOnly := AValue;
  294. with FOwner do
  295. if EditorMode and (FStrings.UpdateCount = 0) then
  296. InvalidateCell(Col, Row);
  297. end;
  298. procedure TItemProp.SetEditStyle(const AValue: TEditStyle);
  299. begin
  300. FEditStyle := AValue;
  301. with FOwner do
  302. if EditorMode and (FStrings.UpdateCount = 0) then
  303. InvalidateCell(Col, Row);
  304. end;
  305. procedure TItemProp.SetPickList(const AValue: TStrings);
  306. begin
  307. GetPickList.Assign(AValue);
  308. with FOwner do
  309. if EditorMode and (FStrings.UpdateCount = 0) then
  310. InvalidateCell(Col, Row);
  311. end;
  312. procedure TItemProp.SetKeyDesc(const AValue: string);
  313. begin
  314. FKeyDesc := AValue;
  315. end;
  316. { TValueListStrings }
  317. procedure TValueListStrings.SetTextStr(const Value: string);
  318. var
  319. IsShowingEditor: Boolean;
  320. begin
  321. with FOwner do begin
  322. // Don't show editor while changing values. Edited cell would not be changed.
  323. IsShowingEditor := goAlwaysShowEditor in Options;
  324. Options := Options - [goAlwaysShowEditor];
  325. inherited SetTextStr(Value);
  326. if IsShowingEditor then
  327. Options := Options + [goAlwaysShowEditor];
  328. end;
  329. end;
  330. procedure TValueListStrings.InsertItem(Index: Integer; const S: string; AObject: TObject);
  331. var
  332. i: Integer;
  333. begin
  334. // ToDo: Check validity of key
  335. Changing;
  336. inherited InsertItem(Index, S, AObject);
  337. SetLength(FItemProps, Count);
  338. for i := Count-2 downto Index do
  339. FItemProps[i+1] := FItemProps[i];
  340. FItemProps[Index] := nil;
  341. Changed;
  342. end;
  343. procedure TValueListStrings.Put(Index: Integer; const S: String);
  344. begin
  345. // ToDo: Check validity of key
  346. inherited Put(Index, S);
  347. end;
  348. constructor TValueListStrings.Create(AOwner: TValueListEditor);
  349. begin
  350. inherited Create;
  351. FOwner := AOwner;
  352. end;
  353. destructor TValueListStrings.Destroy;
  354. begin
  355. inherited Destroy;
  356. end;
  357. procedure TValueListStrings.Assign(Source: TPersistent);
  358. var
  359. IsShowingEditor: Boolean;
  360. begin
  361. with FOwner do begin
  362. // Don't show editor while changing values. Edited cell would not be changed.
  363. IsShowingEditor := goAlwaysShowEditor in Options;
  364. Options := Options - [goAlwaysShowEditor];
  365. // ToDo: Assign also ItemProps if Source is TValueListStrings
  366. inherited Assign(Source);
  367. if IsShowingEditor then
  368. Options := Options + [goAlwaysShowEditor];
  369. end;
  370. end;
  371. procedure TValueListStrings.Clear;
  372. var
  373. i: Integer;
  374. begin
  375. inherited Clear;
  376. for i := 0 to Length(FItemProps)-1 do
  377. FItemProps[i].Free;
  378. SetLength(FItemProps, 0);
  379. end;
  380. procedure TValueListStrings.CustomSort(Compare: TStringListSortCompare);
  381. begin
  382. inherited CustomSort(Compare);
  383. // ToDo: Sort also ItemProps using a copy of the orignal order
  384. end;
  385. procedure TValueListStrings.Delete(Index: Integer);
  386. begin
  387. Changing;
  388. inherited Delete(Index);
  389. // ToDo: Delete also ItemProps
  390. Changed;
  391. end;
  392. procedure TValueListStrings.Exchange(Index1, Index2: Integer);
  393. begin
  394. Changing;
  395. inherited Exchange(Index1, Index2);
  396. // ToDo: Exchange also ItemProps
  397. Changed;
  398. end;
  399. function TValueListStrings.GetItemProp(const AKeyOrIndex: Variant): TItemProp;
  400. var
  401. i: Integer;
  402. s: string;
  403. begin
  404. Result := Nil;
  405. if Count > 0 then
  406. begin
  407. if VarIsOrdinal(AKeyOrIndex) then
  408. i := AKeyOrIndex
  409. else begin
  410. s := AKeyOrIndex;
  411. i := IndexOfName(s);
  412. if i = -1 then
  413. raise Exception.Create('TValueListStrings.GetItemProp: Key not found: '+s);
  414. end;
  415. if i >= Length(FItemProps) then
  416. SetLength(FItemProps, i+1);
  417. Result := FItemProps[i];
  418. if not Assigned(Result) then begin
  419. Result := TItemProp.Create(FOwner);
  420. FItemProps[i] := Result;
  421. end;
  422. end;
  423. end;
  424. { TValueListEditor }
  425. constructor TValueListEditor.Create(AOwner: TComponent);
  426. begin
  427. inherited Create(AOwner);
  428. FStrings := TValueListStrings.Create(Self);
  429. FStrings.OnChange := @StringsChange;
  430. FStrings.OnChanging := @StringsChanging;
  431. FTitleCaptions := TStringList.Create;
  432. TStringList(FTitleCaptions).OnChange := @TitlesChanged;
  433. OnSelectEditor := @SelectValueEditor;
  434. // OnEditButtonClick := @EditButtonClick;
  435. //Don't use Columns.Add, it interferes with setting FixedCols := 1 (it will then insert an extra column)
  436. {
  437. with Columns.Add do
  438. Title.Caption := 'Key';
  439. with Columns.Add do begin
  440. Title.Caption := 'Value';
  441. DropDownRows := 8;
  442. end;
  443. }
  444. ColCount:=2;
  445. inherited RowCount := 2;
  446. FixedCols := 0;
  447. // DefaultColWidth := 150;
  448. // DefaultRowHeight := 18;
  449. // Width := 306;
  450. // Height := 300;
  451. Options := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
  452. goColSizing, goEditing, goAlwaysShowEditor, goThumbTracking];
  453. FDisplayOptions := [doColumnTitles, doAutoColResize, doKeyColFixed];
  454. Col := 1;
  455. FDropDownRows := 8;
  456. ShowColumnTitles;
  457. end;
  458. destructor TValueListEditor.Destroy;
  459. begin
  460. FTitleCaptions.Free;
  461. FStrings.Free;
  462. inherited Destroy;
  463. end;
  464. function TValueListEditor.InsertRow(const KeyName, Value: string; Append: Boolean): Integer;
  465. var
  466. NewInd: Integer;
  467. begin
  468. Result := Row;
  469. if (Row > Strings.Count) or ((Row - FixedRows) >= Strings.Count)
  470. or (Cells[0, Row] <> '') or (Cells[1, Row] <> '') then
  471. begin // Add a new Key=Value pair
  472. Strings.BeginUpdate;
  473. try
  474. if Append then
  475. NewInd := Strings.Count
  476. else
  477. NewInd := Result - FixedRows;
  478. Strings.InsertItem(NewInd, KeyName+'='+Value, Nil);
  479. finally
  480. Strings.EndUpdate;
  481. end;
  482. end
  483. else begin // Use an existing row, just update the Key and Value.
  484. Cells[0, Result] := KeyName;
  485. Cells[1, Result] := Value;
  486. end;
  487. end;
  488. procedure TValueListEditor.StringsChange(Sender: TObject);
  489. begin
  490. AdjustRowCount;
  491. Invalidate;
  492. if Assigned(OnStringsChange) then
  493. OnStringsChange(Self);
  494. end;
  495. procedure TValueListEditor.StringsChanging(Sender: TObject);
  496. begin
  497. if Assigned(OnStringsChanging) then
  498. OnStringsChanging(Self);
  499. end;
  500. procedure TValueListEditor.SelectValueEditor(Sender: TObject; aCol, aRow: Integer;
  501. var aEditor: TWinControl);
  502. // Choose the cell editor based on ItemProp.EditStyle
  503. var
  504. ItemProp: TItemProp;
  505. begin
  506. if aCol <> 1 then Exit; // Only for the Value column
  507. ItemProp := Strings.GetItemProp(aRow-FixedRows);
  508. if Assigned(ItemProp) then
  509. case ItemProp.EditStyle of
  510. esSimple: aEditor := EditorByStyle(cbsAuto);
  511. esEllipsis: aEditor := EditorByStyle(cbsEllipsis);
  512. esPickList: begin
  513. aEditor := EditorByStyle(cbsPickList);
  514. (aEditor as TCustomComboBox).Items.Assign(ItemProp.PickList);
  515. //Style := csDropDown, default = csDropDownList;
  516. end;
  517. end;
  518. end;
  519. // Triggering Action ...
  520. //procedure TValueListEditor.EditButtonClick(Sender: TObject);
  521. //begin
  522. // ToDo: support button clicks
  523. //end;
  524. function TValueListEditor.GetFixedRows: Integer;
  525. begin
  526. Result := inherited FixedRows;
  527. end;
  528. procedure TValueListEditor.SetFixedCols(const AValue: Integer);
  529. begin
  530. if (AValue in [0,1]) then
  531. inherited SetFixedCols(AValue);
  532. end;
  533. procedure TValueListEditor.SetFixedRows(AValue: Integer);
  534. begin
  535. if AValue in [0,1] then begin // No other values are allowed
  536. if AValue = 0 then // Typically DisplayOptions are changed directly
  537. DisplayOptions := DisplayOptions - [doColumnTitles]
  538. else
  539. DisplayOptions := DisplayOptions + [doColumnTitles]
  540. end;
  541. end;
  542. function TValueListEditor.GetItemProp(const AKeyOrIndex: Variant): TItemProp;
  543. begin
  544. Result := FStrings.GetItemProp(AKeyOrIndex);
  545. end;
  546. procedure TValueListEditor.SetItemProp(const AKeyOrIndex: Variant; AValue: TItemProp);
  547. begin
  548. FStrings.GetItemProp(AKeyOrIndex).Assign(AValue);
  549. end;
  550. function TValueListEditor.GetOptions: TGridOptions;
  551. begin
  552. Result := inherited Options;
  553. end;
  554. procedure TValueListEditor.SetDisplayOptions(const AValue: TDisplayOptions);
  555. // Set number of fixed rows to 1 if titles are shown (based on DisplayOptions).
  556. // Set the local options value, then Adjust Column Widths and Refresh the display.
  557. begin
  558. if (doColumnTitles in DisplayOptions) <> (doColumnTitles in AValue) then
  559. if doColumnTitles in AValue then begin
  560. if RowCount < 2 then
  561. inherited RowCount := 2;
  562. inherited FixedRows := 1;
  563. end else
  564. inherited FixedRows := 0;
  565. FDisplayOptions := AValue;
  566. ShowColumnTitles;
  567. AdjustColumnWidths;
  568. AdjustRowCount;
  569. Invalidate;
  570. end;
  571. procedure TValueListEditor.SetDropDownRows(const AValue: Integer);
  572. begin
  573. FDropDownRows := AValue;
  574. // ToDo: If edit list for inplace editing is implemented, set its handler, too.
  575. end;
  576. procedure TValueListEditor.SetKeyOptions({const} AValue: TKeyOptions);
  577. begin
  578. // ToDo: Disable Add or enable Edit based on current value.
  579. // Enable Edit when Adding, disable Add when Editing.
  580. // Change Col if needed when editing keys is disabled.
  581. FKeyOptions := AValue;
  582. end;
  583. procedure TValueListEditor.SetOnEditButtonClick(const AValue: TNotifyEvent);
  584. begin
  585. FOnEditButtonClick := AValue;
  586. // If edit list for inplace editing is implemented, set its handler, too.
  587. end;
  588. procedure TValueListEditor.SetOptions(const AValue: TGridOptions);
  589. begin
  590. if not (goColMoving in Options) then
  591. inherited Options := AValue;
  592. end;
  593. procedure TValueListEditor.SetStrings(const AValue: TValueListStrings);
  594. begin
  595. FStrings.Assign(AValue);
  596. end;
  597. procedure TValueListEditor.SetTitleCaptions(const AValue: TStrings);
  598. begin
  599. FTitleCaptions.Assign(AValue);
  600. end;
  601. function TValueListEditor.GetKey(Index: Integer): string;
  602. begin
  603. Result:=Cells[0,Index];
  604. end;
  605. procedure TValueListEditor.SetKey(Index: Integer; const Value: string);
  606. begin
  607. Cells[0,Index]:=Value;
  608. end;
  609. function TValueListEditor.GetValue(const Key: string): string;
  610. var
  611. I: Integer;
  612. begin
  613. Result := '';
  614. I := Strings.IndexOfName(Key);
  615. if Row > -1 then begin
  616. Inc(I, FixedRows);
  617. Result:=Cells[1,I];
  618. end;
  619. end;
  620. procedure TValueListEditor.SetValue(const Key: string; AValue: string);
  621. var
  622. I: Integer;
  623. begin
  624. I := Strings.IndexOfName(Key);
  625. if Row > -1 then begin
  626. Inc(I, FixedRows);
  627. Cells[1,I]:=AValue;
  628. end
  629. else
  630. Strings.Add(Key+'='+AValue);
  631. end;
  632. procedure TValueListEditor.ShowColumnTitles;
  633. var
  634. KeyCap, ValCap: String;
  635. begin
  636. if (doColumnTitles in DisplayOptions) then
  637. begin
  638. KeyCap := rsVLEKey;
  639. ValCap := rsVLEName;
  640. if (TitleCaptions.Count > 0) then KeyCap := TitleCaptions[0];
  641. if (TitleCaptions.Count > 1) then ValCap := TitleCaptions[1];
  642. //Columns[0].Title.Caption := KeyCap;
  643. //Columns[1].Title.Caption := ValCap;
  644. //or:
  645. Cells[0,0] := KeyCap;
  646. Cells[1,0] := ValCap;
  647. end;
  648. end;
  649. procedure TValueListEditor.AdjustColumnWidths;
  650. // If key column is fixed in width then adjust only the second column,
  651. // otherwise adjust both columns propertionally.
  652. var
  653. CW: Integer;
  654. begin
  655. CW := ClientWidth;
  656. if (doKeyColFixed in DisplayOptions) then
  657. begin
  658. //AutoSizeColumn(0);
  659. ColWidths[1] := CW - ColWidths[0];
  660. end
  661. else
  662. begin
  663. ColWidths[0] := CW div 2;
  664. ColWidths[1] := CW div 2;
  665. end;
  666. end;
  667. procedure TValueListEditor.AdjustRowCount;
  668. // Change the number of rows based on the number of items in Strings collection.
  669. // Sets Row and RowCount of parent TCustomDrawGrid class.
  670. var
  671. NewC: Integer;
  672. begin
  673. NewC:=FixedRows+1;
  674. if Strings.Count>0 then
  675. NewC:=Strings.Count+FixedRows;
  676. if NewC<>RowCount then
  677. begin
  678. if NewC<Row then
  679. Row:=NewC-1;
  680. if Row = 0 then
  681. if doColumnTitles in DisplayOptions then
  682. Row:=1;
  683. inherited RowCount:=NewC;
  684. end;
  685. end;
  686. procedure TValueListEditor.ColWidthsChanged;
  687. begin
  688. AdjustColumnWidths;
  689. inherited;
  690. end;
  691. procedure TValueListEditor.DefineCellsProperty(Filer: TFiler);
  692. begin
  693. end;
  694. function TValueListEditor.GetCells(ACol, ARow: Integer): string;
  695. var
  696. I: Integer;
  697. begin
  698. Result:='';
  699. if (ARow=0) and (doColumnTitles in DisplayOptions) then
  700. begin
  701. Result := Inherited GetCells(ACol, ARow);
  702. end
  703. else
  704. begin
  705. I:=ARow-FixedRows;
  706. if Strings.Count<=I then exit;
  707. if ACol=0 then
  708. Result:=Strings.Names[I]
  709. else if ACol=1 then
  710. Result:=Strings.ValueFromIndex[I];
  711. end;
  712. end;
  713. procedure TValueListEditor.SetCells(ACol, ARow: Integer; const AValue: string);
  714. var
  715. I: Integer;
  716. Line: string;
  717. begin
  718. if (ARow = 0) and (doColumnTitles in DisplayOptions) then
  719. begin
  720. Inherited SetCells(ACol, ARow, AValue);
  721. end
  722. else
  723. begin
  724. I:=ARow-FixedRows;
  725. if ACol=0 then
  726. Line:=AValue+'='+Cells[1,ARow]
  727. else
  728. Line:=Cells[0,ARow]+'='+AValue;
  729. if I>=Strings.Count then
  730. Strings.Insert(I,Line)
  731. else
  732. Strings[I]:=Line;
  733. end;
  734. end;
  735. function TValueListEditor.GetEditText(ACol, ARow: Integer): string;
  736. begin
  737. Result:= Cells[ACol, ARow];
  738. if Assigned(OnGetEditText) then
  739. OnGetEditText(Self, ACol, ARow, Result);
  740. end;
  741. procedure TValueListEditor.SetEditText(ACol, ARow: Longint; const Value: string);
  742. begin
  743. inherited SetEditText(ACol, ARow, Value);
  744. Cells[ACol, ARow] := Value;
  745. end;
  746. procedure TValueListEditor.TitlesChanged(Sender: TObject);
  747. begin
  748. // Refresh the display.
  749. ShowColumnTitles;
  750. AdjustRowCount;
  751. Invalidate;
  752. end;
  753. function TValueListEditor.ValidateEntry(const ACol, ARow: Integer;
  754. const OldValue: string; var NewValue: string): boolean;
  755. var
  756. Index, i: Integer;
  757. begin
  758. Result := inherited ValidateEntry(ACol, ARow, OldValue, NewValue);
  759. if ((ACol - FixedCols) = 0) then
  760. begin//Check for duplicate key names (only in "Key" column)
  761. Index := ARow - FixedRows;
  762. for i := 0 to FStrings.Count - 1 do
  763. begin
  764. if (Index <> i) then
  765. begin
  766. if (Utf8CompareText(FStrings.Names[i], NewValue) = 0) then
  767. begin
  768. Result := False;
  769. ShowMessage(Format(rsVLEDuplicateKey,[NewValue, i + FixedRows]));
  770. if Editor is TStringCellEditor then TStringCelleditor(Editor).SelectAll;
  771. end;
  772. end;
  773. end;
  774. end;
  775. end;
  776. class procedure TValueListEditor.WSRegisterClass;
  777. begin
  778. // RegisterPropertyToSkip(Self, 'SomeProperty', 'VCL compatibility property', '');
  779. inherited WSRegisterClass;
  780. end;
  781. procedure TValueListEditor.DoOnResize;
  782. begin
  783. inherited DoOnResize;
  784. if (doAutoColResize in DisplayOptions) then AdjustColumnWidths;
  785. end;
  786. procedure Register;
  787. begin
  788. RegisterComponents('Additional',[TValueListEditor]);
  789. end;
  790. end.