source: tags/1.1.0/Forms/UFormContacts.pas

Last change on this file was 63, checked in by chronos, 2 years ago
  • Fixed: Open directory with saved split contact files in default file manager under Linux.
  • Fixed: Don't use forbidden characters in saved contact file name.
File size: 14.3 KB
Line 
1unit UFormContacts;
2
3{$mode delphi}
4
5interface
6
7uses
8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
9 ComCtrls, Menus, ActnList, UContact, UListViewSort, fgl, LazUTF8;
10
11type
12
13 { TFormContacts }
14
15 TFormContacts = class(TForm)
16 AAdd: TAction;
17 AClone: TAction;
18 ALoadFromFile: TAction;
19 ASaveToFile: TAction;
20 ASelectAll: TAction;
21 ARemove: TAction;
22 AModify: TAction;
23 ActionList1: TActionList;
24 ListView1: TListView;
25 ListViewFilter1: TListViewFilter;
26 ListViewSort1: TListViewSort;
27 MenuItem1: TMenuItem;
28 MenuItem2: TMenuItem;
29 MenuItem3: TMenuItem;
30 MenuItem4: TMenuItem;
31 MenuItem5: TMenuItem;
32 MenuItem6: TMenuItem;
33 MenuItem7: TMenuItem;
34 MenuItem8: TMenuItem;
35 OpenDialog1: TOpenDialog;
36 PopupMenuContact: TPopupMenu;
37 SaveDialog1: TSaveDialog;
38 StatusBar1: TStatusBar;
39 ToolBar1: TToolBar;
40 ToolButton1: TToolButton;
41 ToolButton2: TToolButton;
42 ToolButton3: TToolButton;
43 ToolButton4: TToolButton;
44 ToolButton5: TToolButton;
45 ToolButton6: TToolButton;
46 ToolButton7: TToolButton;
47 procedure AAddExecute(Sender: TObject);
48 procedure ACloneExecute(Sender: TObject);
49 procedure ALoadFromFileExecute(Sender: TObject);
50 procedure AModifyExecute(Sender: TObject);
51 procedure ARemoveExecute(Sender: TObject);
52 procedure ASaveToFileExecute(Sender: TObject);
53 procedure ASelectAllExecute(Sender: TObject);
54 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
55 procedure FormCreate(Sender: TObject);
56 procedure FormShow(Sender: TObject);
57 procedure ListView1Data(Sender: TObject; Item: TListItem);
58 procedure ListView1DblClick(Sender: TObject);
59 procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
60 Selected: Boolean);
61 procedure ListViewFilter1Change(Sender: TObject);
62 procedure ListViewSort1ColumnWidthChanged(Sender: TObject);
63 function ListViewSort1CompareItem(Item1, Item2: TObject): Integer;
64 procedure ListViewSort1Filter(ListViewSort: TListViewSort);
65 private
66 FContacts: TContacts;
67 FUpdateCount: Integer;
68 procedure FilterList(List: TFPGObjectList<TObject>);
69 procedure SetContacts(AValue: TContacts);
70 procedure FormContactPrevious(Sender: TObject);
71 procedure FormContactNext(Sender: TObject);
72 procedure DoUpdateInterface;
73 public
74 property Contacts: TContacts read FContacts write SetContacts;
75 procedure ReloadList;
76 procedure BeginUpdate;
77 procedure EndUpdate;
78 procedure UpdateInterface;
79 end;
80
81var
82 FormContacts: TFormContacts;
83
84
85implementation
86
87{$R *.lfm}
88
89uses
90 UFormContact, UCore;
91
92resourcestring
93 SRemoveContacts = 'Remove contacts';
94 SRemoveContactsQuery = 'Do you want to remove selected contacts?';
95 STotal = 'Total';
96 SFiltered = 'Filtered';
97 SSelected = 'Selected';
98 SEndUpdateTooLow = 'Update counter error';
99
100{ TFormContacts }
101
102procedure TFormContacts.ListView1Data(Sender: TObject; Item: TListItem);
103
104 procedure AddItem(Text: string; IsCaption: Boolean = False);
105 begin
106 if IsCaption then begin
107 if Text <> '' then Item.Caption := Text
108 else Item.Caption := ' ';
109 end else begin
110 if Text <> '' then Item.SubItems.Add(Text)
111 else Item.SubItems.Add(' ');
112 end;
113 end;
114
115begin
116 if Item.Index < ListViewSort1.List.Count then
117 with TContact(ListViewSort1.List[Item.Index]) do begin
118 AddItem(Fields[cfFullName], True);
119 AddItem(Fields[cfFirstName]);
120 AddItem(Fields[cfMiddleName]);
121 AddItem(Fields[cfLastName]);
122 AddItem(Fields[cfTel]);
123 AddItem(Fields[cfTelCell]);
124 AddItem(Fields[cfTelHome]);
125 AddItem(Fields[cfTelWork]);
126 Item.Data := ListViewSort1.List[Item.Index];
127 end;
128end;
129
130procedure TFormContacts.ListView1DblClick(Sender: TObject);
131begin
132 AModify.Execute;
133end;
134
135procedure TFormContacts.ListView1SelectItem(Sender: TObject; Item: TListItem;
136 Selected: Boolean);
137begin
138 UpdateInterface;
139end;
140
141procedure TFormContacts.ListViewFilter1Change(Sender: TObject);
142begin
143 ReloadList;
144 UpdateInterface;
145end;
146
147procedure TFormContacts.ListViewSort1ColumnWidthChanged(Sender: TObject);
148begin
149 ListViewFilter1.UpdateFromListView(ListView1);
150end;
151
152function TFormContacts.ListViewSort1CompareItem(Item1, Item2: TObject): Integer;
153begin
154 Result := 0;
155 if Assigned(Item1) and Assigned(Item2) and (ListViewSort1.Order <> soNone) then begin
156 with ListViewSort1 do
157 case Column of
158 0: Result := CompareString(TContact(Item1).Fields[cfFullName], TContact(Item2).Fields[cfFullName]);
159 1: Result := CompareString(TContact(Item1).Fields[cfFirstName], TContact(Item2).Fields[cfFirstName]);
160 2: Result := CompareString(TContact(Item1).Fields[cfMiddleName], TContact(Item2).Fields[cfMiddleName]);
161 3: Result := CompareString(TContact(Item1).Fields[cfLastName], TContact(Item2).Fields[cfLastName]);
162 4: Result := CompareString(TContact(Item1).Fields[cfTel], TContact(Item2).Fields[cfTel]);
163 5: Result := CompareString(TContact(Item1).Fields[cfTelCell], TContact(Item2).Fields[cfTelCell]);
164 6: Result := CompareString(TContact(Item1).Fields[cfTelHome], TContact(Item2).Fields[cfTelHome]);
165 7: Result := CompareString(TContact(Item1).Fields[cfTelWork], TContact(Item2).Fields[cfTelWork]);
166 end;
167 if ListViewSort1.Order = soDown then Result := -Result;
168 end else Result := 0;
169end;
170
171procedure TFormContacts.ListViewSort1Filter(ListViewSort: TListViewSort);
172begin
173 if Assigned(Contacts) then Contacts.AssignToList(ListViewSort1.List)
174 else begin
175 ListViewSort1.List.Clear;
176 end;
177 FilterList(ListViewSort1.List);
178end;
179
180procedure TFormContacts.FilterList(List: TFPGObjectList<TObject>);
181var
182 I: Integer;
183 FoundCount: Integer;
184 EnteredCount: Integer;
185begin
186 EnteredCount := ListViewFilter1.TextEnteredCount;
187 for I := List.Count - 1 downto 0 do begin
188 if List.Items[I] is TContact then begin
189 with TContact(List.Items[I]) do begin
190 with ListViewFilter1 do
191 if Visible and (EnteredCount > 0) then begin
192 FoundCount := 0;
193 if Pos(UTF8LowerCase(StringGrid.Cells[0, 0]),
194 UTF8LowerCase(TContact(List.Items[I]).Fields[cfFullName])) > 0 then Inc(FoundCount);
195 if Pos(UTF8LowerCase(StringGrid.Cells[1, 0]),
196 UTF8LowerCase(TContact(List.Items[I]).Fields[cfFirstName])) > 0 then Inc(FoundCount);
197 if Pos(UTF8LowerCase(StringGrid.Cells[2, 0]),
198 UTF8LowerCase(TContact(List.Items[I]).Fields[cfMiddleName])) > 0 then Inc(FoundCount);
199 if Pos(UTF8LowerCase(StringGrid.Cells[3, 0]),
200 UTF8LowerCase(TContact(List.Items[I]).Fields[cfLastName])) > 0 then Inc(FoundCount);
201 if Pos(UTF8LowerCase(StringGrid.Cells[4, 0]),
202 UTF8LowerCase(TContact(List.Items[I]).Fields[cfTel])) > 0 then Inc(FoundCount);
203 if Pos(UTF8LowerCase(StringGrid.Cells[5, 0]),
204 UTF8LowerCase(TContact(List.Items[I]).Fields[cfTelCell])) > 0 then Inc(FoundCount);
205 if Pos(UTF8LowerCase(StringGrid.Cells[6, 0]),
206 UTF8LowerCase(TContact(List.Items[I]).Fields[cfTelHome])) > 0 then Inc(FoundCount);
207 if Pos(UTF8LowerCase(StringGrid.Cells[7, 0]),
208 UTF8LowerCase(TContact(List.Items[I]).Fields[cfTelWork])) > 0 then Inc(FoundCount);
209 if FoundCount <> EnteredCount then List.Delete(I);
210 end;
211 end;
212 end else
213 if TContact(List.Items[I]) is TContact then begin
214 List.Delete(I);
215 end;
216 end;
217end;
218
219procedure TFormContacts.SetContacts(AValue: TContacts);
220begin
221 if FContacts = AValue then Exit;
222 FContacts := AValue;
223 ReloadList;
224 UpdateInterface;
225 ListViewFilter1.Reset;
226end;
227
228procedure TFormContacts.FormContactPrevious(Sender: TObject);
229var
230 I: Integer;
231begin
232 I := ListViewSort1.List.IndexOf(TFormContact(Sender).Contact);
233 if (I <> -1) and (I > 0) then
234 TFormContact(Sender).Contact := TContact(ListViewSort1.List[I - 1]);
235end;
236
237procedure TFormContacts.FormContactNext(Sender: TObject);
238var
239 I: Integer;
240begin
241 I := ListViewSort1.List.IndexOf(TFormContact(Sender).Contact);
242 if (I <> -1) and (I < ListViewSort1.List.Count - 1) then
243 TFormContact(Sender).Contact := TContact(ListViewSort1.List[I + 1]);
244end;
245
246procedure TFormContacts.DoUpdateInterface;
247var
248 Text: string;
249 SelectedCount: Integer;
250begin
251 AAdd.Enabled := Assigned(Contacts);
252 AModify.Enabled := Assigned(Contacts) and Assigned(ListView1.Selected);
253 ARemove.Enabled := Assigned(Contacts) and Assigned(ListView1.Selected);
254
255 Text := '';
256 if Assigned(Contacts) then begin
257 Text := STotal + ': ' + IntToStr(Contacts.Count);
258 if ListView1.Items.Count < Contacts.Count then
259 Text := Text + ', ' + SFiltered + ': ' + IntToStr(ListView1.Items.Count);
260 SelectedCount := ListView1.SelCount;
261 if SelectedCount > 0 then
262 Text := Text + ', ' + SSelected + ': ' + IntToStr(SelectedCount);
263 end;
264 StatusBar1.Panels[0].Text := Text;
265end;
266
267procedure TFormContacts.FormShow(Sender: TObject);
268begin
269 Core.PersistentForm1.Load(Self);
270 Core.ThemeManager1.UseTheme(Self);
271 Core.Translator.TranslateComponentRecursive(Self);
272 ReloadList;
273 UpdateInterface;
274 ListViewFilter1.UpdateFromListView(ListView1);
275end;
276
277procedure TFormContacts.AAddExecute(Sender: TObject);
278var
279 FormContact: TFormContact;
280 Contact: TContact;
281begin
282 FormContact := TFormContact.Create(nil);
283 try
284 Contact := TContact.Create;
285 try
286 Contact.Parent := Contacts.ContactsFile;
287 FormContact.Contact := Contact;
288 FormContact.OnPrevious := FormContactPrevious;
289 FormContact.OnNext := FormContactNext;
290 if FormContact.ShowModal = mrOK then begin
291 Contacts.Add(Contact);
292 Core.DataFile.Modified := True;
293 ReloadList;
294 UpdateInterface;
295 Contact := nil;
296 end;
297 finally
298 if Assigned(Contact) then
299 Contact.Free;
300 end;
301 finally
302 FormContact.Free;
303 end;
304end;
305
306procedure TFormContacts.ACloneExecute(Sender: TObject);
307var
308 FormContact: TFormContact;
309 Contact: TContact;
310begin
311 FormContact := TFormContact.Create(nil);
312 try
313 Contact := TContact.Create;
314 try
315 Contact.Parent := Contacts.ContactsFile;
316 Contact.Assign(TContact(ListView1.Selected.Data));
317 FormContact.Contact := Contact;
318 FormContact.OnPrevious := FormContactPrevious;
319 FormContact.OnNext := FormContactNext;
320 if FormContact.ShowModal = mrOK then begin
321 Contacts.Add(Contact);
322 Contact := nil;
323 Core.DataFile.Modified := True;
324 ReloadList;
325 UpdateInterface;
326 end;
327 finally
328 if Assigned(Contact) then
329 Contact.Free;
330 end;
331 finally
332 FormContact.Free;
333 end;
334end;
335
336procedure TFormContacts.ALoadFromFileExecute(Sender: TObject);
337var
338 TempFile: TContactsFile;
339begin
340 if Assigned(ListView1.Selected) then begin
341 TempFile := TContactsFile.Create;
342 try
343 OpenDialog1.Filter := TempFile.GetFileFilter;
344 OpenDialog1.DefaultExt := TempFile.GetFileExt;
345 finally
346 TempFile.Free;
347 end;
348 OpenDialog1.InitialDir := ExtractFileDir(Core.LastContactFileName);
349 OpenDialog1.FileName := ExtractFileName(Core.LastContactFileName);
350 if OpenDialog1.Execute then begin
351 TContact(ListView1.Selected.Data).LoadFromFile(OpenDialog1.FileName);
352 Core.LastContactFileName := OpenDialog1.FileName;
353 ReloadList;
354 end;
355 end;
356end;
357
358procedure TFormContacts.AModifyExecute(Sender: TObject);
359var
360 FormContact: TFormContact;
361 Contact: TContact;
362begin
363 FormContact := TFormContact.Create(nil);
364 try
365 Contact := TContact.Create;
366 try
367 Contact.Parent := Contacts.ContactsFile;
368 Contact.Assign(TContact(ListView1.Selected.Data));
369 FormContact.Contact := Contact;
370 FormContact.OnPrevious := FormContactPrevious;
371 FormContact.OnNext := FormContactNext;
372 if FormContact.ShowModal = mrOK then begin
373 TContact(ListView1.Selected.Data).Assign(Contact);
374 Core.DataFile.Modified := True;
375 ReloadList;
376 UpdateInterface;
377 end;
378 finally
379 Contact.Free;
380 end;
381 finally
382 FormContact.Free;
383 end;
384end;
385
386procedure TFormContacts.ARemoveExecute(Sender: TObject);
387var
388 I: Integer;
389begin
390 if Assigned(ListView1.Selected) then
391 if MessageDlg(SRemoveContacts, SRemoveContactsQuery,
392 TMsgDlgType.mtConfirmation, [mbCancel, mbOk], 0) = mrOk then begin
393 for I := ListView1.Items.Count - 1 downto 0 do
394 if ListView1.Items[I].Selected then begin
395 Contacts.Delete(I);
396 end;
397 Core.DataFile.Modified := True;
398 ReloadList;
399 UpdateInterface;
400 end;
401end;
402
403procedure TFormContacts.ASaveToFileExecute(Sender: TObject);
404var
405 TempFile: TContactsFile;
406begin
407 if Assigned(ListView1.Selected) then begin
408 TempFile := TContactsFile.Create;
409 try
410 SaveDialog1.Filter := TempFile.GetFileFilter;
411 SaveDialog1.DefaultExt := TempFile.GetFileExt;
412 finally
413 TempFile.Free;
414 end;
415 SaveDialog1.InitialDir := ExtractFileDir(Core.LastContactFileName);
416 SaveDialog1.FileName := TContact(ListView1.Selected.Data).FullNameToFileName +
417 VCardFileExt;
418 if SaveDialog1.Execute then begin
419 TContact(ListView1.Selected.Data).SaveToFile(SaveDialog1.FileName);
420 Core.LastContactFileName := SaveDialog1.FileName;
421 end;
422 end;
423end;
424
425procedure TFormContacts.ASelectAllExecute(Sender: TObject);
426var
427 I: Integer;
428begin
429 BeginUpdate;
430 ListView1.BeginUpdate;
431 for I := 0 to ListView1.Items.Count - 1 do
432 ListView1.Items[I].Selected := True;
433 //ListView1.SelectAll;
434 ListView1.EndUpdate;
435 EndUpdate;
436end;
437
438procedure TFormContacts.FormClose(Sender: TObject; var CloseAction: TCloseAction
439 );
440begin
441 Core.PersistentForm1.Save(Self);
442end;
443
444procedure TFormContacts.FormCreate(Sender: TObject);
445var
446 I: Integer;
447begin
448 FContacts := nil;
449 for I := 0 to ToolBar1.ButtonCount - 1 do begin
450 ToolBar1.Buttons[I].ShowHint := True;
451 ToolBar1.Buttons[I].Hint := ToolBar1.Buttons[I].Caption;
452 end;
453end;
454
455procedure TFormContacts.ReloadList;
456begin
457 ListViewSort1.Refresh;
458end;
459
460procedure TFormContacts.BeginUpdate;
461begin
462 Inc(FUpdateCount);
463end;
464
465procedure TFormContacts.EndUpdate;
466begin
467 if FUpdateCount <= 0 then raise Exception(SEndUpdateTooLow);
468 Dec(FUpdateCount);
469 if FUpdateCount = 0 then DoUpdateInterface;
470end;
471
472procedure TFormContacts.UpdateInterface;
473begin
474 if FUpdateCount = 0 then DoUpdateInterface;
475 ALoadFromFile.Enabled := Assigned(ListView1.Selected);
476 ASaveToFile.Enabled := Assigned(ListView1.Selected);
477 AModify.Enabled := Assigned(ListView1.Selected);
478 AClone.Enabled := Assigned(ListView1.Selected);
479 ARemove.Enabled := Assigned(ListView1.Selected);
480 ASelectAll.Enabled := ListView1.Items.Count > 0;
481end;
482
483end.
484
Note: See TracBrowser for help on using the repository browser.