diff --git a/components/tvplanit/languages/vpsr.de.po b/components/tvplanit/languages/vpsr.de.po index d51e8e4ed..b0a4abe24 100644 --- a/components/tvplanit/languages/vpsr.de.po +++ b/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" diff --git a/components/tvplanit/languages/vpsr.en.po b/components/tvplanit/languages/vpsr.en.po index a866caf14..82580d339 100644 --- a/components/tvplanit/languages/vpsr.en.po +++ b/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" diff --git a/components/tvplanit/languages/vpsr.fi.po b/components/tvplanit/languages/vpsr.fi.po index 44c611db6..e4dd4b99e 100644 --- a/components/tvplanit/languages/vpsr.fi.po +++ b/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 "" diff --git a/components/tvplanit/languages/vpsr.fr.po b/components/tvplanit/languages/vpsr.fr.po index 9595ff077..c724a0d28 100644 --- a/components/tvplanit/languages/vpsr.fr.po +++ b/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" diff --git a/components/tvplanit/languages/vpsr.nl.po b/components/tvplanit/languages/vpsr.nl.po index 719b8fe61..d065cc15a 100644 --- a/components/tvplanit/languages/vpsr.nl.po +++ b/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" diff --git a/components/tvplanit/languages/vpsr.pl.po b/components/tvplanit/languages/vpsr.pl.po index 4b13458a5..93cae1e13 100644 --- a/components/tvplanit/languages/vpsr.pl.po +++ b/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" diff --git a/components/tvplanit/languages/vpsr.pot b/components/tvplanit/languages/vpsr.pot index aba3c2566..dfc6a3abb 100644 --- a/components/tvplanit/languages/vpsr.pot +++ b/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 "" diff --git a/components/tvplanit/languages/vpsr.ru.po b/components/tvplanit/languages/vpsr.ru.po index af108777e..884ff0fd4 100644 --- a/components/tvplanit/languages/vpsr.ru.po +++ b/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 "Выберите звук" diff --git a/components/tvplanit/source/include/vpsr.inc b/components/tvplanit/source/include/vpsr.inc index 256a18f3b..b93b5cde5 100644 --- a/components/tvplanit/source/include/vpsr.inc +++ b/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'; diff --git a/components/tvplanit/source/vpbase.pas b/components/tvplanit/source/vpbase.pas index d4d5dee8b..573349bc7 100644 --- a/components/tvplanit/source/vpbase.pas +++ b/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, diff --git a/components/tvplanit/source/vpbasedatafiles.pas b/components/tvplanit/source/vpbasedatafiles.pas index b3a79ff5a..ba14884b8 100644 --- a/components/tvplanit/source/vpbasedatafiles.pas +++ b/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); - Attr := Split(keypart, TYPE_DELIMITER); // Split at ',' + keypart := copy(keypart, Length('TYPE=')+1, MaxInt); + 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; diff --git a/components/tvplanit/source/vpcontactgrid.pas b/components/tvplanit/source/vpcontactgrid.pas index e3828b212..d707639e2 100644 --- a/components/tvplanit/source/vpcontactgrid.pas +++ b/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,16 +1563,26 @@ 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); - NewItem := TVpMenuItem.Create(Self); - NewItem.Kind := mikImportContactFromVCards; - NewItem.OnClick := PopupAddVCards; - NewItem.Tag := 0; - FDefaultPopup.Items.Add(NewItem); + if RsContactPopupImportVCards <> '' then begin + NewItem := TVpMenuItem.Create(Self); + NewItem.Kind := mikImportContactFromVCards; + 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; @@ -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; diff --git a/components/tvplanit/source/vpdata.pas b/components/tvplanit/source/vpdata.pas index fb9b45a35..cf546ffbb 100644 --- a/components/tvplanit/source/vpdata.pas +++ b/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 diff --git a/components/tvplanit/source/vpimportpreview_vcard.lfm b/components/tvplanit/source/vpimportpreview_vcard.lfm index 27aa7c5bb..a90254590 100644 --- a/components/tvplanit/source/vpimportpreview_vcard.lfm +++ b/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 diff --git a/components/tvplanit/source/vpimportpreview_vcard.pas b/components/tvplanit/source/vpimportpreview_vcard.pas index beac24641..2dff26568 100644 --- a/components/tvplanit/source/vpimportpreview_vcard.pas +++ b/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 diff --git a/components/tvplanit/source/vpmisc.pas b/components/tvplanit/source/vpmisc.pas index a38f5aba6..8b7e333dc 100644 --- a/components/tvplanit/source/vpmisc.pas +++ b/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); diff --git a/components/tvplanit/source/vpvcard.pas b/components/tvplanit/source/vpvcard.pas index 045e27320..059fd1027 100644 --- a/components/tvplanit/source/vpvcard.pas +++ b/components/tvplanit/source/vpvcard.pas @@ -47,6 +47,9 @@ type FCarPhone: String; FISDN: String; FPager: String; + + FBirthDay: TDateTime; + FAnniversary: TDateTime; FSkip: Boolean; public @@ -60,36 +63,41 @@ type function GetPhone: String; function GetWorkAddress: String; - property FirstName: String read FFirstName; - property LastName: String read FLastName; - property Title: String read FTitle; + procedure SaveToStrings(AList: TStrings); - property Company: String read FCompany; - property WorkAddress: String read FWorkAddress; - property WorkCity: String read FWorkCity; - 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 FirstName: String read FFirstName write FFirstName; + property LastName: String read FLastName write FLastName; + property Title: String read FTitle write FTitle; - 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; + property Company: String read FCompany write FCompany; + property WorkAddress: String read FWorkAddress write FWorkAddress; + property WorkCity: String read FWorkCity write FWorkCity; + property WorkZip: String read FWorkZip write FWorkZip; + property WorkState: String read FWorkState write FWorkState; + property WorkCountry: String read FWorkCountry write FWorkCountry; + property WorkEMail: String read FWorkEMail write FWorkEMail; + property WorkPhone: String read FWorkPhone write FWorkPhone; + property WorkFax: String read FWorkFax write FWorkFax; - property CarPhone: String read FCarPhone; - property Mobile: String read FMobile; - property ISDN: String read FISDN; - property Pager: String read FPager; + property HomeAddress: String read FHomeAddress write FHomeAddress; + property HomeCity: String read FHomeCity write FHomeCity; + property HomeZip: String read FHomeZip write FHomeZip; + 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': - FCompany := item.Value; + 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 - FHomeEMail := IfThen(FHomeEMail = '', item.Value, FHomeEMail + ITEM_SEPARATOR + item.Value) + if (item.Attributes.IndexOf('WORK') <> -1) then + 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 - FHomePhone := IfThen(FHomePhone = '', item.Value, FHomePhone + ITEM_SEPARATOR + item.Value) + if item.Attributes.IndexOf('WORK') <> -1 then + 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 := ''; + 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 := ''; + 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; -property LastName: String read FLastName; -property Title: String read FTitle; +procedure TVpVCard.SaveToStrings(AList: TStrings); +var + s: String; +begin + AList.Add('BEGIN:VCARD'); + AList.Add('VERSION:3.0'); -property Company: String read FCompany; -property WorkAddress: String read FWorkAddress; -property WorkCity: String read FWorkCity; -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; + // Name + AList.Add('FN:' + GetFullName); + AList.Add('N:' + LastName + ';' + FirstName + ';;;'); + + // Addresses + if (WorkAddress <> '') or (WorkCity <> '') or (WorkZip <> '') or + (WorkState <> '') or (WorkCountry <> '') + then + 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.