1 { TSmallOrderedSetEditDlg
2
3 Copyright (C) 2017 Lazarus team
4
5 This library is free software; you can redistribute it and/or modify it
6 under the same terms as the Lazarus Component Library (LCL)
7
8 See the file COPYING.modifiedLGPL.txt, included in this distribution,
9 for details about the license.
10
11 Abstract:
12 Dialog to edit a set of items (string) and able to order them.
13 }
14 unit SmallOrderedSetEditor;
15
16 {$mode objfpc}{$H+}
17
18 interface
19
20 uses
21 Classes, SysUtils, Types, math,
22 Forms, Controls, Graphics, Dialogs, StdCtrls,
23 ButtonPanel, ComCtrls, Buttons, LCLType, Themes,
24 LazLoggerBase, LazUTF8;
25
26 type
27 TSmOrdSetEditOption = (
28 oseoHideUpDown,
29 oseoErrorDuplicateItems, // default: ignore and skip
30 oseoErrorDuplicateAvailable, // default: ignore and skip
31 oseoErrorItemsContainNotAvailable // default: merge Items into AvailableItems
32 );
33 TSmOrdSetEditOptions = set of TSmOrdSetEditOption;
34
35 { TSmallOrderedSetEditDlg }
36
37 TSmallOrderedSetEditDlg = class(TForm)
38 ButtonPanel1: TButtonPanel;
39 HeaderLabel: TLabel;
40 ImageList1: TImageList;
41 ItemsTreeView: TTreeView;
42 MoveDownBitBtn: TBitBtn;
43 MoveUpBitBtn: TBitBtn;
44 procedure ItemsTreeViewAdvancedCustomDrawItem(Sender: TCustomTreeView;
45 Node: TTreeNode; {%H-}State: TCustomDrawState; Stage: TCustomDrawStage;
46 var PaintImages, {%H-}DefaultDraw: Boolean);
47 procedure ItemsTreeViewMouseDown(Sender: TObject; {%H-}Button: TMouseButton;
48 {%H-}Shift: TShiftState; X, Y: Integer);
49 procedure ItemsTreeViewSelectionChanged(Sender: TObject);
50 procedure MoveDownBitBtnClick(Sender: TObject);
51 procedure MoveUpBitBtnClick(Sender: TObject);
52 private
53 FAvailableItems: TStrings;
54 FItems: TStrings;
55 FOptions: TSmOrdSetEditOptions;
GetHeaderCaptionnull56 function GetHeaderCaption: TTranslateString;
57 procedure SetAvailableItems(const AValue: TStrings);
58 procedure SetHeaderCaption(const AValue: TTranslateString);
59 procedure SetItems(const AValue: TStrings);
SetListnull60 function SetList(List, NewList: TStrings; ErrorOnDuplicate: boolean): boolean;
61 procedure UpdateButtonState;
62 protected
63 procedure SetOptions(const AValue: TSmOrdSetEditOptions); virtual;
IndexOfnull64 //function IndexOf(List: TStrings; Value: string): integer; virtual;
65 procedure UpdateShowing; override;
66 procedure ToggleNode(Node: TTreeNode); virtual;
67 public
68 constructor Create(TheOwner: TComponent); override;
69 destructor Destroy; override;
70 procedure Init; virtual;
71 property Options: TSmOrdSetEditOptions read FOptions write SetOptions;
72 property HeaderCaption: TTranslateString read GetHeaderCaption write SetHeaderCaption;
73 property Items: TStrings read FItems write SetItems;
74 property AvailableItems: TStrings read FAvailableItems write SetAvailableItems;
75 end;
76
CreateOrderedSetEditornull77 function CreateOrderedSetEditor(Items, AvailableItems: TStrings): TSmallOrderedSetEditDlg;
ShowOrderedSetEditornull78 function ShowOrderedSetEditor(aCaption: string; Items, AvailableItems: TStrings): TModalResult;
79
80 implementation
81
CreateOrderedSetEditornull82 function CreateOrderedSetEditor(Items, AvailableItems: TStrings): TSmallOrderedSetEditDlg;
83 begin
84 Result:=TSmallOrderedSetEditDlg.Create(nil);
85 Result.Items:=Items;
86 Result.AvailableItems:=AvailableItems;
87 Result.Init;
88 end;
89
ShowOrderedSetEditornull90 function ShowOrderedSetEditor(aCaption: string; Items, AvailableItems: TStrings
91 ): TModalResult;
92 var
93 Dlg: TSmallOrderedSetEditDlg;
94 begin
95 Dlg:=CreateOrderedSetEditor(Items,AvailableItems);
96 try
97 Dlg.Caption:=aCaption;
98 Result:=Dlg.ShowModal;
99 if Result=mrOK then
100 Items.Assign(Dlg.Items);
101 finally
102 Dlg.Free;
103 end;
104 end;
105
106 {$R *.lfm}
107
108 { TSmallOrderedSetEditDlg }
109
110 procedure TSmallOrderedSetEditDlg.ItemsTreeViewAdvancedCustomDrawItem(
111 Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState;
112 Stage: TCustomDrawStage; var PaintImages, DefaultDraw: Boolean);
113 var
114 Selected: Boolean;
115 R: TRect;
116 Details: TThemedElementDetails;
117 begin
118 Selected:=Node.ImageIndex>0;
119 if Stage=cdPrePaint then
120 PaintImages:=false
121 else if Stage=cdPostPaint then
122 begin
123 R:=Node.DisplayRect(false);
124 R.Left := Node.DisplayIconLeft;
125 if Selected then
126 Details := ThemeServices.GetElementDetails(tbCheckBoxCheckedNormal)
127 else
128 Details := ThemeServices.GetElementDetails(tbCheckBoxUncheckedNormal);
129 R.Right:=R.Left+ThemeServices.GetDetailSize(Details).cx;
130 ThemeServices.DrawElement(ItemsTreeView.Canvas.Handle, Details, R, nil);
131 end;
132 end;
133
134 procedure TSmallOrderedSetEditDlg.ItemsTreeViewMouseDown(Sender: TObject;
135 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
136 var
137 Node: TTreeNode;
138 begin
139 Node:=ItemsTreeView.GetNodeAt(X,Y);
140 if Node=nil then exit;
141 ToggleNode(Node);
142 end;
143
144 procedure TSmallOrderedSetEditDlg.ItemsTreeViewSelectionChanged(Sender: TObject);
145 begin
146 UpdateButtonState;
147 end;
148
149 procedure TSmallOrderedSetEditDlg.MoveDownBitBtnClick(Sender: TObject);
150 var
151 SelNode: TTreeNode;
152 begin
153 SelNode:=ItemsTreeView.Selected;
154 if (SelNode=nil) or (SelNode.Index>=ItemsTreeView.Items.TopLvlCount-1) then exit;
155 SelNode.Index:=SelNode.Index+1;
156 UpdateButtonState;
157 end;
158
159 procedure TSmallOrderedSetEditDlg.MoveUpBitBtnClick(Sender: TObject);
160 var
161 SelNode: TTreeNode;
162 begin
163 SelNode:=ItemsTreeView.Selected;
164 if (SelNode=nil) or (SelNode.Index<1) then exit;
165 SelNode.Index:=SelNode.Index-1;
166 UpdateButtonState;
167 end;
168
TSmallOrderedSetEditDlg.GetHeaderCaptionnull169 function TSmallOrderedSetEditDlg.GetHeaderCaption: TTranslateString;
170 begin
171 Result:=HeaderLabel.Caption;
172 end;
173
174 procedure TSmallOrderedSetEditDlg.SetAvailableItems(const AValue: TStrings);
175 begin
176 SetList(FAvailableItems,AValue,oseoErrorDuplicateAvailable in Options);
177 end;
178
179 procedure TSmallOrderedSetEditDlg.SetHeaderCaption(const AValue: TTranslateString);
180 begin
181 if HeaderCaption=AValue then Exit;
182 HeaderLabel.Caption:=AValue;
183 HeaderLabel.Visible:=HeaderLabel.Caption<>'';
184 end;
185
186 procedure TSmallOrderedSetEditDlg.SetItems(const AValue: TStrings);
187 begin
188 SetList(FItems,AValue,oseoErrorDuplicateItems in Options);
189 end;
190
191 procedure TSmallOrderedSetEditDlg.UpdateButtonState;
192 var
193 SelNode: TTreeNode;
194 begin
195 SelNode:=ItemsTreeView.Selected;
196 MoveUpBitBtn.Enabled:=(SelNode<>nil) and (SelNode.Index>0);
197 MoveDownBitBtn.Enabled:=(SelNode<>nil) and (SelNode.Index<ItemsTreeView.Items.TopLvlCount-1);
198 end;
199
200 procedure TSmallOrderedSetEditDlg.SetOptions(const AValue: TSmOrdSetEditOptions);
201 begin
202 if FOptions=AValue then Exit;
203 FOptions:=AValue;
204 MoveUpBitBtn.Visible:=not (oseoHideUpDown in Options);
205 MoveDownBitBtn.Visible:=not (oseoHideUpDown in Options);
206 end;
207 {
IndexOfnull208 function TSmallOrderedSetEditDlg.IndexOf(List: TStrings; Value: string): integer;
209 begin
210 Result:=List.IndexOf(Value);
211 end;
212 }
213 function TSmallOrderedSetEditDlg.SetList(List, NewList: TStrings;
214 ErrorOnDuplicate: boolean): boolean;
215 var
216 CleanList: TStringListUTF8Fast;
217 i: Integer;
218 s: String;
219 begin
220 CleanList:=TStringListUTF8Fast.Create;
221 try
222 for i:=0 to NewList.Count-1 do
223 begin
224 s:=NewList[i];
225 if CleanList.IndexOf(s)>=0 then
226 begin
227 if ErrorOnDuplicate then
228 raise EListError.Create(DbgSName(Self)+': duplicate item '+IntToStr(i)+' "'+s+'"');
229 continue;
230 end;
231 CleanList.Add(s);
232 end;
233 if List.Equals(CleanList) then exit(false);
234 Result:=true;
235 List.Assign(CleanList);
236 finally
237 CleanList.Free;
238 end;
239 end;
240
241 procedure TSmallOrderedSetEditDlg.UpdateShowing;
242 var
243 CheckedDetails, UnCheckedDetails: TThemedElementDetails;
244 CheckedSize, UnCheckedSize: TSize;
245 Bmp: TBitmap;
246 begin
247 inherited UpdateShowing;
248 if Visible and (ImageList1.Count=0) then begin
249 CheckedDetails := ThemeServices.GetElementDetails(tbCheckBoxCheckedNormal);
250 UnCheckedDetails := ThemeServices.GetElementDetails(tbCheckBoxCheckedNormal);
251 CheckedSize:=ThemeServices.GetDetailSize(CheckedDetails);
252 UnCheckedSize:=ThemeServices.GetDetailSize(UnCheckedDetails);
253 ImageList1.Width:=Max(CheckedSize.cx,UnCheckedSize.cx);
254 ImageList1.Height:=Max(CheckedSize.cy,UnCheckedSize.cy);
255 Bmp:=TBitmap.Create;
256 Bmp.SetSize(ImageList1.Width,ImageList1.Height);
257 ImageList1.Add(Bmp,nil);
258 ImageList1.Add(Bmp,nil);
259 Bmp.Free;
260 end;
261 end;
262
263 procedure TSmallOrderedSetEditDlg.ToggleNode(Node: TTreeNode);
264 var
265 i, j: Integer;
266 begin
267 Node.ImageIndex:=1-Node.ImageIndex;
268 Node.SelectedIndex:=Node.ImageIndex;
269 if Node.ImageIndex=0 then
270 begin
271 i:=Items.IndexOf(Node.Text);
272 Items.Delete(i);
273 end else begin
274 j:=0;
275 for i:=0 to Node.Index-1 do
276 begin
277 if ItemsTreeView.Items[i].ImageIndex>0 then
278 inc(j);
279 end;
280 Items.Insert(j,Node.Text);
281 end;
282 end;
283
284 constructor TSmallOrderedSetEditDlg.Create(TheOwner: TComponent);
285 begin
286 inherited Create(TheOwner);
287 FItems:=TStringList.Create;
288 FAvailableItems:=TStringList.Create;
289 end;
290
291 destructor TSmallOrderedSetEditDlg.Destroy;
292 begin
293 FreeAndNil(FItems);
294 FreeAndNil(FAvailableItems);
295 inherited Destroy;
296 end;
297
298 procedure TSmallOrderedSetEditDlg.Init;
299 var
300 i: Integer;
301 s: String;
302 Node: TTreeNode;
303 begin
304 for i:=FItems.Count-1 downto 0 do
305 begin
306 s:=FItems[i];
307 if AvailableItems.IndexOf(s)<0 then
308 begin
309 if oseoErrorItemsContainNotAvailable in Options then
310 raise EListError.Create(DbgSName(Self)+': item '+IntToStr(i)+' "'+s+'" is not in AvailableItems');
311 FAvailableItems.Insert(0,s);
312 end;
313 end;
314
315 ItemsTreeView.BeginUpdate;
316 ItemsTreeView.Items.Clear;
317 for i:=0 to AvailableItems.Count-1 do
318 begin
319 s:=AvailableItems[i];
320 Node:=ItemsTreeView.Items.Add(nil,s);
321 if Items.IndexOf(s)>=0 then
322 Node.ImageIndex:=1
323 else
324 Node.ImageIndex:=0;
325 Node.SelectedIndex:=Node.ImageIndex;
326 end;
327 ItemsTreeView.EndUpdate;
328 UpdateButtonState;
329 end;
330
331 end.
332
333