source: Common/Forms/FormList.pas

Last change on this file was 583, checked in by chronos, 10 days ago
  • Added: ItemList class and forms to Common package.
File size: 8.3 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 SNew = 'New';
75
76{ TFormList }
77
78procedure TFormList.ARemoveExecute(Sender: TObject);
79var
80 I: Integer;
81begin
82 if Assigned(ListView1.Selected) then begin
83 if MessageDlg(SRemoveItems, SRemoveItemsQuery,
84 TMsgDlgType.mtConfirmation, [mbCancel, mbOk], 0) = mrOk then begin
85 for I := ListView1.Items.Count - 1 downto 0 do
86 if ListView1.Items[I].Selected then begin
87 if List.Count <= MinItemCount then Break;
88 ListView1.Items[I].Selected := False;
89 FList.Remove(TItem(ListView1.Items[I].Data));
90 end;
91 UpdateList;
92 UpdateInterface;
93 end;
94 end;
95end;
96
97procedure TFormList.AModifyExecute(Sender: TObject);
98var
99 TempEntry: TItem;
100 FormItem: TFormItem;
101begin
102 if Assigned(ListView1.Selected) then
103 with TItem(ListView1.Selected.Data) do begin
104 TempEntry := FList.CreateItem;
105 TempEntry.Assign(TItem(ListView1.Selected.Data));
106 FormItem := TFormItem.Create(Self);
107 try
108 FormItem.Item := TempEntry;
109 if FormItem.ShowModal = mrOk then begin
110 TItem(ListView1.Selected.Data).Assign(TempEntry);
111 UpdateList;
112 UpdateInterface;
113 end;
114 finally
115 FreeAndNil(FormItem);
116 FreeAndNil(TempEntry);
117 end;
118 end;
119end;
120
121procedure TFormList.AAddExecute(Sender: TObject);
122var
123 TempEntry: TItem;
124 FormItem: TFormItem;
125begin
126 if (MaxItemCount <> -1) and (FList.Count >= MaxItemCount) then Exit;
127
128 TempEntry := FList.CreateItem;
129 FormItem := TFormItem.Create(Self);
130 try
131 TempEntry.Name := FList.GetNextAvailableName(SNew + ' ' + LowerCase(List.GetName));
132 FormItem.Item := TempEntry;
133 if FormItem.ShowModal = mrOk then begin
134 FList.Add(TempEntry);
135 TempEntry := nil;
136 UpdateList;
137 UpdateInterface;
138 end;
139 finally
140 FreeAndNil(FormItem);
141 end;
142 TempEntry.Free;
143end;
144
145procedure TFormList.ACloneExecute(Sender: TObject);
146var
147 TempEntry: TItem;
148 FormItem: TFormItem;
149begin
150 if (MaxItemCount <> -1) and (FList.Count >= MaxItemCount) then Exit;
151
152 TempEntry := FList.CreateItem;
153 TempEntry.Assign(TItem(ListView1.Selected.Data));
154 FormItem := TFormItem.Create(Self);
155 try
156 TempEntry.Name := List.GetNextAvailableName(TempEntry.Name);
157 FormItem.Item := TempEntry;
158 if FormItem.ShowModal = mrOk then begin
159 FList.Add(TempEntry);
160 TempEntry := nil;
161 UpdateList;
162 UpdateInterface;
163 end;
164 finally
165 FreeAndNil(FormItem);
166 end;
167 TempEntry.Free;
168end;
169
170procedure TFormList.ASelectAllExecute(Sender: TObject);
171var
172 I: Integer;
173begin
174 for I := 0 to ListView1.Items.Count - 1 do
175 ListView1.Items[I].Selected := True;
176end;
177
178procedure TFormList.FormCreate(Sender: TObject);
179var
180 I: Integer;
181begin
182 for I := 0 to ToolBar1.ButtonCount - 1 do
183 ToolBar1.Buttons[I].Hint := ToolBar1.Buttons[I].Caption;
184 MinItemCount := 0;
185 MaxItemCount := -1;
186end;
187
188procedure TFormList.FormDestroy(Sender: TObject);
189begin
190 List := nil;
191end;
192
193procedure TFormList.FormShow(Sender: TObject);
194begin
195 UpdateListViewColumns;
196 UpdateList;
197 UpdateInterface;
198end;
199
200procedure TFormList.ListView1CustomDrawSubItem(Sender: TCustomListView;
201 Item: TListItem; SubItem: Integer; State: TCustomDrawState;
202 var DefaultDraw: Boolean);
203var
204 ItemFields: TItemFields;
205 ItemField: TItemField;
206begin
207 ItemFields := TItem(Item.Data).GetFields;
208 try
209 ItemField := ItemFields[SubItem];
210 if ItemField.DataType = dtColor then
211 with ListView1.Canvas do begin
212 Brush.Color := TItem(Item.Data).GetValueColor(ItemField.Index);
213 Brush.Style := bsSolid;
214 FillRect(Item.DisplayRectSubItem(SubItem, drBounds));
215 end;
216 finally
217 ItemFields.Free;
218 end;
219end;
220
221procedure TFormList.ListView1Data(Sender: TObject; Item: TListItem);
222var
223 I: Integer;
224 Fields: TItemFields;
225begin
226 if Item.Index < ListView1.Items.Count then
227 with FList[Item.Index] do begin
228 //Item.Caption := GetName;
229 Item.Data := FList[Item.Index];
230 Fields := FList.GetItemFields;
231 try
232 for I := 0 to Fields.Count - 1 do begin
233 if I = 0 then Item.Caption := GetValueAsText(Fields[I].Index)
234 else Item.SubItems.Add(GetValueAsText(Fields[I].Index));
235 end;
236 finally
237 Fields.Free;
238 end;
239 end;
240end;
241
242procedure TFormList.ListView1KeyPress(Sender: TObject; var Key: char);
243begin
244 if Key = #13 then AModify.Execute;
245 if Key = #27 then Close;
246end;
247
248procedure TFormList.ListView1KeyUp(Sender: TObject; var Key: Word;
249 Shift: TShiftState);
250begin
251 if Key = 45 then AAdd.Execute;
252 if Key = 46 then ARemove.Execute;
253end;
254
255procedure TFormList.ListView1SelectItem(Sender: TObject;
256 Item: TListItem; Selected: Boolean);
257begin
258 UpdateInterface;
259end;
260
261procedure TFormList.SetList(AValue: TBaseItemList);
262begin
263 if FList = AValue then Exit;
264 FList := AValue;
265 UpdateInterface;
266 UpdateList;
267end;
268
269procedure TFormList.SetImages(AValue: TImageList);
270begin
271 if FImages = AValue then Exit;
272 FImages := AValue;
273 ToolBar1.Images := FImages;
274 PopupMenu1.Images := FImages;
275end;
276
277procedure TFormList.UpdateListViewColumns;
278var
279 I: Integer;
280 Fields: TItemFields;
281begin
282 if not Assigned(FList) then begin
283 while ListView1.Columns.Count > 0 do
284 ListView1.Columns.Delete(ListView1.Columns.Count - 1);
285 Exit;
286 end;
287 Fields := List.GetItemFields;
288 ListView1.Columns.BeginUpdate;
289 try
290 while ListView1.Columns.Count < Fields.Count do
291 ListView1.Columns.Add;
292 while ListView1.Columns.Count > Fields.Count do
293 ListView1.Columns.Delete(ListView1.Columns.Count - 1);
294 for I := 0 to ListView1.Columns.Count - 1 do begin
295 ListView1.Columns[I].Caption := Fields[I].Name;
296 ListView1.Columns[I].Width := Scale96ToScreen(100);
297 end;
298 finally
299 ListView1.Columns.EndUpdate;
300 end;
301 Fields.Free;
302end;
303
304procedure TFormList.UpdateInterface;
305begin
306 ARemove.Enabled := Assigned(FList) and Assigned(ListView1.Selected) and ((List.Count - ListView1.SelCount) >= MinItemCount);
307 AModify.Enabled := Assigned(FList) and Assigned(ListView1.Selected);
308 AAdd.Enabled := Assigned(FList) and ((MaxItemCount = -1) or ((MaxItemCount <> -1) and (List.Count < MaxItemCount)));
309 AClone.Enabled := Assigned(FList) and ((MaxItemCount = -1) or ((MaxItemCount <> -1) and (List.Count < MaxItemCount)));
310 ASelectAll.Enabled := ListView1.Items.Count > 0;
311end;
312
313procedure TFormList.UpdateList;
314begin
315 if Assigned(FList) then ListView1.Items.Count := FList.Count
316 else ListView1.Items.Count := 0;
317 ListView1.Refresh;
318end;
319
320end.
321
Note: See TracBrowser for help on using the repository browser.