1 | unit UFormContact;
|
---|
2 |
|
---|
3 | {$mode delphi}
|
---|
4 |
|
---|
5 | interface
|
---|
6 |
|
---|
7 | uses
|
---|
8 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
---|
9 | ComCtrls, ActnList, Menus, ExtCtrls, ExtDlgs, UContact, UFormProperties;
|
---|
10 |
|
---|
11 | type
|
---|
12 |
|
---|
13 | { TFormContact }
|
---|
14 |
|
---|
15 | TFormContact = class(TForm)
|
---|
16 | APhotoClear: TAction;
|
---|
17 | APhotoSave: TAction;
|
---|
18 | APhotoLoad: TAction;
|
---|
19 | ActionList1: TActionList;
|
---|
20 | ButtonCancel: TButton;
|
---|
21 | ButtonNext: TButton;
|
---|
22 | ButtonOk: TButton;
|
---|
23 | ButtonPrevious: TButton;
|
---|
24 | EditAim: TEdit;
|
---|
25 | EditCategories: TEdit;
|
---|
26 | EditMatrix: TEdit;
|
---|
27 | EditGaduGadu: TEdit;
|
---|
28 | EditGroupWise: TEdit;
|
---|
29 | EditYouTube: TEdit;
|
---|
30 | EditGender: TEdit;
|
---|
31 | EditLinkedIn: TEdit;
|
---|
32 | EditFacebook: TEdit;
|
---|
33 | EditInstagram: TEdit;
|
---|
34 | EditMySpace: TEdit;
|
---|
35 | EditTwitter: TEdit;
|
---|
36 | EditReddit: TEdit;
|
---|
37 | EditMastodon: TEdit;
|
---|
38 | EditWindowsLive: TEdit;
|
---|
39 | EditSnapchat: TEdit;
|
---|
40 | EditYahoo: TEdit;
|
---|
41 | EditGoogleTalk: TEdit;
|
---|
42 | EditMsn: TEdit;
|
---|
43 | EditIrc: TEdit;
|
---|
44 | EditSkype: TEdit;
|
---|
45 | EditHomeAddressCity: TEdit;
|
---|
46 | EditHomeAddressCountry: TEdit;
|
---|
47 | EditHomeAddressPostalCode: TEdit;
|
---|
48 | EditHomeAddressPostOfficeBox: TEdit;
|
---|
49 | EditHomeAddressRegion: TEdit;
|
---|
50 | EditHomeAddressStreet: TEdit;
|
---|
51 | EditHomeAddressStreetExtended: TEdit;
|
---|
52 | EditAddressWorkCity: TEdit;
|
---|
53 | EditAddressWorkCountry: TEdit;
|
---|
54 | EditAddressWorkPostalCode: TEdit;
|
---|
55 | EditAddressWorkPostOfficeBox: TEdit;
|
---|
56 | EditAddressWorkRegion: TEdit;
|
---|
57 | EditAddressWorkStreet: TEdit;
|
---|
58 | EditAddressWorkStreetExtended: TEdit;
|
---|
59 | EditAniversary: TEdit;
|
---|
60 | EditJabber: TEdit;
|
---|
61 | EditIcq: TEdit;
|
---|
62 | EditWorkEmail: TEdit;
|
---|
63 | EditPager: TEdit;
|
---|
64 | EditFax: TEdit;
|
---|
65 | EditWeb: TEdit;
|
---|
66 | EditHomeFax: TEdit;
|
---|
67 | EditWorkFax: TEdit;
|
---|
68 | EditHomeMobile: TEdit;
|
---|
69 | EditWorkMobile: TEdit;
|
---|
70 | EditWorkPager: TEdit;
|
---|
71 | EditHomePhone: TEdit;
|
---|
72 | EditNickName: TEdit;
|
---|
73 | EditHomePager: TEdit;
|
---|
74 | EditHomeEmail: TEdit;
|
---|
75 | EditHomeWeb: TEdit;
|
---|
76 | EditWorkWeb: TEdit;
|
---|
77 | EditDepartment: TEdit;
|
---|
78 | EditFullName: TEdit;
|
---|
79 | EditOrganization: TEdit;
|
---|
80 | EditTitle: TEdit;
|
---|
81 | EditTitleBefore: TEdit;
|
---|
82 | EditMiddleName: TEdit;
|
---|
83 | EditTitleAfter: TEdit;
|
---|
84 | EditBirthday: TEdit;
|
---|
85 | EditLastName: TEdit;
|
---|
86 | EditEmail: TEdit;
|
---|
87 | EditPhone: TEdit;
|
---|
88 | EditFirstName: TEdit;
|
---|
89 | EditMobile: TEdit;
|
---|
90 | EditWorkPhone: TEdit;
|
---|
91 | EditQq: TEdit;
|
---|
92 | EditPeerTube: TEdit;
|
---|
93 | GroupBox1: TGroupBox;
|
---|
94 | GroupBox2: TGroupBox;
|
---|
95 | ImagePhoto: TImage;
|
---|
96 | Label1: TLabel;
|
---|
97 | Label10: TLabel;
|
---|
98 | Label11: TLabel;
|
---|
99 | Label12: TLabel;
|
---|
100 | Label13: TLabel;
|
---|
101 | Label14: TLabel;
|
---|
102 | Label15: TLabel;
|
---|
103 | Label16: TLabel;
|
---|
104 | Label17: TLabel;
|
---|
105 | Label18: TLabel;
|
---|
106 | Label19: TLabel;
|
---|
107 | Label2: TLabel;
|
---|
108 | Label20: TLabel;
|
---|
109 | Label21: TLabel;
|
---|
110 | Label22: TLabel;
|
---|
111 | Label23: TLabel;
|
---|
112 | Label24: TLabel;
|
---|
113 | Label25: TLabel;
|
---|
114 | Label26: TLabel;
|
---|
115 | Label27: TLabel;
|
---|
116 | Label28: TLabel;
|
---|
117 | Label29: TLabel;
|
---|
118 | Label3: TLabel;
|
---|
119 | Label30: TLabel;
|
---|
120 | Label31: TLabel;
|
---|
121 | Label32: TLabel;
|
---|
122 | Label33: TLabel;
|
---|
123 | Label34: TLabel;
|
---|
124 | Label35: TLabel;
|
---|
125 | Label36: TLabel;
|
---|
126 | Label37: TLabel;
|
---|
127 | Label38: TLabel;
|
---|
128 | Label39: TLabel;
|
---|
129 | Label4: TLabel;
|
---|
130 | Label40: TLabel;
|
---|
131 | Label41: TLabel;
|
---|
132 | Label42: TLabel;
|
---|
133 | Label43: TLabel;
|
---|
134 | Label44: TLabel;
|
---|
135 | Label45: TLabel;
|
---|
136 | Label46: TLabel;
|
---|
137 | Label47: TLabel;
|
---|
138 | Label48: TLabel;
|
---|
139 | Label49: TLabel;
|
---|
140 | Label5: TLabel;
|
---|
141 | Label50: TLabel;
|
---|
142 | Label51: TLabel;
|
---|
143 | Label52: TLabel;
|
---|
144 | Label53: TLabel;
|
---|
145 | Label54: TLabel;
|
---|
146 | Label55: TLabel;
|
---|
147 | Label56: TLabel;
|
---|
148 | Label57: TLabel;
|
---|
149 | Label6: TLabel;
|
---|
150 | Label7: TLabel;
|
---|
151 | Label8: TLabel;
|
---|
152 | Label9: TLabel;
|
---|
153 | LabelOrganization: TLabel;
|
---|
154 | LabelOrganization1: TLabel;
|
---|
155 | LabelOrganization10: TLabel;
|
---|
156 | LabelOrganization11: TLabel;
|
---|
157 | LabelOrganization12: TLabel;
|
---|
158 | LabelOrganization2: TLabel;
|
---|
159 | LabelOrganization3: TLabel;
|
---|
160 | LabelOrganization4: TLabel;
|
---|
161 | LabelOrganization5: TLabel;
|
---|
162 | LabelOrganization6: TLabel;
|
---|
163 | LabelOrganization7: TLabel;
|
---|
164 | LabelOrganization8: TLabel;
|
---|
165 | LabelOrganization9: TLabel;
|
---|
166 | MemoNotes: TMemo;
|
---|
167 | MenuItem1: TMenuItem;
|
---|
168 | MenuItem2: TMenuItem;
|
---|
169 | MenuItem3: TMenuItem;
|
---|
170 | OpenPictureDialog1: TOpenPictureDialog;
|
---|
171 | PageControlContact: TPageControl;
|
---|
172 | PopupMenuPhoto: TPopupMenu;
|
---|
173 | SavePictureDialog1: TSavePictureDialog;
|
---|
174 | TabSheetSocial: TTabSheet;
|
---|
175 | TabSheetChat: TTabSheet;
|
---|
176 | TabSheetOthers: TTabSheet;
|
---|
177 | TabSheetHome: TTabSheet;
|
---|
178 | TabSheetWork: TTabSheet;
|
---|
179 | TabSheetGeneral: TTabSheet;
|
---|
180 | TabSheetAll: TTabSheet;
|
---|
181 | procedure APhotoClearExecute(Sender: TObject);
|
---|
182 | procedure APhotoLoadExecute(Sender: TObject);
|
---|
183 | procedure APhotoSaveExecute(Sender: TObject);
|
---|
184 | procedure ButtonNextClick(Sender: TObject);
|
---|
185 | procedure ButtonPreviousClick(Sender: TObject);
|
---|
186 | procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
---|
187 | procedure FormCreate(Sender: TObject);
|
---|
188 | procedure FormDestroy(Sender: TObject);
|
---|
189 | procedure FormShow(Sender: TObject);
|
---|
190 | procedure TabSheetAllShow(Sender: TObject);
|
---|
191 | procedure TabSheetChatHide(Sender: TObject);
|
---|
192 | procedure TabSheetChatShow(Sender: TObject);
|
---|
193 | procedure TabSheetGeneralHide(Sender: TObject);
|
---|
194 | procedure TabSheetGeneralShow(Sender: TObject);
|
---|
195 | procedure TabSheetHomeHide(Sender: TObject);
|
---|
196 | procedure TabSheetHomeShow(Sender: TObject);
|
---|
197 | procedure TabSheetOthersHide(Sender: TObject);
|
---|
198 | procedure TabSheetOthersShow(Sender: TObject);
|
---|
199 | procedure TabSheetSocialHide(Sender: TObject);
|
---|
200 | procedure TabSheetSocialShow(Sender: TObject);
|
---|
201 | procedure TabSheetWorkHide(Sender: TObject);
|
---|
202 | procedure TabSheetWorkShow(Sender: TObject);
|
---|
203 | private
|
---|
204 | FProfilePhotoActive: Boolean;
|
---|
205 | procedure SetProfilePhotoActive(AValue: Boolean);
|
---|
206 | private
|
---|
207 | FContact: TContact;
|
---|
208 | FOnGetNext: TGetContactEvent;
|
---|
209 | FOnGetPrevious: TGetContactEvent;
|
---|
210 | FormProperties: TFormProperties;
|
---|
211 | procedure SetContact(AValue: TContact);
|
---|
212 | procedure ReloadAllPropertiesTab;
|
---|
213 | property ProfilePhotoActive: Boolean read FProfilePhotoActive
|
---|
214 | write SetProfilePhotoActive;
|
---|
215 | public
|
---|
216 | procedure UpdateInterface;
|
---|
217 | property Contact: TContact read FContact write SetContact;
|
---|
218 | property OnGetPrevious: TGetContactEvent read FOnGetPrevious write FOnGetPrevious;
|
---|
219 | property OnGetNext: TGetContactEvent read FOnGetNext write FOnGetNext;
|
---|
220 | end;
|
---|
221 |
|
---|
222 | var
|
---|
223 | FormContact: TFormContact;
|
---|
224 |
|
---|
225 |
|
---|
226 | implementation
|
---|
227 |
|
---|
228 | {$R *.lfm}
|
---|
229 |
|
---|
230 | uses
|
---|
231 | UCore;
|
---|
232 |
|
---|
233 | { TFormContact }
|
---|
234 |
|
---|
235 | procedure TFormContact.FormShow(Sender: TObject);
|
---|
236 | begin
|
---|
237 | Core.PersistentForm1.Load(Self);
|
---|
238 |
|
---|
239 | FormProperties.ManualDock(TabSheetAll, nil, alClient);
|
---|
240 | FormProperties.Align := alClient;
|
---|
241 | FormProperties.Show;
|
---|
242 |
|
---|
243 | // Force to load default profile image
|
---|
244 | ProfilePhotoActive := True;
|
---|
245 | ProfilePhotoActive := False;
|
---|
246 |
|
---|
247 | PageControlContact.TabIndex := Core.LastContactTabIndex;
|
---|
248 | UpdateInterface;
|
---|
249 | end;
|
---|
250 |
|
---|
251 | procedure TFormContact.TabSheetAllShow(Sender: TObject);
|
---|
252 | begin
|
---|
253 | FormProperties.Properties := Contact.Properties;
|
---|
254 | FormProperties.ReloadList;
|
---|
255 | FormProperties.UpdateInterface;
|
---|
256 | end;
|
---|
257 |
|
---|
258 | procedure TFormContact.TabSheetChatHide(Sender: TObject);
|
---|
259 | begin
|
---|
260 | Contact.Fields[cfMatrix] := EditMatrix.Text;
|
---|
261 | Contact.Fields[cfJabber] := EditJabber.Text;
|
---|
262 | Contact.Fields[cfIcq] := EditIcq.Text;
|
---|
263 | Contact.Fields[cfMsn] := EditMsn.Text;
|
---|
264 | Contact.Fields[cfSkype] := EditSkype.Text;
|
---|
265 | Contact.Fields[cfQq] := EditQq.Text;
|
---|
266 | Contact.Fields[cfGoogleTalk] := EditGoogleTalk.Text;
|
---|
267 | Contact.Fields[cfWindowsLive] := EditWindowsLive.Text;
|
---|
268 | Contact.Fields[cfYahoo] := EditYahoo.Text;
|
---|
269 | Contact.Fields[cfAim] := EditAim.Text;
|
---|
270 | Contact.Fields[cfIrc] := EditIrc.Text;
|
---|
271 | Contact.Fields[cfGroupWise] := EditGroupWise.Text;
|
---|
272 | Contact.Fields[cfGaduGadu] := EditGaduGadu.Text;
|
---|
273 |
|
---|
274 | ReloadAllPropertiesTab;
|
---|
275 | end;
|
---|
276 |
|
---|
277 | procedure TFormContact.TabSheetChatShow(Sender: TObject);
|
---|
278 | begin
|
---|
279 | EditMatrix.Text := Contact.Fields[cfMatrix];
|
---|
280 | EditJabber.Text := Contact.Fields[cfJabber];
|
---|
281 | EditIcq.Text := Contact.Fields[cfIcq];
|
---|
282 | EditMsn.Text := Contact.Fields[cfMsn];
|
---|
283 | EditSkype.Text := Contact.Fields[cfSkype];
|
---|
284 | EditQq.Text := Contact.Fields[cfQq];
|
---|
285 | EditGoogleTalk.Text := Contact.Fields[cfGoogleTalk];
|
---|
286 | EditWindowsLive.Text := Contact.Fields[cfWindowsLive];
|
---|
287 | EditYahoo.Text := Contact.Fields[cfYahoo];
|
---|
288 | EditAim.Text := Contact.Fields[cfAim];
|
---|
289 | EditIrc.Text := Contact.Fields[cfIrc];
|
---|
290 | EditGroupWise.Text := Contact.Fields[cfGroupWise];
|
---|
291 | EditGaduGadu.Text := Contact.Fields[cfGaduGadu];
|
---|
292 | end;
|
---|
293 |
|
---|
294 | procedure TFormContact.TabSheetGeneralHide(Sender: TObject);
|
---|
295 | var
|
---|
296 | Photo: string;
|
---|
297 | PhotoProperty: TContactProperty;
|
---|
298 | Stream: TMemoryStream;
|
---|
299 | JpegImage: TJpegImage;
|
---|
300 | GifImage: TGIFImage;
|
---|
301 | PngImage: TPortableNetworkGraphic;
|
---|
302 | begin
|
---|
303 | Contact.Fields[cfFullName] := EditFullName.Text;
|
---|
304 | Contact.Fields[cfMiddleName] := EditMiddleName.Text;
|
---|
305 | Contact.Fields[cfFirstName] := EditFirstName.Text;
|
---|
306 | Contact.Fields[cfLastName] := EditLastName.Text;
|
---|
307 | Contact.Fields[cfTitleAfter] := EditTitleAfter.Text;
|
---|
308 | Contact.Fields[cfTitleBefore] := EditTitleBefore.Text;
|
---|
309 | Contact.Fields[cfNickName] := EditNickName.Text;
|
---|
310 | Contact.Fields[cfEmail] := EditEmail.Text;
|
---|
311 | Contact.Fields[cfTel] := EditPhone.Text;
|
---|
312 | Contact.Fields[cfTelCell] := EditMobile.Text;
|
---|
313 | Contact.Fields[cfTelFax] := EditFax.Text;
|
---|
314 | Contact.Fields[cfTelPager] := EditPager.Text;
|
---|
315 | Contact.Fields[cfDayOfBirth] := EditBirthday.Text;
|
---|
316 | Contact.Fields[cfAnniversary] := EditAniversary.Text;
|
---|
317 | Contact.Fields[cfUrl] := EditWeb.Text;
|
---|
318 | Contact.Fields[cfGender] := EditGender.Text;
|
---|
319 | Contact.Fields[cfCategories] := EditCategories.Text;
|
---|
320 |
|
---|
321 | // Photo
|
---|
322 | if ProfilePhotoActive then begin
|
---|
323 | PhotoProperty := Contact.GetProperty(cfPhoto);
|
---|
324 | if not Assigned(PhotoProperty) then begin
|
---|
325 | PhotoProperty := TContactProperty.Create;
|
---|
326 | PhotoProperty.Name := 'PHOTO';
|
---|
327 | PhotoProperty.Attributes.DelimitedText := 'JPEG';
|
---|
328 | Contact.Properties.Add(PhotoProperty);
|
---|
329 | end;
|
---|
330 | PhotoProperty.Encoding := 'BASE64';
|
---|
331 | Stream := TMemoryStream.Create;
|
---|
332 | try
|
---|
333 | if PhotoProperty.Attributes.IndexOf('JPEG') <> -1 then begin
|
---|
334 | JpegImage := TJPEGImage.Create;
|
---|
335 | try
|
---|
336 | try
|
---|
337 | JpegImage.SetSize(ImagePhoto.Picture.Bitmap.Width, ImagePhoto.Picture.Bitmap.Height);
|
---|
338 | JpegImage.Canvas.Draw(0, 0, ImagePhoto.Picture.Bitmap);
|
---|
339 | JpegImage.SaveToStream(Stream);
|
---|
340 | except
|
---|
341 | end;
|
---|
342 | finally
|
---|
343 | JpegImage.Free;
|
---|
344 | end;
|
---|
345 | end else
|
---|
346 | if PhotoProperty.Attributes.IndexOf('PNG') <> -1 then begin
|
---|
347 | PngImage := TPortableNetworkGraphic.Create;
|
---|
348 | try
|
---|
349 | try
|
---|
350 | PngImage.SetSize(ImagePhoto.Picture.Bitmap.Width, ImagePhoto.Picture.Bitmap.Height);
|
---|
351 | PngImage.Canvas.Draw(0, 0, ImagePhoto.Picture.Bitmap);
|
---|
352 | PngImage.SaveToStream(Stream);
|
---|
353 | except
|
---|
354 | end;
|
---|
355 | finally
|
---|
356 | PngImage.Free;
|
---|
357 | end;
|
---|
358 | end else
|
---|
359 | if PhotoProperty.Attributes.IndexOf('GIF') <> -1 then begin
|
---|
360 | GifImage := TGIFImage.Create;
|
---|
361 | try
|
---|
362 | try
|
---|
363 | GifImage.SetSize(ImagePhoto.Picture.Bitmap.Width, ImagePhoto.Picture.Bitmap.Height);
|
---|
364 | GifImage.Canvas.Draw(0, 0, ImagePhoto.Picture.Bitmap);
|
---|
365 | GifImage.SaveToStream(Stream);
|
---|
366 | except
|
---|
367 | end;
|
---|
368 | finally
|
---|
369 | GifImage.Free;
|
---|
370 | end;
|
---|
371 | end else begin
|
---|
372 | try
|
---|
373 | ImagePhoto.Picture.SaveToStream(Stream);
|
---|
374 | except
|
---|
375 | end;
|
---|
376 | end;
|
---|
377 |
|
---|
378 | SetLength(Photo, Stream.Size);
|
---|
379 | Stream.Position := 0;
|
---|
380 | Stream.Read(Photo[1], Length(Photo));
|
---|
381 | Contact.Fields[cfPhoto] := Photo;
|
---|
382 | finally
|
---|
383 | Stream.Free;
|
---|
384 | end;
|
---|
385 | end else begin
|
---|
386 | PhotoProperty := Contact.GetProperty(cfPhoto);
|
---|
387 | if Assigned(PhotoProperty) then
|
---|
388 | Contact.Properties.Remove(PhotoProperty);
|
---|
389 | end;
|
---|
390 |
|
---|
391 | ReloadAllPropertiesTab;
|
---|
392 | end;
|
---|
393 |
|
---|
394 | procedure TFormContact.TabSheetGeneralShow(Sender: TObject);
|
---|
395 | var
|
---|
396 | Photo: string;
|
---|
397 | JpegImage: TJpegImage;
|
---|
398 | PngImage: TPortableNetworkGraphic;
|
---|
399 | GifImage: TGIFImage;
|
---|
400 | Stream: TMemoryStream;
|
---|
401 | PhotoProperty: TContactProperty;
|
---|
402 | begin
|
---|
403 | EditFullName.Text := Contact.Fields[cfFullName];
|
---|
404 | EditFirstName.Text := Contact.Fields[cfFirstName];
|
---|
405 | EditLastName.Text := Contact.Fields[cfLastName];
|
---|
406 | EditMiddleName.Text := Contact.Fields[cfMiddleName];
|
---|
407 | EditTitleAfter.Text := Contact.Fields[cfTitleAfter];
|
---|
408 | EditTitleBefore.Text := Contact.Fields[cfTitleBefore];
|
---|
409 | EditNickName.Text := Contact.Fields[cfNickName];
|
---|
410 | EditEmail.Text := Contact.Fields[cfEmail];
|
---|
411 | EditPhone.Text := Contact.Fields[cfTel];
|
---|
412 | EditMobile.Text := Contact.Fields[cfTelCell];
|
---|
413 | EditFax.Text := Contact.Fields[cfTelFax];
|
---|
414 | EditPager.Text := Contact.Fields[cfTelPager];
|
---|
415 | EditBirthday.Text := Contact.Fields[cfDayOfBirth];
|
---|
416 | EditAniversary.Text := Contact.Fields[cfAnniversary];
|
---|
417 | EditWeb.Text := Contact.Fields[cfUrl];
|
---|
418 | EditGender.Text := Contact.Fields[cfGender];
|
---|
419 | EditCategories.Text := Contact.Fields[cfCategories];
|
---|
420 |
|
---|
421 | // Photo
|
---|
422 | PhotoProperty := Contact.GetProperty(cfPhoto);
|
---|
423 | if Assigned(PhotoProperty) then begin
|
---|
424 | Photo := Contact.Fields[cfPhoto];
|
---|
425 | if (Photo <> '') and (PhotoProperty.Encoding <> '') then begin
|
---|
426 | Stream := TMemoryStream.Create;
|
---|
427 | try
|
---|
428 | Stream.Write(Photo[1], Length(Photo));
|
---|
429 | Stream.Position := 0;
|
---|
430 | if (PhotoProperty.Attributes.IndexOf('JPEG') <> -1) or
|
---|
431 | (PhotoProperty.Attributes.IndexOf('jpeg') <> -1) then begin
|
---|
432 | JpegImage := TJPEGImage.Create;
|
---|
433 | try
|
---|
434 | try
|
---|
435 | JpegImage.LoadFromStream(Stream);
|
---|
436 | with ImagePhoto.Picture.Bitmap do begin
|
---|
437 | PixelFormat := pf24bit;
|
---|
438 | SetSize(JpegImage.Width, JpegImage.Height);
|
---|
439 | Canvas.Draw(0, 0, JpegImage);
|
---|
440 | end;
|
---|
441 | ProfilePhotoActive := True;
|
---|
442 | except
|
---|
443 | ProfilePhotoActive := False;
|
---|
444 | end;
|
---|
445 | finally
|
---|
446 | JpegImage.Free;
|
---|
447 | end;
|
---|
448 | end else
|
---|
449 | if (PhotoProperty.Attributes.IndexOf('PNG') <> -1) or
|
---|
450 | (PhotoProperty.Attributes.IndexOf('png') <> -1) then begin
|
---|
451 | PngImage := TPortableNetworkGraphic.Create;
|
---|
452 | try
|
---|
453 | try
|
---|
454 | PngImage.LoadFromStream(Stream);
|
---|
455 | with ImagePhoto.Picture.Bitmap do begin
|
---|
456 | PixelFormat := pf24bit;
|
---|
457 | SetSize(PngImage.Width, PngImage.Height);
|
---|
458 | Canvas.Draw(0, 0, PngImage);
|
---|
459 | end;
|
---|
460 | ProfilePhotoActive := True;
|
---|
461 | except
|
---|
462 | ProfilePhotoActive := False;
|
---|
463 | end;
|
---|
464 | finally
|
---|
465 | PngImage.Free;
|
---|
466 | end;
|
---|
467 | end else
|
---|
468 | if (PhotoProperty.Attributes.IndexOf('GIF') <> -1) or
|
---|
469 | (PhotoProperty.Attributes.IndexOf('gif') <> -1) then begin
|
---|
470 | GifImage := TGIFImage.Create;
|
---|
471 | try
|
---|
472 | try
|
---|
473 | GifImage.LoadFromStream(Stream);
|
---|
474 | with ImagePhoto.Picture.Bitmap do begin
|
---|
475 | PixelFormat := pf24bit;
|
---|
476 | SetSize(GifImage.Width, GifImage.Height);
|
---|
477 | Canvas.Draw(0, 0, GifImage);
|
---|
478 | end;
|
---|
479 | ProfilePhotoActive := True;
|
---|
480 | except
|
---|
481 | ProfilePhotoActive := False;
|
---|
482 | end;
|
---|
483 | finally
|
---|
484 | GifImage.Free;
|
---|
485 | end;
|
---|
486 | end else begin
|
---|
487 | try
|
---|
488 | ImagePhoto.Picture.LoadFromStream(Stream);
|
---|
489 | ProfilePhotoActive := True;
|
---|
490 | except
|
---|
491 | ProfilePhotoActive := False;
|
---|
492 | end;
|
---|
493 | end;
|
---|
494 | finally
|
---|
495 | Stream.Free;
|
---|
496 | end;
|
---|
497 | end else ProfilePhotoActive := False;
|
---|
498 | end else ProfilePhotoActive := False;
|
---|
499 | end;
|
---|
500 |
|
---|
501 | procedure TFormContact.TabSheetHomeHide(Sender: TObject);
|
---|
502 | begin
|
---|
503 | Contact.Fields[cfEmailHome] := EditHomeEmail.Text;
|
---|
504 | Contact.Fields[cfTelHome] := EditHomePhone.Text;
|
---|
505 | Contact.Fields[cfTelCellHome] := EditHomeMobile.Text;
|
---|
506 | Contact.Fields[cfTelFaxHome] := EditHomeFax.Text;
|
---|
507 | Contact.Fields[cfTelPagerHome] := EditHomePager.Text;
|
---|
508 | Contact.Fields[cfHomeAddressPostOfficeBox] := EditHomeAddressPostOfficeBox.Text;
|
---|
509 | Contact.Fields[cfHomeAddressStreet] := EditHomeAddressStreet.Text;
|
---|
510 | Contact.Fields[cfHomeAddressStreetExtended] := EditHomeAddressStreetExtended.Text;
|
---|
511 | Contact.Fields[cfHomeAddressCity] := EditHomeAddressCity.Text;
|
---|
512 | Contact.Fields[cfHomeAddressRegion] := EditHomeAddressRegion.Text;
|
---|
513 | Contact.Fields[cfHomeAddressCountry] := EditHomeAddressCountry.Text;
|
---|
514 | Contact.Fields[cfHomeAddressPostalCode] := EditHomeAddressPostalCode.Text;
|
---|
515 | Contact.Fields[cfUrlHome] := EditHomeWeb.Text;
|
---|
516 |
|
---|
517 | ReloadAllPropertiesTab;
|
---|
518 | end;
|
---|
519 |
|
---|
520 | procedure TFormContact.TabSheetHomeShow(Sender: TObject);
|
---|
521 | begin
|
---|
522 | EditHomeEmail.Text := Contact.Fields[cfEmailHome];
|
---|
523 | EditHomePhone.Text := Contact.Fields[cfTelHome];
|
---|
524 | EditHomeMobile.Text := Contact.Fields[cfTelCellHome];
|
---|
525 | EditHomeFax.Text := Contact.Fields[cfTelFaxHome];
|
---|
526 | EditHomePager.Text := Contact.Fields[cfTelPagerHome];
|
---|
527 | EditHomeAddressPostOfficeBox.Text := Contact.Fields[cfHomeAddressPostOfficeBox];
|
---|
528 | EditHomeAddressStreet.Text := Contact.Fields[cfHomeAddressStreet];
|
---|
529 | EditHomeAddressStreetExtended.Text := Contact.Fields[cfHomeAddressStreetExtended];
|
---|
530 | EditHomeAddressCity.Text := Contact.Fields[cfHomeAddressCity];
|
---|
531 | EditHomeAddressRegion.Text := Contact.Fields[cfHomeAddressRegion];
|
---|
532 | EditHomeAddressCountry.Text := Contact.Fields[cfHomeAddressCountry];
|
---|
533 | EditHomeAddressPostalCode.Text := Contact.Fields[cfHomeAddressPostalCode];
|
---|
534 | EditHomeWeb.Text := Contact.Fields[cfUrlHome];
|
---|
535 | end;
|
---|
536 |
|
---|
537 | procedure TFormContact.TabSheetOthersHide(Sender: TObject);
|
---|
538 | begin
|
---|
539 | Contact.Fields[cfNote] := MemoNotes.Lines.Text;
|
---|
540 |
|
---|
541 | ReloadAllPropertiesTab;
|
---|
542 | end;
|
---|
543 |
|
---|
544 | procedure TFormContact.TabSheetOthersShow(Sender: TObject);
|
---|
545 | begin
|
---|
546 | MemoNotes.Lines.Text := Contact.Fields[cfNote];
|
---|
547 | end;
|
---|
548 |
|
---|
549 | procedure TFormContact.TabSheetSocialHide(Sender: TObject);
|
---|
550 | begin
|
---|
551 | Contact.Fields[cfFacebook] := EditFacebook.Text;
|
---|
552 | Contact.Fields[cfTwitter] := EditTwitter.Text;
|
---|
553 | Contact.Fields[cfInstagram] := EditInstagram.Text;
|
---|
554 | Contact.Fields[cfYouTube] := EditYouTube.Text;
|
---|
555 | Contact.Fields[cfPeerTube] := EditPeerTube.Text;
|
---|
556 | Contact.Fields[cfMastodon] := EditMastodon.Text;
|
---|
557 | Contact.Fields[cfLinkedIn] := EditLinkedIn.Text;
|
---|
558 | Contact.Fields[cfSnapchat] := EditSnapchat.Text;
|
---|
559 | Contact.Fields[cfReddit] := EditReddit.Text;
|
---|
560 | Contact.Fields[cfMySpace] := EditMySpace.Text;
|
---|
561 |
|
---|
562 | ReloadAllPropertiesTab;
|
---|
563 | end;
|
---|
564 |
|
---|
565 | procedure TFormContact.TabSheetSocialShow(Sender: TObject);
|
---|
566 | begin
|
---|
567 | EditFacebook.Text := Contact.Fields[cfFacebook];
|
---|
568 | EditTwitter.Text := Contact.Fields[cfTwitter];
|
---|
569 | EditInstagram.Text := Contact.Fields[cfInstagram];
|
---|
570 | EditYouTube.Text := Contact.Fields[cfYouTube];
|
---|
571 | EditPeerTube.Text := Contact.Fields[cfPeerTube];
|
---|
572 | EditMastodon.Text := Contact.Fields[cfMastodon];
|
---|
573 | EditLinkedIn.Text := Contact.Fields[cfLinkedIn];
|
---|
574 | EditSnapchat.Text := Contact.Fields[cfSnapchat];
|
---|
575 | EditReddit.Text := Contact.Fields[cfReddit];
|
---|
576 | EditMySpace.Text := Contact.Fields[cfMySpace];
|
---|
577 | end;
|
---|
578 |
|
---|
579 | procedure TFormContact.TabSheetWorkHide(Sender: TObject);
|
---|
580 | begin
|
---|
581 | Contact.Fields[cfEmailWork] := EditWorkEmail.Text;
|
---|
582 | Contact.Fields[cfTelWork] := EditWorkPhone.Text;
|
---|
583 | Contact.Fields[cfTelCellWork] := EditWorkMobile.Text;
|
---|
584 | Contact.Fields[cfTelFaxWork] := EditWorkFax.Text;
|
---|
585 | Contact.Fields[cfTelPagerWork] := EditWorkPager.Text;
|
---|
586 | Contact.Fields[cfTitle] := EditTitle.Text;
|
---|
587 | Contact.Fields[cfOrganization] := EditOrganization.Text;
|
---|
588 | Contact.Fields[cfDepartment] := EditDepartment.Text;
|
---|
589 | Contact.Fields[cfWorkAddressPostOfficeBox] := EditAddressWorkPostOfficeBox.Text;
|
---|
590 | Contact.Fields[cfWorkAddressStreet] := EditAddressWorkStreet.Text;
|
---|
591 | Contact.Fields[cfWorkAddressStreetExtended] := EditAddressWorkStreetExtended.Text;
|
---|
592 | Contact.Fields[cfWorkAddressCity] := EditAddressWorkCity.Text;
|
---|
593 | Contact.Fields[cfWorkAddressRegion] := EditAddressWorkRegion.Text;
|
---|
594 | Contact.Fields[cfWorkAddressCountry] := EditAddressWorkCountry.Text;
|
---|
595 | Contact.Fields[cfWorkAddressPostalCode] := EditAddressWorkPostalCode.Text;
|
---|
596 | Contact.Fields[cfUrlWork] := EditWorkWeb.Text;
|
---|
597 |
|
---|
598 | ReloadAllPropertiesTab;
|
---|
599 | end;
|
---|
600 |
|
---|
601 | procedure TFormContact.TabSheetWorkShow(Sender: TObject);
|
---|
602 | begin
|
---|
603 | EditWorkEmail.Text := Contact.Fields[cfEmailWork];
|
---|
604 | EditWorkPhone.Text := Contact.Fields[cfTelWork];
|
---|
605 | EditWorkMobile.Text := Contact.Fields[cfTelCellWork];
|
---|
606 | EditWorkFax.Text := Contact.Fields[cfTelFaxWork];
|
---|
607 | EditWorkPager.Text := Contact.Fields[cfTelPagerWork];
|
---|
608 | EditTitle.Text := Contact.Fields[cfTitle];
|
---|
609 | EditOrganization.Text := Contact.Fields[cfOrganization];
|
---|
610 | EditDepartment.Text := Contact.Fields[cfDepartment];
|
---|
611 | EditAddressWorkPostOfficeBox.Text := Contact.Fields[cfWorkAddressPostOfficeBox];
|
---|
612 | EditAddressWorkStreet.Text := Contact.Fields[cfWorkAddressStreet];
|
---|
613 | EditAddressWorkStreetExtended.Text := Contact.Fields[cfWorkAddressStreetExtended];
|
---|
614 | EditAddressWorkCity.Text := Contact.Fields[cfWorkAddressCity];
|
---|
615 | EditAddressWorkRegion.Text := Contact.Fields[cfWorkAddressRegion];
|
---|
616 | EditAddressWorkCountry.Text := Contact.Fields[cfWorkAddressCountry];
|
---|
617 | EditAddressWorkPostalCode.Text := Contact.Fields[cfWorkAddressPostalCode];
|
---|
618 | EditWorkWeb.Text := Contact.Fields[cfUrlWork];
|
---|
619 | end;
|
---|
620 |
|
---|
621 | procedure TFormContact.SetProfilePhotoActive(AValue: Boolean);
|
---|
622 | begin
|
---|
623 | if FProfilePhotoActive = AValue then Exit;
|
---|
624 | FProfilePhotoActive := AValue;
|
---|
625 | if not FProfilePhotoActive then begin
|
---|
626 | ImagePhoto.Picture.Assign(Core.GetProfileImage.Picture);
|
---|
627 | end;
|
---|
628 | UpdateInterface;
|
---|
629 | end;
|
---|
630 |
|
---|
631 | procedure TFormContact.SetContact(AValue: TContact);
|
---|
632 | begin
|
---|
633 | if FContact = AValue then Exit;
|
---|
634 | FContact := AValue;
|
---|
635 | end;
|
---|
636 |
|
---|
637 | procedure TFormContact.ReloadAllPropertiesTab;
|
---|
638 | begin
|
---|
639 | if TabSheetAll.Visible then begin
|
---|
640 | TabSheetAllShow(nil);
|
---|
641 | end;
|
---|
642 | end;
|
---|
643 |
|
---|
644 | procedure TFormContact.FormClose(Sender: TObject; var CloseAction: TCloseAction
|
---|
645 | );
|
---|
646 | begin
|
---|
647 | // Hide PageControl to fire TabSheet OnHide event on form close
|
---|
648 | PageControlContact.ActivePage.Hide;
|
---|
649 |
|
---|
650 | Core.LastContactTabIndex := PageControlContact.TabIndex;
|
---|
651 | Core.PersistentForm1.Save(Self);
|
---|
652 | end;
|
---|
653 |
|
---|
654 | procedure TFormContact.ButtonNextClick(Sender: TObject);
|
---|
655 | begin
|
---|
656 | if Assigned(FOnGetNext) then
|
---|
657 | Contact := FOnGetNext(Contact);
|
---|
658 | end;
|
---|
659 |
|
---|
660 | procedure TFormContact.APhotoLoadExecute(Sender: TObject);
|
---|
661 | begin
|
---|
662 | if OpenPictureDialog1.Execute then begin
|
---|
663 | ImagePhoto.Picture.LoadFromFile(OpenPictureDialog1.FileName);
|
---|
664 | ProfilePhotoActive := True;
|
---|
665 | end;
|
---|
666 | end;
|
---|
667 |
|
---|
668 | procedure TFormContact.APhotoClearExecute(Sender: TObject);
|
---|
669 | begin
|
---|
670 | ProfilePhotoActive := False;
|
---|
671 | end;
|
---|
672 |
|
---|
673 | procedure TFormContact.APhotoSaveExecute(Sender: TObject);
|
---|
674 | begin
|
---|
675 | if SavePictureDialog1.Execute then begin
|
---|
676 | ImagePhoto.Picture.SaveToFile(SavePictureDialog1.FileName);
|
---|
677 | end;
|
---|
678 | end;
|
---|
679 |
|
---|
680 | procedure TFormContact.ButtonPreviousClick(Sender: TObject);
|
---|
681 | begin
|
---|
682 | if Assigned(FOnGetPrevious) then
|
---|
683 | Contact := FOnGetPrevious(Contact);
|
---|
684 | end;
|
---|
685 |
|
---|
686 | procedure TFormContact.FormCreate(Sender: TObject);
|
---|
687 | begin
|
---|
688 | Core.Translator.TranslateComponentRecursive(Self);
|
---|
689 | Core.ThemeManager1.UseTheme(Self);
|
---|
690 | FContact := nil;
|
---|
691 | FormProperties := TFormProperties.Create(nil);
|
---|
692 | end;
|
---|
693 |
|
---|
694 | procedure TFormContact.FormDestroy(Sender: TObject);
|
---|
695 | begin
|
---|
696 | FreeAndNil(FormProperties);
|
---|
697 | end;
|
---|
698 |
|
---|
699 | procedure TFormContact.UpdateInterface;
|
---|
700 | begin
|
---|
701 | APhotoSave.Enabled := ProfilePhotoActive;
|
---|
702 | APhotoClear.Enabled := ProfilePhotoActive;
|
---|
703 | //ButtonNext.Enabled := Assigned(FOnGetNext) and Assigned(FOnGetNext(Contact));
|
---|
704 | //ButtonPrevious.Enabled := Assigned(FOnGetPrevious) and Assigned(FOnGetPrevious(Contact));
|
---|
705 | end;
|
---|
706 |
|
---|
707 | end.
|
---|
708 |
|
---|