Changeset 14


Ignore:
Timestamp:
Feb 4, 2018, 2:01:05 PM (7 years ago)
Author:
chronos
Message:
  • Added: New File menu action Merge. It can merge multiple vcard files and update values for items with same full name.
Location:
trunk
Files:
9 edited

Legend:

Unmodified
Added
Removed
  • trunk/Forms/UFormContacts.lfm

    r13 r14  
    3434        Width = 387
    3535      end>
     36    MultiSelect = True
    3637    OwnerData = True
    3738    PopupMenu = PopupMenuContact
     
    7576      Action = AAdd
    7677    end
     78    object MenuItem3: TMenuItem
     79      Action = ARemove
     80    end
    7781    object MenuItem2: TMenuItem
    7882      Action = AModify
    7983    end
    80     object MenuItem3: TMenuItem
    81       Action = ARemove
     84    object MenuItem4: TMenuItem
     85      Action = ASelectAll
    8286    end
    8387  end
     
    104108      ShortCut = 46
    105109    end
     110    object ASelectAll: TAction
     111      Caption = 'Select all'
     112      OnExecute = ASelectAllExecute
     113      ShortCut = 16449
     114    end
    106115  end
    107116end
  • trunk/Forms/UFormContacts.pas

    r13 r14  
    1515  TFormContacts = class(TForm)
    1616    AAdd: TAction;
     17    ASelectAll: TAction;
    1718    ARemove: TAction;
    1819    AModify: TAction;
     
    2223    MenuItem2: TMenuItem;
    2324    MenuItem3: TMenuItem;
     25    MenuItem4: TMenuItem;
    2426    PopupMenuContact: TPopupMenu;
    2527    ToolBar1: TToolBar;
     
    3032    procedure AModifyExecute(Sender: TObject);
    3133    procedure ARemoveExecute(Sender: TObject);
     34    procedure ASelectAllExecute(Sender: TObject);
    3235    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    3336    procedure FormCreate(Sender: TObject);
     
    158161end;
    159162
     163procedure TFormContacts.ASelectAllExecute(Sender: TObject);
     164begin
     165  ListView1.SelectAll;
     166end;
     167
    160168procedure TFormContacts.FormClose(Sender: TObject; var CloseAction: TCloseAction
    161169  );
  • trunk/Forms/UFormMain.lfm

    r13 r14  
    11object FormMain: TFormMain
    2   Left = 613
     2  Left = 601
    33  Height = 531
    4   Top = 401
     4  Top = 447
    55  Width = 785
    6   Caption = 'FormMain'
     6  Caption = 'vCard Studio'
    77  ClientHeight = 497
    88  ClientWidth = 785
     
    132132        Action = Core.AFileClose
    133133      end
     134      object MenuItem1: TMenuItem
     135        Caption = '-'
     136      end
     137      object MenuItem3: TMenuItem
     138        Action = Core.AFileMerge
     139      end
    134140      object MenuItem2: TMenuItem
    135141        Caption = '-'
  • trunk/Forms/UFormMain.pas

    r13 r14  
    1616    CoolBar1: TCoolBar;
    1717    MainMenu1: TMainMenu;
     18    MenuItem1: TMenuItem;
     19    MenuItem3: TMenuItem;
    1820    MenuItemToolbar: TMenuItem;
    1921    MenuItemView: TMenuItem;
  • trunk/Languages/vCardStudio.cs.po

    r13 r14  
    2525msgstr "Zavřít"
    2626
     27#: tcore.afilemerge.caption
     28msgid "Merge..."
     29msgstr "Sloučení..."
     30
    2731#: tcore.afilenew.caption
    2832msgid "New"
     
    215219msgstr "Odstranit"
    216220
     221#: tformcontacts.aselectall.caption
     222msgid "Select all"
     223msgstr "Vybrat vše"
     224
    217225#: tformcontacts.caption
    218226msgid "Contacts"
     
    238246
    239247#: tformmain.caption
    240 msgid "FormMain"
    241 msgstr "FormMain"
     248msgid "vCard Studio"
     249msgstr "vCard Studio"
    242250
    243251#: tformmain.menuitemfile.caption
     
    303311msgstr "Neznámý příkaz: %s"
    304312
     313#: ucontact.sunsupportedcontactfieldsindex
     314msgid "Unsupported contact field index"
     315msgstr "Nepodporovaný index pole kontaktu"
     316
    305317#: ucontact.svcardfile
    306318msgctxt "ucontact.svcardfile"
     
    320332msgstr "Soubor '%s' nenalezen."
    321333
     334#: ucore.smergedcontacts
     335msgid "Contacts merged. Loaded: %d, New: %d, Updated: %d"
     336msgstr "Kontakty sloučeny. Načteno: %d, Nových: %d, Aktualizovaných: %d"
     337
    322338#: udatafile.sallfiles
    323339msgid "All files"
  • trunk/Languages/vCardStudio.po

    r13 r14  
    1515msgstr ""
    1616
     17#: tcore.afilemerge.caption
     18msgid "Merge..."
     19msgstr ""
     20
    1721#: tcore.afilenew.caption
    1822msgid "New"
     
    205209msgstr ""
    206210
     211#: tformcontacts.aselectall.caption
     212msgid "Select all"
     213msgstr ""
     214
    207215#: tformcontacts.caption
    208216msgid "Contacts"
     
    228236
    229237#: tformmain.caption
    230 msgid "FormMain"
     238msgid "vCard Studio"
    231239msgstr ""
    232240
     
    291299msgstr ""
    292300
     301#: ucontact.sunsupportedcontactfieldsindex
     302msgid "Unsupported contact field index"
     303msgstr ""
     304
    293305#: ucontact.svcardfile
    294306msgctxt "ucontact.svcardfile"
     
    308320msgstr ""
    309321
     322#: ucore.smergedcontacts
     323msgid "Contacts merged. Loaded: %d, New: %d, Updated: %d"
     324msgstr ""
     325
    310326#: udatafile.sallfiles
    311327msgid "All files"
  • trunk/UContact.pas

    r12 r14  
    1515  TDataType = (dtString, dtInteger, dtDate, dtDateTime, dtImage);
    1616
    17   TContactFieldIndex = (cfFirstName, cfMiddleName, cfLastName, cfTelPrefCell,
    18     cfTelCell, cfTelHome, cfTelHome2, cfTelWork, cfTitle, cfOrganization,
    19     cfAddress, cfNote);
     17  TContactFieldIndex = (cfFirstName, cfMiddleName, cfLastName, cfTitleBefore,
     18    cfTitleAfter, cfFullName, cfTelPrefCell,
     19    cfTelCell, cfTelHome, cfTelHome2, cfTelWork, cfTelVoip,
     20    cfTelPrefWorkVoice, cfTelPrefHomeVoice, cfTelHomeVoice, cfTelWorkVoice,
     21    cfEmailHome, cfEmailInternet, cfNickName, cfNote, cfRole, cfTitle,
     22    cfCategories, cfOrganization, cfAdrHome, cfHomeAddressStreet,
     23    cfHomeAddressCity, cfHomeAddressCountry, cfXTimesContacted,
     24    cfXLastTimeContacted, cfPhoto, cfXJabber);
    2025
    2126  TContactField = class
     
    7378    Photo: string;
    7479    XJabber: string;
     80    procedure Assign(Source: TContact);
     81    function UpdateFrom(Source: TContact): Boolean;
    7582    property Fields[Index: TContactFieldIndex]: string read GetField write SetField;
    7683  end;
     84
     85  { TContacts }
    7786
    7887  TContacts = class(TObjectList)
    7988    ContactsFile: TContactsFile;
     89    function Search(FullName: string): TContact;
    8090  end;
    8191
     
    106116  SVCardFile = 'vCard file';
    107117  SUnknownCommand = 'Unknown command: %s';
     118  SUnsupportedContactFieldsIndex = 'Unsupported contact field index';
     119
     120{ TContacts }
     121
     122function TContacts.Search(FullName: string): TContact;
     123var
     124  Contact: TContact;
     125begin
     126  Result := nil;
     127  for Contact in Self do
     128    if Contact.FullName = FullName then begin
     129      Result := Contact;
     130      Break;
     131    end;
     132end;
    108133
    109134{ TContactFields }
     
    127152    cfMiddleName: Result := MiddleName;
    128153    cfLastName: Result := LastName;
     154    cfTitleBefore: Result := TitleBefore;
     155    cfTitleAfter: Result := TitleAfter;
     156    cfFullName: Result := FullName;
    129157    cfTelPrefCell: Result := TelPrefCell;
    130158    cfTelCell: Result := TelCell;
     
    132160    cfTelHome2: Result := TelHome2;
    133161    cfTelWork: Result := TelWork;
     162    cfTelVoip: Result := TelVoip;
     163    cfTelPrefWorkVoice: Result := TelPrefWorkVoice;
     164    cfTelPrefHomeVoice: Result := TelPrefHomeVoice;
     165    cfTelHomeVoice: Result := TelHomeVoice;
     166    cfTelWorkVoice: Result := TelWorkVoice;
     167    cfEmailHome: Result := EmailHome;
     168    cfEmailInternet: Result := EmailInternet;
     169    cfNickName: Result := NickName;
     170    cfNote: Result := Note;
     171    cfRole: Result := Role;
    134172    cfTitle: Result := Title;
     173    cfCategories: Result := Categories;
    135174    cfOrganization: Result := Organization;
    136     cfAddress: Result := AdrHome;
    137     cfNote: Result := Note;
     175    cfAdrHome: Result := AdrHome;
     176    cfHomeAddressStreet: Result := HomeAddressStreet;
     177    cfHomeAddressCity: Result := HomeAddressCity;
     178    cfHomeAddressCountry: Result := HomeAddressCountry;
     179    cfXTimesContacted: Result := XTimesContacted;
     180    cfXLastTimeContacted: Result := XLastTimeContacted;
     181    cfPhoto: Result := Photo;
     182    cfXJabber: Result := XJabber;
     183    else raise Exception.Create(SUnsupportedContactFieldsIndex);
    138184  end;
    139185end;
     
    145191    cfMiddleName: MiddleName := AValue;
    146192    cfLastName: LastName := AValue;
     193    cfTitleBefore: TitleBefore := AValue;
     194    cfTitleAfter: TitleAfter := AValue;
     195    cfFullName: FullName := AValue;
    147196    cfTelPrefCell: TelPrefCell := AValue;
    148197    cfTelCell: TelCell := AValue;
     
    150199    cfTelHome2: TelHome2 := AValue;
    151200    cfTelWork: TelWork := AValue;
     201    cfTelVoip: TelVoip := AValue;
     202    cfTelPrefWorkVoice: TelPrefWorkVoice := AValue;
     203    cfTelPrefHomeVoice: TelPrefHomeVoice := AValue;
     204    cfTelHomeVoice: TelHomeVoice := AValue;
     205    cfTelWorkVoice: TelWorkVoice := AValue;
     206    cfEmailHome: EmailHome := AValue;
     207    cfEmailInternet: EmailInternet := AValue;
     208    cfNickName: NickName := AValue;
     209    cfNote: Note := AValue;
     210    cfRole: Role := AValue;
    152211    cfTitle: Title := AValue;
     212    cfCategories: Categories := AValue;
    153213    cfOrganization: Organization := AValue;
    154     cfAddress: AdrHome := AValue;
    155     cfNote: Note := AValue;
     214    cfAdrHome: AdrHome := AValue;
     215    cfHomeAddressStreet: HomeAddressStreet := AValue;
     216    cfHomeAddressCity: HomeAddressCity := AValue;
     217    cfHomeAddressCountry: HomeAddressCountry := AValue;
     218    cfXTimesContacted: XTimesContacted := AValue;
     219    cfXLastTimeContacted: XLastTimeContacted := AValue;
     220    cfPhoto: Photo := AValue;
     221    cfXJabber: XJabber := AValue;
     222    else raise Exception.Create(SUnsupportedContactFieldsIndex);
     223  end;
     224end;
     225
     226procedure TContact.Assign(Source: TContact);
     227begin
     228  Version := Source.Version;
     229  FirstName := Source.FirstName;
     230  MiddleName := Source.MiddleName;
     231  LastName := Source.LastName;
     232  TitleBefore := Source.TitleBefore;
     233  TitleAfter := Source.TitleAfter;
     234  FullName := Source.FullName;
     235  TelPrefCell := Source.TelPrefCell;
     236  TelCell := Source.TelCell;
     237  TelHome := Source.TelHome;
     238  TelHome2 := Source.TelHome2;
     239  TelWork := Source.TelWork;
     240  TelVoip := Source.TelVoip;
     241  TelPrefWorkVoice := Source.TelPrefWorkVoice;
     242  TelPrefHomeVoice := Source.TelPrefHomeVoice;
     243  TelHomeVoice := Source.TelHomeVoice;
     244  TelWorkVoice := Source.TelWorkVoice;
     245  EmailHome := Source.EmailHome;
     246  EmailInternet := Source.EmailInternet;
     247  NickName := Source.NickName;
     248  Note := Source.Note;
     249  Role := Source.Role;
     250  Title := Source.Title;
     251  Categories := Source.Categories;
     252  Organization := Source.Organization;
     253  AdrHome := Source.AdrHome;
     254  HomeAddressStreet := Source.HomeAddressStreet;
     255  HomeAddressCity := Source.HomeAddressCity;
     256  HomeAddressCountry := Source.HomeAddressCountry;
     257  XTimesContacted := Source.XTimesContacted;
     258  XLastTimeContacted := Source.XLastTimeContacted;
     259  Photo := Source.Photo;
     260  XJabber := Source.XJabber;
     261end;
     262
     263function TContact.UpdateFrom(Source: TContact): Boolean;
     264var
     265  I: Integer;
     266begin
     267  Result := False;
     268  for I := 0 to Parent.Fields.Count - 1 do begin
     269    if (Source.Fields[TContactField(Parent.Fields[I]).Index] <> '') and
     270      (Source.Fields[TContactField(Parent.Fields[I]).Index] <>
     271      Fields[TContactField(Parent.Fields[I]).Index]) then begin
     272        Result := True;
     273        Fields[TContactField(Parent.Fields[I]).Index] := Source.Fields[TContactField(Parent.Fields[I]).Index];
     274      end;
    156275  end;
    157276end;
     
    176295    AddNew('Middle Name', cfMiddleName, dtString);
    177296    AddNew('Last Name', cfLastName, dtString);
     297    AddNew('Title Before', cfTitleBefore, dtString);
     298    AddNew('Title After', cfTitleAfter, dtString);
     299    AddNew('Full Name', cfFullName, dtString);
    178300    AddNew('Preferred cell phone', cfTelPrefCell, dtString);
    179301    AddNew('Cell phone', cfTelCell, dtString);
     
    181303    AddNew('Home phone 2', cfTelHome2, dtString);
    182304    AddNew('Home work', cfTelWork, dtString);
     305    AddNew('Tel Voip', cfTelVoip, dtString);
     306    AddNew('Tel Pref Work Voice', cfTelPrefWorkVoice, dtString);
     307    AddNew('Tel Pref Home Voice', cfTelPrefHomeVoice, dtString);
     308    AddNew('Tel Home Voice', cfTelHomeVoice, dtString);
     309    AddNew('Tel Work Voice', cfTelWorkVoice, dtString);
     310    AddNew('Email Home', cfEmailHome, dtString);
     311    AddNew('Email Internet', cfEmailInternet, dtString);
     312    AddNew('Nick Name', cfNickName, dtString);
     313    AddNew('Note', cfNote, dtString);
     314    AddNew('Role', cfRole, dtString);
    183315    AddNew('Title', cfTitle, dtString);
     316    AddNew('Categories', cfCategories, dtString);
    184317    AddNew('Organization', cfOrganization, dtString);
    185     AddNew('Address', cfAddress, dtString);
    186     AddNew('Note', cfNote, dtString);
     318    AddNew('Home Address', cfAdrHome, dtString);
     319    AddNew('Home Address Street', cfHomeAddressStreet, dtString);
     320    AddNew('Home Address City', cfHomeAddressCity, dtString);
     321    AddNew('Home Address Country', cfHomeAddressCountry, dtString);
     322    AddNew('Times Contacted', cfXTimesContacted, dtString);
     323    AddNew('Last Time Contacted', cfXLastTimeContacted, dtString);
     324    AddNew('Photo', cfPhoto, dtString);
     325    AddNew('Jabber', cfXJabber, dtString);
    187326  end;
    188327end;
  • trunk/UCore.lfm

    r8 r14  
    77  VerticalOffset = 428
    88  Width = 1020
    9   PPI = 120
    109  object ImageList1: TImageList
    1110    left = 200
     
    429428      OnExecute = ASettingsExecute
    430429    end
     430    object AFileMerge: TAction
     431      Category = 'File'
     432      Caption = 'Merge...'
     433      OnExecute = AFileMergeExecute
     434    end
    431435  end
    432436  object LastOpenedList1: TLastOpenedList
  • trunk/UCore.pas

    r8 r14  
    1212type
    1313
     14  { TMergeResult }
     15
     16  TMergeResult = record
     17    Loaded: Integer;
     18    New: Integer;
     19    Updated: Integer;
     20    procedure Clear;
     21    class operator Add(const A, B: TMergeResult): TMergeResult;
     22  end;
     23
    1424  { TCore }
    1525
    1626  TCore = class(TDataModule)
    1727    AAbout: TAction;
     28    AFileMerge: TAction;
    1829    ASettings: TAction;
    1930    AFileOpenRecent: TAction;
     
    3647    procedure AAboutExecute(Sender: TObject);
    3748    procedure AExitExecute(Sender: TObject);
     49    procedure AFileMergeExecute(Sender: TObject);
    3850    procedure AFileNewExecute(Sender: TObject);
    3951    procedure AFileOpenExecute(Sender: TObject);
     
    6476    procedure FileOpen(FileName: string);
    6577    procedure FileClose;
     78    function FileMerge(FileName: string): TMergeResult;
    6679    procedure Initialize;
    6780    procedure UpdateInterface;
     
    8396  SAppExitQuery = 'File was modified. Do you want to save it before exit?';
    8497  SFileNotFound = 'File ''%s'' not found.';
     98  SMergedContacts = 'Contacts merged. Loaded: %d, New: %d, Updated: %d';
     99
     100{ TMergeResult }
     101
     102procedure TMergeResult.Clear;
     103begin
     104  Loaded := 0;
     105  New := 0;
     106  Updated := 0;
     107end;
     108
     109class operator TMergeResult.Add(const A, B: TMergeResult): TMergeResult;
     110begin
     111  Result.Loaded := A.Loaded + B.Loaded;
     112  Result.New := A.New + B.New;
     113  Result.Updated := A.Updated + B.Updated;
     114end;
    85115
    86116{ TCore }
     
    91121end;
    92122
    93 procedure TCore.AAboutExecute(Sender: TObject);
    94 begin
    95   FormAbout := TFormAbout.Create(nil);
    96   try
    97     FormAbout.ApplicationInfo := ApplicationInfo1;
    98     FormAbout.ShowModal;
    99   finally
    100     FormAbout.Free;
    101   end;
    102 end;
    103 
    104 procedure TCore.AFileCloseExecute(Sender: TObject);
    105 begin
    106   FileClose;
    107   UpdateFile;
    108 end;
    109 
    110 procedure TCore.AHomePageExecute(Sender: TObject);
    111 begin
    112   OpenWebPage(ApplicationInfo1.HomePage);
    113 end;
    114 
    115 procedure TCore.ASettingsExecute(Sender: TObject);
    116 begin
    117   FormSettings := TFormSettings.Create(nil);
    118   try
    119     FormSettings.LoadData;
    120     if FormSettings.ShowModal = mrOK then
    121       FormSettings.SaveData;
    122   finally
    123     FormSettings.Free;
    124   end;
    125 end;
    126 
    127 procedure TCore.AFileNewExecute(Sender: TObject);
    128 begin
    129   FileNew;
    130   UpdateFile;
    131 end;
    132 
    133 procedure TCore.AFileOpenExecute(Sender: TObject);
     123procedure TCore.AFileMergeExecute(Sender: TObject);
    134124var
    135125  TempFile: TDataFile;
     126  I: Integer;
     127  MergeResult: TMergeResult;
     128  TotalMergeResult: TMergeResult;
    136129begin
    137130  TempFile := DefaultDataFileClass.Create;
     
    146139    OpenDialog1.FileName := ExtractFileName(DataFile.FileName);
    147140  end;
     141  OpenDialog1.Options := OpenDialog1.Options + [ofAllowMultiSelect];
     142  if OpenDialog1.Execute then begin
     143    TotalMergeResult.Clear;
     144    for I := 0 to OpenDialog1.Files.Count - 1 do begin
     145      MergeResult := FileMerge(OpenDialog1.Files[I]);
     146      TotalMergeResult := TotalMergeResult + MergeResult;
     147    end;
     148    ShowMessage(Format(SMergedContacts, [TotalMergeResult.Loaded,
     149      TotalMergeResult.New, TotalMergeResult.Updated]));
     150    UpdateFile;
     151  end;
     152end;
     153
     154procedure TCore.AAboutExecute(Sender: TObject);
     155begin
     156  FormAbout := TFormAbout.Create(nil);
     157  try
     158    FormAbout.ApplicationInfo := ApplicationInfo1;
     159    FormAbout.ShowModal;
     160  finally
     161    FormAbout.Free;
     162  end;
     163end;
     164
     165procedure TCore.AFileCloseExecute(Sender: TObject);
     166begin
     167  FileClose;
     168  UpdateFile;
     169end;
     170
     171procedure TCore.AHomePageExecute(Sender: TObject);
     172begin
     173  OpenWebPage(ApplicationInfo1.HomePage);
     174end;
     175
     176procedure TCore.ASettingsExecute(Sender: TObject);
     177begin
     178  FormSettings := TFormSettings.Create(nil);
     179  try
     180    FormSettings.LoadData;
     181    if FormSettings.ShowModal = mrOK then
     182      FormSettings.SaveData;
     183  finally
     184    FormSettings.Free;
     185  end;
     186end;
     187
     188procedure TCore.AFileNewExecute(Sender: TObject);
     189begin
     190  FileNew;
     191  UpdateFile;
     192end;
     193
     194procedure TCore.AFileOpenExecute(Sender: TObject);
     195var
     196  TempFile: TDataFile;
     197begin
     198  TempFile := DefaultDataFileClass.Create;
     199  try
     200    OpenDialog1.Filter := TempFile.GetFileFilter;
     201  finally
     202    TempFile.Free;
     203  end;
     204  OpenDialog1.DefaultExt := '';
     205  if Assigned(DataFile) then begin
     206    OpenDialog1.InitialDir := ExtractFileDir(DataFile.FileName);
     207    OpenDialog1.FileName := ExtractFileName(DataFile.FileName);
     208  end;
     209  OpenDialog1.Options := OpenDialog1.Options - [ofAllowMultiSelect];
    148210  if OpenDialog1.Execute then begin
    149211    FileOpen(OpenDialog1.FileName);
     
    241303end;
    242304
     305function TCore.FileMerge(FileName: string): TMergeResult;
     306var
     307  TempFile: TContactsFile;
     308  NewContact: TContact;
     309  I: Integer;
     310  CountNew: Integer;
     311  CountUpdated: Integer;
     312begin
     313  Result.Clear;
     314  if FileExists(FileName) then begin
     315    TempFile := TContactsFile.Create;
     316    try
     317      TempFile.LoadFromFile(FileName);
     318      Result.Loaded := TempFile.Contacts.Count;
     319      for I := 0 to TempFile.Contacts.Count - 1 do begin
     320        NewContact := TContactsFile(DataFile).Contacts.Search(TContact(TempFile.Contacts[I]).FullName);
     321        if not Assigned(NewContact) then begin
     322          NewContact := TContact.Create;
     323          NewContact.Parent := TContactsFile(DataFile);
     324          NewContact.Assign(TContact(TempFile.Contacts[I]));
     325          TContactsFile(DataFile).Contacts.Add(NewContact);
     326          Inc(Result.New);
     327        end else begin
     328          if NewContact.UpdateFrom(TContact(TempFile.Contacts[I])) then
     329            Inc(Result.Updated);
     330        end;
     331      end;
     332      TContactsFile(DataFile).Modified := True;
     333    finally
     334      TempFile.Free;
     335    end;
     336  end else ShowMessage(Format(SFileNotFound, [FileName]));
     337end;
     338
    243339procedure TCore.FileNew;
    244340begin
     
    257353    FormContacts.Contacts := TContactsFile(DataFile).Contacts
    258354    else FormContacts.Contacts := nil;
     355  FormContacts.ReloadList;
    259356end;
    260357
Note: See TracChangeset for help on using the changeset viewer.