tvplanit: Export contacts as vcard files. Fix some bugs in vcard import.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8395 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/tvplanit/languages/vpsr.de.po

@@ -275,10 +275,6 @@ msgstr "Adress-Einträge"
 msgid "Add contact..."
 msgstr "Kontakt hinzufügen..."
 
-#: vpsr.rscontactpopupaddvcards
-msgid "Add contact from vCard(s)..."
-msgstr "Kontakt hinzufügen von vCard..."
-
 #: vpsr.rscontactpopupdelete
 msgid "Delete contact..."
 msgstr "Kontakt löschen..."
@@ -287,6 +283,14 @@ msgstr "Kontakt löschen..."
 msgid "Edit contact..."
 msgstr "Kontakt bearbeiten..."
 
+#: vpsr.rscontactpopupexportvcard
+msgid "Export contact to vCard..."
+msgstr "Als vCard exportieren..."
+
+#: vpsr.rscontactpopupimportvcards
+msgid "Import contact(s) from vCard(s)..."
+msgstr "Kontakt(e) von vCard(s) importieren..."
+
 #: vpsr.rscontactselement
 msgid "Contacts"
 msgstr "Kontakte"
@@ -1202,6 +1206,10 @@ msgstr "Format in Datei speichern?"
 msgid "Save format to \"%s\"?"
 msgstr "Format speichern als \"%s\"?"
 
+#: vpsr.rssavevcardtitle
+msgid "Export to vCard"
+msgstr "Als vCard exportieren"
+
 #: vpsr.rsselectasound
 msgid "Select A Sound"
 msgstr "Einen Klang auswählen"

components/tvplanit/languages/vpsr.en.po

@@ -274,10 +274,6 @@ msgstr "Contact items"
 msgid "Add contact..."
 msgstr "Add contact..."
 
-#: vpsr.rscontactpopupaddvcards
-msgid "Add contact from vCard(s)..."
-msgstr "Add contact from vCard(s)..."
-
 #: vpsr.rscontactpopupdelete
 msgid "Delete contact..."
 msgstr "Delete contact..."
@@ -286,6 +282,14 @@ msgstr "Delete contact..."
 msgid "Edit contact..."
 msgstr "Edit contact..."
 
+#: vpsr.rscontactpopupexportvcard
+msgid "Export contact to vCard..."
+msgstr "Export contact to vCard..."
+
+#: vpsr.rscontactpopupimportvcards
+msgid "Import contact(s) from vCard(s)..."
+msgstr "Import contact(s) from vCard(s)..."
+
 #: vpsr.rscontactselement
 msgid "Contacts"
 msgstr "Contacts"
@@ -1188,6 +1192,10 @@ msgstr "Save format to file?"
 msgid "Save format to \"%s\"?"
 msgstr "Save format to \"%s\"?"
 
+#: vpsr.rssavevcardtitle
+msgid "Export to vCard"
+msgstr "Export to vCard"
+
 #: vpsr.rsselectasound
 msgid "Select A Sound"
 msgstr "Select A Sound"

components/tvplanit/languages/vpsr.fi.po

@@ -265,10 +265,6 @@ msgstr ""
 msgid "Add contact..."
 msgstr ""
 
-#: vpsr.rscontactpopupaddvcards
-msgid "Add contact from vCard(s)..."
-msgstr ""
-
 #: vpsr.rscontactpopupdelete
 msgid "Delete contact..."
 msgstr ""
@@ -277,6 +273,14 @@ msgstr ""
 msgid "Edit contact..."
 msgstr ""
 
+#: vpsr.rscontactpopupexportvcard
+msgid "Export contact to vCard..."
+msgstr ""
+
+#: vpsr.rscontactpopupimportvcards
+msgid "Import contact(s) from vCard(s)..."
+msgstr ""
+
 #: vpsr.rscontactselement
 msgid "Contacts"
 msgstr ""
@@ -1193,6 +1197,10 @@ msgstr ""
 msgid "Save format to \"%s\"?"
 msgstr ""
 
+#: vpsr.rssavevcardtitle
+msgid "Export to vCard"
+msgstr ""
+
 #: vpsr.rsselectasound
 msgid "Select A Sound"
 msgstr ""

components/tvplanit/languages/vpsr.fr.po

@@ -281,10 +281,6 @@ msgstr ""
 msgid "Add contact..."
 msgstr "Ajouter un contact..."
 
-#: vpsr.rscontactpopupaddvcards
-msgid "Add contact from vCard(s)..."
-msgstr ""
-
 #: vpsr.rscontactpopupdelete
 msgid "Delete contact..."
 msgstr "Supprimer un contact..."
@@ -293,6 +289,14 @@ msgstr "Supprimer un contact..."
 msgid "Edit contact..."
 msgstr "Modifier un contact..."
 
+#: vpsr.rscontactpopupexportvcard
+msgid "Export contact to vCard..."
+msgstr ""
+
+#: vpsr.rscontactpopupimportvcards
+msgid "Import contact(s) from vCard(s)..."
+msgstr ""
+
 #: vpsr.rscontactselement
 msgid "Contacts"
 msgstr ""
@@ -1208,6 +1212,10 @@ msgstr ""
 msgid "Save format to \"%s\"?"
 msgstr ""
 
+#: vpsr.rssavevcardtitle
+msgid "Export to vCard"
+msgstr ""
+
 #: vpsr.rsselectasound
 msgid "Select A Sound"
 msgstr "Choissisez un son"

components/tvplanit/languages/vpsr.nl.po

@@ -275,10 +275,6 @@ msgstr ""
 msgid "Add contact..."
 msgstr "Contact toevoegen..."
 
-#: vpsr.rscontactpopupaddvcards
-msgid "Add contact from vCard(s)..."
-msgstr ""
-
 #: vpsr.rscontactpopupdelete
 msgid "Delete contact..."
 msgstr "Contact wissen..."
@@ -287,6 +283,14 @@ msgstr "Contact wissen..."
 msgid "Edit contact..."
 msgstr "Contact bewerken..."
 
+#: vpsr.rscontactpopupexportvcard
+msgid "Export contact to vCard..."
+msgstr ""
+
+#: vpsr.rscontactpopupimportvcards
+msgid "Import contact(s) from vCard(s)..."
+msgstr ""
+
 #: vpsr.rscontactselement
 msgid "Contacts"
 msgstr ""
@@ -1202,6 +1206,10 @@ msgstr ""
 msgid "Save format to \"%s\"?"
 msgstr ""
 
+#: vpsr.rssavevcardtitle
+msgid "Export to vCard"
+msgstr ""
+
 #: vpsr.rsselectasound
 msgid "Select A Sound"
 msgstr "Kies een geluid"

components/tvplanit/languages/vpsr.pl.po

@@ -275,10 +275,6 @@ msgstr ""
 msgid "Add contact..."
 msgstr "Dodawanie kontaktu..."
 
-#: vpsr.rscontactpopupaddvcards
-msgid "Add contact from vCard(s)..."
-msgstr "Dodawanie kontaktu z pliku vCard"
-
 #: vpsr.rscontactpopupdelete
 msgid "Delete contact..."
 msgstr "Usuń kontakt..."
@@ -287,6 +283,14 @@ msgstr "Usuń kontakt..."
 msgid "Edit contact..."
 msgstr "Edytuj kontakt..."
 
+#: vpsr.rscontactpopupexportvcard
+msgid "Export contact to vCard..."
+msgstr ""
+
+#: vpsr.rscontactpopupimportvcards
+msgid "Import contact(s) from vCard(s)..."
+msgstr ""
+
 #: vpsr.rscontactselement
 msgid "Contacts"
 msgstr "Kontakty"
@@ -1201,6 +1205,10 @@ msgstr "Zapisać dane do pliku?"
 msgid "Save format to \"%s\"?"
 msgstr "Zapisać format do \"%s\"?"
 
+#: vpsr.rssavevcardtitle
+msgid "Export to vCard"
+msgstr ""
+
 #: vpsr.rsselectasound
 msgid "Select A Sound"
 msgstr "Wybierz dźwięk"

components/tvplanit/languages/vpsr.pot

@@ -264,10 +264,6 @@ msgstr ""
 msgid "Add contact..."
 msgstr ""
 
-#: vpsr.rscontactpopupaddvcards
-msgid "Add contact from vCard(s)..."
-msgstr ""
-
 #: vpsr.rscontactpopupdelete
 msgid "Delete contact..."
 msgstr ""
@@ -276,6 +272,14 @@ msgstr ""
 msgid "Edit contact..."
 msgstr ""
 
+#: vpsr.rscontactpopupexportvcard
+msgid "Export contact to vCard..."
+msgstr ""
+
+#: vpsr.rscontactpopupimportvcards
+msgid "Import contact(s) from vCard(s)..."
+msgstr ""
+
 #: vpsr.rscontactselement
 msgid "Contacts"
 msgstr ""
@@ -1178,6 +1182,10 @@ msgstr ""
 msgid "Save format to \"%s\"?"
 msgstr ""
 
+#: vpsr.rssavevcardtitle
+msgid "Export to vCard"
+msgstr ""
+
 #: vpsr.rsselectasound
 msgid "Select A Sound"
 msgstr ""

components/tvplanit/languages/vpsr.ru.po

@@ -275,10 +275,6 @@ msgstr ""
 msgid "Add contact..."
 msgstr "Добавить контакт..."
 
-#: vpsr.rscontactpopupaddvcards
-msgid "Add contact from vCard(s)..."
-msgstr ""
-
 #: vpsr.rscontactpopupdelete
 msgid "Delete contact..."
 msgstr "Удалить контакт..."
@@ -287,6 +283,14 @@ msgstr "Удалить контакт..."
 msgid "Edit contact..."
 msgstr "Изменить контакт"
 
+#: vpsr.rscontactpopupexportvcard
+msgid "Export contact to vCard..."
+msgstr ""
+
+#: vpsr.rscontactpopupimportvcards
+msgid "Import contact(s) from vCard(s)..."
+msgstr ""
+
 #: vpsr.rscontactselement
 msgid "Contacts"
 msgstr "Контакты"
@@ -1202,6 +1206,10 @@ msgstr ""
 msgid "Save format to \"%s\"?"
 msgstr ""
 
+#: vpsr.rssavevcardtitle
+msgid "Export to vCard"
+msgstr ""
+
 #: vpsr.rsselectasound
 msgid "Select A Sound"
 msgstr "Выберите звук"

components/tvplanit/source/include/vpsr.inc

@@ -162,11 +162,13 @@ resourcestring
 
   {Contact Specific}
   RSContactPopupAdd         = 'Add contact...';
-  RSContactPopupAddVCards   = 'Add contact from vCard(s)...';
   RSContactPopupEdit        = 'Edit contact...';
   RSContactPopupDelete      = 'Delete contact...';
   RSConfirmDeleteContact    = 'Delete contact %s?';
+  RSContactPopupImportVCards= 'Import contact(s) from vCard(s)...';
+  RSContactPopupExportVCard = 'Export contact to vCard...';
   RSLoadVCardsTitle         = 'Import from vCard(s)';
+  RSSaveVCardTitle          = 'Export to vCard';
   RSVCardFilter             = 'vCard files (*.vcf)|*.vcf';
   RSContactItems            = 'Contact items';
 

components/tvplanit/source/vpbase.pas

@@ -81,7 +81,8 @@ type
     mikAddEvent, mikEditEvent, mikDeleteEvent,
     mikAddTask, mikEditTask, mikDeleteTask,
     mikAddContact, mikEditContact, mikDeleteContact,
-    mikImportEventFromICal, mikImportTaskFromICal, mikImportContactFromVCards,
+    mikImportEventFromICal, mikImportTaskFromICal,
+    mikImportContactFromVCards, mikExportContactToVCard,
     mikResourceGroups, mikNoOverlaidEvents,
     mikChangeDate, mikCustomDate, mikToday, mikYesterday, mikTomorrow,
     mikPrevDay, mikNextDay, mikPrevWeek, mikNextWeek,
@@ -93,7 +94,8 @@ type
      RSPopupAddEvent, RSPopupEditEvent, RSPopupDeleteEvent,
      RSTaskPopupAdd, RSTaskPopupEdit, RSTaskPopupDelete,
      RSContactPopupAdd, RSContactPopupEdit, RSContactPopupDelete,
-     RSPopupAddEventFromICal, RSPopupAddTaskFromICal, RSContactPopupAddVCards,
+     RSPopupAddEventFromICal, RSPopupAddTaskFromICal,
+     RSContactPopupImportVCards, RSContactPopupExportVCard,
      RSPopupResourceGroups, RSNoOverlayedEvents,
      RSPopupChangeDate, RSCustomDate, RSToday, RSYesterday, RSTomorrow,
      RSPrevDay, RSNextDay, RSPrevWeek, RSNextWeek,

components/tvplanit/source/vpbasedatafiles.pas

@@ -94,8 +94,9 @@ procedure TVpFileItem.GetParts(AText: String; out AKey: String;
 var
   p: Integer;
   keypart, valuepart: String;
-  i: Integer;
+  i, j, n: Integer;
   QuotedPrintable: Boolean = false;
+  sa: TStringArray = nil;
 begin
   // Split at ':' into key and value parts
   p := pos(KEY_VALUE_DELIMITER, AText);
@@ -106,6 +107,25 @@ begin
 
   // Process key part
   Attr := nil;
+  (*
+  sa := keypart.Split(KEY_DELIMITER);
+  AKey := sa[0];
+  for i := 1 to High(sa) do
+    // We only consider the "type" attributes...
+    if pos('TYPE=', Uppercase(sa[i])) = 1 then
+    begin
+      keypart := copy(keypart, Length('TYPE='), MaxInt);
+      Attr := keypart.Split(TYPE_DELIMITER);  // Split at ','
+    end else
+      Attr := keypart.Split(KEY_DELIMITER);   // Split at ';'
+
+  for i := Low(Attr) to High(Attr) do
+    if Attr[i] = 'QUOTED-PRINTABLE' then
+    begin
+      QuotedPrintable := true;
+      break;
+    end;
+    *)
   p := pos(KEY_DELIMITER, keypart);
   if p = 0 then begin
     AKey := keypart;
@@ -114,10 +134,21 @@ begin
     AKey := Copy(keypart, 1, p-1);
     keypart := Copy(keypart, p+1, MaxInt);
     if pos('TYPE=', keypart) = 1 then begin
-      keypart := copy(keypart, Length('TYPE='), MaxInt);
+      keypart := copy(keypart, Length('TYPE=')+1, MaxInt);
-      Attr := Split(keypart, TYPE_DELIMITER);  // Split at ','
+      sa := Split(keypart, TYPE_DELIMITER);  // Split at ','
+      n := Length(Attr);
+      SetLength(Attr, n + Length(sa));
+      for j := 0 to High(sa) do
+        Attr[n+j] := sa[j];
     end else
-      Attr := Split(keypart, KEY_DELIMITER);   // Split at ';'
+    begin
+      sa := Split(keypart, KEY_DELIMITER);   // Split at ';'
+      n := Length(Attr);
+      SetLength(Attr, n + Length(sa));
+      for j := 0 to High(sa) do
+        Attr[n+j] := sa[j];
+    end;
+
     for i:=Low(Attr) to High(Attr) do
       if Attr[i] = 'QUOTED-PRINTABLE' then begin
         QuotedPrintable := true;

components/tvplanit/source/vpcontactgrid.pas

@@ -201,9 +201,10 @@ type
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
     procedure ScrollIntoView;
     procedure PopupAddContact(Sender: TObject);
-    procedure PopupAddVCards(Sender: TObject);
     procedure PopupDeleteContact(Sender: TObject);
     procedure PopupEditContact(Sender: TObject);
+    procedure PopupExportVCard(Sender: TObject);
+    procedure PopupImportVCards(Sender: TObject);
     procedure EditContact;
     procedure EndEdit(Sender: TObject);
     function GetPopupMenu: TPopupMenu; override;
@@ -249,6 +250,7 @@ type
       Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime;
       StartLine, StopLine: Integer; UseGran: TVpGranularity;
       DisplayOnly: Boolean); override;
+    procedure ExportVCardFile(const AFileName: String; const AContacts: TVpContactArr);
     function ImportVCardFile(const AFileName: String; 
       APreview: Boolean = false): TVpContactArr;
 
@@ -1078,7 +1080,9 @@ begin
   end else
   if Button = mbRight then begin
     HideHintWindow;
-    if not Assigned (PopupMenu) then begin
+    //if not Assigned (PopupMenu) then begin
+    if (PopupMenu = FDefaultPopup) then
+    begin
       if not Focused then
         SetFocus;
       cgClickPoint := Point(X, Y);
@@ -1539,7 +1543,7 @@ begin
     NewItem := TVpMenuItem.Create(Self);
     NewItem.Kind := mikAddContact;
     NewItem.OnClick := PopupAddContact;
-    NewItem.Tag := 0;
+    NewItem.Tag := 0;             // Tag = 1: disabled when readonly or no active contact.
     FDefaultPopup.Items.Add(NewItem);
   end;
 
@@ -1559,17 +1563,27 @@ begin
     FDefaultPopup.Items.Add(NewItem);
   end;
 
-  if RsContactPopupAddVCards <> '' then begin
+  if (RsContactPopupImportVCards <> '') or (RSContactPopupExportVCard <> '') then begin
     NewItem := TVpMenuItem.Create(Self);
     NewItem.Kind := mikSeparator;
     FDefaultPopup.Items.Add(NewItem);
 
+    if RsContactPopupImportVCards <> '' then begin
       NewItem := TVpMenuItem.Create(Self);
       NewItem.Kind := mikImportContactFromVCards;
-    NewItem.OnClick := PopupAddVCards;
+      NewItem.OnClick := PopupImportVCards;
       NewItem.Tag := 0;
       FDefaultPopup.Items.Add(NewItem);
     end;
+
+    if RsContactPopupExportVCard <> '' then begin
+      NewItem := TVpMenuItem.Create(Self);
+      NewItem.Kind := mikExportContactToVCard;
+      NewItem.OnClick := PopupExportVCard;
+      NewItem.Tag := 1;
+      FDefaultPopup.Items.Add(NewItem);
+    end;
+  end;
 end;
 
 procedure TVpContactGrid.PopupAddContact(Sender: TObject);
@@ -1591,6 +1605,15 @@ begin
   cgSpawnContactEditDialog(True);
 end;
 
+procedure TVpContactGrid.ExportVCardFile(const AFileName: String;
+  const AContacts: TVpContactArr);
+begin
+  if (not Assigned(Datastore)) or (not Assigned(Datastore.Resource)) then
+    exit;
+
+  Datastore.Resource.Contacts.ExportVCardFile(AFileName, AContacts);
+end;
+
 function TVpContactGrid.ImportVCardFile(const AFileName: String; 
   APreview: Boolean = false): TVpContactArr;
 begin
@@ -1609,7 +1632,46 @@ begin
   end;
 end;
 
-procedure TVpContactGrid.PopupAddVCards(Sender: TObject);
+procedure TVpContactGrid.PopupDeleteContact (Sender : TObject);
+begin
+  if ReadOnly then                                                     
+    Exit;                                                              
+  if FActiveContact <> nil then
+    DeleteActiveContact (True);
+end;
+
+procedure TVpContactGrid.PopupEditContact (Sender : TObject);
+begin
+  if ReadOnly then                                                     
+    Exit;                                                              
+  if FActiveContact <> nil then
+    { edit this contact }
+    cgSpawnContactEditDialog(False);
+end;
+
+procedure TVpContactGrid.PopupExportVCard(Sender: TObject);
+var
+  dlg: TSaveDialog;
+begin
+  if (not Assigned(Datastore)) or (not Assigned(Datastore.Resource)) or
+    (FActiveContact = nil)
+  then
+    exit;
+
+  dlg := TSaveDialog.Create(nil);
+  try
+    dlg.Title := RSSaveVCardTitle;
+    dlg.Filter := RSVCardFilter;
+    dlg.FileName := '';
+    dlg.Options := dlg.Options - [ofAllowMultiSelect] + [ofOverwritePrompt];
+    if dlg.Execute then
+      ExportVCardFile(dlg.FileName, [FActiveContact]);
+  finally
+    dlg.Free;
+  end;
+end;
+
+procedure TVpContactGrid.PopupImportVCards(Sender: TObject);
 var
   dlg: TOpenDialog;
   vcards: TVpVCards;
@@ -1631,50 +1693,12 @@ begin
     if dlg.Execute then begin
       for fn in dlg.Files do
         ImportVCardFile(fn, dlg.Files.Count=1);
-        (*
-      Screen.Cursor := crHourGlass;
-      Application.ProcessMessages;
-      vcards := TVpVCards.Create;
-      try
-        for fn in dlg.Files do begin
-          vcards.LoadFromFile(fn);
-          for i := 0 to vcards.Count-1 do begin
-            id := DataStore.GetNextID (ContactsTableName);
-            FActiveContact := Datastore.Resource.Contacts.AddContact(id);
-            FActiveContact.LoadFromVCard(vcards[i]);
-            Datastore.PostContacts;
-            DataStore.NotifyDependents;
-          end;
-        end;
-        Invalidate;
-      finally
-        vcards.Free;
-        Screen.Cursor := crDefault;
-      end;
-      *)
     end;
   finally
     dlg.Free;
   end;
 end;
 
-procedure TVpContactGrid.PopupDeleteContact (Sender : TObject);
-begin
-  if ReadOnly then                                                     
-    Exit;                                                              
-  if FActiveContact <> nil then
-    DeleteActiveContact (True);
-end;
-
-procedure TVpContactGrid.PopupEditContact (Sender : TObject);
-begin
-  if ReadOnly then                                                     
-    Exit;                                                              
-  if FActiveContact <> nil then
-    { edit this contact }
-    cgSpawnContactEditDialog(False);
-end;
-
 procedure TVpContactGrid.KeyDown(var Key: Word; Shift: TShiftState);
 var
   PopupPoint: TPoint;

components/tvplanit/source/vpdata.pas

@@ -495,6 +495,7 @@ type
     function GetContact(Index: Integer): TVpContact;
     function Last:TVpContact;
     function ImportVCardFile(const AFileName: String; const APreview: Boolean = false): TVpContactArr;
+    procedure ExportVCardFile(const AFileName: String; const AContacts: TVpContactArr);
     procedure Sort;
 
     property ContactsList: TList
@@ -626,6 +627,9 @@ type
     function ContainsWorkData: Boolean;
     function ContainsHomeData: Boolean;
     function FullName: string;
+
+    // VCards
+    function CreateVCard: TVpVCard;
     procedure LoadFromVCard(ACard: TVpVCard);
 
     property Loading: Boolean read FLoading write FLoading;
@@ -2117,6 +2121,100 @@ begin
   Result := (Address1 <> '') or (FCity1 <> '') or (FState1 <> '') or (FCountry1 <> '');
 end;
 
+function TVpContact.CreateVCard: TVpVCard;
+
+  function FirstOrSecond(Which, KeyFirst, KeySecond: Integer; First, Second: String): String;
+  begin
+    if Which = KeyFirst then
+      Result := First
+    else if Which = KeySecond then
+      Result := Second
+    else
+      Result := '';
+  end;
+
+  function GetAddressDetail(AddrType: TVpAddressType; What: String): String;
+  var
+    at: integer;
+  begin
+    at := ord(AddrType);
+    case What of
+      'Address':
+        Result := FirstOrSecond(at, FAddressType1, FAddressType2, FAddress1, FAddress2);
+      'City':
+        Result := FirstOrSecond(at, FAddressType1, FAddressType2, FCity1, FCity2);
+      'Zip':
+        Result := FirstOrSecond(at, FAddressType1, FAddressType2, FZip1, FZip2);
+      'State':
+        Result := FirstOrSecond(at, FAddressType1, FAddressType2, FState1, FState2);
+      'Country':
+        Result := FirstOrSecond(at, FAddressType1, FAddressType2, FCountry1, FCountry2);
+    end;
+  end;
+
+  function GetEMail(AEMailType: TVpEMailType): String;
+  begin
+    if ord(AEMailType) = FEMailType1 then
+      Result := FEMail1
+    else if ord(AEMailType) = FEMailType2 then
+      Result := FEMail2
+    else if ord(AEMailType) = FEMailType3 then
+      Result := FEMail3
+    else
+      Result := '';
+  end;
+
+  function GetPhone(APhoneType: TVpPhoneType): String;
+  begin
+    if ord(APhoneType) = FPhoneType1 then
+      Result := FPhone1
+    else if ord(APhoneType) = FPhoneType2 then
+      Result := FPhone2
+    else if ord(APhoneType) = FPhoneType3 then
+      Result := FPhone3
+    else if ord(APhoneType) = FPhoneType4 then
+      Result := FPhone4
+    else if ord(APhoneType) = FPhoneType5 then
+      Result := FPhone5
+    else
+      Result := '';
+  end;
+
+
+begin
+  Result := TVpVCard.Create;
+  Result.LastName := FLastName;
+  Result.FirstName := FFirstName;
+  Result.Title := FTitle;
+
+  Result.Company := FCompany;
+  Result.WorkAddress := GetAddressDetail(atWork, 'Address');
+  Result.WorkCity := GetAddressDetail(atWork, 'City');
+  Result.WorkZip := GetAddressDetail(atWork, 'Zip');
+  Result.WorkState := GetAddressDetail(atWork, 'State');
+  Result.WorkCountry := GetAddressDetail(atWork, 'Country');
+  Result.WorkPhone := GetPhone(ptWork);
+  Result.WorkFax := GetPhone(ptWorkFax);
+  Result.WorkEMail := GetEMail(mtWork);
+
+  Result.WorkAddress := GetAddressDetail(atHome, 'Address');
+  Result.WorkCity := GetAddressDetail(atHome, 'City');
+  Result.WorkZip := GetAddressDetail(atHome, 'Zip');
+  Result.WorkState := GetAddressDetail(atHome, 'State');
+  Result.WorkCountry := GetAddressDetail(atHome, 'Country');
+  Result.HomePhone := GetPhone(ptHome);
+  Result.HomeFax := GetPhone(ptHomeFax);
+  Result.HomeEMail := GetEMail(mtHome);
+
+  Result.CarPhone := GetPhone(ptCar);
+  Result.Mobile := GetPhone(ptMobile);
+  Result.ISDN := GetPhone(ptISDN);
+  Result.Pager := GetPhone(ptPager);
+
+  Result.BirthDay := FBirthdate;
+  Result.Anniversary := FAnniversary;
+end;
+
 function TVpContact.FullName : string;
 begin
   if (FFirstName = '') and (FLastName = '') then
@@ -2790,6 +2888,23 @@ begin
   end;
 end;
 
+procedure TVpContacts.ExportVCardFile(const AFileName: String;
+  const AContacts: TVpContactArr);
+var
+  vCards: TVpVCards;
+  lContact: TVpContact;
+begin
+  vCards := TVpVCards.Create;
+  try
+    for lContact in AContacts do
+      if lContact <> nil then
+        vCards.Add(lContact.CreateVCard);
+    vCards.SaveToFile(AFileName);
+  finally
+    vCards.Free;
+  end;
+end;
+
 function TVpContacts.ImportVCardFile(const AFileName: String; 
   const APreview: Boolean = false): TVpContactArr;
 const

components/tvplanit/source/vpimportpreview_vcard.lfm

@@ -20,11 +20,11 @@ inherited VpImportPreviewVCardForm: TVpImportPreviewVCardForm
         PickList.Strings = (        )
         ReadOnly = True
         Title.Caption = 'Items'
-        Width = 630
+        Width = 634
       end>
     ColWidths = (
       33
-      630
+      634
     )
   end
   inherited ButtonPanel: TPanel

components/tvplanit/source/vpimportpreview_vcard.pas

@@ -79,15 +79,15 @@ begin
   
   s := ACard.GetWorkAddress;
   if s <> '' then
-    Result := Result + LineEnding + RSWorkAddress + ' ' + s;
+    Result := Result + LineEnding + RSWorkAddress + ': ' + s;
   
   s := ACard.GetHomeAddress;
   if s <> '' then
-    Result := Result + LineEnding + RSHomeAddress + ' ' + s;
+    Result := Result + LineEnding + RSHomeAddress + ': ' + s;
   
   s := ACard.GetPhone;
   if s <> '' then
-    Result := Result + LineEnding + RSPhone + ' ' + s;
+    Result := Result + LineEnding + RSPhone + ': ' + s;
   
   s := ACard.GetEMail;
   if s <> '' then

components/tvplanit/source/vpmisc.pas

@@ -205,7 +205,7 @@ implementation
 uses
   Math,
  {$IFDEF LCL}
-  DateUtils, StrUtils, EditBtn, ButtonPanel,
+  DateUtils, StrUtils, LazUTF8, EditBtn, ButtonPanel,
  {$ENDIF}
   VpSR, VpBaseDS;
 
@@ -395,7 +395,7 @@ var
 begin
   {be sure that the Canvas Font is set before entering this routine}
   EllipsisWidth := Canvas.TextWidth(ELLIPSIS);
-  Len := Length(S);
+  Len := UTF8Length(S);
   Result := S;
   Extent := Canvas.TextWidth(Result);
   ShowEllipsis := False;
@@ -404,7 +404,7 @@ begin
     ShowEllipsis := True;
     Width := MaxWidth - EllipsisWidth;
     if Len > MinChars then begin
-      Delete(Result, Len, 1);
+      UTF8Delete(Result, Len, 1);
       dec(Len);
     end else
       break;
@@ -416,7 +416,7 @@ begin
     Extent := Canvas.TextWidth(Result);
     iDots := 3;
     while (iDots > 0) and (Extent > MaxWidth) do begin
-      Delete(Result, Len, 1);
+      UTF8Delete(Result, Len, 1);
       Dec(Len);
       Extent := Canvas.TextWidth(Result);
       Dec(iDots);

components/tvplanit/source/vpvcard.pas

@@ -48,6 +48,9 @@ type
     FISDN: String;
     FPager: String;
 
+    FBirthDay: TDateTime;
+    FAnniversary: TDateTime;
+    
     FSkip: Boolean;
   public
     constructor Create;
@@ -60,36 +63,41 @@ type
     function GetPhone: String;
     function GetWorkAddress: String;
 
-    property FirstName: String read FFirstName;
+    procedure SaveToStrings(AList: TStrings);
-    property LastName: String read FLastName;
-    property Title: String read FTitle;
 
-    property Company: String read FCompany;
+    property FirstName: String read FFirstName write FFirstName;
-    property WorkAddress: String read FWorkAddress;
+    property LastName: String read FLastName write FLastName;
-    property WorkCity: String read FWorkCity;
+    property Title: String read FTitle write FTitle;
-    property WorkZip: String read FWorkZip;
-    property WorkState: String read FWorkState;
-    property WorkCountry: String read FWorkCountry;
-    property WorkEMail: String read FWorkEMail;
-    property WorkPhone: String read FWorkPhone;
-    property WorkFax: String read FWorkFax;
 
-    property HomeAddress: String read FHomeAddress;
+    property Company: String read FCompany write FCompany;
-    property HomeCity: String read FHomeCity;
+    property WorkAddress: String read FWorkAddress write FWorkAddress;
-    property HomeZip: String read FHomeZip;
+    property WorkCity: String read FWorkCity write FWorkCity;
-    property HomeState: String read FHomeState;
+    property WorkZip: String read FWorkZip write FWorkZip;
-    property HomeCountry: String read FHomeCountry;
+    property WorkState: String read FWorkState write FWorkState;
-    property HomeEMail: String read FHomeEMail;
+    property WorkCountry: String read FWorkCountry write FWorkCountry;
-    property HomePhone: String read FHomePhone;
+    property WorkEMail: String read FWorkEMail write FWorkEMail;
-    property HomeFax: String read FHomeFax;
+    property WorkPhone: String read FWorkPhone write FWorkPhone;
+    property WorkFax: String read FWorkFax write FWorkFax;
 
-    property CarPhone: String read FCarPhone;
+    property HomeAddress: String read FHomeAddress write FHomeAddress;
-    property Mobile: String read FMobile;
+    property HomeCity: String read FHomeCity write FHomeCity;
-    property ISDN: String read FISDN;
+    property HomeZip: String read FHomeZip write FHomeZip;
-    property Pager: String read FPager;
+    property HomeState: String read FHomeState write FHomeState;
+    property HomeCountry: String read FHomeCountry write FHomeCountry;
+    property HomeEMail: String read FHomeEMail write FHomeEMail;
+    property HomePhone: String read FHomePhone write FHomePhone;
+    property HomeFax: String read FHomeFax write FHomeFax;
+
+    property CarPhone: String read FCarPhone write FCarPhone;
+    property Mobile: String read FMobile write FMobile;
+    property ISDN: String read FISDN write FISDN;
+    property Pager: String read FPager write FPager;
+
+    property BirthDay: TDateTime read FBirthday write FBirthDay;
+    property Anniversary: TDateTime read FAnniversary write FAnniversary;
 
     property Version: String read FVersion;
-    property Skip: Boolean read FSkip write FSkip;
+    property Skip: Boolean read FSkip write FSkip;     // Flag to skip import
   end;
 
   TVpVCards = class
@@ -99,12 +107,17 @@ type
     function GetCount: Integer;
   protected
     procedure LoadFromStrings(const AStrings: TStrings);
+    procedure SaveToStrings(AList: TStrings);
+
   public
     constructor Create;
     destructor Destroy; override;
+    procedure Add(ACard: TVpVCard);
     procedure ClearCards;
     procedure LoadFromFile(const AFileName: String);
     procedure LoadFromStream(const AStream: TStream);
+    procedure SaveToFile(const AFileName: String);
+    procedure SaveToStream(const AStream: TStream);
     property Count: Integer read GetCount;
     property Card[AIndex: Integer]: TVpVCard read GetCard; default;
   end;
@@ -203,6 +216,8 @@ var
   item: TVpVCardItem;
   fn, ln, t: String;
   fullName: String;
+  fs: TFormatSettings;
+  dt: TDateTime;
 begin
   inherited;
 
@@ -221,7 +236,11 @@ begin
           if FTitle = '' then FTitle := t;
         end;
       'ORG':
+        begin
           FCompany := item.Value;
+          if (FCompany <> '') and (FCompany[Length(FCompany)] = ';') then
+            Delete(FCompany, Length(FCompany), 1);
+        end;
       'ADR':
         if item.Attributes.IndexOf('WORK') <> -1 then
           VCardAddress(item.Value, FWorkAddress, FWorkCity, FWorkZip, FWorkState, FWorkCountry)
@@ -233,10 +252,13 @@ begin
         else
           VCardAddress(item.Value, FWorkAddress, FWorkCity, FWorkZip, FWorkState, FWorkCountry);
       'EMAIL':
-        if (FCompany = '') or (item.Attributes.IndexOf('HOME') <> -1) then
+        if (item.Attributes.IndexOf('WORK') <> -1) then
-          FHomeEMail := IfThen(FHomeEMail = '', item.Value, FHomeEMail + ITEM_SEPARATOR + item.Value)
+          FWorkEMail := IfThen(FWorkEMail = '', item.Value, FWorkEMail + ITEM_SEPARATOR + ' ' + item.Value)
         else
-          FWorkEMail := IfThen(FWorkEMail = '', item.Value, FWorkEMail + ITEM_SEPARATOR + item.Value);
+        if (FCompany = '') or (item.Attributes.IndexOf('HOME') <> -1) then
+          FHomeEMail := IfThen(FHomeEMail = '', item.Value, FHomeEMail + ITEM_SEPARATOR + ' ' + item.Value)
+        else
+          FWorkEMail := IfThen(FWorkEMail = '', item.Value, FWorkEMail + ITEM_SEPARATOR + ' ' + item.Value);
       'TEL':
         if item.Attributes.IndexOf('CELL') <> -1 then
           FMobile := item.Value
@@ -256,10 +278,26 @@ begin
         if item.Attributes.IndexOf('ISDN') <> -1 then
           FISDN := item.Value
         else
-        if (FCompany = '') or (item.Attributes.IndexOf('HOME') <> -1) then
+        if item.Attributes.IndexOf('WORK') <> -1 then
-          FHomePhone := IfThen(FHomePhone = '', item.Value, FHomePhone + ITEM_SEPARATOR + item.Value)
+          FWorkPhone := IfThen(FWorkPhone = '', item.Value, FWorkPhone + ITEM_SEPARATOR + ' ' + item.Value)
         else
-          FWorkPhone := IfThen(FWorkPhone = '', item.Value, FWorkPhone + ITEM_SEPARATOR + item.Value);
+        if (item.Attributes.IndexOf('HOME') <> -1) then
+          FHomePhone := IfThen(FHomePhone = '', item.Value, FHomePhone + ITEM_SEPARATOR + ' ' +item.Value)
+        else
+          FWorkPhone := IfThen(FWorkPhone = '', item.Value, FWorkPhone + ITEM_SEPARATOR + ' ' + item.Value);
+      'BDAY', 'ANNIVERSARY':
+        begin
+          fs := FormatSettings;
+          fs.DateSeparator := '-';
+          fs.ShortDateFormat := 'yyyy/mm/dd';
+          if TryStrToDate(item.Value, dt) then
+          begin
+            if (item.Key = 'BDAY') then
+              FBirthday := dt
+            else if (item.Key = 'ANNIVERSARY') then
+              FAnniversary := dt;
+          end;
+        end;
     end;
   end;
   
@@ -277,19 +315,12 @@ begin
 end;
 
 function TVpVCard.GetEMail: String;
-var
-  sw, sh: String;
 begin
-  if WorkEMail <> '' then sw := Format('%s (work)', [WorkEMail]) else sw := '';
-  if HomeEMail <> '' then sh := Format('%s (home)', [HomeEMail]) else sh := '';
-  if (sw <> '') and (sh <> '') then
-    Result := sw + '; ' + sh
-  else if (sw <> '') then
-    Result := sw
-  else if (sh <> '') then
-    Result := sh
-  else
   Result := '';
+  if WorkEMail <> '' then Result := Format('%s; %s (work)', [Result, WorkEMail]);
+  if HomeEMail <> '' then Result := Format('%s; %s (home)', [Result, HomeEMail]);
+  if Result <> '' then
+    Delete(Result, 1, 2);
 end;
 
 function TVpVCard.GetFullName: String;
@@ -312,19 +343,12 @@ begin
 end;
 
 function TVpVCard.GetPhone: String; 
-var
-  sw, sh: String;
 begin
-  if WorkPhone <> '' then sw := Format('%s (work)', [WorkPhone]) else sw := '';
-  if HomePhone <> '' then sh := Format('%s (home)', [HomePhone]) else sh := '';
-  if (sw <> '') and (sh <> '') then
-    Result := sw + '; ' + sh
-  else if (sw <> '') then
-    Result := sw
-  else if (sh <> '') then
-    Result := sh
-  else
   Result := '';
+  if WorkPhone <> '' then Result := Format('%s; %s (work)', [Result, WorkPhone]);
+  if HomePhone <> '' then Result := Format('%s; %s (home)', [Result, HomePhone]);
+  if Mobile <> '' then Result := Format('%s; %s (mobile)', [Result, Mobile]);
+  if Result <> '' then Delete(Result, 1, 2);
 end;
   
 function TVpVCard.GetWorkAddress: String;
@@ -339,33 +363,63 @@ begin
   if WorkCountry <> '' then
     Result := Result + ', ' + WorkCountry;
 end;
-                             (*
-function GetHomeAddress: String;
-function GetWorkAddress: String;
 
-property FirstName: String read FFirstName;
+procedure TVpVCard.SaveToStrings(AList: TStrings);
-property LastName: String read FLastName;
+var
-property Title: String read FTitle;
+  s: String;
+begin
+  AList.Add('BEGIN:VCARD');
+  AList.Add('VERSION:3.0');
 
-property Company: String read FCompany;
+  // Name
-property WorkAddress: String read FWorkAddress;
+  AList.Add('FN:' + GetFullName);
-property WorkCity: String read FWorkCity;
+  AList.Add('N:' + LastName + ';' + FirstName + ';;;');
-property WorkZip: String read FWorkZip;
+
-property WorkState: String read FWorkState;
+  // Addresses
-property WorkCountry: String read FWorkCountry;
+  if (WorkAddress <> '') or (WorkCity <> '') or (WorkZip <> '') or
-property WorkEMail: String read FWorkEMail;
+     (WorkState <> '') or (WorkCountry <> '')
-property WorkPhone: String read FWorkPhone;
+  then
-property WorkFax: String read FWorkFax;
+    AList.Add('ADR;TYPE=WORK:' + WorkAddress + ';' + WorkCity + ';' +
+      WorkState +';' + WorkZip + ';' + WorkCountry);
+  if (HomeAddress <> '') or (HomeCity <> '') or (HomeZip <> '') or
+     (HomeState <> '') or (HomeCountry <> '')
+  then
+    AList.Add('ADR;TYPE=HOME:' + HomeAddress + ';' + HomeCity + ';' +
+      HomeState +';' + HomeZip + ';' + HomeCountry);
+
+  // Company
+  if Company <> '' then
+    AList.Add('ORG:' + Company);
+
+  // Phone numbers
+  if WorkPhone <> '' then
+    AList.Add('TEL;TYPE=WORK:' + WorkPhone);
+  if HomePhone <> '' then
+    AList.Add('TEL;TYPE=HOME:' + HomePhone);
+  if Mobile <> '' then
+    AList.Add('TEL;TYPE=CELL:' + Mobile);
+  if CarPhone <> '' then
+    AList.Add('TEL;TYPE=CAR:' + CarPhone);
+  if ISDN <> '' then
+    AList.Add('TEL;TYPE=ISDN:' + ISDN);
+  if Pager <> '' then
+    AList.Add('TEL;TYPE=PAGER:' + Pager);
+
+  // Fax
+  if WorkFax <> '' then
+    AList.Add('TEL;TYPE="fax,work":' + WorkFax);
+  if HomeFax <> '' then
+    AList.Add('TEL;TYPE="fax,home":' + HomeFax);
+
+  // E-Mail
+  if WorkEMail <> '' then
+    AList.Add('EMAIL;TYPE=WORK:' + WorkEMail);
+  if HomeEMail <> '' then
+    AList.Add('EMAIL;TYPE=HOME:' + HomeEMail);
+
+  AList.Add('END:VCARD');
+end;
 
-property HomeAddress: String read FHomeAddress;
-property HomeCity: String read FHomeCity;
-property HomeZip: String read FHomeZip;
-property HomeState: String read FHomeState;
-property HomeCountry: String read FHomeCountry;
-property HomeEMail: String read FHomeEMail;
-property HomePhone: String read FHomePhone;
-property HomeFax: String read FHomeFax;
-                               *)
 
 {==============================================================================}
 {                                TVpCards                                      }
@@ -383,6 +437,15 @@ begin
   inherited;
 end;
 
+procedure TVpVCards.Add(ACard: TVpVCard);
+var
+  n: Integer;
+begin
+  n := Length(FCards);
+  SetLength(FCards, n+1);
+  FCards[n] := ACard;
+end;
+
 procedure TVpVCards.ClearCards;
 var
   j: Integer;
@@ -466,5 +529,40 @@ begin
   SetLength(FCards, n);
 end;
 
+procedure TVpVCards.SaveToFile(const AFileName: String);
+var
+  L: TStrings;
+begin
+  L := TStringList.Create;
+  try
+    SaveToStrings(L);
+    L.SaveToFile(AFileName);
+  finally
+    L.Free;
+  end;
+end;
+
+procedure TVpVCards.SaveToStream(const AStream: TStream);
+var
+  L: TStrings;
+begin
+  L := TStringList.Create;
+  try
+    SaveToStrings(L);
+    L.SaveToStream(AStream);
+  finally
+    L.Free;
+  end;
+end;
+
+procedure TVpVCards.SaveToStrings(AList: TStrings);
+var
+  i: Integer;
+begin
+  AList.clear;
+  for i := 0 to Count-1 do
+    FCards[i].SaveToStrings(AList);
+end;
+
 end.