Changeset 53 for trunk


Ignore:
Timestamp:
Dec 8, 2021, 2:02:17 PM (3 years ago)
Author:
chronos
Message:
  • Added: Allow to load from file or save to file individual selected contacts from the list.
Location:
trunk
Files:
7 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormContacts.lfm

    r52 r53  
    1414  object ListView1: TListView
    1515    Left = 0
    16     Height = 810
     16    Height = 801
    1717    Top = 0
    1818    Width = 1210
    … …  
    5858    Left = 0
    5959    Height = 39
    60     Top = 842
     60    Top = 833
    6161    Width = 1210
    6262    Align = alBottom
    … …  
    8686      Action = AClone
    8787    end
     88    object ToolButton5: TToolButton
     89      Left = 141
     90      Height = 33
     91      Top = 2
     92      Style = tbsSeparator
     93    end
     94    object ToolButton6: TToolButton
     95      Left = 149
     96      Top = 2
     97      Action = ALoadFromFile
     98    end
     99    object ToolButton7: TToolButton
     100      Left = 184
     101      Top = 2
     102      Action = ASaveToFile
     103    end
    88104  end
    89105  object ListViewFilter1: TListViewFilter
    90106    Left = 0
    91107    Height = 32
    92     Top = 810
     108    Top = 801
    93109    Width = 1210
    94110    OnChange = ListViewFilter1Change
    … …  
    97113  object StatusBar1: TStatusBar
    98114    Left = 0
    99     Height = 27
    100     Top = 881
     115    Height = 36
     116    Top = 872
    101117    Width = 1210
    102118    Panels = <   
    … …  
    124140    object MenuItem4: TMenuItem
    125141      Action = ASelectAll
     142    end
     143    object MenuItem6: TMenuItem
     144      Caption = '-'
     145    end
     146    object MenuItem7: TMenuItem
     147      Action = ALoadFromFile
     148    end
     149    object MenuItem8: TMenuItem
     150      Action = ASaveToFile
    126151    end
    127152  end
    … …  
    158183      OnExecute = ACloneExecute
    159184    end
     185    object ALoadFromFile: TAction
     186      Caption = 'Load from file...'
     187      ImageIndex = 5
     188      OnExecute = ALoadFromFileExecute
     189    end
     190    object ASaveToFile: TAction
     191      Caption = 'Save to file...'
     192      ImageIndex = 7
     193      OnExecute = ASaveToFileExecute
     194    end
    160195  end
    161196  object ListViewSort1: TListViewSort
    … …  
    169204    Top = 428
    170205  end
     206  object SaveDialog1: TSaveDialog
     207    Left = 720
     208    Top = 408
     209  end
     210  object OpenDialog1: TOpenDialog
     211    Left = 720
     212    Top = 480
     213  end
    171214end

  • trunk/Forms/UFormContacts.lrj

    r52 r53  
    1111{"hash":93079237,"name":"tformcontacts.aremove.caption","sourcebytes":[82,101,109,111,118,101],"value":"Remove"},
    1212{"hash":195296268,"name":"tformcontacts.aselectall.caption","sourcebytes":[83,101,108,101,99,116,32,97,108,108],"value":"Select all"},
    13 {"hash":4863557,"name":"tformcontacts.aclone.caption","sourcebytes":[67,108,111,110,101],"value":"Clone"}
     13{"hash":4863557,"name":"tformcontacts.aclone.caption","sourcebytes":[67,108,111,110,101],"value":"Clone"},
     14{"hash":177113358,"name":"tformcontacts.aloadfromfile.caption","sourcebytes":[76,111,97,100,32,102,114,111,109,32,102,105,108,101,46,46,46],"value":"Load from file..."},
     15{"hash":10127854,"name":"tformcontacts.asavetofile.caption","sourcebytes":[83,97,118,101,32,116,111,32,102,105,108,101,46,46,46],"value":"Save to file..."}
    1416]}

  • trunk/Forms/UFormContacts.pas

    r52 r53  
    1616    AAdd: TAction;
    1717    AClone: TAction;
     18    ALoadFromFile: TAction;
     19    ASaveToFile: TAction;
    1820    ASelectAll: TAction;
    1921    ARemove: TAction;
    … …  
    2830    MenuItem4: TMenuItem;
    2931    MenuItem5: TMenuItem;
     32    MenuItem6: TMenuItem;
     33    MenuItem7: TMenuItem;
     34    MenuItem8: TMenuItem;
     35    OpenDialog1: TOpenDialog;
    3036    PopupMenuContact: TPopupMenu;
     37    SaveDialog1: TSaveDialog;
    3138    StatusBar1: TStatusBar;
    3239    ToolBar1: TToolBar;
    … …  
    3542    ToolButton3: TToolButton;
    3643    ToolButton4: TToolButton;
     44    ToolButton5: TToolButton;
     45    ToolButton6: TToolButton;
     46    ToolButton7: TToolButton;
    3747    procedure AAddExecute(Sender: TObject);
    3848    procedure ACloneExecute(Sender: TObject);
     49    procedure ALoadFromFileExecute(Sender: TObject);
    3950    procedure AModifyExecute(Sender: TObject);
    4051    procedure ARemoveExecute(Sender: TObject);
     52    procedure ASaveToFileExecute(Sender: TObject);
    4153    procedure ASelectAllExecute(Sender: TObject);
    4254    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    … …  
    314326end;
    315327
     328procedure TFormContacts.ALoadFromFileExecute(Sender: TObject);
     329var
     330  TempFile: TContactsFile;
     331begin
     332  if Assigned(ListView1.Selected) then begin
     333    TempFile := TContactsFile.Create;
     334    try
     335      OpenDialog1.Filter := TempFile.GetFileFilter;
     336      OpenDialog1.DefaultExt := TempFile.GetFileExt;
     337    finally
     338      TempFile.Free;
     339    end;
     340    OpenDialog1.InitialDir := ExtractFileDir(Core.LastContactFileName);
     341    OpenDialog1.FileName := ExtractFileName(Core.LastContactFileName);
     342    if OpenDialog1.Execute then begin
     343      TContact(ListView1.Selected.Data).LoadFromFile(OpenDialog1.FileName);
     344      Core.LastContactFileName := OpenDialog1.FileName;
     345      ReloadList;
     346    end;
     347  end;
     348end;
     349
    316350procedure TFormContacts.AModifyExecute(Sender: TObject);
    317351var
    … …  
    359393end;
    360394
     395procedure TFormContacts.ASaveToFileExecute(Sender: TObject);
     396var
     397  TempFile: TContactsFile;
     398begin
     399  if Assigned(ListView1.Selected) then begin
     400    TempFile := TContactsFile.Create;
     401    try
     402      SaveDialog1.Filter := TempFile.GetFileFilter;
     403      SaveDialog1.DefaultExt := TempFile.GetFileExt;
     404    finally
     405      TempFile.Free;
     406    end;
     407    SaveDialog1.InitialDir := ExtractFileDir(Core.LastContactFileName);
     408    SaveDialog1.FileName := TContact(ListView1.Selected.Data).Fields[cfFullName] +
     409      VCardFileExt;
     410    if SaveDialog1.Execute then begin
     411      TContact(ListView1.Selected.Data).SaveToFile(SaveDialog1.FileName);
     412      Core.LastContactFileName := SaveDialog1.FileName;
     413    end;
     414  end;
     415end;
     416
    361417procedure TFormContacts.ASelectAllExecute(Sender: TObject);
    362418var
    … …  
    409465begin
    410466  if FUpdateCount = 0 then DoUpdateInterface;
     467  ALoadFromFile.Enabled := Assigned(ListView1.Selected);
     468  ASaveToFile.Enabled := Assigned(ListView1.Selected);
     469  AModify.Enabled := Assigned(ListView1.Selected);
     470  AClone.Enabled := Assigned(ListView1.Selected);
     471  ARemove.Enabled := Assigned(ListView1.Selected);
     472  ASelectAll.Enabled := ListView1.Items.Count > 0;
    411473end;
    412474

  • trunk/Languages/vCardStudio.cs.po

    r52 r53  
    7777
    7878#: tformcontact.aphotoload.caption
     79msgctxt "tformcontact.aphotoload.caption"
    7980msgid "Load from file"
    8081msgstr "Načíst ze souboru"
    8182
    8283#: tformcontact.aphotosave.caption
     84msgctxt "tformcontact.aphotosave.caption"
    8385msgid "Save to file"
    8486msgstr "Uložit do souboru"
    … …  
    358360msgstr "Klonovat"
    359361
     362#: tformcontacts.aloadfromfile.caption
     363msgctxt "tformcontacts.aloadfromfile.caption"
     364msgid "Load from file..."
     365msgstr "Načíst ze souboru..."
     366
    360367#: tformcontacts.amodify.caption
    361368msgctxt "tformcontacts.amodify.caption"
    … …  
    368375msgstr "Odstranit"
    369376
     377#: tformcontacts.asavetofile.caption
     378msgctxt "tformcontacts.asavetofile.caption"
     379msgid "Save to file..."
     380msgstr "Uložit do souboru..."
     381
    370382#: tformcontacts.aselectall.caption
    371383msgctxt "tformcontacts.aselectall.caption"
    … …  
    618630msgstr "E-mail"
    619631
     632#: ucontact.sexpectedproperty
     633msgid "Expected contact property"
     634msgstr "Očekávána vlastnost kontaktu"
     635
    620636#: ucontact.sfax
    621637msgid "Fax"
    … …  
    932948msgid "Invalid line length for encoded text"
    933949msgstr "Neplatná délka řádky kódovaného textu"
     950

  • trunk/Languages/vCardStudio.po

    r52 r53  
    6767
    6868#: tformcontact.aphotoload.caption
     69msgctxt "tformcontact.aphotoload.caption"
    6970msgid "Load from file"
    7071msgstr ""
    7172
    7273#: tformcontact.aphotosave.caption
     74msgctxt "tformcontact.aphotosave.caption"
    7375msgid "Save to file"
    7476msgstr ""
    … …  
    348350msgstr ""
    349351
     352#: tformcontacts.aloadfromfile.caption
     353msgctxt "tformcontacts.aloadfromfile.caption"
     354msgid "Load from file..."
     355msgstr ""
     356
    350357#: tformcontacts.amodify.caption
    351358msgctxt "tformcontacts.amodify.caption"
    … …  
    358365msgstr ""
    359366
     367#: tformcontacts.asavetofile.caption
     368msgctxt "tformcontacts.asavetofile.caption"
     369msgid "Save to file..."
     370msgstr ""
     371
    360372#: tformcontacts.aselectall.caption
    361373msgctxt "tformcontacts.aselectall.caption"
    … …  
    606618msgstr ""
    607619
     620#: ucontact.sexpectedproperty
     621msgid "Expected contact property"
     622msgstr ""
     623
    608624#: ucontact.sfax
    609625msgid "Fax"

  • trunk/UContact.pas

    r52 r53  
    9898    constructor Create;
    9999    destructor Destroy; override;
     100    procedure SaveToStrings(Output: TStrings);
     101    function LoadFromStrings(Lines: TStrings; StartLine: Integer = 0): Integer;
     102    procedure SaveToFile(FileName: string);
     103    procedure LoadFromFile(FileName: string);
    100104    property Fields[Index: TContactFieldIndex]: string read GetField write SetField;
    101105  end;
    … …  
    132136  end;
    133137
     138const
     139  VCardFileExt = '.vcf';
     140
    134141
    135142implementation
    … …  
    144151  SFieldIndexNotDefined = 'Field index not defined';
    145152  SContactHasNoParent = 'Contact has no parent';
     153  SExpectedProperty = 'Expected contact property';
    146154  SLastName = 'Last Name';
    147155  SFirstName = 'First Name';
    … …  
    593601  FreeAndNil(Properties);
    594602  inherited;
     603end;
     604
     605procedure TContact.SaveToStrings(Output: TStrings);
     606var
     607  I: Integer;
     608  J: Integer;
     609  NameText: string;
     610  Value2: string;
     611  Text: string;
     612  LineIndex: Integer;
     613  OutText: string;
     614  LinePrefix: string;
     615const
     616  MaxLineLength = 73;
     617begin
     618    with Output do begin
     619      Add('BEGIN:VCARD');
     620      for J := 0 to Properties.Count - 1 do
     621      with Properties[J] do begin
     622        NameText := Name;
     623        if Attributes.Count > 0 then
     624          NameText := NameText + ';' + Attributes.DelimitedText;
     625        if Encoding <> '' then begin
     626          Value2 := GetEncodedValue;
     627          NameText := NameText + ';ENCODING=' + Encoding;
     628        end else Value2 := Value;
     629        if Pos(LineEnding, Value2) > 0 then begin
     630          Add(NameText + ':' + GetNext(Value2, LineEnding));
     631          while Pos(LineEnding, Value2) > 0 do begin
     632            Add(' ' + GetNext(Value2, LineEnding));
     633          end;
     634          Add(' ' + GetNext(Value2, LineEnding));
     635          Add('');
     636        end else begin
     637          OutText := NameText + ':' + Value2;
     638          LineIndex := 0;
     639          LinePrefix := '';
     640          while True do begin
     641            if Length(OutText) > MaxLineLength then begin
     642              if (LineIndex > 0) and (LinePrefix = '') then LinePrefix := ' ';
     643              Add(LinePrefix + Copy(OutText, 1, MaxLineLength));
     644              System.Delete(OutText, 1, MaxLineLength);
     645              Inc(LineIndex);
     646              Continue;
     647            end else begin
     648              Add(LinePrefix + OutText);
     649              Break;
     650            end;
     651          end;
     652          if LinePrefix <> '' then Add('');
     653        end;
     654      end;
     655      Add('END:VCARD');
     656    end;
     657end;
     658
     659function TContact.LoadFromStrings(Lines: TStrings; StartLine: Integer = 0): Integer;
     660type
     661  TParseState = (psNone, psInside, psFinished);
     662var
     663  ParseState: TParseState;
     664  Line: string;
     665  Value: string;
     666  I: Integer;
     667  NewProperty: TContactProperty;
     668  CommandPart: string;
     669  Names: string;
     670begin
     671  ParseState := psNone;
     672  I := StartLine;
     673  while I < Lines.Count do begin
     674    Line := Trim(Lines[I]);
     675    if Line = '' then begin
     676      // Skip empty lines
     677    end else
     678    if ParseState = psNone then begin
     679      if Line = 'BEGIN:VCARD' then begin
     680        ParseState := psInside;
     681      end else begin
     682        Parent.Error('Expected vCard begin', I + 1);
     683        I := -1;
     684        Break;
     685      end;
     686    end else
     687    if ParseState = psInside then begin
     688      if Line = 'END:VCARD' then begin
     689        ParseState := psFinished;
     690        Inc(I);
     691        Break;
     692      end else
     693      if Pos(':', Line) > 0 then begin
     694        CommandPart := GetNext(Line, ':');
     695        Names := CommandPart;
     696        Value := Line;
     697        while True do begin
     698          Inc(I);
     699          if (Length(Lines[I]) > 0) and (Lines[I][1] = ' ') then begin
     700            Value := Value + Trim(Lines[I]);
     701          end else
     702          if (Length(Lines[I]) > 0) and (Length(Value) > 0) and (Value[Length(Value)] = '=') and
     703            (Lines[I][1] = '=') then begin
     704            Value := Value + Copy(Trim(Lines[I]), 2, MaxInt);
     705          end else begin
     706            Dec(I);
     707            Break;
     708          end;
     709        end;
     710        NewProperty := Properties.GetByName(Names);
     711        if not Assigned(NewProperty) then begin
     712          NewProperty := TContactProperty.Create;
     713          Properties.Add(NewProperty);
     714        end;
     715        NewProperty.Attributes.DelimitedText := Names;
     716        if NewProperty.Attributes.Count > 0 then begin
     717          NewProperty.Name := NewProperty.Attributes[0];
     718          NewProperty.Attributes.Delete(0);
     719        end;
     720        NewProperty.Value := Value;
     721        NewProperty.EvaluateAttributes;
     722      end else begin
     723        Parent.Error(SExpectedProperty, I + 1);
     724        I := -1;
     725        Break;
     726      end;
     727    end;
     728    Inc(I);
     729  end;
     730  Result := I;
     731end;
     732
     733procedure TContact.SaveToFile(FileName: string);
     734var
     735  Lines: TStringList;
     736begin
     737  Lines := TStringList.Create;
     738  try
     739    SaveToStrings(Lines);
     740    Lines.SaveToFile(FileName);
     741  finally
     742    Lines.Free;
     743  end;
     744end;
     745
     746procedure TContact.LoadFromFile(FileName: string);
     747var
     748  Lines: TStringList;
     749  I: Integer;
     750begin
     751  Lines := TStringList.Create;
     752  try
     753    Lines.LoadFromFile(FileName);
     754    I := LoadFromStrings(Lines);
     755  finally
     756    Lines.Free;
     757  end;
    595758end;
    596759
    … …  
    672835function TContactsFile.GetFileExt: string;
    673836begin
    674   Result := '.vcf';
     837  Result := VCardFileExt;
    675838end;
    676839
    … …  
    693856  Output: TStringList;
    694857  I: Integer;
    695   J: Integer;
    696   NameText: string;
    697   Value2: string;
    698   Text: string;
    699   LineIndex: Integer;
    700   OutText: string;
    701   LinePrefix: string;
    702 const
    703   MaxLineLength = 73;
    704858begin
    705859  inherited;
     860  Output := TStringList.Create;
    706861  try
    707     Output := TStringList.Create;
    708862    for I := 0 to Contacts.Count - 1 do
    709     with Contacts[I], Output do begin
    710       Add('BEGIN:VCARD');
    711       for J := 0 to Properties.Count - 1 do
    712       with Properties[J] do begin
    713         NameText := Name;
    714         if Attributes.Count > 0 then
    715           NameText := NameText + ';' + Attributes.DelimitedText;
    716         if Encoding <> '' then begin
    717           Value2 := GetEncodedValue;
    718           NameText := NameText + ';ENCODING=' + Encoding;
    719         end else Value2 := Value;
    720         if Pos(LineEnding, Value2) > 0 then begin
    721           Add(NameText + ':' + GetNext(Value2, LineEnding));
    722           while Pos(LineEnding, Value2) > 0 do begin
    723             Add(' ' + GetNext(Value2, LineEnding));
    724           end;
    725           Add(' ' + GetNext(Value2, LineEnding));
    726           Add('');
    727         end else begin
    728           OutText := NameText + ':' + Value2;
    729           LineIndex := 0;
    730           LinePrefix := '';
    731           while True do begin
    732             if Length(OutText) > MaxLineLength then begin
    733               if (LineIndex > 0) and (LinePrefix = '') then LinePrefix := ' ';
    734               Add(LinePrefix + Copy(OutText, 1, MaxLineLength));
    735               System.Delete(OutText, 1, MaxLineLength);
    736               Inc(LineIndex);
    737               Continue;
    738             end else begin
    739               Add(LinePrefix + OutText);
    740               Break;
    741             end;
    742           end;
    743           if LinePrefix <> '' then Add('');
    744         end;
    745       end;
    746       Add('END:VCARD');
    747     end;
     863      Contacts[I].SaveToStrings(Output);
    748864    Output.SaveToFile(FileName);
    749865  finally
    … …  
    755871var
    756872  Lines: TStringList;
    757   Line: string;
    758   Value: string;
    759   I: Integer;
    760   NewRecord: TContact;
    761   NewProperty: TContactProperty;
    762   CommandPart: string;
    763   Names: string;
     873  Contact: TContact;
     874  I: Integer;
    764875begin
    765876  inherited;
    766   NewRecord := nil;
    767877  Contacts.Clear;
    768878  Lines := TStringList.Create;
    … …  
    771881    I := 0;
    772882    while I < Lines.Count do begin
    773       Line := Lines[I];
    774       if Line = '' then
    775       else
    776       if Line = 'BEGIN:VCARD' then begin
    777         NewRecord := TContact.Create;
    778         NewRecord.Parent := Self;
    779       end else
    780       if Line = 'END:VCARD' then begin
    781         if Assigned(NewRecord) then begin
    782           Contacts.Add(NewRecord);
    783           NewRecord := nil;
    784         end else Error(SFoundBlockEndWithoutBlockStart, I + 1);
    785       end else
    786       if Pos(':', Line) > 0 then begin
    787         CommandPart := GetNext(Line, ':');
    788         if Assigned(NewRecord) then begin
    789           Names := CommandPart;
    790           Value := Line;
    791           while True do begin
    792             Inc(I);
    793             if (Length(Lines[I]) > 0) and (Lines[I][1] = ' ') then begin
    794               Value := Value + Trim(Lines[I]);
    795             end else
    796             if (Length(Lines[I]) > 0) and (Length(Value) > 0) and (Value[Length(Value)] = '=') and
    797               (Lines[I][1] = '=') then begin
    798               Value := Value + Copy(Trim(Lines[I]), 2, MaxInt);
    799             end else begin
    800               Dec(I);
    801               Break;
    802             end;
    803           end;
    804           NewProperty := NewRecord.Properties.GetByName(Names);
    805           if not Assigned(NewProperty) then begin
    806             NewProperty := TContactProperty.Create;
    807             NewRecord.Properties.Add(NewProperty);
    808           end;
    809           NewProperty.Attributes.DelimitedText := Names;
    810           if NewProperty.Attributes.Count > 0 then begin
    811             NewProperty.Name := NewProperty.Attributes[0];
    812             NewProperty.Attributes.Delete(0);
    813           end;
    814           NewProperty.Value := Value;
    815           NewProperty.EvaluateAttributes;
    816         end else Error(SFoundPropertiesBeforeBlockStart, I + 1);
     883      Contact := TContact.Create;
     884      Contact.Parent := Self;
     885      I := Contact.LoadFromStrings(Lines, I);
     886      if (I <= Lines.Count) and (I <> -1) then Contacts.Add(Contact)
     887      else begin
     888        FreeAndNil(Contact);
     889        Break;
    817890      end;
    818       Inc(I);
    819891    end;
    820892  finally

  • trunk/UCore.pas

    r52 r53  
    8282    ReopenLastFileOnStart: Boolean;
    8383    LastContactTabIndex: Integer;
     84    LastContactFileName: string;
    8485    ToolbarVisible: Boolean;
    8586    function GetProfileImage: TImage;
    … …  
    431432    ReopenLastFileOnStart := ReadBoolWithDefault('ReopenLastFileOnStart', True);
    432433    LastContactTabIndex := ReadIntegerWithDefault('LastContactTabIndex', 0);
     434    LastContactFileName := ReadStringWithDefault('LastContactFileName', '');
    433435  finally
    434436    Free;
    … …  
    453455    WriteBool('ReopenLastFileOnStart', ReopenLastFileOnStart);
    454456    WriteInteger('LastContactTabIndex', LastContactTabIndex);
     457    WriteString('LastContactFileName', LastContactFileName);
    455458  finally
    456459    Free;
Note: See TracChangeset for help on using the changeset viewer.