source: tags/1.4.0/Forms/UFormFindDuplicity.pas

Last change on this file was 134, checked in by chronos, 3 years ago
  • Modified: UDataFile unit moved into Common package and TDataFile class made TComponent descendant.
File size: 6.8 KB
Line 
1unit UFormFindDuplicity;
2
3interface
4
5uses
6 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
7 ExtCtrls, StdCtrls, ActnList, Menus, UVCard, Generics.Collections,
8 Generics.Defaults;
9
10type
11
12 { TFoundItem }
13
14 TFoundItem = class
15 Field: string;
16 Contacts: TContacts;
17 constructor Create;
18 destructor Destroy; override;
19 end;
20
21 { TFoundItems }
22
23 TFoundItems = class(TObjectList<TFoundItem>)
24 function SearchByField(Field: string): TFoundItem;
25 end;
26
27 { TFormFindDuplicity }
28
29 TFormFindDuplicity = class(TForm)
30 AShowContacts: TAction;
31 ActionList1: TActionList;
32 ButtonMerge: TButton;
33 ComboBoxField: TComboBox;
34 Label1: TLabel;
35 ListView1: TListView;
36 MenuItem1: TMenuItem;
37 Panel1: TPanel;
38 PopupMenu1: TPopupMenu;
39 procedure AShowContactsExecute(Sender: TObject);
40 procedure ButtonMergeClick(Sender: TObject);
41 procedure ComboBoxFieldChange(Sender: TObject);
42 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
43 procedure FormCreate(Sender: TObject);
44 procedure FormDestroy(Sender: TObject);
45 procedure FormShow(Sender: TObject);
46 procedure ListView1Data(Sender: TObject; Item: TListItem);
47 private
48 FContacts: TContacts;
49 procedure SetContacts(AValue: TContacts);
50 public
51 FoundItems: TFoundItems;
52 ContactFieldIndex: TContactFieldIndex;
53 procedure Find;
54 procedure ReloadList;
55 property Contacts: TContacts read FContacts write SetContacts;
56 end;
57
58var
59 FormFindDuplicity: TFormFindDuplicity;
60
61
62implementation
63
64{$R *.lfm}
65
66uses
67 UCore, UFormContacts, UVCardFile;
68
69{ TFoundItems }
70
71function TFoundItems.SearchByField(Field: string): TFoundItem;
72var
73 Item: TFoundItem;
74begin
75 Result := nil;
76 for Item in Self do
77 if Item.Field = Field then begin
78 Result := Item;
79 Break;
80 end;
81end;
82
83{ TFoundItem }
84
85constructor TFoundItem.Create;
86begin
87 Contacts := TContacts.Create(False);
88end;
89
90destructor TFoundItem.Destroy;
91begin
92 FreeAndNil(Contacts);
93 inherited;
94end;
95
96{ TFormFindDuplicity }
97
98procedure TFormFindDuplicity.ListView1Data(Sender: TObject; Item: TListItem);
99begin
100 if Item.Index < FoundItems.Count then
101 with TFoundItem(FoundItems[Item.Index]) do begin
102 Item.Caption := Field;
103 Item.Data := FoundItems[Item.Index];
104 Item.SubItems.Add(Contacts.ToString);
105 Item.SubItems.Add(IntToStr(Contacts.Count));
106 end;
107end;
108
109procedure TFormFindDuplicity.SetContacts(AValue: TContacts);
110var
111 ContactField: TContactField;
112 Items: TStringList;
113 I: Integer;
114begin
115 if FContacts = AValue then Exit;
116 FContacts := AValue;
117 if Assigned(FContacts) then begin
118 Items := TStringList.Create;
119 try
120 TContact.GetFields.LoadToStrings(Items);
121
122 // Remove fields which are not used in contacts
123 for I := Items.Count - 1 downto 0 do
124 if Contacts.CountByField(TContactField(Items.Objects[I]).Index) = 0 then
125 Items.Delete(I);
126
127 ComboBoxField.Items.Assign(Items);
128 finally
129 Items.Free;
130 end;
131 ContactField := TContact.GetFields.GetByIndex(ContactFieldIndex);
132 ComboBoxField.ItemIndex := ComboBoxField.Items.IndexOfObject(ContactField);
133 if (ComboBoxField.Items.Count > 0) and (ComboBoxField.ItemIndex = -1) then
134 ComboBoxField.ItemIndex := 0;
135 end else ComboBoxField.Clear;
136end;
137
138function FoundItemsSort(constref Item1, Item2: TFoundItem): Integer;
139begin
140 if Item1.Contacts.Count < Item2.Contacts.Count then Result := 1
141 else if Item1.Contacts.Count > Item2.Contacts.Count then Result := -1
142 else Result := 0;
143end;
144
145procedure TFormFindDuplicity.Find;
146var
147 I: Integer;
148 Item: TFoundItem;
149 FieldName: string;
150begin
151 FoundItems.Clear;
152 for I := 0 to Contacts.Count - 1 do begin
153 FieldName := Contacts[I].Fields[ContactFieldIndex];
154 if FieldName <> '' then begin
155 Item := FoundItems.SearchByField(FieldName);
156 if not Assigned(Item) then begin
157 Item := TFoundItem.Create;
158 Item.Field := FieldName;
159 FoundItems.Add(Item);
160 end;
161 Item.Contacts.Add(Contacts[I]);
162 end;
163 end;
164 FoundItems.Sort(TComparer<TFoundItem>.Construct(FoundItemsSort));
165 ReloadList;
166end;
167
168procedure TFormFindDuplicity.FormCreate(Sender: TObject);
169begin
170 Core.Translator.TranslateComponentRecursive(Self);
171 Core.ThemeManager1.UseTheme(Self);
172
173 FoundItems := TFoundItems.Create;
174 ContactFieldIndex := cfFullName;
175end;
176
177procedure TFormFindDuplicity.ComboBoxFieldChange(Sender: TObject);
178begin
179 if ComboBoxField.ItemIndex <> -1 then
180 ContactFieldIndex := TContactField(ComboBoxField.Items.Objects[ComboBoxField.ItemIndex]).Index
181 else ContactFieldIndex := cfTelCell;
182 Find;
183end;
184
185procedure TFormFindDuplicity.AShowContactsExecute(Sender: TObject);
186var
187 Form: TFormContacts;
188 I: Integer;
189begin
190 if Assigned(ListView1.Selected) then begin
191 Form := TFormContacts.Create(nil);
192 Form.Contacts := TContacts.Create(False);
193 Form.Contacts.ParentVCard := Contacts.ParentVCard;
194 with TFoundItem(ListView1.Selected.Data) do
195 for I := 0 to Contacts.Count - 1 do
196 Form.Contacts.Add(Contacts[I]);
197 Form.ShowModal;
198 with TFoundItem(ListView1.Selected.Data) do begin
199 // Remove all deleted
200 for I := 0 to Contacts.Count - 1 do
201 if Form.Contacts.IndexOf(Contacts[I]) = -1 then begin
202 Form.Contacts.Remove(Contacts[I]);
203 Self.Contacts.Remove(Contacts[I]);
204 Self.Contacts.ParentVCard.Modified := True;
205 end;
206
207 // Add newly added
208 for I := 0 to Form.Contacts.Count - 1 do
209 if Contacts.IndexOf(Form.Contacts[I]) = -1 then begin
210 Form.Contacts.Add(Form.Contacts[I]);
211 Self.Contacts.Add(Form.Contacts[I]);
212 Self.Contacts.ParentVCard.Modified := True;
213 end;
214 end;
215 Form.Contacts.Free;
216 Form.Free;
217 Find;
218 end;
219end;
220
221procedure TFormFindDuplicity.ButtonMergeClick(Sender: TObject);
222var
223 TempContacts: TVCardFile;
224 I: Integer;
225begin
226 TempContacts := TVCardFile.Create(nil);
227 try
228 for I := 0 to Contacts.Count - 1 do
229 TempContacts.VCard.Contacts.Merge(Contacts[I], TContactField(ComboBoxField.Items.Objects[ComboBoxField.ItemIndex]).Index);
230 Contacts.Assign(TempContacts.VCard.Contacts);
231 Find;
232 finally
233 TempContacts.Free;
234 end;
235end;
236
237procedure TFormFindDuplicity.FormClose(Sender: TObject;
238 var CloseAction: TCloseAction);
239begin
240 Core.PersistentForm1.Save(Self);
241end;
242
243procedure TFormFindDuplicity.FormDestroy(Sender: TObject);
244begin
245 FreeAndNil(FoundItems);
246end;
247
248procedure TFormFindDuplicity.FormShow(Sender: TObject);
249begin
250 Core.PersistentForm1.Load(Self);
251 Find;
252end;
253
254procedure TFormFindDuplicity.ReloadList;
255begin
256 ListView1.Items.Count := FoundItems.Count;
257 ListView1.Refresh;
258end;
259
260end.
261
Note: See TracBrowser for help on using the repository browser.