Changeset 82 for trunk


Ignore:
Timestamp:
Dec 21, 2021, 5:16:41 PM (3 years ago)
Author:
chronos
Message:
  • Fixed: Settings option to load previously opened file wasn't working for disabled state.
  • Fixed: Disable Find action if no file is opened.
  • Modified: Move fields initialization method to TContact class and made it static so it is initialized only once.
  • Added: Allow to set default vCard version in settings dialog.
  • Modified: Add GTK2 theming support to snap package.
Location:
trunk
Files:
16 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormContacts.lfm

    r76 r82  
    1616  object ListView1: TListView
    1717    Left = 0
    18     Height = 801
     18    Height = 810
    1919    Top = 0
    2020    Width = 1210
    … …  
    6868    Left = 0
    6969    Height = 39
    70     Top = 833
     70    Top = 842
    7171    Width = 1210
    7272    Align = alBottom
    … …  
    116116    Left = 0
    117117    Height = 32
    118     Top = 801
     118    Top = 810
    119119    Width = 1210
    120120    OnChange = ListViewFilter1Change
    … …  
    123123  object StatusBar1: TStatusBar
    124124    Left = 0
    125     Height = 36
    126     Top = 872
     125    Height = 27
     126    Top = 881
    127127    Width = 1210
    128128    Panels = <   

  • trunk/Forms/UFormContacts.pas

    r77 r82  
    203203        for J := 0 to FilterItems.Count - 1 do begin
    204204          if FilterItems[J].FieldIndex = cfNone then begin
    205             for K := 0 to TContact(List.Items[I]).Parent.Fields.Count - 1 do begin
     205            for K := 0 to TContact(List.Items[I]).GetFields.Count - 1 do begin
    206206              if Pos(UTF8LowerCase(FilterItems[J].Value),
    207                 UTF8LowerCase(TContact(List.Items[I]).Fields[TContact(List.Items[I]).Parent.Fields[K].Index])) > 0 then begin
     207                UTF8LowerCase(TContact(List.Items[I]).Fields[TContact(List.Items[I]).GetFields[K].Index])) > 0 then begin
    208208                  Inc(FoundCount);
    209209                  Break;
    … …  
    286286  for I := 0 to ListView1.Columns.Count - 1 do begin
    287287    if Assigned(Contacts) and Assigned(Contacts.ContactsFile) then begin
    288       Field := Contacts.ContactsFile.Fields.GetByIndex(ListViewColumns[I]);
     288      Field := TContact.GetFields.GetByIndex(ListViewColumns[I]);
    289289      if Assigned(Field) then
    290290        ListView1.Columns[I].Caption := Field.Title;
    … …  
    312312    Contact := TContact.Create;
    313313    try
    314       Contact.Parent := Contacts.ContactsFile;
     314      Contact.ContactsFile := Contacts.ContactsFile;
    315315      FormContact.Contact := Contact;
    316316      FormContact.OnGetPrevious := GetPreviousContact;
    317317      FormContact.OnGetNext := GetNextContact;
     318      Contact.Properties.AddNew('VERSION', Core.DefaultVcardVersion);
    318319      if FormContact.ShowModal = mrOK then begin
    319320        Contacts.Add(Contact);
    … …  
    341342    Contact := TContact.Create;
    342343    try
    343       Contact.Parent := Contacts.ContactsFile;
     344      Contact.ContactsFile := Contacts.ContactsFile;
    344345      Contact.Assign(TContact(ListView1.Selected.Data));
    345346      FormContact.Contact := Contact;
    … …  
    442443    Contact := TContact.Create;
    443444    try
    444       Contact.Parent := Contacts.ContactsFile;
     445      Contact.ContactsFile := Contacts.ContactsFile;
    445446      Contact.Assign(TContact(ListView1.Selected.Data));
    446447      FormContact.Contact := Contact;

  • trunk/Forms/UFormFind.lfm

    r76 r82  
    2727    object ComboBoxField: TComboBox
    2828      Left = 184
    29       Height = 33
     29      Height = 41
    3030      Top = 16
    3131      Width = 240
    32       ItemHeight = 25
     32      ItemHeight = 0
    3333      OnChange = ComboBoxFieldChange
    3434      ParentFont = False
    … …  
    3838    object Label1: TLabel
    3939      Left = 13
    40       Height = 25
     40      Height = 24
    4141      Top = 19
    42       Width = 125
     42      Width = 135
    4343      Caption = 'By contact field:'
    4444      ParentColor = False
    … …  
    4747    object EditValue: TEdit
    4848      Left = 440
    49       Height = 33
     49      Height = 42
    5050      Top = 16
    5151      Width = 208

  • trunk/Forms/UFormFind.pas

    r76 r82  
    6363    Items := TStringList.Create;
    6464    try
    65       Contacts.ContactsFile.Fields.LoadToStrings(Items);
     65      TContact.GetFields.LoadToStrings(Items);
    6666
    6767      // Remove fields which are not used in contacts
    … …  
    7575      Items.Free;
    7676    end;
    77     ContactField := Contacts.ContactsFile.Fields.GetByIndex(ContactFieldIndex);
     77    ContactField := TContact.GetFields.GetByIndex(ContactFieldIndex);
    7878    ComboBoxField.ItemIndex := ComboBoxField.Items.IndexOfObject(ContactField);
    7979    if (ComboBoxField.Items.Count > 0) and (ComboBoxField.ItemIndex = -1) then

  • trunk/Forms/UFormFindDuplicity.lfm

    r73 r82  
    3131      item
    3232        Caption = 'Count'
    33         Width = 136
     33        Width = 242
    3434      end>
    3535    OwnerData = True
    … …  
    5656    object ComboBoxField: TComboBox
    5757      Left = 160
    58       Height = 33
     58      Height = 41
    5959      Top = 16
    6060      Width = 326
    61       ItemHeight = 25
     61      ItemHeight = 0
    6262      OnChange = ComboBoxFieldChange
    6363      ParentFont = False
    … …  
    6767    object Label1: TLabel
    6868      Left = 13
    69       Height = 25
     69      Height = 24
    7070      Top = 19
    71       Width = 125
     71      Width = 135
    7272      Caption = 'By contact field:'
    7373      ParentColor = False

  • trunk/Forms/UFormFindDuplicity.pas

    r73 r82  
    119119    Items := TStringList.Create;
    120120    try
    121       Contacts.ContactsFile.Fields.LoadToStrings(Items);
     121      TContact.GetFields.LoadToStrings(Items);
    122122
    123123      // Remove fields which are not used in contacts
    … …  
    130130      Items.Free;
    131131    end;
    132     ContactField := Contacts.ContactsFile.Fields.GetByIndex(ContactFieldIndex);
     132    ContactField := TContact.GetFields.GetByIndex(ContactFieldIndex);
    133133    ComboBoxField.ItemIndex := ComboBoxField.Items.IndexOfObject(ContactField);
    134134    if (ComboBoxField.Items.Count > 0) and (ComboBoxField.ItemIndex = -1) then

  • trunk/Forms/UFormProperty.pas

    r68 r82  
    102102  Core.ThemeManager1.UseTheme(Self);
    103103  FContactProperty := nil;
    104   TContactsFile(Core.DataFile).Fields.LoadToStrings(ComboBoxField.Items);
     104  TContact.GetFields.LoadToStrings(ComboBoxField.Items);
    105105end;
    106106
    … …  
    129129    Groups.Free;
    130130  end;
    131   Field := TContactsFile(Core.DataFile).Fields.GetBySysNameGroups(EditName.Text,
     131  Field := TContact.GetFields.GetBySysNameGroups(EditName.Text,
    132132    GroupsArray);
    133133  if Assigned(Field) then

  • trunk/Forms/UFormSettings.lfm

    r23 r82  
    33  Height = 360
    44  Top = 367
    5   Width = 577
     5  Width = 564
    66  Caption = 'Settings'
    77  ClientHeight = 360
    8   ClientWidth = 577
     8  ClientWidth = 564
    99  Constraints.MinHeight = 360
    1010  Constraints.MinWidth = 480
    … …  
    1616  LCLVersion = '2.0.12.0'
    1717  object ComboBoxLanguage: TComboBox
    18     Left = 192
     18    Left = 240
    1919    Height = 41
    20     Top = 36
    21     Width = 312
     20    Top = 16
     21    Width = 264
    2222    ItemHeight = 0
    2323    ParentFont = False
    … …  
    2828    Left = 24
    2929    Height = 24
    30     Top = 36
     30    Top = 24
    3131    Width = 88
    3232    Caption = 'Language:'
    … …  
    3535  end
    3636  object ButtonOk: TButton
    37     Left = 451
     37    Left = 438
    3838    Height = 37
    3939    Top = 307
    … …  
    4747  end
    4848  object ButtonCancel: TButton
    49     Left = 307
     49    Left = 294
    5050    Height = 37
    5151    Top = 307
    … …  
    5858  end
    5959  object CheckBoxAutomaticDPI: TCheckBox
    60     Left = 19
     60    Left = 24
    6161    Height = 30
    62     Top = 125
     62    Top = 200
    6363    Width = 148
    6464    Caption = 'Automatic DPI'
    … …  
    6969  end
    7070  object SpinEditDPI: TSpinEdit
    71     Left = 192
     71    Left = 240
    7272    Height = 42
    73     Top = 173
     73    Top = 232
    7474    Width = 145
    7575    MaxValue = 300
    … …  
    8181  end
    8282  object LabelDPI: TLabel
    83     Left = 96
     83    Left = 56
    8484    Height = 24
    85     Top = 182
     85    Top = 240
    8686    Width = 35
    8787    Caption = 'DPI:'
    … …  
    9191  end
    9292  object CheckBoxReopenLastFileOnStart: TCheckBox
    93     Left = 19
     93    Left = 24
    9494    Height = 30
    95     Top = 86
     95    Top = 160
    9696    Width = 226
    9797    Caption = 'Reopen last file on start'
    … …  
    103103    Height = 2
    104104    Top = 288
    105     Width = 547
     105    Width = 534
    106106    Anchors = [akLeft, akRight, akBottom]
    107107  end
    … …  
    109109    Left = 24
    110110    Height = 24
    111     Top = 221
     111    Top = 72
    112112    Width = 63
    113113    Caption = 'Theme:'
    … …  
    116116  end
    117117  object ComboBoxTheme: TComboBox
    118     Left = 192
     118    Left = 240
    119119    Height = 41
    120     Top = 221
    121     Width = 312
     120    Top = 64
     121    Width = 264
    122122    ItemHeight = 0
    123123    ParentFont = False
    … …  
    125125    TabOrder = 6
    126126  end
     127  object Label3: TLabel
     128    Left = 24
     129    Height = 24
     130    Top = 120
     131    Width = 186
     132    Caption = 'Default vCard version:'
     133    ParentColor = False
     134  end
     135  object EditDefaultVcardVersion: TEdit
     136    Left = 240
     137    Height = 42
     138    Top = 112
     139    Width = 144
     140    TabOrder = 7
     141  end
    127142end

  • trunk/Forms/UFormSettings.lrj

    r21 r82  
    77{"hash":300234,"name":"tformsettings.labeldpi.caption","sourcebytes":[68,80,73,58],"value":"DPI:"},
    88{"hash":55973348,"name":"tformsettings.checkboxreopenlastfileonstart.caption","sourcebytes":[82,101,111,112,101,110,32,108,97,115,116,32,102,105,108,101,32,111,110,32,115,116,97,114,116],"value":"Reopen last file on start"},
    9 {"hash":95339402,"name":"tformsettings.label2.caption","sourcebytes":[84,104,101,109,101,58],"value":"Theme:"}
     9{"hash":95339402,"name":"tformsettings.label2.caption","sourcebytes":[84,104,101,109,101,58],"value":"Theme:"},
     10{"hash":232157114,"name":"tformsettings.label3.caption","sourcebytes":[68,101,102,97,117,108,116,32,118,67,97,114,100,32,118,101,114,115,105,111,110,58],"value":"Default vCard version:"}
    1011]}

  • trunk/Forms/UFormSettings.pas

    r23 r82  
    2121    ComboBoxLanguage: TComboBox;
    2222    ComboBoxTheme: TComboBox;
     23    EditDefaultVcardVersion: TEdit;
    2324    Label1: TLabel;
    2425    Label2: TLabel;
     26    Label3: TLabel;
    2527    LabelDPI: TLabel;
    2628    SpinEditDPI: TSpinEdit;
    … …  
    100102  SpinEditDPI.Value := Core.ScaleDPI1.DPI.X;
    101103  CheckBoxReopenLastFileOnStart.Checked := Core.ReopenLastFileOnStart;
     104  EditDefaultVcardVersion.Text := Core.DefaultVcardVersion;
    102105  UpdateInterface;
    103106end;
    … …  
    108111  Core.ScaleDPI1.DPI := Point(SpinEditDPI.Value, SpinEditDPI.Value);
    109112  Core.ReopenLastFileOnStart := CheckBoxReopenLastFileOnStart.Checked;
     113  Core.DefaultVcardVersion := EditDefaultVcardVersion.Text;
    110114end;
    111115

  • trunk/Install/snap/snapcraft.yaml

    r79 r82  
    4242      install -d -m 755 $SNAPCRAFT_PART_INSTALL/usr/share/pixmaps
    4343      install -m 755 Images/vCard\ Studio.png $SNAPCRAFT_PART_INSTALL/usr/share/pixmaps
     44    after:
     45      - desktop-gtk2
    4446    stage:
    4547      - etc
    … …  
    8284      - libxrender1
    8385
     86  desktop-gtk2:
     87    source: https://github.com/ubuntu/snapcraft-desktop-helpers.git
     88    source-subdir: gtk
     89    plugin: make
     90    make-parameters: ["FLAVOR=gtk2"]
     91    build-packages:
     92      - build-essential
     93      - libgtk2.0-dev
     94    stage-packages:
     95      - libxkbcommon0  # XKB_CONFIG_ROOT
     96      - ttf-ubuntu-font-family
     97      - dmz-cursor-theme
     98      - light-themes
     99      - adwaita-icon-theme
     100      - gnome-themes-standard
     101      - shared-mime-info
     102      - libgtk2.0-0
     103      - libgdk-pixbuf2.0-0
     104      - libglib2.0-bin
     105      - libgtk2.0-bin
     106      - unity-gtk2-module
     107      - locales-all
     108      - libappindicator1
     109      - xdg-user-dirs
     110      - ibus-gtk
     111      - libibus-1.0-5
     112     
     113# additional plugs to pick up the GTK theme and icons from the system
     114plugs:
     115  icon-themes:
     116    interface: content
     117    target: $SNAP/data-dir/icons
     118    default-provider: gtk-common-themes
     119  sound-themes:
     120    interface: content
     121    target: $SNAP/data-dir/sounds
     122    default-provider: gtk-common-themes
     123  gtk-2-engines:
     124    interface: content
     125    target: $SNAP/lib/gtk-2.0
     126    default-provider: gtk2-common-themes:gtk-2-engines
     127  gtk-2-themes:
     128    interface: content
     129    target: $SNAP/usr/share/themes
     130    default-provider: gtk2-common-themes:gtk-2-themes
     131
     132environment:
     133  XDG_DATA_DIRS: $SNAP/usr/share:$XDG_DATA_DIRS
     134  GTK_PATH: $SNAP/lib/gtk-2.0
     135 
    84136apps:
    85137  vcard-studio:
    86138    command: usr/bin/vCardStudio
     139    command-chain:
     140      - bin/desktop-launch
    87141    desktop: usr/share/applications/vCardStudio.desktop   
    88142    plugs:

  • trunk/Languages/vCardStudio.cs.po

    r77 r82  
    779779msgstr "Téma:"
    780780
     781#: tformsettings.label3.caption
     782msgid "Default vCard version:"
     783msgstr "Výchozí verze vCard:"
     784
    781785#: tformsettings.labeldpi.caption
    782786msgid "DPI:"
    … …  
    12491253msgid "Invalid line length for encoded text"
    12501254msgstr "Neplatná délka řádky kódovaného textu"
    1251 

  • trunk/Languages/vCardStudio.po

    r76 r82  
    767767msgstr ""
    768768
     769#: tformsettings.label3.caption
     770msgid "Default vCard version:"
     771msgstr ""
     772
    769773#: tformsettings.labeldpi.caption
    770774msgid "DPI:"

  • trunk/UContact.pas

    r77 r82  
    106106
    107107  TContactProperties = class(TFPGObjectList<TContactProperty>)
     108    function AddNew(Name, Value: string): TContactProperty;
    108109    procedure Assign(Source: TContactProperties);
    109110    procedure AssignToList(List: TFPGObjectList<TObject>);
    … …  
    121122    FModified: Boolean;
    122123    FOnModify: TNotifyEvent;
     124    class var FFields: TContactFields;
    123125    function GetField(Index: TContactFieldIndex): string;
    124126    procedure SetField(Index: TContactFieldIndex; AValue: string);
    … …  
    127129  public
    128130    Properties: TContactProperties;
    129     Parent: TContactsFile;
     131    ContactsFile: TContactsFile;
     132    class function GetFields: TContactFields;
    130133    function HasField(FieldIndex: TContactFieldIndex): Boolean;
    131134    function FullNameToFileName: string;
    … …  
    136139    constructor Create;
    137140    destructor Destroy; override;
     141    class destructor Destroy;
    138142    procedure SaveToStrings(Output: TStrings);
    139143    function LoadFromStrings(Lines: TStrings; StartLine: Integer = 0): Integer;
    … …  
    167171  private
    168172    FOnError: TErrorEvent;
    169     procedure InitFields;
    170173    procedure Error(Text: string; Line: Integer);
    171174    function NewItem(Key, Value: string): string;
    172175  public
    173     Fields: TContactFields;
    174176    Contacts: TContacts;
    175177    function GetFileName: string; override;
    … …  
    430432{ TContactProperties }
    431433
     434function TContactProperties.AddNew(Name, Value: string): TContactProperty;
     435begin
     436  Result := TContactProperty.Create;
     437  Result.Name := Name;
     438  Result.Value := Value;
     439  Add(Result);
     440end;
     441
    432442procedure TContactProperties.Assign(Source: TContactProperties);
    433443var
    … …  
    643653  for I := 0 to Count - 1 do begin
    644654    Items[I].Assign(Source.Items[I]);
    645     Items[I].Parent := ContactsFile;
     655    Items[I].ContactsFile := ContactsFile;
    646656  end;
    647657end;
    … …  
    655665    NewContact := TContact.Create;
    656666    NewContact.Assign(Contacts[I]);
    657     NewContact.Parent := ContactsFile;
     667    NewContact.ContactsFile := ContactsFile;
    658668    Add(NewContact);
    659669  end;
    … …  
    668678    NewContact := TContact.Create;
    669679    NewContact.Assign(Contacts[I]);
    670     NewContact.Parent := ContactsFile;
     680    NewContact.ContactsFile := ContactsFile;
    671681    Insert(Index, NewContact);
    672682    Inc(Index);
    … …  
    687697begin
    688698  Result := TContact.Create;
    689   Result.Parent := ContactsFile;
     699  Result.ContactsFile := ContactsFile;
    690700  Add(Result);
    691701end;
    … …  
    723733    NewContact := TContact.Create;
    724734    NewContact.Assign(Contact);
    725     NewContact.Parent := ContactsFile;
     735    NewContact.ContactsFile := ContactsFile;
    726736    Add(NewContact);
    727737  end;
    … …  
    813823{ TContact }
    814824
    815 function TContact.GetField(Index: TContactFieldIndex): string;
    816 var
    817   Prop: TContactProperty;
    818   Field: TContactField;
    819 begin
    820   if not Assigned(Parent) then raise Exception.Create(SContactHasNoParent);
    821   Field := Parent.Fields.GetByIndex(Index);
    822   if Assigned(Field) then begin
    823     Prop := GetProperty(Field);
    824     if Assigned(Prop) then begin
    825       Field := Parent.Fields.GetByIndex(Index);
    826       if Field.ValueIndex <> -1 then begin
    827         Result := DecodeEscaped(Prop.ValueItem[Field.ValueIndex])
    828       end else Result := Prop.Value;
    829     end else Result := '';
    830   end else raise Exception.Create(SFieldIndexNotDefined);
    831 end;
    832 
    833 procedure TContact.SetField(Index: TContactFieldIndex; AValue: string);
    834 var
    835   Prop: TContactProperty;
    836   Field: TContactField;
    837   I: Integer;
    838 begin
    839   if not Assigned(Parent) then raise Exception.Create(SContactHasNoParent);
    840   Field := Parent.Fields.GetByIndex(Index);
    841   if Assigned(Field) then begin
    842     Prop := GetProperty(Field);
    843     if (not Assigned(Prop)) and (AValue <> '') then begin
    844       Prop := TContactProperty.Create;
    845       Prop.Name := Field.SysName;
    846       for I := 0 to Length(Field.Groups) - 1 do
    847         Prop.Attributes.Add(Field.Groups[I]);
    848       Properties.Add(Prop);
    849     end;
    850     if Assigned(Prop) then begin
    851       if Field.ValueIndex <> -1 then begin
    852         Prop.ValueItem[Field.ValueIndex] := EncodeEscaped(AValue);
    853       end else Prop.Value := AValue;
    854 
    855       // Remove if empty
    856       if Prop.Value = '' then begin
    857         Properties.Remove(Prop);
    858       end;
    859     end;
    860     Modified := True;
    861   end else raise Exception.Create(SFieldIndexNotDefined);
    862 end;
    863 
    864 procedure TContact.SetModified(AValue: Boolean);
    865 begin
    866   if FModified = AValue then Exit;
    867   FModified := AValue;
    868   DoOnModify;
    869 end;
    870 
    871 procedure TContact.DoOnModify;
    872 begin
    873   if Assigned(FOnModify) then FOnModify(Self);
    874 end;
    875 
    876 function TContact.HasField(FieldIndex: TContactFieldIndex): Boolean;
    877 var
    878   Field: TContactField;
    879 begin
    880   if not Assigned(Parent) then raise Exception.Create(SContactHasNoParent);
    881   Field := Parent.Fields.GetByIndex(FieldIndex);
    882   if Assigned(Field) then begin
    883     Result := Assigned(GetProperty(Field));
    884   end else raise Exception.Create(SFieldIndexNotDefined);
    885 end;
    886 
    887 function TContact.FullNameToFileName: string;
    888 var
    889   I: Integer;
    890 begin
    891   Result := Fields[cfFullName];
    892   for I := 1 to Length(Result) do begin
    893     if Result[I] in [':', '/', '\', '.', '"', '*', '|', '?', '<', '>'] then
    894       Result[I] := '_';
    895   end;
    896 end;
    897 
    898 function TContact.GetProperty(Field: TContactField): TContactProperty;
    899 var
    900   I: Integer;
    901 begin
    902   Result := Properties.GetByNameGroups(Field.SysName, Field.Groups, Field.NoGroups);
    903   I := 0;
    904   while (not Assigned(Result)) and (I < Field.Alternatives.Count) do begin
    905     Result := Properties.GetByNameGroups(Field.Alternatives[I].SysName,
    906       Field.Alternatives[I].Groups, Field.Alternatives[I].NoGroups);
    907     if Assigned(Result) then Break;
    908     Inc(I);
    909   end;
    910 end;
    911 
    912 function TContact.GetProperty(FieldIndex: TContactFieldIndex): TContactProperty;
    913 var
    914   Field: TContactField;
    915 begin
    916   if not Assigned(Parent) then raise Exception.Create(SContactHasNoParent);
    917   Field := Parent.Fields.GetByIndex(FieldIndex);
    918   if Assigned(Field) then begin
    919     Result := GetProperty(Field);
    920   end else Result := nil;
    921 end;
    922 
    923 procedure TContact.Assign(Source: TContact);
    924 begin
    925   Properties.Assign(Source.Properties);
    926   FModified := Source.FModified;
    927 end;
    928 
    929 function TContact.UpdateFrom(Source: TContact): Boolean;
    930 var
    931   I: Integer;
    932 begin
    933   if not Assigned(Parent) then raise Exception.Create(SContactHasNoParent);
    934   Result := False;
    935   for I := 0 to Parent.Fields.Count - 1 do begin
    936     if (Source.Fields[Parent.Fields[I].Index] <> '') and
    937       (Source.Fields[Parent.Fields[I].Index] <>
    938       Fields[Parent.Fields[I].Index]) then begin
    939         Result := True;
    940         Fields[Parent.Fields[I].Index] := Source.Fields[Parent.Fields[I].Index];
    941       end;
    942   end;
    943 end;
    944 
    945 constructor TContact.Create;
    946 begin
    947   Properties := TContactProperties.Create;
    948 end;
    949 
    950 destructor TContact.Destroy;
    951 begin
    952   FreeAndNil(Properties);
    953   inherited;
    954 end;
    955 
    956 procedure TContact.SaveToStrings(Output: TStrings);
    957 var
    958   I: Integer;
    959   NameText: string;
    960   Value2: string;
    961   LineIndex: Integer;
    962   OutText: string;
    963   LinePrefix: string;
    964   CutLength: Integer;
    965 const
    966   MaxLineLength = 73;
    967 begin
    968     with Output do begin
    969       Add(VCardBegin);
    970       for I := 0 to Properties.Count - 1 do
    971       with Properties[I] do begin
    972         NameText := Name;
    973         if Attributes.Count > 0 then
    974           NameText := NameText + ';' + Attributes.DelimitedText;
    975         if Encoding <> '' then begin
    976           Value2 := GetEncodedValue;
    977           NameText := NameText + ';ENCODING=' + Encoding;
    978         end else Value2 := Value;
    979         if Pos(LineEnding, Value2) > 0 then begin
    980           Add(NameText + ':' + GetNext(Value2, LineEnding));
    981           while Pos(LineEnding, Value2) > 0 do begin
    982             Add(' ' + GetNext(Value2, LineEnding));
    983           end;
    984           Add(' ' + GetNext(Value2, LineEnding));
    985           Add('');
    986         end else begin
    987           OutText := NameText + ':' + Value2;
    988           LineIndex := 0;
    989           LinePrefix := '';
    990           while True do begin
    991             if Length(OutText) > MaxLineLength then begin
    992               CutLength := MaxLineLength;
    993               if Encoding = 'QUOTED-PRINTABLE' then begin
    994                 // Do not cut encoded items
    995                 if ((CutLength - 2) >= 1) and (OutText[CutLength - 2] = '=') then
    996                   Dec(CutLength, 2)
    997                 else if ((CutLength - 1) >= 1) and (OutText[CutLength - 1] = '=') then
    998                   Dec(CutLength, 1);
    999               end;
    1000               Add(LinePrefix + Copy(OutText, 1, CutLength));
    1001               LinePrefix := ' ';
    1002               System.Delete(OutText, 1, CutLength);
    1003               Inc(LineIndex);
    1004               Continue;
    1005             end else begin
    1006               Add(LinePrefix + OutText);
    1007               Break;
    1008             end;
    1009           end;
    1010           if LinePrefix <> '' then Add('');
    1011         end;
    1012       end;
    1013       Add(VCardEnd);
    1014     end;
    1015 end;
    1016 
    1017 function TContact.LoadFromStrings(Lines: TStrings; StartLine: Integer = 0): Integer;
    1018 type
    1019   TParseState = (psNone, psInside, psFinished);
    1020 var
    1021   ParseState: TParseState;
    1022   Line: string;
    1023   Value: string;
    1024   I: Integer;
    1025   NewProperty: TContactProperty;
    1026   CommandPart: string;
    1027   Names: string;
    1028 begin
    1029   ParseState := psNone;
    1030   I := StartLine;
    1031   while I < Lines.Count do begin
    1032     Line := Trim(Lines[I]);
    1033     if Line = '' then begin
    1034       // Skip empty lines
    1035     end else
    1036     if ParseState = psNone then begin
    1037       if Line = VCardBegin then begin
    1038         ParseState := psInside;
    1039       end else begin
    1040         Parent.Error(SExpectedVCardBegin, I + 1);
    1041         I := -1;
    1042         Break;
    1043       end;
    1044     end else
    1045     if ParseState = psInside then begin
    1046       if Line = VCardEnd then begin
    1047         ParseState := psFinished;
    1048         Inc(I);
    1049         Break;
    1050       end else
    1051       if Pos(':', Line) > 0 then begin
    1052         CommandPart := GetNext(Line, ':');
    1053         Names := CommandPart;
    1054         Value := Line;
    1055         while True do begin
    1056           Inc(I);
    1057           if (Length(Lines[I]) > 0) and (Lines[I][1] = ' ') then begin
    1058             Value := Value + Trim(Lines[I]);
    1059           end else
    1060           if (Length(Lines[I]) > 0) and (Length(Value) > 0) and (Value[Length(Value)] = '=') and
    1061             (Lines[I][1] = '=') then begin
    1062             Value := Value + Copy(Trim(Lines[I]), 2, MaxInt);
    1063           end else begin
    1064             Dec(I);
    1065             Break;
    1066           end;
    1067         end;
    1068         NewProperty := Properties.GetByName(Names);
    1069         if not Assigned(NewProperty) then begin
    1070           NewProperty := TContactProperty.Create;
    1071           Properties.Add(NewProperty);
    1072         end;
    1073         NewProperty.Attributes.DelimitedText := Names;
    1074         if NewProperty.Attributes.Count > 0 then begin
    1075           NewProperty.Name := NewProperty.Attributes[0];
    1076           NewProperty.Attributes.Delete(0);
    1077         end;
    1078         NewProperty.Value := Value;
    1079         NewProperty.EvaluateAttributes;
    1080       end else begin
    1081         Parent.Error(SExpectedProperty, I + 1);
    1082         I := -1;
    1083         Break;
    1084       end;
    1085     end;
    1086     Inc(I);
    1087   end;
    1088   Result := I;
    1089 end;
    1090 
    1091 procedure TContact.SaveToFile(FileName: string);
    1092 var
    1093   Lines: TStringList;
    1094 begin
    1095   Lines := TStringList.Create;
    1096   try
    1097     SaveToStrings(Lines);
    1098     Lines.SaveToFile(FileName);
    1099   finally
    1100     Lines.Free;
    1101   end;
    1102 end;
    1103 
    1104 procedure TContact.LoadFromFile(FileName: string);
    1105 var
    1106   Lines: TStringList;
    1107 begin
    1108   Lines := TStringList.Create;
    1109   try
    1110     Lines.LoadFromFile(FileName);
    1111     {$IF FPC_FULLVERSION>=30200}
    1112     if (Length(Lines.Text) > 0) and (Pos(VCardBegin, Lines.Text) = 0) then begin
    1113       Lines.LoadFromFile(FileName, TEncoding.Unicode);
    1114       if (Length(Lines.Text) > 0) and (Pos(VCardBegin, Lines.Text) = 0) then begin
    1115         Lines.LoadFromFile(FileName, TEncoding.BigEndianUnicode);
    1116       end;
    1117     end;
    1118     {$ENDIF}
    1119     LoadFromStrings(Lines);
    1120   finally
    1121     Lines.Free;
    1122   end;
    1123 end;
    1124 
    1125 { TContactsFile }
    1126 
    1127 procedure TContactsFile.InitFields;
    1128 begin
    1129   with Fields do begin
     825class function TContact.GetFields: TContactFields;
     826begin
     827  if not Assigned(FFields) then begin
     828    FFields := TContactFields.Create;
     829    with FFields do begin
    1130830    AddNew('VERSION', [], [], SVersion, cfVersion, dtString);
    1131831    AddNew('N', [], [], SLastName, cfLastName, dtString, 0);
    … …  
    1230930    with AddNew('X-MYSPACE', [], [], SMySpace, cfMySpace, dtString) do
    1231931      AddAlternative('X-SOCIALPROFILE', ['MYSPACE'], []);
    1232   end;
    1233 end;
     932    end;
     933  end;
     934  Result := FFields;
     935end;
     936
     937function TContact.GetField(Index: TContactFieldIndex): string;
     938var
     939  Prop: TContactProperty;
     940  Field: TContactField;
     941begin
     942  if not Assigned(ContactsFile) then raise Exception.Create(SContactHasNoParent);
     943  Field := GetFields.GetByIndex(Index);
     944  if Assigned(Field) then begin
     945    Prop := GetProperty(Field);
     946    if Assigned(Prop) then begin
     947      Field := GetFields.GetByIndex(Index);
     948      if Field.ValueIndex <> -1 then begin
     949        Result := DecodeEscaped(Prop.ValueItem[Field.ValueIndex])
     950      end else Result := Prop.Value;
     951    end else Result := '';
     952  end else raise Exception.Create(SFieldIndexNotDefined);
     953end;
     954
     955procedure TContact.SetField(Index: TContactFieldIndex; AValue: string);
     956var
     957  Prop: TContactProperty;
     958  Field: TContactField;
     959  I: Integer;
     960begin
     961  if not Assigned(ContactsFile) then raise Exception.Create(SContactHasNoParent);
     962  Field := GetFields.GetByIndex(Index);
     963  if Assigned(Field) then begin
     964    Prop := GetProperty(Field);
     965    if (not Assigned(Prop)) and (AValue <> '') then begin
     966      Prop := TContactProperty.Create;
     967      Prop.Name := Field.SysName;
     968      for I := 0 to Length(Field.Groups) - 1 do
     969        Prop.Attributes.Add(Field.Groups[I]);
     970      Properties.Add(Prop);
     971    end;
     972    if Assigned(Prop) then begin
     973      if Field.ValueIndex <> -1 then begin
     974        Prop.ValueItem[Field.ValueIndex] := EncodeEscaped(AValue);
     975      end else Prop.Value := AValue;
     976
     977      // Remove if empty
     978      if Prop.Value = '' then begin
     979        Properties.Remove(Prop);
     980      end;
     981    end;
     982    Modified := True;
     983  end else raise Exception.Create(SFieldIndexNotDefined);
     984end;
     985
     986procedure TContact.SetModified(AValue: Boolean);
     987begin
     988  if FModified = AValue then Exit;
     989  FModified := AValue;
     990  DoOnModify;
     991end;
     992
     993procedure TContact.DoOnModify;
     994begin
     995  if Assigned(FOnModify) then FOnModify(Self);
     996end;
     997
     998function TContact.HasField(FieldIndex: TContactFieldIndex): Boolean;
     999var
     1000  Field: TContactField;
     1001begin
     1002  if not Assigned(ContactsFile) then raise Exception.Create(SContactHasNoParent);
     1003  Field := GetFields.GetByIndex(FieldIndex);
     1004  if Assigned(Field) then begin
     1005    Result := Assigned(GetProperty(Field));
     1006  end else raise Exception.Create(SFieldIndexNotDefined);
     1007end;
     1008
     1009function TContact.FullNameToFileName: string;
     1010var
     1011  I: Integer;
     1012begin
     1013  Result := Fields[cfFullName];
     1014  for I := 1 to Length(Result) do begin
     1015    if Result[I] in [':', '/', '\', '.', '"', '*', '|', '?', '<', '>'] then
     1016      Result[I] := '_';
     1017  end;
     1018end;
     1019
     1020function TContact.GetProperty(Field: TContactField): TContactProperty;
     1021var
     1022  I: Integer;
     1023begin
     1024  Result := Properties.GetByNameGroups(Field.SysName, Field.Groups, Field.NoGroups);
     1025  I := 0;
     1026  while (not Assigned(Result)) and (I < Field.Alternatives.Count) do begin
     1027    Result := Properties.GetByNameGroups(Field.Alternatives[I].SysName,
     1028      Field.Alternatives[I].Groups, Field.Alternatives[I].NoGroups);
     1029    if Assigned(Result) then Break;
     1030    Inc(I);
     1031  end;
     1032end;
     1033
     1034function TContact.GetProperty(FieldIndex: TContactFieldIndex): TContactProperty;
     1035var
     1036  Field: TContactField;
     1037begin
     1038  if not Assigned(ContactsFile) then raise Exception.Create(SContactHasNoParent);
     1039  Field := GetFields.GetByIndex(FieldIndex);
     1040  if Assigned(Field) then begin
     1041    Result := GetProperty(Field);
     1042  end else Result := nil;
     1043end;
     1044
     1045procedure TContact.Assign(Source: TContact);
     1046begin
     1047  Properties.Assign(Source.Properties);
     1048  FModified := Source.FModified;
     1049end;
     1050
     1051function TContact.UpdateFrom(Source: TContact): Boolean;
     1052var
     1053  I: Integer;
     1054begin
     1055  if not Assigned(ContactsFile) then raise Exception.Create(SContactHasNoParent);
     1056  Result := False;
     1057  for I := 0 to GetFields.Count - 1 do begin
     1058    if (Source.Fields[GetFields[I].Index] <> '') and
     1059      (Source.Fields[GetFields[I].Index] <>
     1060      Fields[GetFields[I].Index]) then begin
     1061        Result := True;
     1062        Fields[GetFields[I].Index] := Source.Fields[GetFields[I].Index];
     1063      end;
     1064  end;
     1065end;
     1066
     1067constructor TContact.Create;
     1068begin
     1069  Properties := TContactProperties.Create;
     1070end;
     1071
     1072destructor TContact.Destroy;
     1073begin
     1074  FreeAndNil(Properties);
     1075  inherited;
     1076end;
     1077
     1078class destructor TContact.Destroy;
     1079begin
     1080  FreeAndNil(FFields);
     1081end;
     1082
     1083procedure TContact.SaveToStrings(Output: TStrings);
     1084var
     1085  I: Integer;
     1086  NameText: string;
     1087  Value2: string;
     1088  LineIndex: Integer;
     1089  OutText: string;
     1090  LinePrefix: string;
     1091  CutLength: Integer;
     1092const
     1093  MaxLineLength = 73;
     1094begin
     1095    with Output do begin
     1096      Add(VCardBegin);
     1097      for I := 0 to Properties.Count - 1 do
     1098      with Properties[I] do begin
     1099        NameText := Name;
     1100        if Attributes.Count > 0 then
     1101          NameText := NameText + ';' + Attributes.DelimitedText;
     1102        if Encoding <> '' then begin
     1103          Value2 := GetEncodedValue;
     1104          NameText := NameText + ';ENCODING=' + Encoding;
     1105        end else Value2 := Value;
     1106        if Pos(LineEnding, Value2) > 0 then begin
     1107          Add(NameText + ':' + GetNext(Value2, LineEnding));
     1108          while Pos(LineEnding, Value2) > 0 do begin
     1109            Add(' ' + GetNext(Value2, LineEnding));
     1110          end;
     1111          Add(' ' + GetNext(Value2, LineEnding));
     1112          Add('');
     1113        end else begin
     1114          OutText := NameText + ':' + Value2;
     1115          LineIndex := 0;
     1116          LinePrefix := '';
     1117          while True do begin
     1118            if Length(OutText) > MaxLineLength then begin
     1119              CutLength := MaxLineLength;
     1120              if Encoding = 'QUOTED-PRINTABLE' then begin
     1121                // Do not cut encoded items
     1122                if ((CutLength - 2) >= 1) and (OutText[CutLength - 2] = '=') then
     1123                  Dec(CutLength, 2)
     1124                else if ((CutLength - 1) >= 1) and (OutText[CutLength - 1] = '=') then
     1125                  Dec(CutLength, 1);
     1126              end;
     1127              Add(LinePrefix + Copy(OutText, 1, CutLength));
     1128              LinePrefix := ' ';
     1129              System.Delete(OutText, 1, CutLength);
     1130              Inc(LineIndex);
     1131              Continue;
     1132            end else begin
     1133              Add(LinePrefix + OutText);
     1134              Break;
     1135            end;
     1136          end;
     1137          if LinePrefix <> '' then Add('');
     1138        end;
     1139      end;
     1140      Add(VCardEnd);
     1141    end;
     1142end;
     1143
     1144function TContact.LoadFromStrings(Lines: TStrings; StartLine: Integer = 0): Integer;
     1145type
     1146  TParseState = (psNone, psInside, psFinished);
     1147var
     1148  ParseState: TParseState;
     1149  Line: string;
     1150  Value: string;
     1151  I: Integer;
     1152  NewProperty: TContactProperty;
     1153  CommandPart: string;
     1154  Names: string;
     1155begin
     1156  ParseState := psNone;
     1157  I := StartLine;
     1158  while I < Lines.Count do begin
     1159    Line := Trim(Lines[I]);
     1160    if Line = '' then begin
     1161      // Skip empty lines
     1162    end else
     1163    if ParseState = psNone then begin
     1164      if Line = VCardBegin then begin
     1165        ParseState := psInside;
     1166      end else begin
     1167        ContactsFile.Error(SExpectedVCardBegin, I + 1);
     1168        I := -1;
     1169        Break;
     1170      end;
     1171    end else
     1172    if ParseState = psInside then begin
     1173      if Line = VCardEnd then begin
     1174        ParseState := psFinished;
     1175        Inc(I);
     1176        Break;
     1177      end else
     1178      if Pos(':', Line) > 0 then begin
     1179        CommandPart := GetNext(Line, ':');
     1180        Names := CommandPart;
     1181        Value := Line;
     1182        while True do begin
     1183          Inc(I);
     1184          if (Length(Lines[I]) > 0) and (Lines[I][1] = ' ') then begin
     1185            Value := Value + Trim(Lines[I]);
     1186          end else
     1187          if (Length(Lines[I]) > 0) and (Length(Value) > 0) and (Value[Length(Value)] = '=') and
     1188            (Lines[I][1] = '=') then begin
     1189            Value := Value + Copy(Trim(Lines[I]), 2, MaxInt);
     1190          end else begin
     1191            Dec(I);
     1192            Break;
     1193          end;
     1194        end;
     1195        NewProperty := Properties.GetByName(Names);
     1196        if not Assigned(NewProperty) then begin
     1197          NewProperty := TContactProperty.Create;
     1198          Properties.Add(NewProperty);
     1199        end;
     1200        NewProperty.Attributes.DelimitedText := Names;
     1201        if NewProperty.Attributes.Count > 0 then begin
     1202          NewProperty.Name := NewProperty.Attributes[0];
     1203          NewProperty.Attributes.Delete(0);
     1204        end;
     1205        NewProperty.Value := Value;
     1206        NewProperty.EvaluateAttributes;
     1207      end else begin
     1208        ContactsFile.Error(SExpectedProperty, I + 1);
     1209        I := -1;
     1210        Break;
     1211      end;
     1212    end;
     1213    Inc(I);
     1214  end;
     1215  Result := I;
     1216end;
     1217
     1218procedure TContact.SaveToFile(FileName: string);
     1219var
     1220  Lines: TStringList;
     1221begin
     1222  Lines := TStringList.Create;
     1223  try
     1224    SaveToStrings(Lines);
     1225    Lines.SaveToFile(FileName);
     1226  finally
     1227    Lines.Free;
     1228  end;
     1229end;
     1230
     1231procedure TContact.LoadFromFile(FileName: string);
     1232var
     1233  Lines: TStringList;
     1234begin
     1235  Lines := TStringList.Create;
     1236  try
     1237    Lines.LoadFromFile(FileName);
     1238    {$IF FPC_FULLVERSION>=30200}
     1239    if (Length(Lines.Text) > 0) and (Pos(VCardBegin, Lines.Text) = 0) then begin
     1240      Lines.LoadFromFile(FileName, TEncoding.Unicode);
     1241      if (Length(Lines.Text) > 0) and (Pos(VCardBegin, Lines.Text) = 0) then begin
     1242        Lines.LoadFromFile(FileName, TEncoding.BigEndianUnicode);
     1243      end;
     1244    end;
     1245    {$ENDIF}
     1246    LoadFromStrings(Lines);
     1247  finally
     1248    Lines.Free;
     1249  end;
     1250end;
     1251
     1252{ TContactsFile }
    12341253
    12351254procedure TContactsFile.Error(Text: string; Line: Integer);
    … …  
    12721291  while I < Lines.Count do begin
    12731292    Contact := TContact.Create;
    1274     Contact.Parent := Self;
     1293    Contact.ContactsFile := Self;
    12751294    NewI := Contact.LoadFromStrings(Lines, I);
    12761295    if NewI <= Lines.Count then begin
    … …  
    13391358  Contacts := TContacts.Create;
    13401359  Contacts.ContactsFile := Self;
    1341   Fields := TContactFields.Create;
    1342   InitFields;
    13431360end;
    13441361
    13451362destructor TContactsFile.Destroy;
    13461363begin
    1347   FreeAndNil(Fields);
    13481364  FreeAndNil(Contacts);
    13491365  inherited;

  • trunk/UCore.lfm

    r79 r82  
    498498    Images = ImageList1
    499499    Left = 384
    500     Top = 202
     500    Top = 200
    501501    object AExit: TAction
    502502      Caption = 'Exit'

  • trunk/UCore.pas

    r76 r82  
    8383    GenerateCount: Integer;
    8484    ToolbarVisible: Boolean;
     85    DefaultVcardVersion: string;
    8586    function GetProfileImage: TImage;
    8687    procedure FileNew;
    … …  
    453454    LastPropertyValueFileName := ReadStringWithDefault('LastPropertyValueFileName', '');
    454455    GenerateCount := ReadIntegerWithDefault('GenerateCount', 1);
     456    DefaultVcardVersion := ReadStringWithDefault('DefaultVcardVersion', '2.1');
    455457  finally
    456458    Free;
    … …  
    479481    WriteString('LastPropertyValueFileName', LastPropertyValueFileName);
    480482    WriteInteger('GenerateCount', GenerateCount);
     483    WriteString('DefaultVcardVersion', DefaultVcardVersion);
    481484  finally
    482485    Free;
    … …  
    506509  AFileSplit.Enabled := Assigned(DataFile);
    507510  AFileCombine.Enabled := Assigned(DataFile);
     511  AFind.Enabled := Assigned(DataFile);
    508512  AFindDuplicate.Enabled := Assigned(DataFile);
    509513  AGenerate.Enabled := Assigned(DataFile);
    … …  
    525529      LastOpenedList1.AddItem(FileNameOption);
    526530    end else
    527     if (LastOpenedList1.Items.Count > 0) and FileExists(LastOpenedList1.Items[0]) then begin
     531    if ReopenLastFileOnStart and (LastOpenedList1.Items.Count > 0) and FileExists(LastOpenedList1.Items[0]) then begin
    528532      // Open last opened file
    529533      AFileNew.Execute;
Note: See TracChangeset for help on using the changeset viewer.