Changeset 45 for trunk/Forms


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/Forms
Files:
3 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
Note: See TracChangeset for help on using the changeset viewer.