Changeset 123 for trunk/Forms/UFormContact.pas

Timestamp:

Mar 16, 2022, 11:35:08 AM (3 years ago)

Author:

chronos

Message:

• Added: QR code image visible in contact others tab. It can be saved as image to file.

File:

• trunk/Forms/UFormContact.pas (modified) (12 diffs)

trunk/Forms/UFormContact.pas

@@ -8 +8 @@
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
   ComCtrls, ActnList, Menus, ExtCtrls, ExtDlgs, Buttons, UContact, LCLIntf,
-  UFormProperties, DateUtils{$IFDEF LCLGTK2}, Gtk2Globals{$ENDIF}, UContactImage;
+  UFormProperties, DateUtils, Gtk2Globals, UContactImage, ubarcodes;
 
 type
@@ -21 +21 @@
     APhotoLoad: TAction;
     ActionList1: TActionList;
+    BarcodeQR1: TBarcodeQR;
     ButtonCancel: TButton;
     ButtonHomeAddressShow: TButton;
@@ -96 +97 @@
     GroupBox2: TGroupBox;
     ImagePhoto: TImage;
+    Label1: TLabel;
     Label10: TLabel;
     Label11: TLabel;
@@ -167 +169 @@
     MenuItem4: TMenuItem;
     MenuItem5: TMenuItem;
+    MenuItemSaveQrToFile: TMenuItem;
     OpenPictureDialog1: TOpenPictureDialog;
     PageControlContact: TPageControl;
+    PopupMenuQrCode: TPopupMenu;
     PopupMenuPhoto: TPopupMenu;
     SavePictureDialog1: TSavePictureDialog;
@@ -202 +206 @@
     procedure FormShow(Sender: TObject);
     procedure ImagePhotoClick(Sender: TObject);
+    procedure MenuItemSaveQrToFileClick(Sender: TObject);
     procedure SpeedButtonHomeWebClick(Sender: TObject);
     procedure SpeedButtonAniversaryClick(Sender: TObject);
@@ -249 +254 @@
 
 uses
-  UCore, UCommon, UFormImage, UFormNameDetails;
+  UCore, UCommon, UFormImage, UFormNameDetails, UDataFile;
 
 resourcestring
@@ -255 +260 @@
   SPhotoUrl = 'Photo URL';
   SPhotoUrlQuery = 'Enter URL for profile photo';
+  SImageTypeNotSupported = 'Image type not supported.';
 
 function DateToISO(Date: TDateTime): string;
@@ -341 +347 @@
 end;
 
+procedure TFormContact.MenuItemSaveQrToFileClick(Sender: TObject);
+var
+  F: string;
+begin
+  SavePictureDialog1.Filter := 'Windows bitmap files (*.bmp)|*.bmp|' +
+   'Portable network graphic files (*.png)|*.png|' +
+   'JPEG image files (*.jpg;*.jpeg)|*.jpg;*.jpeg|' +
+   'TIFF image files (*.tiff; *.tif)|*.tiff;*.tif|'+
+   'XPM image files (*.xpm)|*.xpm|' +
+   'Scalable vector graphics files (*.svg)|*.svg|'+
+   'Encapsulated PostScript files (*.eps;*.ps)|*.eps;*.ps|'+
+   SAllFiles + ' (*.*)|*.*';
+  SavePictureDialog1.FilterIndex := 2;
+  SavePictureDialog1.DefaultExt := '.png';
+  if Core.LastQrCodeFileName = '' then
+    Core.LastQrCodeFileName := 'QR code.png';
+  SavePictureDialog1.InitialDir := ExtractFileDir(Core.LastQrCodeFileName);
+  SavePictureDialog1.FileName := ExtractFileName(Core.LastQrCodeFileName);
+  if SavePictureDialog1.Execute then begin
+    F := LowerCase(ExtractFileExt(SavePictureDialog1.FileName));
+    if F = '.bmp' then BarcodeQR1.SaveToFile(SavePictureDialog1.FileName, TBitmap)
+    else if F = '.png' then BarcodeQR1.SaveToFile(SavePictureDialog1.FileName, TPortableNetworkGraphic)
+    else if (F = '.jpg') or (F = '.jpeg') then BarcodeQR1.SaveTofile(SavePictureDialog1.FileName, TJpegImage)
+    else if (F = '.tif') or (F = '.tiff') then BarcodeQR1.SaveToFile(SavePictureDialog1.FileName, TTiffImage)
+    else if F = '.xpm' then BarcodeQR1.SaveToFile(SavePictureDialog1.FileName, TPixmap)
+    else if F = '.svg' then BarcodeQR1.SaveToSvgFile(SavePictureDialog1.FileName)
+    else if (F = '.eps') or (F = '.ps') then BarcodeQR1.SaveToEpsFile(SavePictureDialog1.FileName)
+    else raise Exception.Create(SImageTypeNotSupported);
+    Core.LastQrCodeFileName := SavePictureDialog1.FileName;
+  end;
+end;
+
 procedure TFormContact.SpeedButtonHomeWebClick(Sender: TObject);
 begin
@@ -528 +566 @@
 begin
   MemoNotes.Lines.Text := Contact.Fields[cfNote];
+  BarcodeQR1.Text := Contact.AsString;
 end;
 
@@ -641 +680 @@
 procedure TFormContact.APhotoLoadExecute(Sender: TObject);
 begin
-  OpenPictureDialog1.FileName := Core.LastPhotoFileName;
+  OpenPictureDialog1.InitialDir := ExtractFileDir(Core.LastPhotoFileName);
+  OpenPictureDialog1.FileName := ExtractFileName(Core.LastPhotoFileName);
   if OpenPictureDialog1.Execute then begin
     FPhoto.LoadFromFile(OpenPictureDialog1.FileName);
@@ -655 +695 @@
 procedure TFormContact.APhotoSaveExecute(Sender: TObject);
 begin
-  SavePictureDialog1.FileName := Core.LastPhotoFileName;
+  SavePictureDialog1.InitialDir := ExtractFileDir(Core.LastPhotoFileName);
+  SavePictureDialog1.FileName := ExtractFileName(Core.LastPhotoFileName);
   if SavePictureDialog1.Execute then begin
     ImagePhoto.Picture.SaveToFile(SavePictureDialog1.FileName);
@@ -777 +818 @@
   FPhoto.FieldIndex := cfPhoto;
   FPhoto.OnChange := PhotoChange;
+
+  // Set Barcode unpublished properties
+  BarcodeQR1.Anchors := [akTop, akRight];
+  BarcodeQR1.PopupMenu := PopupMenuQrCode;
 end;