source: tags/1.2.0/Forms/UFormFindDuplicity.pas

Last change on this file was 73, checked in by chronos, 3 years ago
  • Added: Copy, cut and paste context menu action in contacts list.
  • Modified: Merge multiple files action replaced by Combine action. During Combine action files are simply added into final contacts list even with duplicate contacts.
  • Modified: Added Merge button into Find duplicate window to merge contacts by selected contact field.
  • Modified: Show only used contact fields in Find duplicates window.
  • Fixed: Wrong items were removed if contacts and properties lists were in filtered state.
File size: 6.8 KB
Line 
1unit UFormFindDuplicity;
2
3{$mode delphi}
4
5interface
6
7uses
8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
9 ExtCtrls, StdCtrls, ActnList, Menus, fgl, UContact;
10
11type
12
13 { TFoundItem }
14
15 TFoundItem = class
16 Field: string;
17 Contacts: TContacts;
18 constructor Create;
19 destructor Destroy; override;
20 end;
21
22 { TFoundItems }
23
24 TFoundItems = class(TFPGObjectList<TFoundItem>)
25 function SearchByField(Field: string): TFoundItem;
26 end;
27
28 { TFormFindDuplicity }
29
30 TFormFindDuplicity = class(TForm)
31 AShowContacts: TAction;
32 ActionList1: TActionList;
33 ButtonMerge: TButton;
34 ComboBoxField: TComboBox;
35 Label1: TLabel;
36 ListView1: TListView;
37 MenuItem1: TMenuItem;
38 Panel1: TPanel;
39 PopupMenu1: TPopupMenu;
40 procedure AShowContactsExecute(Sender: TObject);
41 procedure ButtonMergeClick(Sender: TObject);
42 procedure ComboBoxFieldChange(Sender: TObject);
43 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
44 procedure FormCreate(Sender: TObject);
45 procedure FormDestroy(Sender: TObject);
46 procedure FormShow(Sender: TObject);
47 procedure ListView1Data(Sender: TObject; Item: TListItem);
48 private
49 FContacts: TContacts;
50 procedure SetContacts(AValue: TContacts);
51 public
52 FoundItems: TFoundItems;
53 ContactFieldIndex: TContactFieldIndex;
54 procedure Find;
55 procedure ReloadList;
56 property Contacts: TContacts read FContacts write SetContacts;
57 end;
58
59var
60 FormFindDuplicity: TFormFindDuplicity;
61
62
63implementation
64
65{$R *.lfm}
66
67uses
68 UCore, UFormContacts;
69
70{ TFoundItems }
71
72function TFoundItems.SearchByField(Field: string): TFoundItem;
73var
74 Item: TFoundItem;
75begin
76 Result := nil;
77 for Item in Self do
78 if Item.Field = Field then begin
79 Result := Item;
80 Break;
81 end;
82end;
83
84{ TFoundItem }
85
86constructor TFoundItem.Create;
87begin
88 Contacts := TContacts.Create(False);
89end;
90
91destructor TFoundItem.Destroy;
92begin
93 FreeAndNil(Contacts);
94 inherited;
95end;
96
97{ TFormFindDuplicity }
98
99procedure TFormFindDuplicity.ListView1Data(Sender: TObject; Item: TListItem);
100begin
101 if Item.Index < FoundItems.Count then
102 with TFoundItem(FoundItems[Item.Index]) do begin
103 Item.Caption := Field;
104 Item.Data := FoundItems[Item.Index];
105 Item.SubItems.Add(Contacts.ToString);
106 Item.SubItems.Add(IntToStr(Contacts.Count));
107 end;
108end;
109
110procedure TFormFindDuplicity.SetContacts(AValue: TContacts);
111var
112 ContactField: TContactField;
113 Items: TStringList;
114 I: Integer;
115begin
116 if FContacts = AValue then Exit;
117 FContacts := AValue;
118 if Assigned(FContacts) then begin
119 Items := TStringList.Create;
120 try
121 Contacts.ContactsFile.Fields.LoadToStrings(Items);
122
123 // Remove fields which are not used in contacts
124 for I := Items.Count - 1 downto 0 do
125 if Contacts.CountByField(TContactField(Items.Objects[I]).Index) = 0 then
126 Items.Delete(I);
127
128 ComboBoxField.Items.Assign(Items);
129 finally
130 Items.Free;
131 end;
132 ContactField := Contacts.ContactsFile.Fields.GetByIndex(ContactFieldIndex);
133 ComboBoxField.ItemIndex := ComboBoxField.Items.IndexOfObject(ContactField);
134 if (ComboBoxField.Items.Count > 0) and (ComboBoxField.ItemIndex = -1) then
135 ComboBoxField.ItemIndex := 0;
136 end else ComboBoxField.Clear;
137end;
138
139function FoundItemsSort(const Item1, Item2: TFoundItem): Integer;
140begin
141 if Item1.Contacts.Count < Item2.Contacts.Count then Result := 1
142 else if Item1.Contacts.Count > Item2.Contacts.Count then Result := -1
143 else Result := 0;
144end;
145
146procedure TFormFindDuplicity.Find;
147var
148 I: Integer;
149 Item: TFoundItem;
150 FieldName: string;
151begin
152 FoundItems.Clear;
153 for I := 0 to Contacts.Count - 1 do begin
154 FieldName := Contacts[I].Fields[ContactFieldIndex];
155 if FieldName <> '' then begin
156 Item := FoundItems.SearchByField(FieldName);
157 if not Assigned(Item) then begin
158 Item := TFoundItem.Create;
159 Item.Field := FieldName;
160 FoundItems.Add(Item);
161 end;
162 Item.Contacts.Add(Contacts[I]);
163 end;
164 end;
165 FoundItems.Sort(FoundItemsSort);
166 ReloadList;
167end;
168
169procedure TFormFindDuplicity.FormCreate(Sender: TObject);
170begin
171 FoundItems := TFoundItems.Create;
172 Core.Translator.TranslateComponentRecursive(Self);
173 Core.ThemeManager1.UseTheme(Self);
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.ContactsFile := Contacts.ContactsFile;
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.ContactsFile.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.ContactsFile.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: TContactsFile;
224 I: Integer;
225begin
226 TempContacts := TContactsFile.Create;
227 try
228 for I := 0 to Contacts.Count - 1 do
229 TempContacts.Contacts.Merge(Contacts[I], TContactField(ComboBoxField.Items.Objects[ComboBoxField.ItemIndex]).Index);
230 Contacts.Assign(TempContacts.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.