source: tags/1.2.0/Forms/UFormContacts.pas

Last change on this file was 77, checked in by chronos, 4 years ago
  • Modified: More preparation for future Previous and Next buttons in Contact window.
File size: 17.2 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, Clipbrd;
10
11type
12
13 { TFormContacts }
14
15 TFormContacts = class(TForm)
16 AAdd: TAction;
17 AClone: TAction;
18 ACopy: TAction;
19 ACut: TAction;
20 APaste: TAction;
21 ALoadFromFile: TAction;
22 ASaveToFile: TAction;
23 ASelectAll: TAction;
24 ARemove: TAction;
25 AModify: TAction;
26 ActionList1: TActionList;
27 ListView1: TListView;
28 ListViewFilter1: TListViewFilter;
29 ListViewSort1: TListViewSort;
30 MenuItem1: TMenuItem;
31 MenuItem10: TMenuItem;
32 MenuItem11: TMenuItem;
33 MenuItem12: TMenuItem;
34 MenuItem2: TMenuItem;
35 MenuItem3: TMenuItem;
36 MenuItem4: TMenuItem;
37 MenuItem5: TMenuItem;
38 MenuItem6: TMenuItem;
39 MenuItem7: TMenuItem;
40 MenuItem8: TMenuItem;
41 MenuItem9: TMenuItem;
42 OpenDialog1: TOpenDialog;
43 PopupMenuContact: TPopupMenu;
44 SaveDialog1: TSaveDialog;
45 StatusBar1: TStatusBar;
46 ToolBar1: TToolBar;
47 ToolButton1: TToolButton;
48 ToolButton2: TToolButton;
49 ToolButton3: TToolButton;
50 ToolButton4: TToolButton;
51 ToolButton5: TToolButton;
52 ToolButton6: TToolButton;
53 ToolButton7: TToolButton;
54 procedure AAddExecute(Sender: TObject);
55 procedure ACloneExecute(Sender: TObject);
56 procedure ACopyExecute(Sender: TObject);
57 procedure ACutExecute(Sender: TObject);
58 procedure ALoadFromFileExecute(Sender: TObject);
59 procedure AModifyExecute(Sender: TObject);
60 procedure APasteExecute(Sender: TObject);
61 procedure ARemoveExecute(Sender: TObject);
62 procedure ASaveToFileExecute(Sender: TObject);
63 procedure ASelectAllExecute(Sender: TObject);
64 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
65 procedure FormCreate(Sender: TObject);
66 procedure FormDestroy(Sender: TObject);
67 procedure FormResize(Sender: TObject);
68 procedure FormShow(Sender: TObject);
69 procedure ListView1Data(Sender: TObject; Item: TListItem);
70 procedure ListView1DblClick(Sender: TObject);
71 procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
72 Selected: Boolean);
73 procedure ListViewFilter1Change(Sender: TObject);
74 procedure ListViewSort1ColumnWidthChanged(Sender: TObject);
75 function ListViewSort1CompareItem(Item1, Item2: TObject): Integer;
76 procedure ListViewSort1Filter(ListViewSort: TListViewSort);
77 private
78 FContacts: TContacts;
79 FUpdateCount: Integer;
80 procedure FilterList(List: TFPGObjectList<TObject>);
81 procedure SetContacts(AValue: TContacts);
82 function GetPreviousContact(Contact: TContact): TContact;
83 function GetNextContact(Contact: TContact): TContact;
84 procedure DoUpdateInterface;
85 procedure UpdateColumns;
86 public
87 ListViewColumns: TContactFieldIndexes;
88 FilterItems: TContactFilterItems;
89 property Contacts: TContacts read FContacts write SetContacts;
90 procedure ReloadList;
91 procedure BeginUpdate;
92 procedure EndUpdate;
93 procedure UpdateInterface;
94 end;
95
96var
97 FormContacts: TFormContacts;
98
99
100implementation
101
102{$R *.lfm}
103
104uses
105 UFormContact, UCore;
106
107resourcestring
108 SRemoveContacts = 'Remove contacts';
109 SRemoveContactsQuery = 'Do you want to remove selected contacts?';
110 STotal = 'Total';
111 SFiltered = 'Filtered';
112 SSelected = 'Selected';
113 SEndUpdateTooLow = 'Update counter error';
114
115{ TFormContacts }
116
117procedure TFormContacts.ListView1Data(Sender: TObject; Item: TListItem);
118
119 procedure AddItem(Text: string; IsCaption: Boolean = False);
120 begin
121 if IsCaption then begin
122 if Text <> '' then Item.Caption := Text
123 else Item.Caption := ' ';
124 end else begin
125 if Text <> '' then Item.SubItems.Add(Text)
126 else Item.SubItems.Add(' ');
127 end;
128 end;
129
130var
131 I: Integer;
132begin
133 if Item.Index < ListViewSort1.List.Count then
134 with TContact(ListViewSort1.List[Item.Index]) do begin
135 for I := 0 to ListViewColumns.Count - 1 do begin
136 AddItem(Fields[ListViewColumns[I]], I = 0);
137 end;
138 Item.Data := ListViewSort1.List[Item.Index];
139 end;
140end;
141
142procedure TFormContacts.ListView1DblClick(Sender: TObject);
143begin
144 AModify.Execute;
145end;
146
147procedure TFormContacts.ListView1SelectItem(Sender: TObject; Item: TListItem;
148 Selected: Boolean);
149begin
150 UpdateInterface;
151end;
152
153procedure TFormContacts.ListViewFilter1Change(Sender: TObject);
154var
155 I: Integer;
156begin
157 // Load filter StringGrid cells into filter
158 FilterItems.Clear;
159 for I := 0 to ListViewColumns.Count - 1 do
160 if I < ListViewFilter1.StringGrid.ColCount then
161 if ListViewFilter1.StringGrid.Cells[I, 0] <> '' then
162 FilterItems.AddNew(ListViewColumns[I], ListViewFilter1.StringGrid.Cells[I, 0]);
163
164 ReloadList;
165 UpdateInterface;
166end;
167
168procedure TFormContacts.ListViewSort1ColumnWidthChanged(Sender: TObject);
169begin
170 ListViewFilter1.UpdateFromListView(ListView1);
171end;
172
173function TFormContacts.ListViewSort1CompareItem(Item1, Item2: TObject): Integer;
174begin
175 Result := 0;
176 if Assigned(Item1) and Assigned(Item2) and (ListViewSort1.Order <> soNone) then begin
177 with ListViewSort1 do
178 Result := CompareString(TContact(Item1).Fields[ListViewColumns[Column]], TContact(Item2).Fields[ListViewColumns[Column]]);
179 if ListViewSort1.Order = soDown then Result := -Result;
180 end else Result := 0;
181end;
182
183procedure TFormContacts.ListViewSort1Filter(ListViewSort: TListViewSort);
184begin
185 if Assigned(Contacts) then Contacts.AssignToList(ListViewSort1.List)
186 else begin
187 ListViewSort1.List.Clear;
188 end;
189 FilterList(ListViewSort1.List);
190end;
191
192procedure TFormContacts.FilterList(List: TFPGObjectList<TObject>);
193var
194 I: Integer;
195 J: Integer;
196 K: Integer;
197 FoundCount: Integer;
198begin
199 for I := List.Count - 1 downto 0 do begin
200 if List.Items[I] is TContact then begin
201 with TContact(List.Items[I]) do begin
202 FoundCount := 0;
203 for J := 0 to FilterItems.Count - 1 do begin
204 if FilterItems[J].FieldIndex = cfNone then begin
205 for K := 0 to TContact(List.Items[I]).Parent.Fields.Count - 1 do begin
206 if Pos(UTF8LowerCase(FilterItems[J].Value),
207 UTF8LowerCase(TContact(List.Items[I]).Fields[TContact(List.Items[I]).Parent.Fields[K].Index])) > 0 then begin
208 Inc(FoundCount);
209 Break;
210 end;
211 end;
212 end else begin
213 if Pos(UTF8LowerCase(FilterItems[J].Value),
214 UTF8LowerCase(TContact(List.Items[I]).Fields[FilterItems[J].FieldIndex])) > 0 then
215 Inc(FoundCount);
216 end;
217 end;
218 if FoundCount <> FilterItems.Count then List.Delete(I);
219 end;
220 end else
221 if TContact(List.Items[I]) is TContact then begin
222 List.Delete(I);
223 end;
224 end;
225end;
226
227procedure TFormContacts.SetContacts(AValue: TContacts);
228begin
229 if FContacts = AValue then Exit;
230 FContacts := AValue;
231 ReloadList;
232 UpdateInterface;
233 ListViewFilter1.Reset;
234end;
235
236function TFormContacts.GetPreviousContact(Contact: TContact): TContact;
237var
238 I: Integer;
239begin
240 I := ListViewSort1.List.IndexOf(Contact);
241 if (I <> -1) and (I > 0) then
242 Result := TContact(ListViewSort1.List[I - 1])
243 else Result := nil;
244end;
245
246function TFormContacts.GetNextContact(Contact: TContact): TContact;
247var
248 I: Integer;
249begin
250 I := ListViewSort1.List.IndexOf(Contact);
251 if (I <> -1) and (I < ListViewSort1.List.Count - 1) then
252 Result := TContact(ListViewSort1.List[I + 1])
253 else Result := nil;
254end;
255
256procedure TFormContacts.DoUpdateInterface;
257var
258 Text: string;
259 SelectedCount: Integer;
260begin
261 AAdd.Enabled := Assigned(Contacts);
262 AModify.Enabled := Assigned(Contacts) and Assigned(ListView1.Selected);
263 ARemove.Enabled := Assigned(Contacts) and Assigned(ListView1.Selected);
264
265 Text := '';
266 if Assigned(Contacts) then begin
267 Text := STotal + ': ' + IntToStr(Contacts.Count);
268 if ListView1.Items.Count < Contacts.Count then
269 Text := Text + ', ' + SFiltered + ': ' + IntToStr(ListView1.Items.Count);
270 SelectedCount := ListView1.SelCount;
271 if SelectedCount > 0 then
272 Text := Text + ', ' + SSelected + ': ' + IntToStr(SelectedCount);
273 end;
274 StatusBar1.Panels[0].Text := Text;
275end;
276
277procedure TFormContacts.UpdateColumns;
278var
279 I: Integer;
280 Field: TContactField;
281begin
282 while ListView1.Columns.Count < ListViewColumns.Count do
283 ListView1.Columns.Add;
284 while ListView1.Columns.Count > ListViewColumns.Count do
285 ListView1.Columns.Delete(ListView1.Columns.Count - 1);
286 for I := 0 to ListView1.Columns.Count - 1 do begin
287 if Assigned(Contacts) and Assigned(Contacts.ContactsFile) then begin
288 Field := Contacts.ContactsFile.Fields.GetByIndex(ListViewColumns[I]);
289 if Assigned(Field) then
290 ListView1.Columns[I].Caption := Field.Title;
291 end;
292 end;
293end;
294
295procedure TFormContacts.FormShow(Sender: TObject);
296begin
297 Core.PersistentForm1.Load(Self);
298 Core.ThemeManager1.UseTheme(Self);
299 Core.Translator.TranslateComponentRecursive(Self);
300 ReloadList;
301 UpdateInterface;
302 ListViewFilter1.UpdateFromListView(ListView1);
303end;
304
305procedure TFormContacts.AAddExecute(Sender: TObject);
306var
307 FormContact: TFormContact;
308 Contact: TContact;
309begin
310 FormContact := TFormContact.Create(nil);
311 try
312 Contact := TContact.Create;
313 try
314 Contact.Parent := Contacts.ContactsFile;
315 FormContact.Contact := Contact;
316 FormContact.OnGetPrevious := GetPreviousContact;
317 FormContact.OnGetNext := GetNextContact;
318 if FormContact.ShowModal = mrOK then begin
319 Contacts.Add(Contact);
320 Core.DataFile.Modified := True;
321 ReloadList;
322 UpdateInterface;
323 Contact := nil;
324 end;
325 finally
326 if Assigned(Contact) then
327 Contact.Free;
328 end;
329 finally
330 FormContact.Free;
331 end;
332end;
333
334procedure TFormContacts.ACloneExecute(Sender: TObject);
335var
336 FormContact: TFormContact;
337 Contact: TContact;
338begin
339 FormContact := TFormContact.Create(nil);
340 try
341 Contact := TContact.Create;
342 try
343 Contact.Parent := Contacts.ContactsFile;
344 Contact.Assign(TContact(ListView1.Selected.Data));
345 FormContact.Contact := Contact;
346 FormContact.OnGetPrevious := GetPreviousContact;
347 FormContact.OnGetNext := GetNextContact;
348 if FormContact.ShowModal = mrOK then begin
349 Contacts.Add(Contact);
350 Contact := nil;
351 Core.DataFile.Modified := True;
352 ReloadList;
353 UpdateInterface;
354 end;
355 finally
356 if Assigned(Contact) then
357 Contact.Free;
358 end;
359 finally
360 FormContact.Free;
361 end;
362end;
363
364procedure TFormContacts.ACopyExecute(Sender: TObject);
365var
366 Text: string;
367 Strings: TStringList;
368 I: Integer;
369begin
370 Strings := TStringList.Create;
371 try
372 Text := '';
373 for I := 0 to ListView1.Items.Count - 1 do
374 if ListView1.Items[I].Selected then begin
375 Strings.Clear;
376 TContact(ListView1.Items[I].Data).SaveToStrings(Strings);
377 Text := Text + Strings.Text;
378 end;
379 Clipboard.AsText := Text;
380 finally
381 Strings.Free;
382 end;
383end;
384
385procedure TFormContacts.ACutExecute(Sender: TObject);
386var
387 Text: string;
388 Strings: TStringList;
389 I: Integer;
390begin
391 Strings := TStringList.Create;
392 try
393 Text := '';
394 for I := 0 to ListView1.Items.Count - 1 do
395 if ListView1.Items[I].Selected then begin
396 Strings.Clear;
397 TContact(ListView1.Items[I].Data).SaveToStrings(Strings);
398 Text := Text + Strings.Text;
399 end;
400 Clipboard.AsText := Text;
401 for I := 0 to ListView1.Items.Count - 1 do
402 if ListView1.Items[I].Selected then begin
403 Contacts.Delete(Contacts.IndexOf(ListView1.Items[I].Data));
404 end;
405 ReloadList;
406 ListView1.ClearSelection;
407 UpdateInterface;
408 finally
409 Strings.Free;
410 end;
411end;
412
413procedure TFormContacts.ALoadFromFileExecute(Sender: TObject);
414var
415 TempFile: TContactsFile;
416begin
417 if Assigned(ListView1.Selected) then begin
418 TempFile := TContactsFile.Create;
419 try
420 OpenDialog1.Filter := TempFile.GetFileFilter;
421 OpenDialog1.DefaultExt := TempFile.GetFileExt;
422 finally
423 TempFile.Free;
424 end;
425 OpenDialog1.InitialDir := ExtractFileDir(Core.LastContactFileName);
426 OpenDialog1.FileName := ExtractFileName(Core.LastContactFileName);
427 if OpenDialog1.Execute then begin
428 TContact(ListView1.Selected.Data).LoadFromFile(OpenDialog1.FileName);
429 Core.LastContactFileName := OpenDialog1.FileName;
430 ReloadList;
431 end;
432 end;
433end;
434
435procedure TFormContacts.AModifyExecute(Sender: TObject);
436var
437 FormContact: TFormContact;
438 Contact: TContact;
439begin
440 FormContact := TFormContact.Create(nil);
441 try
442 Contact := TContact.Create;
443 try
444 Contact.Parent := Contacts.ContactsFile;
445 Contact.Assign(TContact(ListView1.Selected.Data));
446 FormContact.Contact := Contact;
447 FormContact.OnGetPrevious := GetPreviousContact;
448 FormContact.OnGetNext := GetNextContact;
449 if FormContact.ShowModal = mrOK then begin
450 TContact(ListView1.Selected.Data).Assign(Contact);
451 Core.DataFile.Modified := True;
452 ReloadList;
453 UpdateInterface;
454 end;
455 finally
456 Contact.Free;
457 end;
458 finally
459 FormContact.Free;
460 end;
461end;
462
463procedure TFormContacts.APasteExecute(Sender: TObject);
464var
465 PasteContacts: TContactsFile;
466 Lines: TStringList;
467begin
468 PasteContacts := TContactsFile.Create;
469 Lines := TStringList.Create;
470 try
471 Lines.Text := Clipboard.AsText;
472 PasteContacts.LoadFromStrings(Lines);
473 if PasteContacts.Contacts.Count > 0 then begin
474 if Assigned(ListView1.Selected) then begin
475 Contacts.InsertContacts(Contacts.IndexOf(ListView1.Selected.Data),
476 PasteContacts.Contacts);
477 end else Contacts.AddContacts(PasteContacts.Contacts);
478 Core.DataFile.Modified := True;
479 ReloadList;
480 UpdateInterface;
481 end;
482 finally
483 Lines.Free;
484 PasteContacts.Free;
485 end;
486end;
487
488procedure TFormContacts.ARemoveExecute(Sender: TObject);
489var
490 I: Integer;
491begin
492 if Assigned(ListView1.Selected) then
493 if MessageDlg(SRemoveContacts, SRemoveContactsQuery,
494 TMsgDlgType.mtConfirmation, [mbCancel, mbOk], 0) = mrOk then begin
495 for I := ListView1.Items.Count - 1 downto 0 do
496 if ListView1.Items[I].Selected then begin
497 Contacts.Delete(Contacts.IndexOf(ListView1.Items[I].Data));
498 end;
499 Core.DataFile.Modified := True;
500 ReloadList;
501 UpdateInterface;
502 end;
503end;
504
505procedure TFormContacts.ASaveToFileExecute(Sender: TObject);
506var
507 TempFile: TContactsFile;
508begin
509 if Assigned(ListView1.Selected) then begin
510 TempFile := TContactsFile.Create;
511 try
512 SaveDialog1.Filter := TempFile.GetFileFilter;
513 SaveDialog1.DefaultExt := TempFile.GetFileExt;
514 finally
515 TempFile.Free;
516 end;
517 SaveDialog1.InitialDir := ExtractFileDir(Core.LastContactFileName);
518 SaveDialog1.FileName := TContact(ListView1.Selected.Data).FullNameToFileName +
519 VCardFileExt;
520 if SaveDialog1.Execute then begin
521 TContact(ListView1.Selected.Data).SaveToFile(SaveDialog1.FileName);
522 Core.LastContactFileName := SaveDialog1.FileName;
523 end;
524 end;
525end;
526
527procedure TFormContacts.ASelectAllExecute(Sender: TObject);
528var
529 I: Integer;
530begin
531 BeginUpdate;
532 try
533 ListView1.BeginUpdate;
534 try
535 for I := 0 to ListView1.Items.Count - 1 do
536 ListView1.Items[I].Selected := True;
537 //ListView1.SelectAll;
538 finally
539 ListView1.EndUpdate;
540 end;
541 finally
542 EndUpdate;
543 end;
544end;
545
546procedure TFormContacts.FormClose(Sender: TObject; var CloseAction: TCloseAction
547 );
548begin
549 Core.PersistentForm1.Save(Self);
550end;
551
552procedure TFormContacts.FormCreate(Sender: TObject);
553var
554 I: Integer;
555begin
556 FilterItems := TContactFilterItems.Create;
557
558 ListViewColumns := TContactFieldIndexes.Create;
559 ListViewColumns.Add(cfFullName);
560 ListViewColumns.Add(cfFirstName);
561 ListViewColumns.Add(cfMiddleName);
562 ListViewColumns.Add(cfLastName);
563 ListViewColumns.Add(cfTel);
564 ListViewColumns.Add(cfTelCell);
565 ListViewColumns.Add(cfTelHome);
566 ListViewColumns.Add(cfTelWork);
567 ListViewColumns.Add(cfEmailWork);
568
569 FContacts := nil;
570 for I := 0 to ToolBar1.ButtonCount - 1 do begin
571 ToolBar1.Buttons[I].ShowHint := True;
572 ToolBar1.Buttons[I].Hint := ToolBar1.Buttons[I].Caption;
573 end;
574end;
575
576procedure TFormContacts.FormDestroy(Sender: TObject);
577begin
578 FreeAndNil(ListViewColumns);
579 FreeAndNil(FilterItems);
580end;
581
582procedure TFormContacts.FormResize(Sender: TObject);
583begin
584 ListViewFilter1.UpdateFromListView(ListView1);
585end;
586
587procedure TFormContacts.ReloadList;
588begin
589 ListViewSort1.Refresh;
590end;
591
592procedure TFormContacts.BeginUpdate;
593begin
594 Inc(FUpdateCount);
595end;
596
597procedure TFormContacts.EndUpdate;
598begin
599 if FUpdateCount <= 0 then raise Exception(SEndUpdateTooLow);
600 Dec(FUpdateCount);
601 if FUpdateCount = 0 then DoUpdateInterface;
602end;
603
604procedure TFormContacts.UpdateInterface;
605begin
606 if FUpdateCount = 0 then DoUpdateInterface;
607 AAdd.Enabled := Assigned(Contacts);
608 AModify.Enabled := Assigned(Contacts) and Assigned(ListView1.Selected);
609 AClone.Enabled := Assigned(Contacts) and Assigned(ListView1.Selected);
610 ARemove.Enabled := Assigned(Contacts) and Assigned(ListView1.Selected);
611 ASelectAll.Enabled := ListView1.Items.Count > 0;
612 ALoadFromFile.Enabled := Assigned(Contacts) and Assigned(ListView1.Selected);
613 ASaveToFile.Enabled := Assigned(Contacts) and Assigned(ListView1.Selected);
614 ACopy.Enabled := Assigned(Contacts) and Assigned(ListView1.Selected);
615 ACut.Enabled := Assigned(Contacts) and Assigned(ListView1.Selected);
616 APaste.Enabled := Assigned(Contacts) and (Clipboard.AsText <> '');
617
618 UpdateColumns;
619end;
620
621end.
622
Note: See TracBrowser for help on using the repository browser.