Changeset 45 for trunk


Ignore:
Timestamp:
Dec 2, 2021, 3:19:57 PM (3 years ago)
Author:
chronos
Message:
  • Added: Allow to load photo from file or save it to file.
Location:
trunk
Files:
7 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormContact.lfm

    r43 r45  
    2525    object TabSheetGeneral: TTabSheet
    2626      Caption = 'General'
    27       ClientHeight = 742
    28       ClientWidth = 929
     27      ClientHeight = 744
     28      ClientWidth = 931
    2929      OnShow = TabSheetGeneralShow
    3030      ParentFont = False
    3131      object Label1: TLabel
    3232        Left = 240
    33         Height = 24
     33        Height = 25
    3434        Top = 80
    35         Width = 94
     35        Width = 86
    3636        Caption = 'First name:'
    3737        ParentColor = False
    … …  
    4040      object EditFirstName: TEdit
    4141        Left = 360
    42         Height = 42
     42        Height = 33
    4343        Top = 72
    4444        Width = 155
    … …  
    4848      object Label2: TLabel
    4949        Left = 16
    50         Height = 24
     50        Height = 25
    5151        Top = 250
    52         Width = 63
     52        Width = 59
    5353        Caption = 'Mobile:'
    5454        ParentColor = False
    … …  
    5757      object EditMobile: TEdit
    5858        Left = 144
    59         Height = 42
     59        Height = 33
    6060        Top = 240
    6161        Width = 254
    … …  
    6565      object EditPhone: TEdit
    6666        Left = 144
    67         Height = 42
     67        Height = 33
    6868        Top = 286
    6969        Width = 254
    … …  
    7373      object Label3: TLabel
    7474        Left = 16
    75         Height = 24
     75        Height = 25
    7676        Top = 290
    77         Width = 59
     77        Width = 54
    7878        Caption = 'Phone:'
    7979        ParentColor = False
    … …  
    8282      object EditEmail: TEdit
    8383        Left = 144
    84         Height = 42
     84        Height = 33
    8585        Top = 328
    8686        Width = 254
    … …  
    9090      object Label4: TLabel
    9191        Left = 16
    92         Height = 24
     92        Height = 25
    9393        Top = 336
    94         Width = 58
     94        Width = 53
    9595        Caption = 'E-mail:'
    9696        ParentColor = False
    … …  
    9999      object EditLastName: TEdit
    100100        Left = 671
    101         Height = 42
     101        Height = 33
    102102        Top = 72
    103103        Width = 155
    … …  
    107107      object Label5: TLabel
    108108        Left = 536
    109         Height = 24
     109        Height = 25
    110110        Top = 80
    111         Width = 87
     111        Width = 80
    112112        Caption = 'Last name'
    113113        ParentColor = False
    … …  
    116116      object EditBirthday: TEdit
    117117        Left = 144
    118         Height = 42
     118        Height = 33
    119119        Top = 424
    120120        Width = 254
    … …  
    124124      object Label22: TLabel
    125125        Left = 16
    126         Height = 24
     126        Height = 25
    127127        Top = 432
    128         Width = 76
     128        Width = 69
    129129        Caption = 'Birthday:'
    130130        ParentColor = False
    … …  
    136136        Top = 16
    137137        Width = 207
     138        PopupMenu = PopupMenuPhoto
    138139        Proportional = True
    139140        Stretch = True
    … …  
    141142      object Label24: TLabel
    142143        Left = 240
    143         Height = 24
     144        Height = 25
    144145        Top = 32
    145         Width = 88
     146        Width = 80
    146147        Caption = 'Full name:'
    147148        ParentColor = False
    … …  
    150151      object EditFullName: TEdit
    151152        Left = 360
    152         Height = 42
     153        Height = 33
    153154        Top = 24
    154155        Width = 467
    … …  
    158159      object Label25: TLabel
    159160        Left = 536
    160         Height = 24
     161        Height = 25
    161162        Top = 128
    162         Width = 116
     163        Width = 108
    163164        Caption = 'Middle name:'
    164165        ParentColor = False
    … …  
    167168      object EditMiddleName: TEdit
    168169        Left = 671
    169         Height = 42
     170        Height = 33
    170171        Top = 120
    171172        Width = 155
    … …  
    175176      object Label26: TLabel
    176177        Left = 240
    177         Height = 24
     178        Height = 25
    178179        Top = 176
    179         Width = 101
     180        Width = 93
    180181        Caption = 'Title before:'
    181182        ParentColor = False
    … …  
    184185      object EditTitleBefore: TEdit
    185186        Left = 360
    186         Height = 42
     187        Height = 33
    187188        Top = 168
    188189        Width = 155
    … …  
    192193      object Label27: TLabel
    193194        Left = 536
    194         Height = 24
     195        Height = 25
    195196        Top = 176
    196         Width = 85
     197        Width = 77
    197198        Caption = 'Title after:'
    198199        ParentColor = False
    … …  
    201202      object EditTitleAfter: TEdit
    202203        Left = 671
    203         Height = 42
     204        Height = 33
    204205        Top = 168
    205206        Width = 155
    … …  
    209210      object Label44: TLabel
    210211        Left = 240
    211         Height = 24
     212        Height = 25
    212213        Top = 128
    213         Width = 91
     214        Width = 82
    214215        Caption = 'Nickname:'
    215216        ParentColor = False
    … …  
    218219      object EditNickName: TEdit
    219220        Left = 360
    220         Height = 42
     221        Height = 33
    221222        Top = 120
    222223        Width = 155
    … …  
    226227      object Label45: TLabel
    227228        Left = 432
    228         Height = 24
     229        Height = 25
    229230        Top = 432
    230         Width = 105
     231        Width = 96
    231232        Caption = 'Anniversary:'
    232233        ParentColor = False
    … …  
    235236      object EditAniversary: TEdit
    236237        Left = 575
    237         Height = 42
     238        Height = 33
    238239        Top = 424
    239240        Width = 254
    … …  
    243244      object Label9: TLabel
    244245        Left = 432
    245         Height = 24
     246        Height = 25
    246247        Top = 248
    247         Width = 34
     248        Width = 29
    248249        Caption = 'Fax:'
    249250        ParentColor = False
    … …  
    252253      object EditFax: TEdit
    253254        Left = 575
    254         Height = 42
     255        Height = 33
    255256        Top = 240
    256257        Width = 254
    … …  
    260261      object EditPager: TEdit
    261262        Left = 575
    262         Height = 42
     263        Height = 33
    263264        Top = 286
    264265        Width = 254
    … …  
    268269      object Label10: TLabel
    269270        Left = 432
    270         Height = 24
     271        Height = 25
    271272        Top = 290
    272         Width = 54
     273        Width = 48
    273274        Caption = 'Pager:'
    274275        ParentColor = False
    … …  
    277278      object Label46: TLabel
    278279        Left = 16
    279         Height = 24
     280        Height = 25
    280281        Top = 384
    281         Width = 114
     282        Width = 107
    282283        Caption = 'Web address:'
    283284        ParentColor = False
    … …  
    286287      object EditWeb: TEdit
    287288        Left = 144
    288         Height = 42
     289        Height = 33
    289290        Top = 376
    290291        Width = 683
    … …  
    390391        Anchors = [akTop, akLeft, akRight]
    391392        Caption = 'Address'
    392         ClientHeight = 215
    393         ClientWidth = 888
     393        ClientHeight = 212
     394        ClientWidth = 886
    394395        TabOrder = 6
    395396        object Label36: TLabel
    … …  
    611612        Width = 911
    612613        Caption = 'Address'
    613         ClientHeight = 220
    614         ClientWidth = 909
     614        ClientHeight = 217
     615        ClientWidth = 907
    615616        TabOrder = 4
    616617        object Label31: TLabel
    … …  
    900901  object ActionList1: TActionList
    901902    Images = Core.ImageList1
    902     Left = 848
    903     Top = 488
    904     object AEditField: TAction
    905       Caption = 'Edit'
     903    Left = 592
     904    Top = 528
     905    object APhotoLoad: TAction
     906      Caption = 'Load from file'
     907      OnExecute = APhotoLoadExecute
     908    end
     909    object APhotoSave: TAction
     910      Caption = 'Save to file'
     911      OnExecute = APhotoSaveExecute
    906912    end
    907913  end
    908   object PopupMenu1: TPopupMenu
     914  object PopupMenuPhoto: TPopupMenu
    909915    Images = Core.ImageList1
    910     Left = 856
    911     Top = 368
     916    Left = 408
     917    Top = 528
    912918    object MenuItem1: TMenuItem
    913       Action = AEditField
     919      Action = APhotoLoad
     920    end
     921    object MenuItem2: TMenuItem
     922      Action = APhotoSave
    914923    end
    915924  end
     925  object OpenPictureDialog1: TOpenPictureDialog
     926    Left = 197
     927    Top = 535
     928  end
     929  object SavePictureDialog1: TSavePictureDialog
     930    Left = 197
     931    Top = 617
     932  end
    916933end

  • trunk/Forms/UFormContact.lrj

    r43 r45  
    5757{"hash":147653555,"name":"tformcontact.buttonprevious.caption","sourcebytes":[80,114,101,118,105,111,117,115],"value":"Previous"},
    5858{"hash":347380,"name":"tformcontact.buttonnext.caption","sourcebytes":[78,101,120,116],"value":"Next"},
    59 {"hash":310020,"name":"tformcontact.aeditfield.caption","sourcebytes":[69,100,105,116],"value":"Edit"}
     59{"hash":8431845,"name":"tformcontact.aphotoload.caption","sourcebytes":[76,111,97,100,32,102,114,111,109,32,102,105,108,101],"value":"Load from file"},
     60{"hash":9308581,"name":"tformcontact.aphotosave.caption","sourcebytes":[83,97,118,101,32,116,111,32,102,105,108,101],"value":"Save to file"}
    6061]}

  • trunk/Forms/UFormContact.pas

    r43 r45  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
    9   ComCtrls, ActnList, Menus, ExtCtrls, UContact, UFormProperties;
     9  ComCtrls, ActnList, Menus, ExtCtrls, ExtDlgs, UContact, UFormProperties;
    1010
    1111type
    … …  
    1414
    1515  TFormContact = class(TForm)
    16     AEditField: TAction;
     16    APhotoSave: TAction;
     17    APhotoLoad: TAction;
    1718    ActionList1: TActionList;
    1819    ButtonCancel: TButton;
    … …  
    114115    MemoNotes: TMemo;
    115116    MenuItem1: TMenuItem;
     117    MenuItem2: TMenuItem;
     118    OpenPictureDialog1: TOpenPictureDialog;
    116119    PageControlContact: TPageControl;
    117     PopupMenu1: TPopupMenu;
     120    PopupMenuPhoto: TPopupMenu;
     121    SavePictureDialog1: TSavePictureDialog;
    118122    TabSheetOthers: TTabSheet;
    119123    TabSheetHome: TTabSheet;
    … …  
    121125    TabSheetGeneral: TTabSheet;
    122126    TabSheetAll: TTabSheet;
     127    procedure APhotoLoadExecute(Sender: TObject);
     128    procedure APhotoSaveExecute(Sender: TObject);
    123129    procedure ButtonNextClick(Sender: TObject);
    124130    procedure ButtonOkClick(Sender: TObject);
    … …  
    140146    procedure LoadData;
    141147    procedure SaveData;
     148    procedure UpdateInterface;
    142149    property Contact: TContact read FContact write SetContact;
    143150    property OnPrevious: TNotifyEvent read FOnPrevious write FOnPrevious;
    … …  
    166173  FormProperties.Align := alClient;
    167174  FormProperties.Show;
     175  UpdateInterface;
    168176end;
    169177
    … …  
    195203  if FContact = AValue then Exit;
    196204  FContact := AValue;
    197   LoadData;
     205  if Visible then LoadData;
    198206end;
    199207
    … …  
    212220begin
    213221  if Assigned(FOnNext) then FOnNext(Self);
     222end;
     223
     224procedure TFormContact.APhotoLoadExecute(Sender: TObject);
     225begin
     226  if OpenPictureDialog1.Execute then begin
     227    ImagePhoto.Picture.LoadFromFile(OpenPictureDialog1.FileName);
     228  end;
     229end;
     230
     231procedure TFormContact.APhotoSaveExecute(Sender: TObject);
     232begin
     233  if SavePictureDialog1.Execute then begin
     234    ImagePhoto.Picture.SaveToFile(SavePictureDialog1.FileName);
     235  end;
    214236end;
    215237
    … …  
    294316  MemoNotes.Lines.Text := Contact.Fields[cfNote];
    295317
     318  // Photo
    296319  ImagePhoto.Picture.Bitmap.Clear;
    297320  PhotoProperty := Contact.GetProperty(cfPhoto);
    … …  
    326349    end;
    327350  end;
     351  UpdateInterface;
    328352end;
    329353
    330354procedure TFormContact.SaveData;
     355var
     356  Photo: string;
     357  PhotoProperty: TContactProperty;
     358  Stream: TMemoryStream;
     359  JpegImage: TJpegImage;
    331360begin
    332361  // General
    … …  
    382411  // Others
    383412  Contact.Fields[cfNote] := MemoNotes.Lines.Text;
     413
     414  // Photo
     415  if (ImagePhoto.Picture.Bitmap.Width <> 0) and (ImagePhoto.Picture.Bitmap.Height <> 0) then begin
     416    PhotoProperty := Contact.GetProperty(cfPhoto);
     417    if not Assigned(PhotoProperty) then begin
     418      PhotoProperty := TContactProperty.Create;
     419      PhotoProperty.Name := 'PHOTO';
     420      PhotoProperty.Attributes.DelimitedText := 'JPEG';
     421      Contact.Properties.Add(PhotoProperty);
     422    end;
     423    PhotoProperty.Encoding := 'BASE64';
     424    Stream := TMemoryStream.Create;
     425    try
     426      if PhotoProperty.Attributes.IndexOf('JPEG') <> -1 then begin
     427        JpegImage := TJPEGImage.Create;
     428        try
     429          try
     430            JpegImage.SetSize(ImagePhoto.Picture.Bitmap.Width, ImagePhoto.Picture.Bitmap.Height);
     431            JpegImage.Canvas.Draw(0, 0, ImagePhoto.Picture.Bitmap);
     432            JpegImage.SaveToStream(Stream);
     433          except
     434          end;
     435        finally
     436          JpegImage.Free;
     437        end;
     438      end else begin
     439        try
     440          ImagePhoto.Picture.SaveToStream(Stream);
     441        except
     442        end;
     443      end;
     444
     445      SetLength(Photo, Stream.Size);
     446      Stream.Position := 0;
     447      Stream.Read(Photo[1], Length(Photo));
     448      Contact.Fields[cfPhoto] := Photo;
     449    finally
     450      Stream.Free;
     451    end;
     452  end;
     453end;
     454
     455procedure TFormContact.UpdateInterface;
     456begin
     457  APhotoSave.Enabled := (ImagePhoto.Picture.Bitmap.Width <> 0) and
     458    (ImagePhoto.Picture.Bitmap.Height <> 0);
    384459end;
    385460

  • trunk/Languages/vCardStudio.cs.po

    r43 r45  
    1212"X-Generator: Poedit 3.0\n"
    1313
    14 #: tcore.aabout.caption
    15 msgid "About..."
    16 msgstr "O aplikaci..."
    17 
    18 #: tcore.aexit.caption
    19 msgid "Exit"
    20 msgstr "Ukončit"
    21 
    22 #: tcore.afileclose.caption
    23 msgctxt "tcore.afileclose.caption"
    24 msgid "Close"
    25 msgstr "Zavřít"
    26 
    27 #: tcore.afilemerge.caption
    28 msgid "Merge..."
    29 msgstr "Sloučení..."
    30 
    31 #: tcore.afilenew.caption
    32 msgid "New"
    33 msgstr "Nový"
    34 
    35 #: tcore.afileopen.caption
    36 msgid "Open..."
    37 msgstr "Otevřít..."
    38 
    39 #: tcore.afileopenrecent.caption
    40 msgctxt "tcore.afileopenrecent.caption"
    41 msgid "Open recent"
    42 msgstr "Otevřít nedávné"
    43 
    44 #: tcore.afilesave.caption
    45 msgid "Save"
    46 msgstr "Uložit"
    47 
    48 #: tcore.afilesaveas.caption
    49 msgid "Save as..."
    50 msgstr "Uložit jako..."
    51 
    52 #: tcore.afindduplicate.caption
    53 msgctxt "tcore.afindduplicate.caption"
    54 msgid "Find duplicities"
    55 msgstr "Najít duplikáty"
    56 
    57 #: tcore.agenerate.caption
    58 msgctxt "tcore.agenerate.caption"
    59 msgid "Generate contacts"
    60 msgstr "Generovat kontakty"
    61 
    62 #: tcore.ahomepage.caption
    63 msgctxt "tcore.ahomepage.caption"
    64 msgid "Home page"
    65 msgstr "Domovská stránka"
    66 
    67 #: tcore.applicationinfo1.description
    68 msgid "vCard files management tool"
    69 msgstr "Nástroj pro správu souborů vCard"
    70 
    71 #: tcore.asettings.caption
    72 msgctxt "tcore.asettings.caption"
    73 msgid "Settings"
    74 msgstr "Nastavení"
    75 
    76 #: tformcontact.aeditfield.caption
    77 msgid "Edit"
    78 msgstr "Upravit"
     14#: tformcontact.aphotoload.caption
     15msgid "Load from file"
     16msgstr "Načíst ze souboru"
     17
     18#: tformcontact.aphotosave.caption
     19msgid "Save to file"
     20msgstr "Uložit do souboru"
    7921
    8022#: tformcontact.buttoncancel.caption

  • trunk/Languages/vCardStudio.po

    r43 r45  
    22msgstr "Content-Type: text/plain; charset=UTF-8"
    33
    4 #: tcore.aabout.caption
    5 msgid "About..."
    6 msgstr ""
    7 
    8 #: tcore.aexit.caption
    9 msgid "Exit"
    10 msgstr ""
    11 
    12 #: tcore.afileclose.caption
    13 msgctxt "tcore.afileclose.caption"
    14 msgid "Close"
    15 msgstr ""
    16 
    17 #: tcore.afilemerge.caption
    18 msgid "Merge..."
    19 msgstr ""
    20 
    21 #: tcore.afilenew.caption
    22 msgid "New"
    23 msgstr ""
    24 
    25 #: tcore.afileopen.caption
    26 msgid "Open..."
    27 msgstr ""
    28 
    29 #: tcore.afileopenrecent.caption
    30 msgctxt "tcore.afileopenrecent.caption"
    31 msgid "Open recent"
    32 msgstr ""
    33 
    34 #: tcore.afilesave.caption
    35 msgid "Save"
    36 msgstr ""
    37 
    38 #: tcore.afilesaveas.caption
    39 msgid "Save as..."
    40 msgstr ""
    41 
    42 #: tcore.afindduplicate.caption
    43 msgctxt "tcore.afindduplicate.caption"
    44 msgid "Find duplicities"
    45 msgstr ""
    46 
    47 #: tcore.agenerate.caption
    48 msgctxt "tcore.agenerate.caption"
    49 msgid "Generate contacts"
    50 msgstr ""
    51 
    52 #: tcore.ahomepage.caption
    53 msgctxt "tcore.ahomepage.caption"
    54 msgid "Home page"
    55 msgstr ""
    56 
    57 #: tcore.applicationinfo1.description
    58 msgid "vCard files management tool"
    59 msgstr ""
    60 
    61 #: tcore.asettings.caption
    62 msgctxt "tcore.asettings.caption"
    63 msgid "Settings"
    64 msgstr ""
    65 
    66 #: tformcontact.aeditfield.caption
    67 msgid "Edit"
     4#: tformcontact.aphotoload.caption
     5msgid "Load from file"
     6msgstr ""
     7
     8#: tformcontact.aphotosave.caption
     9msgid "Save to file"
    6810msgstr ""
    6911

  • trunk/UContact.pas

    r42 r45  
    6464    procedure EvaluateAttributes;
    6565    function GetDecodedValue: string;
     66    function GetEncodedValue: string;
    6667    function MatchNameGroups(AName: string; Groups: TStringArray;
    6768      NoGroups: TStringArray): Boolean;
    … …  
    343344begin
    344345  if Encoding = 'BASE64' then begin
    345     Result := DecodeStringBase64(Value)
     346    Result := DecodeStringBase64(Value);
    346347  end else
    347348  if Encoding = 'QUOTED-PRINTABLE' then begin
    348     Result := DecodeQuotedPrintable(Value)
     349    Result := DecodeQuotedPrintable(Value);
    349350  end
    350351  else Result := '';
    351352end;
    352353
     354function TContactProperty.GetEncodedValue: string;
     355begin
     356  if Encoding = 'BASE64' then begin
     357    Result := EncodeStringBase64(Value);
     358  end else
     359  if Encoding = 'QUOTED-PRINTABLE' then begin
     360    Result := EncodeQuotedPrintable(Value);
     361  end
     362  else Result := '';
     363end;
     364
    353365function TContactProperty.MatchNameGroups(AName: string; Groups: TStringArray;
    354366  NoGroups: TStringArray): Boolean;
    355367var
    356368  I: Integer;
    357   Attr: string;
    358 begin
    359   Attr := Attributes.DelimitedText;
     369begin
    360370  Result := Name = AName;
    361371  if Result and (Length(Groups) > 0) then begin
    … …  
    680690  J: Integer;
    681691  NameText: string;
     692  Value2: string;
    682693begin
    683694  inherited;
    … …  
    689700      for J := 0 to Properties.Count - 1 do
    690701      with Properties[J] do begin
    691         if Pos(LineEnding, Value) > 0 then begin
    692           NameText := Name;
    693           if Attributes.Count > 0 then
    694             NameText := NameText + ';' + Attributes.DelimitedText;
    695           Add(NameText + ':' + GetNext(Value, LineEnding));
    696           while Pos(LineEnding, Value) > 0 do begin
    697             Add(' ' + GetNext(Value, LineEnding));
     702        NameText := Name;
     703        if Attributes.Count > 0 then
     704          NameText := NameText + ';' + Attributes.DelimitedText;
     705        if Encoding <> '' then begin
     706          Value2 := GetEncodedValue;
     707          NameText := NameText + ';' + Encoding;
     708        end else Value2 := Value;
     709        if Pos(LineEnding, Value2) > 0 then begin
     710          Add(NameText + ':' + GetNext(Value2, LineEnding));
     711          while Pos(LineEnding, Value2) > 0 do begin
     712            Add(' ' + GetNext(Value2, LineEnding));
    698713          end;
    699           Add(' ' + GetNext(Value, LineEnding));
     714          Add(' ' + GetNext(Value2, LineEnding));
    700715          Add('');
    701716        end else begin
    702           NameText := Name;
    703           if Attributes.Count > 0 then
    704             NameText := NameText + ';' + Attributes.DelimitedText;
    705           Add(NameText + ':' + Value);
     717          Add(NameText + ':' + Value2);
    706718        end;
    707719      end;
    … …  
    769781            NewRecord.Properties.Add(NewProperty);
    770782          end;
    771           NewProperty.Attributes.DelimitedText := UpperCase(Names);
     783          NewProperty.Attributes.DelimitedText := Names;
    772784          if NewProperty.Attributes.Count > 0 then begin
    773785            NewProperty.Name := NewProperty.Attributes[0];

  • trunk/UQuotedPrintable.pas

    r42 r45  
    99
    1010function DecodeQuotedPrintable(Text: string): string;
     11function EncodeQuotedPrintable(Text: string): string;
    1112
    1213
    … …  
    201202end;
    202203
     204function EncodeQuotedPrintable(Text: string): string;
     205begin
     206  Result := Text;
     207end;
     208
    203209end.
    204210
Note: See TracChangeset for help on using the changeset viewer.