pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

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

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8395 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-08-18 17:44:47 +00:00
parent 0afcfc7a66
commit 83950d045a
17 changed files with 512 additions and 176 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
components/tvplanit/languages/vpsr.de.po
View File

@ -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"

16
components/tvplanit/languages/vpsr.en.po
View File

@ -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"

16
components/tvplanit/languages/vpsr.fi.po
View File

@ -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 ""

16
components/tvplanit/languages/vpsr.fr.po
View File

@ -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"

16
components/tvplanit/languages/vpsr.nl.po
View File

@ -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"

16
components/tvplanit/languages/vpsr.pl.po
View File

@ -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"

16
components/tvplanit/languages/vpsr.pot
View File

@ -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 ""

16
components/tvplanit/languages/vpsr.ru.po
View File

@ -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 "Выберите звук"

4
components/tvplanit/source/include/vpsr.inc
View File

@ -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';

6
components/tvplanit/source/vpbase.pas
View File

@ -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,

39
components/tvplanit/source/vpbasedatafiles.pas
View File

@ -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;

120
components/tvplanit/source/vpcontactgrid.pas
View File

@ -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;

115
components/tvplanit/source/vpdata.pas
View File

@ -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

4
components/tvplanit/source/vpimportpreview_vcard.lfm
View File

@ -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

6
components/tvplanit/source/vpimportpreview_vcard.pas
View File

@ -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

8
components/tvplanit/source/vpmisc.pas
View File

@ -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);

258
components/tvplanit/source/vpvcard.pas
View File

@ -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.