tvplanit: Support contacts in VCard import/export.

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

components/tvplanit/source/vpbaseds.pas

@@ -314,8 +314,8 @@ type
     procedure DeleteResource(Res: TVpResource);
     function FindResource(const AResourceName: String): TVpResource;
     
+    function FindBestCategory(const ACategoryNames: TStrings): String;
     function FindBestEventCategory(const ACategoryNames: TStrings): String;
-    function FindBestTaskCategory(const ACategoryNames: TStrings): String;
 
     property Connected : boolean read FConnected write SetConnected;
     property Loading : Boolean read FLoading write FLoading;
@@ -567,7 +567,7 @@ begin
   end;
 end;
 
-function TVpCustomDatastore.FindBestTaskCategory(const ACategoryNames: TStrings): String;
+function TVpCustomDatastore.FindBestCategory(const ACategoryNames: TStrings): String;
 const
   CAT_NAMES: array[TVpCategoryType] of string = ('BUSINESS', 'CLIENTS', 'FAMILY', 'OTHER', 'PERSONAL');
 var

components/tvplanit/source/vpcontactgrid.pas

@@ -200,15 +200,17 @@ type
     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
     procedure ScrollIntoView;
+    procedure EditContact;
+    procedure EndEdit(Sender: TObject);
+
+    { popup menu }
+    function GetPopupMenu: TPopupMenu; override;
+    procedure InitializeDefaultPopup;
     procedure PopupAddContact(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;
-    procedure InitializeDefaultPopup;
 
     { message handlers }
     {$IFNDEF LCL}
@@ -252,7 +254,7 @@ type
       DisplayOnly: Boolean); override;
     procedure ExportVCardFile(const AFileName: String; const AContacts: TVpContactArr);
     function ImportVCardFile(const AFileName: String; 
-      APreview: Boolean = false): TVpContactArr;
+      APreview: Boolean = false; ADefaultCategory: Integer = -1): TVpContactArr;
 
     { - Added to support the buttonbar component.                         }
     function SelectContactByName(const Name: String): Boolean;
@@ -1615,14 +1617,14 @@ begin
 end;
 
 function TVpContactGrid.ImportVCardFile(const AFileName: String; 
-  APreview: Boolean = false): TVpContactArr;
+  APreview: Boolean = false; ADefaultCategory: Integer = -1): TVpContactArr;
 begin
   if ReadOnly or (not CheckCreateResource) or
      (not Assigned(Datastore)) or (not Assigned(Datastore.Resource))
   then
     exit(nil);
 
-  Result := Datastore.Resource.Contacts.ImportVCardFile(AFileName, APreview);
+  Result := Datastore.Resource.Contacts.ImportVCardFile(AFileName, APreview, ADefaultCategory);
   if Length(Result) > 0 then
   begin
     FActiveContact := Result[High(Result)];

components/tvplanit/source/vpdata.pas

@@ -494,7 +494,8 @@ type
       CaseInsensitive: Boolean = True): Integer;
     function GetContact(Index: Integer): TVpContact;
     function Last:TVpContact;
-    function ImportVCardFile(const AFileName: String; const APreview: Boolean = false): TVpContactArr;
+    function ImportVCardFile(const AFileName: String; const APreview: Boolean = false;
+      ADefaultCategory: Integer = -1): TVpContactArr;
     procedure ExportVCardFile(const AFileName: String; const AContacts: TVpContactArr);
     procedure Sort;
 
@@ -555,6 +556,7 @@ type
     FNotes: string;
     //FPrivateRec: boolean;
     FCategory: integer;
+    FPickedCategory: Integer;
     FCustom1: string;
     FCustom2: string;
     FCustom3: string;
@@ -636,6 +638,7 @@ type
     property Changed: Boolean read FChanged write SetChanged;
     property Deleted: Boolean read FDeleted write SetDeleted;
     property Owner: TVpContacts read FOwner write FOwner;
+    property PickedCategory: Integer read FPickedCategory write FPickedCategory;
 
 {$ifdef WITHRTTI}
   published
@@ -2232,6 +2235,9 @@ var
   phoneIdx: Integer;
   phones: array[1..NUM_PHONES] of ^String;
   phonetypes: array[1..NUM_PHONES] of ^Integer;
+  datastore: TVpCustomDatastore;
+  cat: String;
+  ct: TVpCategoryType;
 begin
   phones[1] := @FPhone1;   phonetypes[1] := @FPhoneType1;
   phones[2] := @FPhone2;   phonetypes[2] := @FPhoneType2;
@@ -2336,6 +2342,24 @@ begin
       FPosition := FPosition + '; ' + s;
   end;
 
+  { Category }
+  { tvplanit has only 1 category, vcard may have several. We pick the first one
+    defined by TVpCategorytype. If none is found we select ctOther. }
+  if ACard.PickedCategory > -1 then
+    FCategory := ACard.PickedCategory
+  else
+  begin
+    FCategory := ord(ctOther);
+    datastore := TVpCustomDatastore(Owner.Owner.Owner.Owner);
+    cat := datastore.FindBestCategory(ACard.Categories);
+    for ct in TVpCategoryType do
+      if cat = CategoryLabel(ct) then
+      begin
+        FCategory := ord(ct);
+        break;
+      end;
+  end;
+
   FOwner.FOwner.ContactsDirty := true;
   FChanged := true;
 end;
@@ -2906,7 +2930,7 @@ begin
 end;
 
 function TVpContacts.ImportVCardFile(const AFileName: String; 
-  const APreview: Boolean = false): TVpContactArr;
+  const APreview: Boolean = false; ADefaultCategory: Integer = -1): TVpContactArr;
 const
   BLOCK_SIZE = 10;
 var
@@ -2937,6 +2961,7 @@ begin
     begin
       previewForm := TVPImportPreviewVCardForm.Create(nil);
       previewForm.Position := poMainFormcenter;
+      previewForm.Datastore := datastore;
       previewForm.VCards := vCards;
       if not previewForm.Execute then
       begin
@@ -3043,7 +3068,7 @@ begin
   begin
     FCategory :=ord(ctOther);
     datastore := TVpCustomDatastore(Owner.Owner.Owner.Owner);
-    cat := datastore.FindBestTaskCategory(AEntry.Categories);
+    cat := datastore.FindBestCategory(AEntry.Categories);
     for ct in TVpCategoryType do
       if cat = CategoryLabel(ct) then
       begin

components/tvplanit/source/vpimportpreview_icaltask.lfm

@@ -20,13 +20,13 @@ inherited VpImportPreviewICalTaskForm: TVpImportPreviewICalTaskForm
         PickList.Strings = (        )
         ReadOnly = True
         Title.Caption = 'Items'
-        Width = 630
+        Width = 634
       end>
     OnGetEditText = GridGetEditText
     OnSetEditText = GridSetEditText
     ColWidths = (
       33
-      630
+      634
     )
   end
   inherited ButtonPanel: TPanel

components/tvplanit/source/vpimportpreview_icaltask.pas

@@ -186,7 +186,7 @@ begin
     for i := 0 to FItems.Count-1 do
     begin
       task  := TVpICalToDo(FItems[i]);
-      cat := FDatastore.FindBestTaskCategory(task.Categories);
+      cat := FDatastore.FindBestCategory(task.Categories);
       if cat = '' then cat := FDefaultCategory;
       if cat <> '' then 
         task.PickedCategory := Grid.Columns[2].PickList.IndexOf(cat)

components/tvplanit/source/vpimportpreview_vcard.lfm

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

components/tvplanit/source/vpimportpreview_vcard.pas

@@ -6,16 +6,21 @@ interface
 
 uses
   Classes, SysUtils, Forms, Controls, Graphics, Dialogs,
-  VpData, VpBaseDS, VpImportPreview, VpVCard;
+  VpData, VpBaseDS, VpImportPreview, VpVCard, Grids;
 
 type
   
   { TVpImportPreviewVCardForm }
 
   TVpImportPreviewVCardForm = class(TVpImportPreviewForm)
+    procedure GridGetEditText(Sender: TObject; ACol, ARow: Integer;
+      var Value: string);
+    procedure GridSetEditText(Sender: TObject; ACol, ARow: Integer;
+      const Value: string);
   private
     FVCards: TVpVCards;
     FDatastore: TVpCustomDatastore;
+    FDefaultCategory: String;
     function GetCardText(ACard: TVpVCard): String;
     procedure SetVCards(const AValue: TVpVCards);
 
@@ -29,6 +34,7 @@ type
     function IsChecked(ARow: Integer): Boolean; override;
     property VCards: TVpVCards read FVCards write SetVCards;
     property Datastore: TVpCustomDatastore read FDatastore write FDatastore;
+    property DefaultCategory: String read FDefaultCategory write FDefaultCategory;
   end;
 
 var
@@ -63,11 +69,13 @@ var
   card: TVpVCard;
 begin
   Result := '';
-  if (ACol = 1) and (ARow >= Grid.FixedRows) then
+  if (ARow >= Grid.FixedRows) then
   begin
     card := TVpVCard(FItems[ARow - Grid.FixedRows]);
-    if card <> nil then
+    case ACol of
-      Result := GetCardText(card);
+      1: Result := GetCardText(card);
+      2: Result := Grid.Columns[2].PickList[card.PickedCategory]
+    end;
   end;
 end;
 
@@ -92,6 +100,30 @@ begin
   s := ACard.GetEMail;
   if s <> '' then
     Result := Result + LineEnding + RSEMail + ': ' + s;
+
+  s := ACard.Categories.CommaText;
+  if s = '' then s := RSNoneStr;
+  Result := Result + LineEnding + RSCategoryLabel + ' ' + s;
+end;
+
+procedure TVpImportPreviewVCardForm.GridGetEditText(Sender: TObject; ACol,
+  ARow: Integer; var Value: string);
+var
+  card: TVpVCard;
+begin
+  card := TVpVCard(FItems[Grid.Row - Grid.FixedRows]);
+  if card <> nil then
+    Value := Grid.Columns[2].PickList[card.PickedCategory];
+end;
+
+procedure TVpImportPreviewVCardForm.GridSetEditText(Sender: TObject; ACol,
+  ARow: Integer; const Value: string);
+var
+  card: TVpVCard;
+begin
+  card := TVpVCard(FItems[Grid.Row - Grid.FixedRows]);
+  if card <> nil then
+    card.PickedCategory := Grid.Columns[2].PickList.IndexOf(Value);;
 end;
 
 function TVpImportPreviewVCardForm.IsChecked(ARow: Integer): Boolean;
@@ -109,6 +141,10 @@ end;
 procedure TVpImportPreviewVCardForm.PrepareItems;
 var
   i: Integer;
+  card: TVpVCard;
+  cat: string;
+  ct: TVpCategoryType;
+  L: TStrings;
 begin
   FItems.Clear;
   if FVCards <> nil then
@@ -118,6 +154,39 @@ begin
   inherited;
   
   Grid.Columns[1].Title.Caption := RSContactItems;
+
+  if (FVCards <> nil) and (FDataStore <> nil) and (Grid.Columns.Count = 2) then
+  begin
+    Grid.Columns[1].Title.Caption := RSContactItems;
+
+    with Grid.Columns.Add do
+    begin
+      SizePriority := 0;
+      Width := 160;
+      Title.Caption := RSAssignedCategory;
+      ButtonStyle := cbsPickList;
+      L := TStringList.Create;
+      try
+        for ct in TVpCategoryType do
+          L.Add(CategoryLabel(ct));
+        PickList.Assign(L);
+      finally
+        L.Free;
+      end;
+    end;
+
+    for i := 0 to FItems.Count-1 do
+    begin
+      card  := TVpVCard(FItems[i]);
+      cat := FDatastore.FindBestCategory(card.Categories);
+      if cat = '' then cat := FDefaultCategory;
+      if cat <> '' then
+        card.PickedCategory := Grid.Columns[2].PickList.IndexOf(cat)
+      else
+        card.PickedCategory := ord(ctOther);
+    end;
+  end;
+
 end;
 
 procedure TVpImportPreviewVCardForm.SetVCards(const AValue: TVpVCards);

components/tvplanit/source/vptasklist.pas

@@ -947,14 +947,8 @@ begin
     dlg.FileName := '';
     dlg.Options := dlg.Options + [ofAllowMultiSelect, ofFileMustExist];
     if dlg.Execute then begin
-      Screen.Cursor := crHourGlass;
+      for fn in dlg.Files do
-      try
+        ImportICalFile(fn, dlg.Files.Count = 1);
-        for fn in dlg.Files do
-          Datastore.Resource.Tasks.ImportICalFile(fn);
-        Invalidate;
-      finally
-        Screen.Cursor := crDefault;
-      end;
     end;
   finally
     dlg.Free;

components/tvplanit/source/vpvcard.pas

@@ -50,10 +50,16 @@ type
 
     FBirthDay: TDateTime;
     FAnniversary: TDateTime;
+    FCategories: TStrings;
+    FPickedCategory: Integer;
     
     FSkip: Boolean;
+
+    function GetCategory(AIndex: Integer): String;
+    function GetCategoryCount: Integer;
   public
     constructor Create;
+    destructor Destroy; override;
     procedure Analyze; override;
     function FindItem(AKey, ATags: String): TVpVCardItem;
     
@@ -93,8 +99,12 @@ type
     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 BirthDay: TDateTime read FBirthday write FBirthDay;
+    property Category[AIndex: Integer]: string read GetCategory;
+    property CategoryCount: Integer read GetCategoryCount;
+    property Categories: TStrings read FCategories write FCategories;
+    property PickedCategory: Integer read FPickedCategory write FPickedCategory;
 
     property Version: String read FVersion;
     property Skip: Boolean read FSkip write FSkip;     // Flag to skip import
@@ -208,6 +218,15 @@ end;
 constructor TVpVCard.Create;
 begin
   inherited Create(TVpVCardItem);
+  FCategories := TStringList.Create;
+  FCategories.Delimiter := ',';   // VCard categories are separated by comma in vcf file.
+  FCategories.StrictDelimiter := true;
+end;
+
+destructor TVpVCard.Destroy;
+begin
+  FCategories.Free;
+  inherited;
 end;
 
 procedure TVpVCard.Analyze;
@@ -298,6 +317,8 @@ begin
               FAnniversary := dt;
           end;
         end;
+      'CATEGORIES':
+        FCategories.CommaText := item.Value;
     end;
   end;
   
@@ -314,6 +335,16 @@ begin
   Result := TVpVCardItem(inherited FindItem(AKey, ATags));
 end;
 
+function TVpVCard.GetCategory(AIndex: Integer): String;
+begin
+  Result := FCategories[AIndex];
+end;
+
+function TVpVCard.GetCategoryCount: Integer;
+begin
+  Result := FCategories.Count;
+end;
+
 function TVpVCard.GetEMail: String;
 begin
   Result := '';
@@ -417,6 +448,10 @@ begin
   if HomeEMail <> '' then
     AList.Add('EMAIL;TYPE=HOME:' + HomeEMail);
 
+  // Categories
+  if Categories.Count > 0 then
+    AList.Add('CATEGORIES:' + Categories.CommaText);
+
   AList.Add('END:VCARD');
 end;