source: trunk/Packages/Common/Forms/FormList.pas

Last change on this file was 219, checked in by chronos, 5 days ago
  • Modified: Updated Common package.
  • Modified: Remove U prefix from unit names.
  • Modified: Use Gneeric.Collections instead of fgl.
  • Modified: Do not use global form variables.
File size: 8.5 KB
Line 
1unit FormList;
2
3interface
4
5uses
6 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
7 ActnList, Menus, ItemList, FormEx;
8
9type
10 { TFormList }
11
12 TFormList = class(TFormEx)
13 AAdd: TAction;
14 ASelectAll: TAction;
15 AModify: TAction;
16 ARemove: TAction;
17 AClone: TAction;
18 ActionList1: TActionList;
19 ListView1: TListView;
20 MenuItem1: TMenuItem;
21 MenuItem2: TMenuItem;
22 MenuItem3: TMenuItem;
23 MenuItem4: TMenuItem;
24 MenuItem5: TMenuItem;
25 PopupMenu1: TPopupMenu;
26 ToolBar1: TToolBar;
27 ToolButton1: TToolButton;
28 ToolButton2: TToolButton;
29 ToolButton3: TToolButton;
30 ToolButton4: TToolButton;
31 procedure AAddExecute(Sender: TObject);
32 procedure ACloneExecute(Sender: TObject);
33 procedure AModifyExecute(Sender: TObject);
34 procedure ARemoveExecute(Sender: TObject);
35 procedure ASelectAllExecute(Sender: TObject);
36 procedure FormCreate(Sender: TObject);
37 procedure FormDestroy(Sender: TObject);
38 procedure FormShow(Sender: TObject);
39 procedure ListView1CustomDrawSubItem(Sender: TCustomListView;
40 Item: TListItem; SubItem: Integer; State: TCustomDrawState;
41 var DefaultDraw: Boolean);
42 procedure ListView1Data(Sender: TObject; Item: TListItem);
43 procedure ListView1KeyPress(Sender: TObject; var Key: char);
44 procedure ListView1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState
45 );
46 procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
47 Selected: Boolean);
48 private
49 FImages: TImageList;
50 FList: TBaseItemList;
51 procedure SetImages(AValue: TImageList);
52 procedure SetList(AValue: TBaseItemList);
53 procedure UpdateListViewColumns;
54 public
55 MinItemCount: Integer;
56 MaxItemCount: Integer;
57 procedure UpdateInterface;
58 procedure UpdateList;
59 property List: TBaseItemList read FList write SetList;
60 property Images: TImageList read FImages write SetImages;
61 end;
62
63
64implementation
65
66{$R *.lfm}
67
68uses
69 FormItem;
70
71resourcestring
72 SRemoveItems = 'Remove items';
73 SRemoveItemsQuery = 'Do you want to remove selected items?';
74
75{ TFormList }
76
77procedure TFormList.ARemoveExecute(Sender: TObject);
78var
79 I: Integer;
80begin
81 if Assigned(ListView1.Selected) then begin
82 if MessageDlg(SRemoveItems, SRemoveItemsQuery,
83 TMsgDlgType.mtConfirmation, [mbCancel, mbOk], 0) = mrOk then begin
84 for I := ListView1.Items.Count - 1 downto 0 do
85 if ListView1.Items[I].Selected then begin
86 if List.Count <= MinItemCount then Break;
87 ListView1.Items[I].Selected := False;
88 FList.Remove(TItem(ListView1.Items[I].Data));
89 end;
90 UpdateList;
91 UpdateInterface;
92 end;
93 end;
94end;
95
96procedure TFormList.AModifyExecute(Sender: TObject);
97var
98 TempEntry: TItem;
99 FormItem: TFormItem;
100begin
101 if Assigned(ListView1.Selected) then
102 with TItem(ListView1.Selected.Data) do begin
103 TempEntry := FList.CreateItem;
104 TempEntry.Assign(TItem(ListView1.Selected.Data));
105 FormItem := TFormItem.Create(Self);
106 try
107 FormItem.Item := TempEntry;
108 if FormItem.ShowModal = mrOk then begin
109 TItem(ListView1.Selected.Data).Assign(TempEntry);
110 UpdateList;
111 UpdateInterface;
112 end;
113 finally
114 FreeAndNil(FormItem);
115 FreeAndNil(TempEntry);
116 end;
117 end;
118end;
119
120procedure TFormList.AAddExecute(Sender: TObject);
121var
122 TempEntry: TItem;
123 FormItem: TFormItem;
124begin
125 if (MaxItemCount <> -1) and (FList.Count >= MaxItemCount) then Exit;
126
127 TempEntry := FList.CreateItem;
128 FormItem := TFormItem.Create(Self);
129 try
130 TempEntry.Name := FList.GetNextAvailableName(List.GetName);
131 FormItem.Item := TempEntry;
132 if FormItem.ShowModal = mrOk then begin
133 FList.Add(TempEntry);
134 TempEntry := nil;
135 UpdateList;
136 UpdateInterface;
137 end;
138 finally
139 FreeAndNil(FormItem);
140 end;
141 TempEntry.Free;
142end;
143
144procedure TFormList.ACloneExecute(Sender: TObject);
145var
146 TempEntry: TItem;
147 FormItem: TFormItem;
148begin
149 if (MaxItemCount <> -1) and (FList.Count >= MaxItemCount) then Exit;
150
151 TempEntry := FList.CreateItem;
152 TempEntry.Assign(TItem(ListView1.Selected.Data));
153 FormItem := TFormItem.Create(Self);
154 try
155 TempEntry.Name := List.GetNextAvailableName(TempEntry.Name);
156 FormItem.Item := TempEntry;
157 if FormItem.ShowModal = mrOk then begin
158 FList.Add(TempEntry);
159 TempEntry := nil;
160 UpdateList;
161 UpdateInterface;
162 end;
163 finally
164 FreeAndNil(FormItem);
165 end;
166 TempEntry.Free;
167end;
168
169procedure TFormList.ASelectAllExecute(Sender: TObject);
170var
171 I: Integer;
172begin
173 for I := 0 to ListView1.Items.Count - 1 do
174 ListView1.Items[I].Selected := True;
175end;
176
177procedure TFormList.FormCreate(Sender: TObject);
178var
179 I: Integer;
180begin
181 for I := 0 to ToolBar1.ButtonCount - 1 do
182 ToolBar1.Buttons[I].Hint := ToolBar1.Buttons[I].Caption;
183 MinItemCount := 0;
184 MaxItemCount := -1;
185end;
186
187procedure TFormList.FormDestroy(Sender: TObject);
188begin
189 List := nil;
190end;
191
192procedure TFormList.FormShow(Sender: TObject);
193begin
194 UpdateListViewColumns;
195 UpdateList;
196 UpdateInterface;
197end;
198
199procedure TFormList.ListView1CustomDrawSubItem(Sender: TCustomListView;
200 Item: TListItem; SubItem: Integer; State: TCustomDrawState;
201 var DefaultDraw: Boolean);
202var
203 ItemFields: TItemFields;
204 ItemField: TItemField;
205 DrawRect: TRect;
206begin
207 ItemFields := TItem(Item.Data).GetFields;
208 try
209 ItemField := ItemFields[SubItem];
210 with ListView1.Canvas do
211 if ItemField.DataType = dtColor then begin
212 Brush.Color := TItem(Item.Data).GetValueColor(ItemField.Index);
213 Brush.Style := bsSolid;
214 DrawRect := Item.DisplayRectSubItem(SubItem, drBounds);
215 {$IFDEF LCLQT5}
216 // TODO: Wrong rectangle width on Qt5
217 if DrawRect.Width > ListView1.Columns[SubItem].Width then
218 DrawRect.Width := ListView1.Columns[SubItem].Width;
219 {$ENDIF}
220 FillRect(DrawRect);
221 end;
222 finally
223 ItemFields.Free;
224 end;
225end;
226
227procedure TFormList.ListView1Data(Sender: TObject; Item: TListItem);
228var
229 I: Integer;
230 Fields: TItemFields;
231begin
232 if Item.Index < ListView1.Items.Count then
233 with FList[Item.Index] do begin
234 //Item.Caption := GetName;
235 Item.Data := FList[Item.Index];
236 Fields := FList.GetItemFields;
237 try
238 for I := 0 to Fields.Count - 1 do begin
239 if I = 0 then Item.Caption := GetValueAsText(Fields[I].Index)
240 else Item.SubItems.Add(GetValueAsText(Fields[I].Index));
241 end;
242 finally
243 Fields.Free;
244 end;
245 end;
246end;
247
248procedure TFormList.ListView1KeyPress(Sender: TObject; var Key: char);
249begin
250 if Key = #13 then AModify.Execute;
251 if Key = #27 then Close;
252end;
253
254procedure TFormList.ListView1KeyUp(Sender: TObject; var Key: Word;
255 Shift: TShiftState);
256begin
257 if Key = 45 then AAdd.Execute;
258 if Key = 46 then ARemove.Execute;
259end;
260
261procedure TFormList.ListView1SelectItem(Sender: TObject;
262 Item: TListItem; Selected: Boolean);
263begin
264 UpdateInterface;
265end;
266
267procedure TFormList.SetList(AValue: TBaseItemList);
268begin
269 if FList = AValue then Exit;
270 FList := AValue;
271 UpdateInterface;
272 UpdateList;
273end;
274
275procedure TFormList.SetImages(AValue: TImageList);
276begin
277 if FImages = AValue then Exit;
278 FImages := AValue;
279 ToolBar1.Images := FImages;
280 PopupMenu1.Images := FImages;
281end;
282
283procedure TFormList.UpdateListViewColumns;
284var
285 I: Integer;
286 Fields: TItemFields;
287begin
288 if not Assigned(FList) then begin
289 while ListView1.Columns.Count > 0 do
290 ListView1.Columns.Delete(ListView1.Columns.Count - 1);
291 Exit;
292 end;
293 Fields := List.GetItemFields;
294 ListView1.Columns.BeginUpdate;
295 try
296 while ListView1.Columns.Count < Fields.Count do
297 ListView1.Columns.Add;
298 while ListView1.Columns.Count > Fields.Count do
299 ListView1.Columns.Delete(ListView1.Columns.Count - 1);
300 for I := 0 to ListView1.Columns.Count - 1 do begin
301 ListView1.Columns[I].Caption := Fields[I].Name;
302 ListView1.Columns[I].Width := Scale96ToScreen(100);
303 end;
304 finally
305 ListView1.Columns.EndUpdate;
306 end;
307 Fields.Free;
308end;
309
310procedure TFormList.UpdateInterface;
311begin
312 ARemove.Enabled := Assigned(FList) and Assigned(ListView1.Selected) and ((List.Count - ListView1.SelCount) >= MinItemCount);
313 AModify.Enabled := Assigned(FList) and Assigned(ListView1.Selected);
314 AAdd.Enabled := Assigned(FList) and ((MaxItemCount = -1) or ((MaxItemCount <> -1) and (List.Count < MaxItemCount)));
315 AClone.Enabled := Assigned(FList) and ((MaxItemCount = -1) or ((MaxItemCount <> -1) and (List.Count < MaxItemCount)));
316 ASelectAll.Enabled := ListView1.Items.Count > 0;
317end;
318
319procedure TFormList.UpdateList;
320begin
321 if Assigned(FList) then ListView1.Items.Count := FList.Count
322 else ListView1.Items.Count := 0;
323 ListView1.Refresh;
324end;
325
326end.
327
Note: See TracBrowser for help on using the repository browser.