Changeset 73 for trunk/UContact.pas

Timestamp:

Dec 13, 2021, 11:33:11 PM (2 years ago)

Author:

chronos

Message:

• 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:

• trunk/UContact.pas (modified) (13 diffs)

trunk/UContact.pas

@@ -93 +93 @@
 
   TContactProperties = class(TFPGObjectList<TContactProperty>)
+    procedure Assign(Source: TContactProperties);
     procedure AssignToList(List: TFPGObjectList<TObject>);
     function GetByName(Name: string): TContactProperty;
@@ -110 +111 @@
     Properties: TContactProperties;
     Parent: TContactsFile;
+    function HasField(FieldIndex: TContactFieldIndex): Boolean;
     function FullNameToFileName: string;
     function GetProperty(Field: TContactField): TContactProperty; overload;
@@ -128 +130 @@
   TContacts = class(TFPGObjectList<TContact>)
     ContactsFile: TContactsFile;
+    procedure Assign(Source: TContacts);
+    procedure AddContacts(Contacts: TContacts);
+    procedure InsertContacts(Index: Integer; Contacts: TContacts);
     procedure AssignToList(List: TFPGObjectList<TObject>);
     function AddNew: TContact;
-    function Search(FullName: string): TContact;
+    function Search(Text: string; FieldIndex: TContactFieldIndex): TContact;
+    function CountByField(FieldIndex: TContactFieldIndex): Integer;
+    procedure Merge(Contact: TContact; FieldIndex: TContactFieldIndex);
     function ToString: ansistring; override;
   end;
@@ -148 +155 @@
     function GetFileExt: string; override;
     function GetFileFilter: string; override;
+    procedure SaveToStrings(Output: TStrings);
+    procedure LoadFromStrings(Lines: TStrings);
     procedure SaveToFile(FileName: string); override;
     procedure LoadFromFile(FileName: string); override;
@@ -388 +397 @@
 { TContactProperties }
 
+procedure TContactProperties.Assign(Source: TContactProperties);
+var
+  I: Integer;
+begin
+  while Count < Source.Count do
+    Add(TContactProperty.Create);
+  while Count > Source.Count do
+    Delete(Count - 1);
+  for I := 0 to Count - 1 do
+    Items[I].Assign(Source.Items[I]);
+end;
+
 procedure TContactProperties.AssignToList(List: TFPGObjectList<TObject>);
 var
@@ -579 +600 @@
 { TContacts }
 
+procedure TContacts.Assign(Source: TContacts);
+var
+  I: Integer;
+begin
+  while Count < Source.Count do
+    Add(TContact.Create);
+  while Count > Source.Count do
+    Delete(Count - 1);
+  for I := 0 to Count - 1 do begin
+    Items[I].Assign(Source.Items[I]);
+    Items[I].Parent := ContactsFile;
+  end;
+end;
+
+procedure TContacts.AddContacts(Contacts: TContacts);
+var
+  I: Integer;
+  NewContact: TContact;
+begin
+  for I := 0 to Contacts.Count - 1 do begin
+    NewContact := TContact.Create;
+    NewContact.Assign(Contacts[I]);
+    NewContact.Parent := ContactsFile;
+    Add(NewContact);
+  end;
+end;
+
+procedure TContacts.InsertContacts(Index: Integer; Contacts: TContacts);
+var
+  I: Integer;
+  NewContact: TContact;
+begin
+  for I := 0 to Contacts.Count - 1 do begin
+    NewContact := TContact.Create;
+    NewContact.Assign(Contacts[I]);
+    NewContact.Parent := ContactsFile;
+    Insert(Index, NewContact);
+    Inc(Index);
+  end;
+end;
+
 procedure TContacts.AssignToList(List: TFPGObjectList<TObject>);
 var
@@ -596 +658 @@
 end;
 
-function TContacts.Search(FullName: string): TContact;
-var
-  Contact: TContact;
+function TContacts.Search(Text: string; FieldIndex: TContactFieldIndex): TContact;
+var
+  I: Integer;
 begin
   Result := nil;
-  for Contact in Self do
-    if Contact.Fields[cfFullName] = FullName then begin
-      Result := Contact;
+  for I := 0 to Count - 1 do
+    if Items[I].Fields[FieldIndex] = Text then begin
+      Result := Items[I];
       Break;
     end;
+end;
+
+function TContacts.CountByField(FieldIndex: TContactFieldIndex): Integer;
+var
+  I: Integer;
+begin
+  Result := 0;
+  for I := 0 to Count - 1 do
+    if Items[I].HasField(FieldIndex) then
+      Inc(Result);
+end;
+
+procedure TContacts.Merge(Contact: TContact; FieldIndex: TContactFieldIndex);
+var
+  NewContact: TContact;
+begin
+  NewContact := Search(Contact.Fields[FieldIndex], FieldIndex);
+  if Assigned(NewContact) then begin
+    NewContact.UpdateFrom(Contact);
+  end else begin
+    NewContact := TContact.Create;
+    NewContact.Assign(Contact);
+    NewContact.Parent := ContactsFile;
+    Add(NewContact);
+  end;
 end;
 
@@ -741 +828 @@
 end;
 
+function TContact.HasField(FieldIndex: TContactFieldIndex): Boolean;
+var
+  Field: TContactField;
+begin
+  if not Assigned(Parent) then raise Exception.Create(SContactHasNoParent);
+  Field := Parent.Fields.GetByIndex(FieldIndex);
+  if Assigned(Field) then begin
+    Result := Assigned(GetProperty(Field));
+  end else raise Exception.Create(SFieldIndexNotDefined);
+end;
+
 function TContact.FullNameToFileName: string;
 var
@@ -778 +876 @@
 
 procedure TContact.Assign(Source: TContact);
-var
-  I: Integer;
-begin
-  while Properties.Count < Source.Properties.Count do
-    Properties.Add(TContactProperty.Create);
-  while Properties.Count > Source.Properties.Count do
-    Properties.Delete(Properties.Count - 1);
-  for I := 0 to Properties.Count - 1 do
-    Properties[I].Assign(Source.Properties[I]);
+begin
+  Properties.Assign(Source.Properties);
 end;
 
@@ -1114 +1205 @@
 end;
 
+procedure TContactsFile.SaveToStrings(Output: TStrings);
+var
+  I: Integer;
+begin
+  for I := 0 to Contacts.Count - 1 do
+    Contacts[I].SaveToStrings(Output);
+end;
+
+procedure TContactsFile.LoadFromStrings(Lines: TStrings);
+var
+  Contact: TContact;
+  I: Integer;
+  NewI: Integer;
+begin
+  Contacts.Clear;
+
+  I := 0;
+  while I < Lines.Count do begin
+    Contact := TContact.Create;
+    Contact.Parent := Self;
+    NewI := Contact.LoadFromStrings(Lines, I);
+    if NewI <= Lines.Count then begin
+      if NewI <> -1 then begin
+        Contacts.Add(Contact);
+        I := NewI;
+      end else begin
+        FreeAndNil(Contact);
+        Inc(I);
+      end;
+    end else begin
+      FreeAndNil(Contact);
+      Break;
+    end;
+  end;
+end;
+
 function TContactsFile.NewItem(Key, Value: string): string;
 var
@@ -1125 +1252 @@
 procedure TContactsFile.SaveToFile(FileName: string);
 var
-  Output: TStringList;
-  I: Integer;
+  Lines: TStringList;
 begin
   inherited;
-  Output := TStringList.Create;
+  Lines := TStringList.Create;
   try
-    for I := 0 to Contacts.Count - 1 do
-      Contacts[I].SaveToStrings(Output);
-    Output.SaveToFile(FileName);
+    SaveToStrings(Lines);
+    Lines.SaveToFile(FileName);
   finally
-    Output.Free;
+    Lines.Free;
   end
 end;
@@ -1142 +1267 @@
 var
   Lines: TStringList;
-  Contact: TContact;
-  I: Integer;
-  NewI: Integer;
 begin
   inherited;
-  Contacts.Clear;
   Lines := TStringList.Create;
   Lines.LoadFromFile(FileName);
@@ -1159 +1280 @@
   {$ENDIF}
   try
-    I := 0;
-    while I < Lines.Count do begin
-      Contact := TContact.Create;
-      Contact.Parent := Self;
-      NewI := Contact.LoadFromStrings(Lines, I);
-      if NewI <= Lines.Count then begin
-        if NewI <> -1 then begin
-          Contacts.Add(Contact);
-          I := NewI;
-        end else begin
-          FreeAndNil(Contact);
-          Inc(I);
-        end;
-      end else begin
-        FreeAndNil(Contact);
-        Break;
-      end;
-    end;
+    LoadFromStrings(Lines);
   finally
     Lines.Free;