source: tags/1.4.0/Forms/UFormContact.pas

Last change on this file was 140, checked in by chronos, 3 years ago
  • Fixed: Initialize correctly last selected tab in Contact form.
File size: 28.7 KB
Line 
1unit UFormContact;
2
3interface
4
5uses
6 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
7 ComCtrls, ActnList, Menus, ExtCtrls, ExtDlgs, Buttons, UVCard, LCLIntf,
8 UFormProperties, DateUtils, {$IFDEF LCLGTK2}Gtk2Globals, {$ENDIF}UContactImage,
9 ubarcodes;
10
11type
12
13 { TFormContact }
14
15 TFormContact = class(TForm)
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 PanelNotes: TPanel;
174 PanelQrCode: TPanel;
175 PopupMenuQrCode: TPopupMenu;
176 PopupMenuPhoto: TPopupMenu;
177 SavePictureDialog1: TSavePictureDialog;
178 SpeedButtonAniversary: TSpeedButton;
179 SpeedButtonBirthDay: TSpeedButton;
180 SpeedButtonEmail: TSpeedButton;
181 SpeedButtonHomeEmail: TSpeedButton;
182 SpeedButtonHomeWeb: TSpeedButton;
183 SpeedButtonWeb: TSpeedButton;
184 SpeedButtonWorkEmail: TSpeedButton;
185 SpeedButtonWorkWeb: TSpeedButton;
186 Splitter1: TSplitter;
187 TabSheetAll: TTabSheet;
188 TabSheetChat: TTabSheet;
189 TabSheetGeneral: TTabSheet;
190 TabSheetHome: TTabSheet;
191 TabSheetOthers: TTabSheet;
192 TabSheetSocial: TTabSheet;
193 TabSheetWork: TTabSheet;
194 procedure APhotoClearExecute(Sender: TObject);
195 procedure APhotoLoadExecute(Sender: TObject);
196 procedure APhotoSaveExecute(Sender: TObject);
197 procedure APhotoSetUrlExecute(Sender: TObject);
198 procedure APhotoShowExecute(Sender: TObject);
199 procedure ButtonHomeAddressShowClick(Sender: TObject);
200 procedure ButtonNameDetailsClick(Sender: TObject);
201 procedure ButtonNextClick(Sender: TObject);
202 procedure ButtonPreviousClick(Sender: TObject);
203 procedure ButtonWorkAddressShowClick(Sender: TObject);
204 procedure EditFullNameChange(Sender: TObject);
205 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
206 procedure FormCreate(Sender: TObject);
207 procedure FormDestroy(Sender: TObject);
208 procedure FormShow(Sender: TObject);
209 procedure ImagePhotoClick(Sender: TObject);
210 procedure MenuItemSaveQrToFileClick(Sender: TObject);
211 procedure PanelQrCodeResize(Sender: TObject);
212 procedure SpeedButtonHomeWebClick(Sender: TObject);
213 procedure SpeedButtonAniversaryClick(Sender: TObject);
214 procedure SpeedButtonBirthDayClick(Sender: TObject);
215 procedure SpeedButtonEmailClick(Sender: TObject);
216 procedure SpeedButtonHomeEmailClick(Sender: TObject);
217 procedure SpeedButtonWebClick(Sender: TObject);
218 procedure SpeedButtonWorkEmailClick(Sender: TObject);
219 procedure SpeedButtonWorkWebClick(Sender: TObject);
220 procedure TabSheetAllShow(Sender: TObject);
221 procedure TabSheetChatHide(Sender: TObject);
222 procedure TabSheetChatShow(Sender: TObject);
223 procedure TabSheetGeneralHide(Sender: TObject);
224 procedure TabSheetGeneralShow(Sender: TObject);
225 procedure TabSheetHomeHide(Sender: TObject);
226 procedure TabSheetHomeShow(Sender: TObject);
227 procedure TabSheetOthersHide(Sender: TObject);
228 procedure TabSheetOthersShow(Sender: TObject);
229 procedure TabSheetSocialHide(Sender: TObject);
230 procedure TabSheetSocialShow(Sender: TObject);
231 procedure TabSheetWorkHide(Sender: TObject);
232 procedure TabSheetWorkShow(Sender: TObject);
233 private
234 FPhoto: TContactImage;
235 procedure PhotoChange(Sender: TObject);
236 private
237 FContact: TContact;
238 FOnGetNext: TGetContactEvent;
239 FOnGetPrevious: TGetContactEvent;
240 FormProperties: TFormProperties;
241 procedure SetContact(AValue: TContact);
242 procedure ReloadAllPropertiesTab;
243 public
244 procedure UpdateInterface;
245 property Contact: TContact read FContact write SetContact;
246 property OnGetPrevious: TGetContactEvent read FOnGetPrevious write FOnGetPrevious;
247 property OnGetNext: TGetContactEvent read FOnGetNext write FOnGetNext;
248 end;
249
250var
251 FormContact: TFormContact;
252
253
254implementation
255
256{$R *.lfm}
257
258uses
259 UCore, UCommon, UFormImage, UFormNameDetails, UDataFile;
260
261resourcestring
262 SContact = 'Contact';
263 SPhotoUrl = 'Photo URL';
264 SPhotoUrlQuery = 'Enter URL for profile photo';
265 SImageTypeNotSupported = 'Image type not supported.';
266
267function DateToISO(Date: TDateTime): string;
268begin
269 Result := FormatDateTime('yyyy-mm-dd', Date);
270end;
271
272function URLEncode(Text: string): string;
273var
274 I: Integer;
275begin
276 Result := '';
277 for I := 1 to Length(Text) do begin
278 if not (Text[I] in ['A'..'Z', 'a'..'z', '0'..'9', '-', '_', '~', '.', ':', '/']) then
279 Result := Result + '%' + IntToHex(Ord(Text[I]), 2)
280 else
281 Result := Result + Text[I];
282 end;
283end;
284
285procedure UpdateEditNoOnChange(Edit: TEdit; Text: string);
286var
287 LastHandler: TNotifyEvent;
288begin
289 LastHandler := Edit.OnChange;
290 Edit.OnChange := nil;
291 try
292 Edit.Text := Text;
293 finally
294 Edit.OnChange := LastHandler;
295 end;
296end;
297
298{$IF FPC_FULLVERSION<30200}
299function TryISOStrToDate(const aString: string; out OutDate: TDateTime): Boolean;
300var
301 xYear, xMonth, xDay: LongInt;
302begin
303 case Length(aString) of
304 8: Result :=
305 TryStrToInt(Copy(aString, 1, 4), xYear) and
306 TryStrToInt(Copy(aString, 5, 2), xMonth) and
307 TryStrToInt(Copy(aString, 7, 2), xDay) and
308 TryEncodeDate(xYear, xMonth, xDay, OutDate);
309 10: Result :=
310 TryStrToInt(Copy(aString, 1, 4), xYear) and
311 TryStrToInt(Copy(aString, 6, 2), xMonth) and
312 TryStrToInt(Copy(aString, 9, 2), xDay) and
313 TryEncodeDate(xYear, xMonth, xDay, OutDate);
314 else
315 Result := False;
316 end;
317 if not Result then
318 OutDate := 0;
319end;
320{$ENDIF}
321
322{ TFormContact }
323
324procedure TFormContact.FormShow(Sender: TObject);
325begin
326 {$IFDEF LCLGTK2}
327 // GTK2 bug workaround https://gitlab.com/freepascal.org/lazarus/lazarus/-/issues/35720
328 if Visible then LastMouse.WinControl := PageControlContact.ActivePage;
329 {$ENDIF}
330 Core.PersistentForm1.Load(Self);
331 PhotoChange(nil);
332
333 FormProperties.BeginUpdate;
334 try
335
336 FormProperties.ManualDock(TabSheetAll, nil, alClient);
337 FormProperties.Align := alClient;
338 FormProperties.Show;
339
340 UpdateInterface;
341 finally
342 FormProperties.EndUpdate;
343 end;
344end;
345
346procedure TFormContact.ImagePhotoClick(Sender: TObject);
347begin
348 APhotoShow.Execute;
349end;
350
351procedure TFormContact.MenuItemSaveQrToFileClick(Sender: TObject);
352var
353 F: string;
354begin
355 SavePictureDialog1.Filter := 'Windows bitmap files (*.bmp)|*.bmp|' +
356 'Portable network graphic files (*.png)|*.png|' +
357 'JPEG image files (*.jpg;*.jpeg)|*.jpg;*.jpeg|' +
358 'TIFF image files (*.tiff; *.tif)|*.tiff;*.tif|'+
359 'XPM image files (*.xpm)|*.xpm|' +
360 'Scalable vector graphics files (*.svg)|*.svg|'+
361 'Encapsulated PostScript files (*.eps;*.ps)|*.eps;*.ps|'+
362 SAllFiles + ' (*.*)|*.*';
363 SavePictureDialog1.FilterIndex := 2;
364 SavePictureDialog1.DefaultExt := '.png';
365 if Core.LastQrCodeFileName = '' then
366 Core.LastQrCodeFileName := 'QR code.png';
367 SavePictureDialog1.InitialDir := ExtractFileDir(Core.LastQrCodeFileName);
368 SavePictureDialog1.FileName := ExtractFileName(Core.LastQrCodeFileName);
369 if SavePictureDialog1.Execute then begin
370 F := LowerCase(ExtractFileExt(SavePictureDialog1.FileName));
371 if F = '.bmp' then BarcodeQR1.SaveToFile(SavePictureDialog1.FileName, TBitmap)
372 else if F = '.png' then BarcodeQR1.SaveToFile(SavePictureDialog1.FileName, TPortableNetworkGraphic)
373 else if (F = '.jpg') or (F = '.jpeg') then BarcodeQR1.SaveTofile(SavePictureDialog1.FileName, TJpegImage)
374 else if (F = '.tif') or (F = '.tiff') then BarcodeQR1.SaveToFile(SavePictureDialog1.FileName, TTiffImage)
375 else if F = '.xpm' then BarcodeQR1.SaveToFile(SavePictureDialog1.FileName, TPixmap)
376 else if F = '.svg' then BarcodeQR1.SaveToSvgFile(SavePictureDialog1.FileName)
377 else if (F = '.eps') or (F = '.ps') then BarcodeQR1.SaveToEpsFile(SavePictureDialog1.FileName)
378 else raise Exception.Create(SImageTypeNotSupported);
379 Core.LastQrCodeFileName := SavePictureDialog1.FileName;
380 end;
381end;
382
383procedure TFormContact.PanelQrCodeResize(Sender: TObject);
384begin
385 BarcodeQR1.SetBounds(BarcodeQR1.Left, BarcodeQR1.Top,
386 PanelQrCode.Width - BarcodeQR1.Left * 2,
387 PanelQrCode.Width - BarcodeQR1.Left * 2);
388end;
389
390procedure TFormContact.SpeedButtonHomeWebClick(Sender: TObject);
391begin
392 if EditHomeWeb.Text <> '' then OpenURL(EditHomeWeb.Text);
393end;
394
395procedure TFormContact.SpeedButtonAniversaryClick(Sender: TObject);
396var
397 Date: TDateTime;
398begin
399 if TryISOStrToDate(EditAniversary.Text, Date) then
400 CalendarDialog1.Date := Date
401 else CalendarDialog1.Date := Now;
402 if CalendarDialog1.Execute then
403 EditAniversary.Text := DateToISO(CalendarDialog1.Date);
404end;
405
406procedure TFormContact.SpeedButtonBirthDayClick(Sender: TObject);
407var
408 Date: TDateTime;
409begin
410 if TryISOStrToDate(EditBirthday.Text, Date) then
411 CalendarDialog1.Date := Date
412 else CalendarDialog1.Date := Now;
413 if CalendarDialog1.Execute then
414 EditBirthday.Text := DateToISO(CalendarDialog1.Date);
415end;
416
417procedure TFormContact.SpeedButtonEmailClick(Sender: TObject);
418begin
419 if EditEmail.Text <> '' then OpenEmail(EditEmail.Text);
420end;
421
422procedure TFormContact.SpeedButtonHomeEmailClick(Sender: TObject);
423begin
424 if EditHomeEmail.Text <> '' then OpenEmail(EditHomeEmail.Text);
425end;
426
427procedure TFormContact.SpeedButtonWebClick(Sender: TObject);
428begin
429 if EditWeb.Text <> '' then OpenURL(EditWeb.Text);
430end;
431
432procedure TFormContact.SpeedButtonWorkEmailClick(Sender: TObject);
433begin
434 if EditWorkEmail.Text <> '' then OpenEmail(EditWorkEmail.Text);
435end;
436
437procedure TFormContact.SpeedButtonWorkWebClick(Sender: TObject);
438begin
439 if EditWorkWeb.Text <> '' then OpenURL(EditWorkWeb.Text);
440end;
441
442procedure TFormContact.TabSheetAllShow(Sender: TObject);
443begin
444 FormProperties.BeginUpdate;
445 try
446 FormProperties.Properties := Contact.Properties;
447 FormProperties.ReloadList;
448 FormProperties.UpdateInterface;
449 FormProperties.Show;
450 finally
451 FormProperties.EndUpdate;
452 end;
453end;
454
455procedure TFormContact.TabSheetChatHide(Sender: TObject);
456begin
457 Contact.Fields[cfMatrix] := EditMatrix.Text;
458 Contact.Fields[cfJabber] := EditJabber.Text;
459 Contact.Fields[cfIcq] := EditIcq.Text;
460 Contact.Fields[cfMsn] := EditMsn.Text;
461 Contact.Fields[cfSkype] := EditSkype.Text;
462 Contact.Fields[cfQq] := EditQq.Text;
463 Contact.Fields[cfGoogleTalk] := EditGoogleTalk.Text;
464 Contact.Fields[cfWindowsLive] := EditWindowsLive.Text;
465 Contact.Fields[cfYahoo] := EditYahoo.Text;
466 Contact.Fields[cfAim] := EditAim.Text;
467 Contact.Fields[cfIrc] := EditIrc.Text;
468 Contact.Fields[cfGroupWise] := EditGroupWise.Text;
469 Contact.Fields[cfGaduGadu] := EditGaduGadu.Text;
470
471 ReloadAllPropertiesTab;
472end;
473
474procedure TFormContact.TabSheetChatShow(Sender: TObject);
475begin
476 EditMatrix.Text := Contact.Fields[cfMatrix];
477 EditJabber.Text := Contact.Fields[cfJabber];
478 EditIcq.Text := Contact.Fields[cfIcq];
479 EditMsn.Text := Contact.Fields[cfMsn];
480 EditSkype.Text := Contact.Fields[cfSkype];
481 EditQq.Text := Contact.Fields[cfQq];
482 EditGoogleTalk.Text := Contact.Fields[cfGoogleTalk];
483 EditWindowsLive.Text := Contact.Fields[cfWindowsLive];
484 EditYahoo.Text := Contact.Fields[cfYahoo];
485 EditAim.Text := Contact.Fields[cfAim];
486 EditIrc.Text := Contact.Fields[cfIrc];
487 EditGroupWise.Text := Contact.Fields[cfGroupWise];
488 EditGaduGadu.Text := Contact.Fields[cfGaduGadu];
489end;
490
491procedure TFormContact.TabSheetGeneralHide(Sender: TObject);
492begin
493 Contact.Fields[cfFullName] := EditFullName.Text;
494 Contact.Fields[cfNickName] := EditNickName.Text;
495 Contact.Fields[cfEmail] := EditEmail.Text;
496 Contact.Fields[cfTel] := EditPhone.Text;
497 Contact.Fields[cfTelCell] := EditMobile.Text;
498 Contact.Fields[cfTelFax] := EditFax.Text;
499 Contact.Fields[cfTelPager] := EditPager.Text;
500 Contact.Fields[cfDayOfBirth] := EditBirthday.Text;
501 Contact.Fields[cfAnniversary] := EditAniversary.Text;
502 Contact.Fields[cfUrl] := EditWeb.Text;
503 Contact.Fields[cfGender] := EditGender.Text;
504 Contact.Fields[cfCategories] := EditCategories.Text;
505
506 FPhoto.Contact := Contact;
507 FPhoto.Save;
508
509 ReloadAllPropertiesTab;
510end;
511
512procedure TFormContact.TabSheetGeneralShow(Sender: TObject);
513begin
514 UpdateEditNoOnChange(EditFullName, Contact.Fields[cfFullName]);
515 EditNickName.Text := Contact.Fields[cfNickName];
516 EditEmail.Text := Contact.Fields[cfEmail];
517 EditPhone.Text := Contact.Fields[cfTel];
518 EditMobile.Text := Contact.Fields[cfTelCell];
519 EditFax.Text := Contact.Fields[cfTelFax];
520 EditPager.Text := Contact.Fields[cfTelPager];
521 EditBirthday.Text := Contact.Fields[cfDayOfBirth];
522 EditAniversary.Text := Contact.Fields[cfAnniversary];
523 EditWeb.Text := Contact.Fields[cfUrl];
524 EditGender.Text := Contact.Fields[cfGender];
525 EditCategories.Text := Contact.Fields[cfCategories];
526
527 FPhoto.Contact := Contact;
528 FPhoto.Load;
529end;
530
531procedure TFormContact.TabSheetHomeHide(Sender: TObject);
532begin
533 Contact.Fields[cfEmailHome] := EditHomeEmail.Text;
534 Contact.Fields[cfTelHome] := EditHomePhone.Text;
535 Contact.Fields[cfTelCellHome] := EditHomeMobile.Text;
536 Contact.Fields[cfTelFaxHome] := EditHomeFax.Text;
537 Contact.Fields[cfTelPagerHome] := EditHomePager.Text;
538 Contact.Fields[cfHomeAddressPostOfficeBox] := EditHomeAddressPostOfficeBox.Text;
539 Contact.Fields[cfHomeAddressStreet] := EditHomeAddressStreet.Text;
540 Contact.Fields[cfHomeAddressStreetExtended] := EditHomeAddressStreetExtended.Text;
541 Contact.Fields[cfHomeAddressCity] := EditHomeAddressCity.Text;
542 Contact.Fields[cfHomeAddressRegion] := EditHomeAddressRegion.Text;
543 Contact.Fields[cfHomeAddressCountry] := EditHomeAddressCountry.Text;
544 Contact.Fields[cfHomeAddressPostalCode] := EditHomeAddressPostalCode.Text;
545 Contact.Fields[cfUrlHome] := EditHomeWeb.Text;
546
547 ReloadAllPropertiesTab;
548end;
549
550procedure TFormContact.TabSheetHomeShow(Sender: TObject);
551begin
552 EditHomeEmail.Text := Contact.Fields[cfEmailHome];
553 EditHomePhone.Text := Contact.Fields[cfTelHome];
554 EditHomeMobile.Text := Contact.Fields[cfTelCellHome];
555 EditHomeFax.Text := Contact.Fields[cfTelFaxHome];
556 EditHomePager.Text := Contact.Fields[cfTelPagerHome];
557 EditHomeAddressPostOfficeBox.Text := Contact.Fields[cfHomeAddressPostOfficeBox];
558 EditHomeAddressStreet.Text := Contact.Fields[cfHomeAddressStreet];
559 EditHomeAddressStreetExtended.Text := Contact.Fields[cfHomeAddressStreetExtended];
560 EditHomeAddressCity.Text := Contact.Fields[cfHomeAddressCity];
561 EditHomeAddressRegion.Text := Contact.Fields[cfHomeAddressRegion];
562 EditHomeAddressCountry.Text := Contact.Fields[cfHomeAddressCountry];
563 EditHomeAddressPostalCode.Text := Contact.Fields[cfHomeAddressPostalCode];
564 EditHomeWeb.Text := Contact.Fields[cfUrlHome];
565end;
566
567procedure TFormContact.TabSheetOthersHide(Sender: TObject);
568begin
569 Contact.Fields[cfNote] := MemoNotes.Lines.Text;
570
571 ReloadAllPropertiesTab;
572end;
573
574procedure TFormContact.TabSheetOthersShow(Sender: TObject);
575var
576 ContactWithoutImages: TContact;
577begin
578 MemoNotes.Lines.Text := Contact.Fields[cfNote];
579 BarcodeQR1.Text := Contact.AsString;
580 if BarcodeQR1.ErrorString <> '' then begin
581 ContactWithoutImages := TContact.Create;
582 try
583 ContactWithoutImages.Assign(Contact);
584 ContactWithoutImages.ParentVCard := Contact.ParentVCard;
585 while ContactWithoutImages.HasField(cfPhoto) do
586 ContactWithoutImages.Fields[cfPhoto] := '';
587 while ContactWithoutImages.HasField(cfLogo) do
588 ContactWithoutImages.Fields[cfLogo] := '';
589 BarcodeQR1.Text := ContactWithoutImages.AsString;
590 if BarcodeQR1.ErrorString <> '' then begin
591 BarcodeQR1.Text := '';
592 BarcodeQR1.Visible := False;
593 end else BarcodeQR1.Visible := True;
594 finally
595 ContactWithoutImages.Free;
596 end;
597 end else BarcodeQR1.Visible := True;
598end;
599
600procedure TFormContact.TabSheetSocialHide(Sender: TObject);
601begin
602 Contact.Fields[cfFacebook] := EditFacebook.Text;
603 Contact.Fields[cfTwitter] := EditTwitter.Text;
604 Contact.Fields[cfInstagram] := EditInstagram.Text;
605 Contact.Fields[cfYouTube] := EditYouTube.Text;
606 Contact.Fields[cfPeerTube] := EditPeerTube.Text;
607 Contact.Fields[cfMastodon] := EditMastodon.Text;
608 Contact.Fields[cfLinkedIn] := EditLinkedIn.Text;
609 Contact.Fields[cfSnapchat] := EditSnapchat.Text;
610 Contact.Fields[cfReddit] := EditReddit.Text;
611 Contact.Fields[cfMySpace] := EditMySpace.Text;
612
613 ReloadAllPropertiesTab;
614end;
615
616procedure TFormContact.TabSheetSocialShow(Sender: TObject);
617begin
618 EditFacebook.Text := Contact.Fields[cfFacebook];
619 EditTwitter.Text := Contact.Fields[cfTwitter];
620 EditInstagram.Text := Contact.Fields[cfInstagram];
621 EditYouTube.Text := Contact.Fields[cfYouTube];
622 EditPeerTube.Text := Contact.Fields[cfPeerTube];
623 EditMastodon.Text := Contact.Fields[cfMastodon];
624 EditLinkedIn.Text := Contact.Fields[cfLinkedIn];
625 EditSnapchat.Text := Contact.Fields[cfSnapchat];
626 EditReddit.Text := Contact.Fields[cfReddit];
627 EditMySpace.Text := Contact.Fields[cfMySpace];
628end;
629
630procedure TFormContact.TabSheetWorkHide(Sender: TObject);
631begin
632 Contact.Fields[cfEmailWork] := EditWorkEmail.Text;
633 Contact.Fields[cfTelWork] := EditWorkPhone.Text;
634 Contact.Fields[cfTelCellWork] := EditWorkMobile.Text;
635 Contact.Fields[cfTelFaxWork] := EditWorkFax.Text;
636 Contact.Fields[cfTelPagerWork] := EditWorkPager.Text;
637 Contact.Fields[cfTitle] := EditTitle.Text;
638 Contact.Fields[cfOrganization] := EditOrganization.Text;
639 Contact.Fields[cfDepartment] := EditDepartment.Text;
640 Contact.Fields[cfWorkAddressPostOfficeBox] := EditWorkAddressPostOfficeBox.Text;
641 Contact.Fields[cfWorkAddressStreet] := EditWorkAddressStreet.Text;
642 Contact.Fields[cfWorkAddressStreetExtended] := EditWorkAddressStreetExtended.Text;
643 Contact.Fields[cfWorkAddressCity] := EditWorkAddressCity.Text;
644 Contact.Fields[cfWorkAddressRegion] := EditWorkAddressRegion.Text;
645 Contact.Fields[cfWorkAddressCountry] := EditWorkAddressCountry.Text;
646 Contact.Fields[cfWorkAddressPostalCode] := EditWorkAddressPostalCode.Text;
647 Contact.Fields[cfUrlWork] := EditWorkWeb.Text;
648
649 ReloadAllPropertiesTab;
650end;
651
652procedure TFormContact.TabSheetWorkShow(Sender: TObject);
653begin
654 EditWorkEmail.Text := Contact.Fields[cfEmailWork];
655 EditWorkPhone.Text := Contact.Fields[cfTelWork];
656 EditWorkMobile.Text := Contact.Fields[cfTelCellWork];
657 EditWorkFax.Text := Contact.Fields[cfTelFaxWork];
658 EditWorkPager.Text := Contact.Fields[cfTelPagerWork];
659 EditTitle.Text := Contact.Fields[cfTitle];
660 EditOrganization.Text := Contact.Fields[cfOrganization];
661 EditDepartment.Text := Contact.Fields[cfDepartment];
662 EditWorkAddressPostOfficeBox.Text := Contact.Fields[cfWorkAddressPostOfficeBox];
663 EditWorkAddressStreet.Text := Contact.Fields[cfWorkAddressStreet];
664 EditWorkAddressStreetExtended.Text := Contact.Fields[cfWorkAddressStreetExtended];
665 EditWorkAddressCity.Text := Contact.Fields[cfWorkAddressCity];
666 EditWorkAddressRegion.Text := Contact.Fields[cfWorkAddressRegion];
667 EditWorkAddressCountry.Text := Contact.Fields[cfWorkAddressCountry];
668 EditWorkAddressPostalCode.Text := Contact.Fields[cfWorkAddressPostalCode];
669 EditWorkWeb.Text := Contact.Fields[cfUrlWork];
670end;
671
672procedure TFormContact.PhotoChange(Sender: TObject);
673begin
674 if FPhoto.Used and (FPhoto.Url = '') then
675 ImagePhoto.Picture.Bitmap.Assign(FPhoto.Bitmap)
676 else ImagePhoto.Picture.Assign(Core.GetProfileImage.Picture);
677 UpdateInterface;
678end;
679
680procedure TFormContact.SetContact(AValue: TContact);
681begin
682 if FContact = AValue then Exit;
683 FContact := AValue;
684end;
685
686procedure TFormContact.ReloadAllPropertiesTab;
687begin
688 if TabSheetAll.Visible then begin
689 TabSheetAllShow(nil);
690 end;
691end;
692
693procedure TFormContact.FormClose(Sender: TObject; var CloseAction: TCloseAction
694 );
695begin
696 // Hide PageControl to fire TabSheet OnHide event on form close
697 PageControlContact.ActivePage.Hide;
698
699 Core.LastContactTabIndex := PageControlContact.TabIndex;
700 Core.PersistentForm1.Save(Self);
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.LastPhotoFileName);
712 OpenPictureDialog1.FileName := ExtractFileName(Core.LastPhotoFileName);
713 if OpenPictureDialog1.Execute then begin
714 FPhoto.LoadFromFile(OpenPictureDialog1.FileName);
715 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.LastPhotoFileName);
727 SavePictureDialog1.FileName := ExtractFileName(Core.LastPhotoFileName);
728 if SavePictureDialog1.Execute then begin
729 ImagePhoto.Picture.SaveToFile(SavePictureDialog1.FileName);
730 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.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.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 Core.Translator.TranslateComponentRecursive(Self);
843 Core.ThemeManager1.UseTheme(Self);
844 FContact := nil;
845 FormProperties := TFormProperties.Create(nil);
846 FPhoto := TContactImage.Create(nil);
847 FPhoto.FieldIndex := cfPhoto;
848 FPhoto.OnChange := PhotoChange;
849
850 // Set Barcode unpublished properties
851 BarcodeQR1.Anchors := [akTop, akLeft];
852 BarcodeQR1.PopupMenu := PopupMenuQrCode;
853
854 PageControlContact.TabIndex := Core.LastContactTabIndex;
855end;
856
857procedure TFormContact.FormDestroy(Sender: TObject);
858begin
859 FreeAndNil(FPhoto);
860 FreeAndNil(FormProperties);
861end;
862
863procedure TFormContact.UpdateInterface;
864var
865 Title: string;
866begin
867 Title := SContact;
868 if EditFullName.Text <> '' then Title := EditFullName.Text + ' - ' + Title
869 else
870 if EditOrganization.Text <> '' then Title := EditOrganization.Text + ' - ' + Title;
871 Caption := Title;
872 APhotoSave.Enabled := FPhoto.Used;
873 APhotoClear.Enabled := FPhoto.Used;
874 //ButtonNext.Enabled := Assigned(FOnGetNext) and Assigned(FOnGetNext(Contact));
875 //ButtonPrevious.Enabled := Assigned(FOnGetPrevious) and Assigned(FOnGetPrevious(Contact));
876end;
877
878end.
879
Note: See TracBrowser for help on using the repository browser.