source: trunk/Forms/FormContact.pas

Last change on this file was 173, checked in by chronos, 17 months ago
  • Modified: TNameDetails class moved into separate file.
File size: 28.7 KB
Line 
1unit FormContact;
2
3interface
4
5uses
6 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
7 ComCtrls, ActnList, Menus, ExtCtrls, ExtDlgs, Buttons, VCard, LCLIntf,
8 FormProperties, DateUtils, {$IFDEF LCLGTK2}Gtk2Globals, {$ENDIF}ContactImage,
9 ubarcodes, FormEx;
10
11type
12
13 { TFormContact }
14
15 TFormContact = class(TFormEx)
16 APhotoSetUrl: TAction;
17 APhotoShow: TAction;
18 APhotoClear: TAction;
19 APhotoSave: TAction;
20 APhotoLoad: TAction;
21 ActionList1: TActionList;
22 BarcodeQR1: TBarcodeQR;
23 ButtonCancel: TButton;
24 ButtonHomeAddressShow: TButton;
25 ButtonNameDetails: TButton;
26 ButtonNext: TButton;
27 ButtonOk: TButton;
28 ButtonPrevious: TButton;
29 ButtonWorkAddressShow: TButton;
30 CalendarDialog1: TCalendarDialog;
31 EditAim: TEdit;
32 EditAniversary: TEdit;
33 EditBirthday: TEdit;
34 EditCategories: TEdit;
35 EditDepartment: TEdit;
36 EditEmail: TEdit;
37 EditFacebook: TEdit;
38 EditFax: TEdit;
39 EditFullName: TEdit;
40 EditGaduGadu: TEdit;
41 EditGender: TEdit;
42 EditGoogleTalk: TEdit;
43 EditGroupWise: TEdit;
44 EditHomeAddressCity: TEdit;
45 EditHomeAddressCountry: TEdit;
46 EditHomeAddressPostalCode: TEdit;
47 EditHomeAddressPostOfficeBox: TEdit;
48 EditHomeAddressRegion: TEdit;
49 EditHomeAddressStreet: TEdit;
50 EditHomeAddressStreetExtended: TEdit;
51 EditHomeEmail: TEdit;
52 EditHomeFax: TEdit;
53 EditHomeMobile: TEdit;
54 EditHomePager: TEdit;
55 EditHomePhone: TEdit;
56 EditHomeWeb: TEdit;
57 EditIcq: TEdit;
58 EditInstagram: TEdit;
59 EditIrc: TEdit;
60 EditJabber: TEdit;
61 EditLinkedIn: TEdit;
62 EditMastodon: TEdit;
63 EditMatrix: TEdit;
64 EditMobile: TEdit;
65 EditMsn: TEdit;
66 EditMySpace: TEdit;
67 EditNickName: TEdit;
68 EditOrganization: TEdit;
69 EditPager: TEdit;
70 EditPeerTube: TEdit;
71 EditPhone: TEdit;
72 EditQq: TEdit;
73 EditReddit: TEdit;
74 EditSkype: TEdit;
75 EditSnapchat: TEdit;
76 EditTitle: TEdit;
77 EditTwitter: TEdit;
78 EditWeb: TEdit;
79 EditWindowsLive: TEdit;
80 EditWorkAddressCity: TEdit;
81 EditWorkAddressCountry: TEdit;
82 EditWorkAddressPostalCode: TEdit;
83 EditWorkAddressPostOfficeBox: TEdit;
84 EditWorkAddressRegion: TEdit;
85 EditWorkAddressStreet: TEdit;
86 EditWorkAddressStreetExtended: TEdit;
87 EditWorkEmail: TEdit;
88 EditWorkFax: TEdit;
89 EditWorkMobile: TEdit;
90 EditWorkPager: TEdit;
91 EditWorkPhone: TEdit;
92 EditWorkWeb: TEdit;
93 EditYahoo: TEdit;
94 EditYouTube: TEdit;
95 GroupBox1: TGroupBox;
96 GroupBox2: TGroupBox;
97 ImagePhoto: TImage;
98 Label1: TLabel;
99 Label10: TLabel;
100 Label11: TLabel;
101 Label12: TLabel;
102 Label13: TLabel;
103 Label14: TLabel;
104 Label15: TLabel;
105 Label16: TLabel;
106 Label17: TLabel;
107 Label18: TLabel;
108 Label19: TLabel;
109 Label2: TLabel;
110 Label20: TLabel;
111 Label21: TLabel;
112 Label22: TLabel;
113 Label23: TLabel;
114 Label24: TLabel;
115 Label28: TLabel;
116 Label29: TLabel;
117 Label3: TLabel;
118 Label30: TLabel;
119 Label31: TLabel;
120 Label32: TLabel;
121 Label33: TLabel;
122 Label34: TLabel;
123 Label35: TLabel;
124 Label36: TLabel;
125 Label37: TLabel;
126 Label38: TLabel;
127 Label39: TLabel;
128 Label4: TLabel;
129 Label40: TLabel;
130 Label41: TLabel;
131 Label42: TLabel;
132 Label43: TLabel;
133 Label44: TLabel;
134 Label45: TLabel;
135 Label46: TLabel;
136 Label47: TLabel;
137 Label48: TLabel;
138 Label49: TLabel;
139 Label50: TLabel;
140 Label51: TLabel;
141 Label52: TLabel;
142 Label53: TLabel;
143 Label54: TLabel;
144 Label55: TLabel;
145 Label56: TLabel;
146 Label57: TLabel;
147 Label6: TLabel;
148 Label7: TLabel;
149 Label8: TLabel;
150 Label9: TLabel;
151 LabelOrganization: TLabel;
152 LabelOrganization1: TLabel;
153 LabelOrganization10: TLabel;
154 LabelOrganization11: TLabel;
155 LabelOrganization12: TLabel;
156 LabelOrganization2: TLabel;
157 LabelOrganization3: TLabel;
158 LabelOrganization4: TLabel;
159 LabelOrganization5: TLabel;
160 LabelOrganization6: TLabel;
161 LabelOrganization7: TLabel;
162 LabelOrganization8: TLabel;
163 LabelOrganization9: TLabel;
164 MemoNotes: TMemo;
165 MenuItem1: TMenuItem;
166 MenuItem2: TMenuItem;
167 MenuItem3: TMenuItem;
168 MenuItem4: TMenuItem;
169 MenuItem5: TMenuItem;
170 MenuItemSaveQrToFile: TMenuItem;
171 OpenPictureDialog1: TOpenPictureDialog;
172 PageControlContact: TPageControl;
173 Panel1: TPanel;
174 Panel2: TPanel;
175 Panel3: TPanel;
176 Panel4: TPanel;
177 Panel5: TPanel;
178 PanelNotes: TPanel;
179 PanelQrCode: TPanel;
180 PopupMenuQrCode: TPopupMenu;
181 PopupMenuPhoto: TPopupMenu;
182 SavePictureDialog1: TSavePictureDialog;
183 SpeedButtonAniversary: TSpeedButton;
184 SpeedButtonBirthDay: TSpeedButton;
185 SpeedButtonEmail: TSpeedButton;
186 SpeedButtonHomeEmail: TSpeedButton;
187 SpeedButtonHomeWeb: TSpeedButton;
188 SpeedButtonWeb: TSpeedButton;
189 SpeedButtonWorkEmail: TSpeedButton;
190 SpeedButtonWorkWeb: TSpeedButton;
191 Splitter1: TSplitter;
192 TabSheetAll: TTabSheet;
193 TabSheetChat: TTabSheet;
194 TabSheetGeneral: TTabSheet;
195 TabSheetHome: TTabSheet;
196 TabSheetOthers: TTabSheet;
197 TabSheetSocial: TTabSheet;
198 TabSheetWork: TTabSheet;
199 procedure APhotoClearExecute(Sender: TObject);
200 procedure APhotoLoadExecute(Sender: TObject);
201 procedure APhotoSaveExecute(Sender: TObject);
202 procedure APhotoSetUrlExecute(Sender: TObject);
203 procedure APhotoShowExecute(Sender: TObject);
204 procedure ButtonHomeAddressShowClick(Sender: TObject);
205 procedure ButtonNameDetailsClick(Sender: TObject);
206 procedure ButtonNextClick(Sender: TObject);
207 procedure ButtonPreviousClick(Sender: TObject);
208 procedure ButtonWorkAddressShowClick(Sender: TObject);
209 procedure EditFullNameChange(Sender: TObject);
210 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
211 procedure FormCreate(Sender: TObject);
212 procedure FormDestroy(Sender: TObject);
213 procedure FormShow(Sender: TObject);
214 procedure ImagePhotoClick(Sender: TObject);
215 procedure MenuItemSaveQrToFileClick(Sender: TObject);
216 procedure PanelQrCodeResize(Sender: TObject);
217 procedure SpeedButtonHomeWebClick(Sender: TObject);
218 procedure SpeedButtonAniversaryClick(Sender: TObject);
219 procedure SpeedButtonBirthDayClick(Sender: TObject);
220 procedure SpeedButtonEmailClick(Sender: TObject);
221 procedure SpeedButtonHomeEmailClick(Sender: TObject);
222 procedure SpeedButtonWebClick(Sender: TObject);
223 procedure SpeedButtonWorkEmailClick(Sender: TObject);
224 procedure SpeedButtonWorkWebClick(Sender: TObject);
225 procedure TabSheetAllShow(Sender: TObject);
226 procedure TabSheetChatHide(Sender: TObject);
227 procedure TabSheetChatShow(Sender: TObject);
228 procedure TabSheetGeneralHide(Sender: TObject);
229 procedure TabSheetGeneralShow(Sender: TObject);
230 procedure TabSheetHomeHide(Sender: TObject);
231 procedure TabSheetHomeShow(Sender: TObject);
232 procedure TabSheetOthersHide(Sender: TObject);
233 procedure TabSheetOthersShow(Sender: TObject);
234 procedure TabSheetSocialHide(Sender: TObject);
235 procedure TabSheetSocialShow(Sender: TObject);
236 procedure TabSheetWorkHide(Sender: TObject);
237 procedure TabSheetWorkShow(Sender: TObject);
238 private
239 FPhoto: TContactImage;
240 procedure PhotoChange(Sender: TObject);
241 private
242 FContact: TContact;
243 FOnGetNext: TGetContactEvent;
244 FOnGetPrevious: TGetContactEvent;
245 FormProperties: TFormProperties;
246 procedure SetContact(AValue: TContact);
247 procedure ReloadAllPropertiesTab;
248 public
249 procedure UpdateInterface;
250 property Contact: TContact read FContact write SetContact;
251 property OnGetPrevious: TGetContactEvent read FOnGetPrevious write FOnGetPrevious;
252 property OnGetNext: TGetContactEvent read FOnGetNext write FOnGetNext;
253 end;
254
255
256implementation
257
258{$R *.lfm}
259
260uses
261 Core, Common, FormImage, FormNameDetails, DataFile, NameDetails;
262
263resourcestring
264 SContact = 'Contact';
265 SPhotoUrl = 'Photo URL';
266 SPhotoUrlQuery = 'Enter URL for profile photo';
267 SImageTypeNotSupported = 'Image type not supported.';
268
269function DateToISO(Date: TDateTime): string;
270begin
271 Result := FormatDateTime('yyyy-mm-dd', Date);
272end;
273
274function URLEncode(Text: string): string;
275var
276 I: Integer;
277begin
278 Result := '';
279 for I := 1 to Length(Text) do begin
280 if not (Text[I] in ['A'..'Z', 'a'..'z', '0'..'9', '-', '_', '~', '.', ':', '/']) then
281 Result := Result + '%' + IntToHex(Ord(Text[I]), 2)
282 else
283 Result := Result + Text[I];
284 end;
285end;
286
287procedure UpdateEditNoOnChange(Edit: TEdit; Text: string);
288var
289 LastHandler: TNotifyEvent;
290begin
291 LastHandler := Edit.OnChange;
292 Edit.OnChange := nil;
293 try
294 Edit.Text := Text;
295 finally
296 Edit.OnChange := LastHandler;
297 end;
298end;
299
300{$IF FPC_FULLVERSION<30200}
301function TryISOStrToDate(const aString: string; out OutDate: TDateTime): Boolean;
302var
303 xYear, xMonth, xDay: LongInt;
304begin
305 case Length(aString) of
306 8: Result :=
307 TryStrToInt(Copy(aString, 1, 4), xYear) and
308 TryStrToInt(Copy(aString, 5, 2), xMonth) and
309 TryStrToInt(Copy(aString, 7, 2), xDay) and
310 TryEncodeDate(xYear, xMonth, xDay, OutDate);
311 10: Result :=
312 TryStrToInt(Copy(aString, 1, 4), xYear) and
313 TryStrToInt(Copy(aString, 6, 2), xMonth) and
314 TryStrToInt(Copy(aString, 9, 2), xDay) and
315 TryEncodeDate(xYear, xMonth, xDay, OutDate);
316 else
317 Result := False;
318 end;
319 if not Result then
320 OutDate := 0;
321end;
322{$ENDIF}
323
324{ TFormContact }
325
326procedure TFormContact.FormShow(Sender: TObject);
327begin
328 {$IFDEF LCLGTK2}
329 // GTK2 bug workaround https://gitlab.com/freepascal.org/lazarus/lazarus/-/issues/35720
330 if Visible then LastMouse.WinControl := PageControlContact.ActivePage;
331 {$ENDIF}
332 PhotoChange(nil);
333
334 FormProperties.BeginUpdate;
335 try
336
337 FormProperties.ManualDock(TabSheetAll, nil, alClient);
338 FormProperties.Align := alClient;
339 FormProperties.Show;
340
341 UpdateInterface;
342 finally
343 FormProperties.EndUpdate;
344 end;
345end;
346
347procedure TFormContact.ImagePhotoClick(Sender: TObject);
348begin
349 APhotoShow.Execute;
350end;
351
352procedure TFormContact.MenuItemSaveQrToFileClick(Sender: TObject);
353var
354 F: string;
355begin
356 SavePictureDialog1.Filter := 'Windows bitmap files (*.bmp)|*.bmp|' +
357 'Portable network graphic files (*.png)|*.png|' +
358 'JPEG image files (*.jpg;*.jpeg)|*.jpg;*.jpeg|' +
359 'TIFF image files (*.tiff; *.tif)|*.tiff;*.tif|'+
360 'XPM image files (*.xpm)|*.xpm|' +
361 'Scalable vector graphics files (*.svg)|*.svg|'+
362 'Encapsulated PostScript files (*.eps;*.ps)|*.eps;*.ps|'+
363 SAllFiles + ' (*.*)|*.*';
364 SavePictureDialog1.FilterIndex := 2;
365 SavePictureDialog1.DefaultExt := '.png';
366 if Core.Core.LastQrCodeFileName = '' then
367 Core.Core.LastQrCodeFileName := 'QR code.png';
368 SavePictureDialog1.InitialDir := ExtractFileDir(Core.Core.LastQrCodeFileName);
369 SavePictureDialog1.FileName := ExtractFileName(Core.Core.LastQrCodeFileName);
370 if SavePictureDialog1.Execute then begin
371 F := LowerCase(ExtractFileExt(SavePictureDialog1.FileName));
372 if F = '.bmp' then BarcodeQR1.SaveToFile(SavePictureDialog1.FileName, TBitmap)
373 else if F = '.png' then BarcodeQR1.SaveToFile(SavePictureDialog1.FileName, TPortableNetworkGraphic)
374 else if (F = '.jpg') or (F = '.jpeg') then BarcodeQR1.SaveTofile(SavePictureDialog1.FileName, TJpegImage)
375 else if (F = '.tif') or (F = '.tiff') then BarcodeQR1.SaveToFile(SavePictureDialog1.FileName, TTiffImage)
376 else if F = '.xpm' then BarcodeQR1.SaveToFile(SavePictureDialog1.FileName, TPixmap)
377 else if F = '.svg' then BarcodeQR1.SaveToSvgFile(SavePictureDialog1.FileName)
378 else if (F = '.eps') or (F = '.ps') then BarcodeQR1.SaveToEpsFile(SavePictureDialog1.FileName)
379 else raise Exception.Create(SImageTypeNotSupported);
380 Core.Core.LastQrCodeFileName := SavePictureDialog1.FileName;
381 end;
382end;
383
384procedure TFormContact.PanelQrCodeResize(Sender: TObject);
385begin
386 BarcodeQR1.SetBounds(BarcodeQR1.Left, BarcodeQR1.Top,
387 PanelQrCode.Width - BarcodeQR1.Left * 2,
388 PanelQrCode.Width - BarcodeQR1.Left * 2);
389end;
390
391procedure TFormContact.SpeedButtonHomeWebClick(Sender: TObject);
392begin
393 if EditHomeWeb.Text <> '' then OpenURL(EditHomeWeb.Text);
394end;
395
396procedure TFormContact.SpeedButtonAniversaryClick(Sender: TObject);
397var
398 Date: TDateTime;
399begin
400 if TryISOStrToDate(EditAniversary.Text, Date) then
401 CalendarDialog1.Date := Date
402 else CalendarDialog1.Date := Now;
403 if CalendarDialog1.Execute then
404 EditAniversary.Text := DateToISO(CalendarDialog1.Date);
405end;
406
407procedure TFormContact.SpeedButtonBirthDayClick(Sender: TObject);
408var
409 Date: TDateTime;
410begin
411 if TryISOStrToDate(EditBirthday.Text, Date) then
412 CalendarDialog1.Date := Date
413 else CalendarDialog1.Date := Now;
414 if CalendarDialog1.Execute then
415 EditBirthday.Text := DateToISO(CalendarDialog1.Date);
416end;
417
418procedure TFormContact.SpeedButtonEmailClick(Sender: TObject);
419begin
420 if EditEmail.Text <> '' then OpenEmail(EditEmail.Text);
421end;
422
423procedure TFormContact.SpeedButtonHomeEmailClick(Sender: TObject);
424begin
425 if EditHomeEmail.Text <> '' then OpenEmail(EditHomeEmail.Text);
426end;
427
428procedure TFormContact.SpeedButtonWebClick(Sender: TObject);
429begin
430 if EditWeb.Text <> '' then OpenURL(EditWeb.Text);
431end;
432
433procedure TFormContact.SpeedButtonWorkEmailClick(Sender: TObject);
434begin
435 if EditWorkEmail.Text <> '' then OpenEmail(EditWorkEmail.Text);
436end;
437
438procedure TFormContact.SpeedButtonWorkWebClick(Sender: TObject);
439begin
440 if EditWorkWeb.Text <> '' then OpenURL(EditWorkWeb.Text);
441end;
442
443procedure TFormContact.TabSheetAllShow(Sender: TObject);
444begin
445 FormProperties.BeginUpdate;
446 try
447 FormProperties.Properties := Contact.Properties;
448 FormProperties.ReloadList;
449 FormProperties.UpdateInterface;
450 FormProperties.Show;
451 finally
452 FormProperties.EndUpdate;
453 end;
454end;
455
456procedure TFormContact.TabSheetChatHide(Sender: TObject);
457begin
458 Contact.Fields[cfMatrix] := EditMatrix.Text;
459 Contact.Fields[cfJabber] := EditJabber.Text;
460 Contact.Fields[cfIcq] := EditIcq.Text;
461 Contact.Fields[cfMsn] := EditMsn.Text;
462 Contact.Fields[cfSkype] := EditSkype.Text;
463 Contact.Fields[cfQq] := EditQq.Text;
464 Contact.Fields[cfGoogleTalk] := EditGoogleTalk.Text;
465 Contact.Fields[cfWindowsLive] := EditWindowsLive.Text;
466 Contact.Fields[cfYahoo] := EditYahoo.Text;
467 Contact.Fields[cfAim] := EditAim.Text;
468 Contact.Fields[cfIrc] := EditIrc.Text;
469 Contact.Fields[cfGroupWise] := EditGroupWise.Text;
470 Contact.Fields[cfGaduGadu] := EditGaduGadu.Text;
471
472 ReloadAllPropertiesTab;
473end;
474
475procedure TFormContact.TabSheetChatShow(Sender: TObject);
476begin
477 EditMatrix.Text := Contact.Fields[cfMatrix];
478 EditJabber.Text := Contact.Fields[cfJabber];
479 EditIcq.Text := Contact.Fields[cfIcq];
480 EditMsn.Text := Contact.Fields[cfMsn];
481 EditSkype.Text := Contact.Fields[cfSkype];
482 EditQq.Text := Contact.Fields[cfQq];
483 EditGoogleTalk.Text := Contact.Fields[cfGoogleTalk];
484 EditWindowsLive.Text := Contact.Fields[cfWindowsLive];
485 EditYahoo.Text := Contact.Fields[cfYahoo];
486 EditAim.Text := Contact.Fields[cfAim];
487 EditIrc.Text := Contact.Fields[cfIrc];
488 EditGroupWise.Text := Contact.Fields[cfGroupWise];
489 EditGaduGadu.Text := Contact.Fields[cfGaduGadu];
490end;
491
492procedure TFormContact.TabSheetGeneralHide(Sender: TObject);
493begin
494 Contact.Fields[cfFullName] := EditFullName.Text;
495 Contact.Fields[cfNickName] := EditNickName.Text;
496 Contact.Fields[cfEmail] := EditEmail.Text;
497 Contact.Fields[cfTel] := EditPhone.Text;
498 Contact.Fields[cfTelCell] := EditMobile.Text;
499 Contact.Fields[cfTelFax] := EditFax.Text;
500 Contact.Fields[cfTelPager] := EditPager.Text;
501 Contact.Fields[cfDayOfBirth] := EditBirthday.Text;
502 Contact.Fields[cfAnniversary] := EditAniversary.Text;
503 Contact.Fields[cfUrl] := EditWeb.Text;
504 Contact.Fields[cfGender] := EditGender.Text;
505 Contact.Fields[cfCategories] := EditCategories.Text;
506
507 FPhoto.Contact := Contact;
508 FPhoto.Save;
509
510 ReloadAllPropertiesTab;
511end;
512
513procedure TFormContact.TabSheetGeneralShow(Sender: TObject);
514begin
515 UpdateEditNoOnChange(EditFullName, Contact.Fields[cfFullName]);
516 EditNickName.Text := Contact.Fields[cfNickName];
517 EditEmail.Text := Contact.Fields[cfEmail];
518 EditPhone.Text := Contact.Fields[cfTel];
519 EditMobile.Text := Contact.Fields[cfTelCell];
520 EditFax.Text := Contact.Fields[cfTelFax];
521 EditPager.Text := Contact.Fields[cfTelPager];
522 EditBirthday.Text := Contact.Fields[cfDayOfBirth];
523 EditAniversary.Text := Contact.Fields[cfAnniversary];
524 EditWeb.Text := Contact.Fields[cfUrl];
525 EditGender.Text := Contact.Fields[cfGender];
526 EditCategories.Text := Contact.Fields[cfCategories];
527
528 FPhoto.Contact := Contact;
529 FPhoto.Load;
530end;
531
532procedure TFormContact.TabSheetHomeHide(Sender: TObject);
533begin
534 Contact.Fields[cfEmailHome] := EditHomeEmail.Text;
535 Contact.Fields[cfTelHome] := EditHomePhone.Text;
536 Contact.Fields[cfTelCellHome] := EditHomeMobile.Text;
537 Contact.Fields[cfTelFaxHome] := EditHomeFax.Text;
538 Contact.Fields[cfTelPagerHome] := EditHomePager.Text;
539 Contact.Fields[cfHomeAddressPostOfficeBox] := EditHomeAddressPostOfficeBox.Text;
540 Contact.Fields[cfHomeAddressStreet] := EditHomeAddressStreet.Text;
541 Contact.Fields[cfHomeAddressStreetExtended] := EditHomeAddressStreetExtended.Text;
542 Contact.Fields[cfHomeAddressCity] := EditHomeAddressCity.Text;
543 Contact.Fields[cfHomeAddressRegion] := EditHomeAddressRegion.Text;
544 Contact.Fields[cfHomeAddressCountry] := EditHomeAddressCountry.Text;
545 Contact.Fields[cfHomeAddressPostalCode] := EditHomeAddressPostalCode.Text;
546 Contact.Fields[cfUrlHome] := EditHomeWeb.Text;
547
548 ReloadAllPropertiesTab;
549end;
550
551procedure TFormContact.TabSheetHomeShow(Sender: TObject);
552begin
553 EditHomeEmail.Text := Contact.Fields[cfEmailHome];
554 EditHomePhone.Text := Contact.Fields[cfTelHome];
555 EditHomeMobile.Text := Contact.Fields[cfTelCellHome];
556 EditHomeFax.Text := Contact.Fields[cfTelFaxHome];
557 EditHomePager.Text := Contact.Fields[cfTelPagerHome];
558 EditHomeAddressPostOfficeBox.Text := Contact.Fields[cfHomeAddressPostOfficeBox];
559 EditHomeAddressStreet.Text := Contact.Fields[cfHomeAddressStreet];
560 EditHomeAddressStreetExtended.Text := Contact.Fields[cfHomeAddressStreetExtended];
561 EditHomeAddressCity.Text := Contact.Fields[cfHomeAddressCity];
562 EditHomeAddressRegion.Text := Contact.Fields[cfHomeAddressRegion];
563 EditHomeAddressCountry.Text := Contact.Fields[cfHomeAddressCountry];
564 EditHomeAddressPostalCode.Text := Contact.Fields[cfHomeAddressPostalCode];
565 EditHomeWeb.Text := Contact.Fields[cfUrlHome];
566end;
567
568procedure TFormContact.TabSheetOthersHide(Sender: TObject);
569begin
570 Contact.Fields[cfNote] := MemoNotes.Lines.Text;
571
572 ReloadAllPropertiesTab;
573end;
574
575procedure TFormContact.TabSheetOthersShow(Sender: TObject);
576var
577 ContactWithoutImages: TContact;
578begin
579 MemoNotes.Lines.Text := Contact.Fields[cfNote];
580 BarcodeQR1.Text := Contact.AsString;
581 if BarcodeQR1.ErrorString <> '' then begin
582 ContactWithoutImages := TContact.Create;
583 try
584 ContactWithoutImages.Assign(Contact);
585 ContactWithoutImages.ParentVCard := Contact.ParentVCard;
586 while ContactWithoutImages.HasField(cfPhoto) do
587 ContactWithoutImages.Fields[cfPhoto] := '';
588 while ContactWithoutImages.HasField(cfLogo) do
589 ContactWithoutImages.Fields[cfLogo] := '';
590 BarcodeQR1.Text := ContactWithoutImages.AsString;
591 if BarcodeQR1.ErrorString <> '' then begin
592 BarcodeQR1.Text := '';
593 BarcodeQR1.Visible := False;
594 end else BarcodeQR1.Visible := True;
595 finally
596 ContactWithoutImages.Free;
597 end;
598 end else BarcodeQR1.Visible := True;
599end;
600
601procedure TFormContact.TabSheetSocialHide(Sender: TObject);
602begin
603 Contact.Fields[cfFacebook] := EditFacebook.Text;
604 Contact.Fields[cfTwitter] := EditTwitter.Text;
605 Contact.Fields[cfInstagram] := EditInstagram.Text;
606 Contact.Fields[cfYouTube] := EditYouTube.Text;
607 Contact.Fields[cfPeerTube] := EditPeerTube.Text;
608 Contact.Fields[cfMastodon] := EditMastodon.Text;
609 Contact.Fields[cfLinkedIn] := EditLinkedIn.Text;
610 Contact.Fields[cfSnapchat] := EditSnapchat.Text;
611 Contact.Fields[cfReddit] := EditReddit.Text;
612 Contact.Fields[cfMySpace] := EditMySpace.Text;
613
614 ReloadAllPropertiesTab;
615end;
616
617procedure TFormContact.TabSheetSocialShow(Sender: TObject);
618begin
619 EditFacebook.Text := Contact.Fields[cfFacebook];
620 EditTwitter.Text := Contact.Fields[cfTwitter];
621 EditInstagram.Text := Contact.Fields[cfInstagram];
622 EditYouTube.Text := Contact.Fields[cfYouTube];
623 EditPeerTube.Text := Contact.Fields[cfPeerTube];
624 EditMastodon.Text := Contact.Fields[cfMastodon];
625 EditLinkedIn.Text := Contact.Fields[cfLinkedIn];
626 EditSnapchat.Text := Contact.Fields[cfSnapchat];
627 EditReddit.Text := Contact.Fields[cfReddit];
628 EditMySpace.Text := Contact.Fields[cfMySpace];
629end;
630
631procedure TFormContact.TabSheetWorkHide(Sender: TObject);
632begin
633 Contact.Fields[cfEmailWork] := EditWorkEmail.Text;
634 Contact.Fields[cfTelWork] := EditWorkPhone.Text;
635 Contact.Fields[cfTelCellWork] := EditWorkMobile.Text;
636 Contact.Fields[cfTelFaxWork] := EditWorkFax.Text;
637 Contact.Fields[cfTelPagerWork] := EditWorkPager.Text;
638 Contact.Fields[cfTitle] := EditTitle.Text;
639 Contact.Fields[cfOrganization] := EditOrganization.Text;
640 Contact.Fields[cfDepartment] := EditDepartment.Text;
641 Contact.Fields[cfWorkAddressPostOfficeBox] := EditWorkAddressPostOfficeBox.Text;
642 Contact.Fields[cfWorkAddressStreet] := EditWorkAddressStreet.Text;
643 Contact.Fields[cfWorkAddressStreetExtended] := EditWorkAddressStreetExtended.Text;
644 Contact.Fields[cfWorkAddressCity] := EditWorkAddressCity.Text;
645 Contact.Fields[cfWorkAddressRegion] := EditWorkAddressRegion.Text;
646 Contact.Fields[cfWorkAddressCountry] := EditWorkAddressCountry.Text;
647 Contact.Fields[cfWorkAddressPostalCode] := EditWorkAddressPostalCode.Text;
648 Contact.Fields[cfUrlWork] := EditWorkWeb.Text;
649
650 ReloadAllPropertiesTab;
651end;
652
653procedure TFormContact.TabSheetWorkShow(Sender: TObject);
654begin
655 EditWorkEmail.Text := Contact.Fields[cfEmailWork];
656 EditWorkPhone.Text := Contact.Fields[cfTelWork];
657 EditWorkMobile.Text := Contact.Fields[cfTelCellWork];
658 EditWorkFax.Text := Contact.Fields[cfTelFaxWork];
659 EditWorkPager.Text := Contact.Fields[cfTelPagerWork];
660 EditTitle.Text := Contact.Fields[cfTitle];
661 EditOrganization.Text := Contact.Fields[cfOrganization];
662 EditDepartment.Text := Contact.Fields[cfDepartment];
663 EditWorkAddressPostOfficeBox.Text := Contact.Fields[cfWorkAddressPostOfficeBox];
664 EditWorkAddressStreet.Text := Contact.Fields[cfWorkAddressStreet];
665 EditWorkAddressStreetExtended.Text := Contact.Fields[cfWorkAddressStreetExtended];
666 EditWorkAddressCity.Text := Contact.Fields[cfWorkAddressCity];
667 EditWorkAddressRegion.Text := Contact.Fields[cfWorkAddressRegion];
668 EditWorkAddressCountry.Text := Contact.Fields[cfWorkAddressCountry];
669 EditWorkAddressPostalCode.Text := Contact.Fields[cfWorkAddressPostalCode];
670 EditWorkWeb.Text := Contact.Fields[cfUrlWork];
671end;
672
673procedure TFormContact.PhotoChange(Sender: TObject);
674begin
675 if FPhoto.Used and (FPhoto.Url = '') then
676 ImagePhoto.Picture.Bitmap.Assign(FPhoto.Bitmap)
677 else ImagePhoto.Picture.Assign(Core.Core.GetProfileImage.Picture);
678 UpdateInterface;
679end;
680
681procedure TFormContact.SetContact(AValue: TContact);
682begin
683 if FContact = AValue then Exit;
684 FContact := AValue;
685end;
686
687procedure TFormContact.ReloadAllPropertiesTab;
688begin
689 if TabSheetAll.Visible then begin
690 TabSheetAllShow(nil);
691 end;
692end;
693
694procedure TFormContact.FormClose(Sender: TObject; var CloseAction: TCloseAction
695 );
696begin
697 // Hide PageControl to fire TabSheet OnHide event on form close
698 PageControlContact.ActivePage.Hide;
699
700 Core.Core.LastContactTabIndex := PageControlContact.TabIndex;
701end;
702
703procedure TFormContact.ButtonNextClick(Sender: TObject);
704begin
705 if Assigned(FOnGetNext) then
706 Contact := FOnGetNext(Contact);
707end;
708
709procedure TFormContact.APhotoLoadExecute(Sender: TObject);
710begin
711 OpenPictureDialog1.InitialDir := ExtractFileDir(Core.Core.LastPhotoFileName);
712 OpenPictureDialog1.FileName := ExtractFileName(Core.Core.LastPhotoFileName);
713 if OpenPictureDialog1.Execute then begin
714 FPhoto.LoadFromFile(OpenPictureDialog1.FileName);
715 Core.Core.LastPhotoFileName := OpenPictureDialog1.FileName;
716 end;
717end;
718
719procedure TFormContact.APhotoClearExecute(Sender: TObject);
720begin
721 FPhoto.Clear;
722end;
723
724procedure TFormContact.APhotoSaveExecute(Sender: TObject);
725begin
726 SavePictureDialog1.InitialDir := ExtractFileDir(Core.Core.LastPhotoFileName);
727 SavePictureDialog1.FileName := ExtractFileName(Core.Core.LastPhotoFileName);
728 if SavePictureDialog1.Execute then begin
729 ImagePhoto.Picture.SaveToFile(SavePictureDialog1.FileName);
730 Core.Core.LastPhotoFileName := SavePictureDialog1.FileName;
731 end;
732end;
733
734procedure TFormContact.APhotoSetUrlExecute(Sender: TObject);
735begin
736 FPhoto.Url := InputBox(SPhotoUrl, SPhotoUrlQuery, FPhoto.Url);
737end;
738
739procedure TFormContact.APhotoShowExecute(Sender: TObject);
740begin
741 with TFormImage.Create(nil) do
742 try
743 Image.Assign(FPhoto);
744 if ShowModal = mrOK then begin
745 FPhoto.Assign(Image);
746 UpdateInterface;
747 end;
748 finally
749 Free;
750 end;
751end;
752
753procedure TFormContact.ButtonHomeAddressShowClick(Sender: TObject);
754var
755 Address: string;
756begin
757 Address := '';
758 if EditHomeAddressStreet.Text <> '' then Address := Address + ' ' + EditHomeAddressStreet.Text;
759 if EditHomeAddressStreetExtended.Text <> '' then Address := Address + ' ' + EditHomeAddressStreetExtended.Text;
760 if EditHomeAddressPostOfficeBox.Text <> '' then Address := Address + ' ' + EditHomeAddressPostOfficeBox.Text;
761 if EditHomeAddressCity.Text <> '' then Address := Address + ' ' + EditHomeAddressCity.Text;
762 if EditHomeAddressCountry.Text <> '' then Address := Address + ' ' + EditHomeAddressCountry.Text;
763 if Trim(Address) <> '' then
764 OpenURL(Core.Core.MapUrl + URLEncode(Trim(Address)));
765end;
766
767procedure TFormContact.ButtonNameDetailsClick(Sender: TObject);
768begin
769 with TFormNameDetails.Create(nil) do
770 try
771 EditFirstName.Text := Contact.Fields[cfFirstName];
772 EditLastName.Text := Contact.Fields[cfLastName];
773 EditMiddleName.Text := Contact.Fields[cfMiddleName];
774 EditTitleAfter.Text := Contact.Fields[cfTitleAfter];
775 EditTitleBefore.Text := Contact.Fields[cfTitleBefore];
776 if ShowModal = mrOk then begin
777 Contact.Fields[cfMiddleName] := EditMiddleName.Text;
778 Contact.Fields[cfFirstName] := EditFirstName.Text;
779 Contact.Fields[cfLastName] := EditLastName.Text;
780 Contact.Fields[cfTitleAfter] := EditTitleAfter.Text;
781 Contact.Fields[cfTitleBefore] := EditTitleBefore.Text;
782 with TNameDetails.Create do
783 try
784 Prefix := EditTitleBefore.Text;
785 First := EditFirstName.Text;
786 Middle := EditMiddleName.Text;
787 Last := EditLastName.Text;
788 Suffix := EditTitleAfter.Text;
789 UpdateEditNoOnChange(EditFullName, GetCombined);
790 finally
791 Free;
792 end;
793 end;
794 finally
795 Free;
796 end;
797end;
798
799procedure TFormContact.ButtonPreviousClick(Sender: TObject);
800begin
801 if Assigned(FOnGetPrevious) then
802 Contact := FOnGetPrevious(Contact);
803end;
804
805procedure TFormContact.ButtonWorkAddressShowClick(Sender: TObject);
806var
807 Address: string;
808begin
809 Address := '';
810 if EditWorkAddressStreet.Text <> '' then Address := Address + ' ' + EditWorkAddressStreet.Text;
811 if EditWorkAddressStreetExtended.Text <> '' then Address := Address + ' ' + EditWorkAddressStreetExtended.Text;
812 if EditWorkAddressPostOfficeBox.Text <> '' then Address := Address + ' ' + EditWorkAddressPostOfficeBox.Text;
813 if EditWorkAddressCity.Text <> '' then Address := Address + ' ' + EditWorkAddressCity.Text;
814 if EditWorkAddressCountry.Text <> '' then Address := Address + ' ' + EditWorkAddressCountry.Text;
815 if Trim(Address) <> '' then
816 OpenURL(Core.Core.MapUrl + URLEncode(Trim(Address)));
817end;
818
819procedure TFormContact.EditFullNameChange(Sender: TObject);
820begin
821 with TNameDetails.Create do
822 try
823 Prefix := Contact.Fields[cfTitleBefore];
824 First := Contact.Fields[cfFirstName];
825 Middle := Contact.Fields[cfMiddleName];
826 Last := Contact.Fields[cfLastName];
827 Suffix := Contact.Fields[cfTitleAfter];
828 Split(EditFullName.Text);
829 Contact.Fields[cfTitleBefore] := Prefix;
830 Contact.Fields[cfFirstName] := First;
831 Contact.Fields[cfMiddleName] := Middle;
832 Contact.Fields[cfLastName] := Last;
833 Contact.Fields[cfTitleAfter] := Suffix;
834 UpdateInterface;
835 finally
836 Free;
837 end;
838end;
839
840procedure TFormContact.FormCreate(Sender: TObject);
841begin
842 FContact := nil;
843 FormProperties := TFormProperties.Create(nil);
844 FPhoto := TContactImage.Create(nil);
845 FPhoto.FieldIndex := cfPhoto;
846 FPhoto.OnChange := PhotoChange;
847
848 // Set Barcode unpublished properties
849 BarcodeQR1.Anchors := [akTop, akLeft];
850 BarcodeQR1.PopupMenu := PopupMenuQrCode;
851
852 PageControlContact.TabIndex := Core.Core.LastContactTabIndex;
853end;
854
855procedure TFormContact.FormDestroy(Sender: TObject);
856begin
857 FreeAndNil(FPhoto);
858 FreeAndNil(FormProperties);
859end;
860
861procedure TFormContact.UpdateInterface;
862var
863 Title: string;
864begin
865 Title := SContact;
866 if EditFullName.Text <> '' then Title := EditFullName.Text + ' - ' + Title
867 else
868 if EditOrganization.Text <> '' then Title := EditOrganization.Text + ' - ' + Title;
869 Caption := Title;
870 APhotoSave.Enabled := FPhoto.Used;
871 APhotoClear.Enabled := FPhoto.Used;
872 //ButtonNext.Enabled := Assigned(FOnGetNext) and Assigned(FOnGetNext(Contact));
873 //ButtonPrevious.Enabled := Assigned(FOnGetPrevious) and Assigned(FOnGetPrevious(Contact));
874end;
875
876end.
877
Note: See TracBrowser for help on using the repository browser.