Added BGRADialogs Unit; Added Icon to TBCRoundedImage

bgracontrols.lpk

@@ -34,7 +34,7 @@
     <Description Value="BGRA Controls is a set of graphical UI elements that you can use with Lazarus LCL applications."/>
     <License Value="Modified LGPL"/>
     <Version Major="9" Release="1" Build="6"/>
-    <Files Count="80">
+    <Files Count="81">
       <Item1>
         <Filename Value="atshapelinebgra.pas"/>
         <HasRegisterProc Value="True"/>
@@ -426,6 +426,11 @@
         <Filename Value="supergaugecommon.pas"/>
         <UnitName Value="supergaugecommon"/>
       </Item80>
+      <Item81>
+        <Filename Value="bgradialogs.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="BGRADialogs"/>
+      </Item81>
     </Files>
     <CompatibilityMode Value="True"/>
     <LazDoc Paths="fpdoc"/>

bgracontrols.pas

@@ -18,7 +18,7 @@ uses
   BGRAThemeButton, BGRAThemeCheckBox, BGRAThemeRadioButton, BGRAVirtualScreen, ColorSpeedButton, DTAnalogClock, 
   DTAnalogCommon, DTAnalogGauge, dtthemedclock, dtthemedgauge, MaterialColors, bgrasvgimagelistform, BCLeaLCDDisplay, 
   BCLeaLED, BCLeaQLED, BCLeaRingSlider, BCLeaSelector, BCLeaTheme, BCLeaLCDDisplay_EditorRegister, BCLeaBoard, 
-  BCLeaEngrave, supergauge, supergaugecommon, LazarusPackageIntf;
+  BCLeaEngrave, supergauge, supergaugecommon, BGRADialogs, LazarusPackageIntf;
 
 implementation
 
@@ -85,6 +85,7 @@ begin
   RegisterUnit('BCLeaBoard', @BCLeaBoard.Register);
   RegisterUnit('BCLeaEngrave', @BCLeaEngrave.Register);
   RegisterUnit('supergauge', @supergauge.Register);
+  RegisterUnit('BGRADialogs', @BGRADialogs.Register);
 end;
 
 initialization

bgradialogs.pas

@@ -0,0 +1,267 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+{
+  Additional dialogs to take advantage of our controls
+}
+unit BGRADialogs;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, ExtDlgs, Controls, StdCtrls, BGRABitmapTypes, BCRoundedImage;
+
+type
+  TBGRAOpenPictureDialog = class(TPreviewFileDialog)
+   private
+    FDefaultFilter: string;
+    FImageCtrl: TBCRoundedImage;
+    FPictureGroupBox: TGroupBox;
+    FPreviewFilename: string;
+  protected
+    class procedure WSRegisterClass; override;
+    function  IsFilterStored: Boolean; virtual;
+    property ImageCtrl: TBCRoundedImage read FImageCtrl;
+    property PictureGroupBox: TGroupBox read FPictureGroupBox;
+    procedure InitPreviewControl; override;
+    procedure ClearPreview; virtual;
+    procedure UpdatePreview; virtual;
+  public
+    constructor Create(TheOwner: TComponent); override;
+    procedure DoClose; override;
+    procedure DoSelectionChange; override;
+    procedure DoShow; override;
+    function GetFilterExt: String;
+    property DefaultFilter: string read FDefaultFilter;
+  published
+    property Filter stored IsFilterStored;
+  end;
+
+  { TSavePictureDialog }
+
+  TBGRASavePictureDialog = class(TBGRAOpenPictureDialog)
+  protected
+    class procedure WSRegisterClass; override;
+    function DefaultTitle: string; override;
+  public
+    constructor Create(TheOwner: TComponent); override;
+  end;
+
+
+//Functions to Get Filters String useful in Dialogs
+function GetBGRAFormatFilter(AFormat: TBGRAImageFormat): String;
+procedure BuildBGRAFilterStrings(AUseReaders: Boolean; var Descriptions, Filters: String);
+function BuildBGRAImageReaderFilter: String;
+function BuildBGRAImageWriterFilter: String;
+
+procedure Register;
+
+implementation
+
+uses WSExtDlgs, Masks, FileUtil, LazFileUtils, LCLStrConsts, LCLType;
+
+function GetBGRAFormatFilter(AFormat: TBGRAImageFormat): String;
+begin
+  Result := StringReplace('*.' + DefaultBGRAImageTypeExts[AFormat], ';', ';*.', [rfReplaceAll]);
+end;
+
+procedure BuildBGRAFilterStrings(AUseReaders: Boolean; var Descriptions, Filters: String);
+var
+  iFormat: TBGRAImageFormat;
+  Filter: String;
+  addExt: Boolean;
+
+begin
+  Descriptions := '';
+  Filters := '';
+
+  for iFormat:=Low(TBGRAImageFormat) to High(TBGRAImageFormat) do
+  begin
+    if AUseReaders
+    then addExt:= (iFormat<>ifUnknown) and (DefaultBGRAImageReader[iFormat] <> nil)
+    else addExt:= (iFormat<>ifUnknown) and (DefaultBGRAImageWriter[iFormat] <> nil);
+
+    if addExt then
+    begin
+      if (iFormat>ifJpeg) then
+      begin
+        Descriptions := Descriptions + '|';
+        Filters := Filters + ';';
+      end;
+
+      Filter := GetBGRAFormatFilter(iFormat);
+      FmtStr(Descriptions, '%s%s (%s)|%s',
+            [Descriptions, DefaultBGRAImageTypeNames[iFormat], Filter, Filter]);
+      FmtStr(Filters, '%s%s', [Filters, Filter]);
+    end;
+  end;
+
+  FmtStr(Descriptions, '%s (%s)|%1:s|%s', [rsGraphic, Filters, Descriptions]);
+end;
+
+
+function BuildBGRAImageReaderFilter: String;
+var
+  Filters: string;
+
+begin
+  Result := '';
+  BuildBGRAFilterStrings(True, Result, Filters);
+end;
+
+function BuildBGRAImageWriterFilter: String;
+var
+  Filters: string;
+
+begin
+  Result := '';
+  BuildBGRAFilterStrings(False, Result, Filters);
+end;
+
+{ TBGRAOpenPictureDialog }
+
+class procedure TBGRAOpenPictureDialog.WSRegisterClass;
+begin
+  inherited WSRegisterClass;
+  RegisterOpenPictureDialog;
+end;
+
+function TBGRAOpenPictureDialog.IsFilterStored: Boolean;
+begin
+  Result := (Filter<>FDefaultFilter);
+end;
+
+procedure TBGRAOpenPictureDialog.DoClose;
+begin
+  ClearPreview;
+  inherited DoClose;
+end;
+
+procedure TBGRAOpenPictureDialog.DoSelectionChange;
+begin
+  UpdatePreview;
+  inherited DoSelectionChange;
+end;
+
+procedure TBGRAOpenPictureDialog.DoShow;
+begin
+  ClearPreview;
+  inherited DoShow;
+end;
+
+procedure TBGRAOpenPictureDialog.InitPreviewControl;
+begin
+  inherited InitPreviewControl;
+  FPictureGroupBox.Parent:=PreviewFileControl;
+end;
+
+procedure TBGRAOpenPictureDialog.ClearPreview;
+begin
+  FPictureGroupBox.Caption:='None';
+  FImageCtrl.Bitmap:=nil;
+end;
+
+procedure TBGRAOpenPictureDialog.UpdatePreview;
+var
+  CurFilename: String;
+  FileIsValid: boolean;
+begin
+  CurFilename := FileName;
+  if CurFilename = FPreviewFilename then exit;
+
+  FPreviewFilename := CurFilename;
+  FileIsValid := FileExistsUTF8(FPreviewFilename)
+                 and (not DirPathExists(FPreviewFilename))
+                 and FileIsReadable(FPreviewFilename);
+  if FileIsValid then
+    try
+      FImageCtrl.Bitmap.LoadFromFile(FPreviewFilename);
+      FImageCtrl.Invalidate; { #todo -oMaxM : an event in TBGRBitmap might be useful }
+      FPictureGroupBox.Caption := Format('(%dx%d)',
+        [FImageCtrl.Picture.Width, FImageCtrl.Picture.Height]);
+    except
+      FileIsValid := False;
+    end;
+  if not FileIsValid then
+    ClearPreview;
+end;
+
+constructor TBGRAOpenPictureDialog.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  FDefaultFilter := BuildBGRAImageReaderFilter+'|'+
+                    Format(rsAllFiles,[GetAllFilesMask, GetAllFilesMask,'']);
+  Filter:=FDefaultFilter;
+
+  FPictureGroupBox:=TGroupBox.Create(Self);
+  with FPictureGroupBox do begin
+    Name:='FPictureGroupBox';
+    Align:=alClient;
+  end;
+
+  FImageCtrl:=TBCRoundedImage.Create(Self);
+  with FImageCtrl do begin
+    Name:='FImageCtrl';
+    Parent:=FPictureGroupBox;
+    Align:=alClient;
+    Style:=isSquare;
+    Proportional:=true;
+  end;
+end;
+
+function TBGRAOpenPictureDialog.GetFilterExt: String;
+var
+  ParsedFilter: TParseStringList;
+begin
+  Result := '';
+
+  ParsedFilter := TParseStringList.Create(Filter, '|');
+  try
+    if (FilterIndex > 0) and (FilterIndex * 2 <= ParsedFilter.Count) then
+    begin
+      Result := AnsiLowerCase(ParsedFilter[FilterIndex * 2 - 1]);
+      // remove *.*
+      if (Result <> '') and (Result[1] = '*') then Delete(Result, 1, 1);
+      if (Result <> '') and (Result[1] = '.') then Delete(Result, 1, 1);
+      if (Result <> '') and (Result[1] = '*') then Delete(Result, 1, 1);
+      // remove all after ;
+      if Pos(';', Result) > 0 then Delete(Result, Pos(';', Result), MaxInt);
+    end;
+
+    if Result = '' then Result := DefaultExt;
+  finally
+    ParsedFilter.Free;
+  end;
+end;
+
+{ TSavePictureDialog }
+
+class procedure TBGRASavePictureDialog.WSRegisterClass;
+begin
+  inherited WSRegisterClass;
+  RegisterSavePictureDialog;
+end;
+
+function TBGRASavePictureDialog.DefaultTitle: string;
+begin
+  Result := rsfdFileSaveAs;
+end;
+
+constructor TBGRASavePictureDialog.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  FDefaultFilter := BuildBGRAImageWriterFilter+'|'+
+                    Format(rsAllFiles,[GetAllFilesMask, GetAllFilesMask,'']);
+  Filter:=FDefaultFilter;
+
+  fCompStyle:=csSaveFileDialog;
+end;
+
+procedure Register;
+begin
+  RegisterComponents('BGRA Dialogs',[TBGRAOpenPictureDialog, TBGRASavePictureDialog]);
+end;
+
+
+end.
+

images/bgracontrols_images_list.txt

@@ -137,3 +137,12 @@ TBCLeaEngrave_200.png
 tsupergauge.png
 tsupergauge_150.png
 tsupergauge_200.png
+tbcroundedimage.png
+tbcroundedimage_150.png
+tbcroundedimage_200.png
+tbgraopenpicturedialog.png
+tbgraopenpicturedialog_150.png
+tbgraopenpicturedialog_200.png
+tbgrasavepicturedialog.png
+tbgrasavepicturedialog_150.png
+tbgrasavepicturedialog_200.png

test/test_bcroundedimage_pictdialogs/test_bcroundedimage_pictdialogs_main.lfm

@@ -84,6 +84,7 @@ object Form1: TForm1
       BorderStyle = []
       Rounding = 10
       Quality = rfLinear
+      Proportional = False
       OnPaintEvent = BCRoundedImage1PaintEvent
     end
   end
@@ -182,6 +183,15 @@ object Form1: TForm1
     Width = 36
     Caption = 'image:'
   end
+  object Button1: TButton
+    Left = 448
+    Height = 25
+    Top = 208
+    Width = 40
+    Caption = 'test'
+    TabOrder = 11
+    OnClick = Button1Click
+  end
   object openPict: TOpenPictureDialog
     Left = 472
     Top = 48

test/test_bcroundedimage_pictdialogs/test_bcroundedimage_pictdialogs_main.pas

@@ -6,7 +6,7 @@ interface
 
 uses
   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Spin, StdCtrls, ExtDlgs,
-  BCRoundedImage, BGRABitmap;
+  BCRoundedImage, BGRABitmap, BGRADialogs, BGRABitmapTypes;
 
 type
 
@@ -18,6 +18,7 @@ type
     btLoadT: TButton;
     btLoad2: TButton;
     btLoad3: TButton;
+    Button1: TButton;
     cbProportional: TCheckBox;
     cbStretch: TCheckBox;
     edRounding: TFloatSpinEdit;
@@ -32,6 +33,7 @@ type
     procedure BCRoundedImage1PaintEvent(const Sender: TBCRoundedImage; const Bitmap: TBGRABitmap);
     procedure btLoadClick(Sender: TObject);
     procedure btLoadTClick(Sender: TObject);
+    procedure Button1Click(Sender: TObject);
     procedure cbProportionalChange(Sender: TObject);
     procedure cbStretchChange(Sender: TObject);
     procedure edRoundingChange(Sender: TObject);
@@ -59,13 +61,22 @@ begin
 end;
 
 procedure TForm1.btLoadClick(Sender: TObject);
+var
+   openPictBGRA: TBGRAOpenPictureDialog;
+
 begin
-  if openPict.Execute then
-  begin
-    BCRoundedImage1.Picture:= nil;
-    BCRoundedImage1.Bitmap.LoadFromFile(openPict.FileName); //'c:\tmp\Acquisitions Book 1.03.01, Byzantine.jpg'
-    BCRoundedImage1.Invalidate;
-    lbDetails.Caption:= 'image: BGRA '+IntToStr(BCRoundedImage1.Bitmap.Width)+' x '+IntToStr(BCRoundedImage1.Bitmap.Height);
+  try
+     openPictBGRA:= TBGRAOpenPictureDialog.Create(Self);
+     if openPictBGRA.Execute then
+     begin
+       BCRoundedImage1.Picture:= nil;
+       BCRoundedImage1.Bitmap.LoadFromFile(openPictBGRA.FileName); //'c:\tmp\Acquisitions Book 1.03.01, Byzantine.jpg'
+       BCRoundedImage1.Invalidate;
+       lbDetails.Caption:= 'image: BGRA '+IntToStr(BCRoundedImage1.Bitmap.Width)+' x '+IntToStr(BCRoundedImage1.Bitmap.Height);
+     end;
+
+  finally
+    openPictBGRA.Free;
   end;
 end;
 
@@ -80,6 +91,14 @@ begin
   end;
 end;
 
+procedure TForm1.Button1Click(Sender: TObject);
+var
+   t, t2: String;
+
+begin
+  BuildBGRAFilterStrings(True, t, t2);
+end;
+
 procedure TForm1.cbProportionalChange(Sender: TObject);
 begin
   BCRoundedImage1.Proportional:= cbProportional.Checked;