Changeset 52

Timestamp:

Dec 3, 2021, 8:50:43 PM (3 years ago)

Author:

chronos

Message:

• Fixed: Wrong object reference to contact Parent after Merge files action.
• Modified: Optimized select all action.

Location:

trunk

Files:

• Forms/UFormContact.lfm (modified) (6 diffs)
• Forms/UFormContacts.lfm (modified) (4 diffs)
• Forms/UFormContacts.pas (modified) (8 diffs)
• Forms/UFormProperties.lfm (modified) (4 diffs)
• Languages/vCardStudio.cs.po (modified) (2 diffs)
• Languages/vCardStudio.po (modified) (2 diffs)
• UContact.pas (modified) (7 diffs)
• UCore.pas (modified) (1 diff)

trunk/Forms/UFormContact.lfm

@@ -25 +25 @@
     object TabSheetGeneral: TTabSheet
       Caption = 'General'
-      ClientHeight = 744
-      ClientWidth = 931
+      ClientHeight = 742
+      ClientWidth = 929
       OnHide = TabSheetGeneralHide
       OnShow = TabSheetGeneralShow
@@ -298 +298 @@
     object TabSheetHome: TTabSheet
       Caption = 'Home'
-      ClientHeight = 744
-      ClientWidth = 931
+      ClientHeight = 742
+      ClientWidth = 929
       OnHide = TabSheetHomeHide
       OnShow = TabSheetHomeShow
@@ -394 +394 @@
         Anchors = [akTop, akLeft, akRight]
         Caption = 'Address'
-        ClientHeight = 212
-        ClientWidth = 888
+        ClientHeight = 215
+        ClientWidth = 890
         TabOrder = 6
         object Label36: TLabel
@@ -538 +538 @@
     object TabSheetWork: TTabSheet
       Caption = 'Work'
-      ClientHeight = 744
-      ClientWidth = 931
+      ClientHeight = 742
+      ClientWidth = 929
       OnHide = TabSheetWorkHide
       OnShow = TabSheetWorkShow
@@ -616 +616 @@
         Width = 911
         Caption = 'Address'
-        ClientHeight = 217
-        ClientWidth = 907
+        ClientHeight = 220
+        ClientWidth = 909
         TabOrder = 4
         object Label31: TLabel
@@ -827 +827 @@
     object TabSheetOthers: TTabSheet
       Caption = 'Others'
-      ClientHeight = 744
-      ClientWidth = 931
+      ClientHeight = 742
+      ClientWidth = 929
       OnHide = TabSheetOthersHide
       OnShow = TabSheetOthersShow

trunk/Forms/UFormContacts.lfm

@@ -14 +14 @@
   object ListView1: TListView
     Left = 0
-    Height = 801
+    Height = 810
     Top = 0
     Width = 1210
@@ -58 +58 @@
     Left = 0
     Height = 39
-    Top = 833
+    Top = 842
     Width = 1210
     Align = alBottom
@@ -90 +90 @@
     Left = 0
     Height = 32
-    Top = 801
+    Top = 810
     Width = 1210
     OnChange = ListViewFilter1Change
@@ -97 +97 @@
   object StatusBar1: TStatusBar
     Left = 0
-    Height = 36
-    Top = 872
+    Height = 27
+    Top = 881
     Width = 1210
     Panels = <    

trunk/Forms/UFormContacts.pas

@@ -53 +53 @@
   private
     FContacts: TContacts;
+    FUpdateCount: Integer;
     procedure FilterList(List: TFPGObjectList<TObject>);
     procedure SetContacts(AValue: TContacts);
     procedure FormContactPrevious(Sender: TObject);
     procedure FormContactNext(Sender: TObject);
+    procedure DoUpdateInterface;
   public
     property Contacts: TContacts read FContacts write SetContacts;
     procedure ReloadList;
+    procedure BeginUpdate;
+    procedure EndUpdate;
     procedure UpdateInterface;
   end;
@@ -80 +84 @@
   SFiltered = 'Filtered';
   SSelected = 'Selected';
+  SEndUpdateTooLow = 'Update counter error';
 
 { TFormContacts }
@@ -99 +104 @@
   if Item.Index < ListViewSort1.List.Count then
   with TContact(ListViewSort1.List[Item.Index]) do begin
-
     AddItem(Fields[cfFullName], True);
     AddItem(Fields[cfFirstName]);
@@ -220 +224 @@
 end;
 
+procedure TFormContacts.DoUpdateInterface;
+var
+  Text: string;
+  SelectedCount: Integer;
+begin
+  AAdd.Enabled := Assigned(Contacts);
+  AModify.Enabled := Assigned(Contacts) and Assigned(ListView1.Selected);
+  ARemove.Enabled := Assigned(Contacts) and Assigned(ListView1.Selected);
+
+  Text := '';
+  if Assigned(Contacts) then begin
+    Text := STotal + ': ' + IntToStr(Contacts.Count);
+    if ListView1.Items.Count < Contacts.Count then
+      Text := Text + ', ' + SFiltered + ': ' + IntToStr(ListView1.Items.Count);
+    SelectedCount := ListView1.SelCount;
+    if SelectedCount > 0 then
+      Text := Text + ', ' + SSelected + ': ' + IntToStr(SelectedCount);
+  end;
+  StatusBar1.Panels[0].Text := Text;
+end;
+
 procedure TFormContacts.FormShow(Sender: TObject);
 begin
@@ -268 +293 @@
     Contact := TContact.Create;
     try
+      Contact.Parent := Contacts.ContactsFile;
       Contact.Assign(TContact(ListView1.Selected.Data));
       FormContact.Contact := Contact;
@@ -297 +323 @@
     Contact := TContact.Create;
     try
+      Contact.Parent := Contacts.ContactsFile;
       Contact.Assign(TContact(ListView1.Selected.Data));
       FormContact.Contact := Contact;
@@ -333 +360 @@
 
 procedure TFormContacts.ASelectAllExecute(Sender: TObject);
-begin
-  ListView1.SelectAll;
-  UpdateInterface;
+var
+  I: Integer;
+begin
+  BeginUpdate;
+  ListView1.BeginUpdate;
+  for I := 0 to ListView1.Items.Count - 1 do
+    ListView1.Items[I].Selected := True;
+  //ListView1.SelectAll;
+  ListView1.EndUpdate;
+  EndUpdate;
 end;
 
@@ -360 +394 @@
 end;
 
+procedure TFormContacts.BeginUpdate;
+begin
+  Inc(FUpdateCount);
+end;
+
+procedure TFormContacts.EndUpdate;
+begin
+  if FUpdateCount <= 0 then raise Exception(SEndUpdateTooLow);
+  Dec(FUpdateCount);
+  if FUpdateCount = 0 then DoUpdateInterface;
+end;
+
 procedure TFormContacts.UpdateInterface;
-var
-  Text: string;
-  SelectedCount: Integer;
-begin
-  AAdd.Enabled := Assigned(Contacts);
-  AModify.Enabled := Assigned(Contacts) and Assigned(ListView1.Selected);
-  ARemove.Enabled := Assigned(Contacts) and Assigned(ListView1.Selected);
-
-  Text := '';
-  if Assigned(Contacts) then begin
-    Text := STotal + ': ' + IntToStr(Contacts.Count);
-    if ListView1.Items.Count < Contacts.Count then
-      Text := Text + ', ' + SFiltered + ': ' + IntToStr(ListView1.Items.Count);
-    SelectedCount := ListView1.SelCount;
-    if SelectedCount > 0 then
-      Text := Text + ', ' + SSelected + ': ' + IntToStr(SelectedCount);
-  end;
-  StatusBar1.Panels[0].Text := Text;
+begin
+  if FUpdateCount = 0 then DoUpdateInterface;
 end;
 

trunk/Forms/UFormProperties.lfm

@@ -14 +14 @@
   object ListView1: TListView
     Left = 0
-    Height = 801
+    Height = 810
     Top = 0
     Width = 1210
@@ -46 +46 @@
     Left = 0
     Height = 39
-    Top = 833
+    Top = 842
     Width = 1210
     Align = alBottom
@@ -73 +73 @@
     Left = 0
     Height = 32
-    Top = 801
+    Top = 810
     Width = 1210
     OnChange = ListViewFilter1Change
@@ -80 +80 @@
   object StatusBar1: TStatusBar
     Left = 0
-    Height = 36
-    Top = 872
+    Height = 27
+    Top = 881
     Width = 1210
     Panels = <    

trunk/Languages/vCardStudio.cs.po

@@ -602 +602 @@
 msgstr "Kategorie"
 
+#: ucontact.scontacthasnoparent
+msgid "Contact has no parent"
+msgstr "Kontakt nemá rodiče"
+
 #: ucontact.sdayofbirth
 msgid "Day of birth"
@@ -871 +875 @@
 msgstr "Soubor"
 
+#: uformcontacts.sendupdatetoolow
+msgid "Update counter error"
+msgstr "Chyba čítače aktualizací"
+
 #: uformcontacts.sfiltered
 msgctxt "uformcontacts.sfiltered"

trunk/Languages/vCardStudio.po

@@ -590 +590 @@
 msgstr ""
 
+#: ucontact.scontacthasnoparent
+msgid "Contact has no parent"
+msgstr ""
+
 #: ucontact.sdayofbirth
 msgid "Day of birth"
@@ -859 +863 @@
 msgstr ""
 
+#: uformcontacts.sendupdatetoolow
+msgid "Update counter error"
+msgstr ""
+
 #: uformcontacts.sfiltered
 msgctxt "uformcontacts.sfiltered"

trunk/UContact.pas

@@ -143 +143 @@
   SFoundBlockEndWithoutBlockStart = 'Found block end without block start';
   SFieldIndexNotDefined = 'Field index not defined';
+  SContactHasNoParent = 'Contact has no parent';
   SLastName = 'Last Name';
   SFirstName = 'First Name';
@@ -478 +479 @@
 var
   I: Integer;
-begin
+  C: Integer;
+begin
+  C := Count;
   I := 0;
   while (I < Count) and (Items[I].Index <> Index) do Inc(I);
@@ -502 +505 @@
   Field: TContactField;
 begin
+  if not Assigned(Parent) then raise Exception.Create(SContactHasNoParent);
   Prop := GetProperty(Index);
   if Assigned(Prop) then begin
@@ -517 +521 @@
   I: Integer;
 begin
+  if not Assigned(Parent) then raise Exception.Create(SContactHasNoParent);
   Field := Parent.Fields.GetByIndex(Index);
   if Assigned(Field) then begin
@@ -542 +547 @@
 function TContact.GetProperty(Index: TContactFieldIndex): TContactProperty;
 var
-  Prop: TContactProperty;
   Field: TContactField;
 begin
+  if not Assigned(Parent) then raise Exception.Create(SContactHasNoParent);
   Field := Parent.Fields.GetByIndex(Index);
   if Assigned(Field) then begin
@@ -555 +560 @@
   I: Integer;
 begin
-  Parent := Source.Parent;
   while Properties.Count < Source.Properties.Count do
     Properties.Add(TContactProperty.Create);
@@ -568 +572 @@
   I: Integer;
 begin
+  if not Assigned(Parent) then raise Exception.Create(SContactHasNoParent);
   Result := False;
   for I := 0 to Parent.Fields.Count - 1 do begin

trunk/UCore.pas

@@ -374 +374 @@
         if not Assigned(NewContact) then begin
           NewContact := TContact.Create;
+          NewContact.Assign(TempFile.Contacts[I]);
           NewContact.Parent := TContactsFile(DataFile);
-          NewContact.Assign(TempFile.Contacts[I]);
           TContactsFile(DataFile).Contacts.Add(NewContact);
           Inc(Result.New);