TBCRoundedImage Changed class ancestor to TCustomBGRAGraphicControl; Added TBGRABitmap Bitmap draw; Added Stretch, Proportional, Alignments; Added Demo.

TBCRoundedImage Changed class ancestor to TCustomBGRAGraphicControl;
Added TBGRABitmap Bitmap draw;
Added Stretch, Proportional, Alignments;
Added Demo.

README.md

@@ -64,6 +64,12 @@ A label control that can be styled through properties, it supports shadow, custo
 
 Author: Dibo.
 
+### TBCRoundedImage
+
+A Image Viewer which can show a resized image (even proportionally) or not and with different alignments, it can read both from a TPicture and from a TBGRABitmap.
+
+Author: Lainz, Massimo Magnano.
+
 ### TBCMaterialDesignButton
 
 A button control that has an animation effect according to Google Material Design guidelines. It supports custom color for background and for the circle animation, also you can customize the shadow.

bcroundedimage.pas

@@ -9,6 +9,9 @@
   - 2020-09-06: Initial version supporting circle, rounded rectangle and square.
                 Changing the quality of the resample, setting the rounding.
                 OnPaintEvent to customize the final drawing.
+  - 2025-01: MaxM, Changed class ancestor to TCustomBGRAGraphicControl;
+                   Added TBGRABitmap Bitmap draw;
+                   Added Stretch, Proportional, Alignments.
 }
 unit BCRoundedImage;
 
@@ -18,13 +21,15 @@ interface
 
 uses
   Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
-  BGRABitmap, BGRABitmapTypes;
+  BGRABitmap, BGRABitmapTypes, BGRAGraphicControl, BCTypes;
 
 type
   TBCRoundedImage = class;
 
   // Event to draw before the image is sent to canvas
-  TBCRoundedImagePaintEvent = procedure (const Sender: TBCRoundedImage; const Bitmap: TBGRABitmap) of object;
+  //TBCRoundedImagePaintEvent = procedure (const Sender: TBCRoundedImage; const Bitmap: TBGRABitmap) of object;
+  TBCRoundedImagePaintEvent = TBGRARedrawEvent;
+
   // Supported styles are circle, rounded rectangle and square
   TBCRoundedImageStyle = (isCircle, isRoundedRectangle, isSquare);
 
@@ -32,24 +37,46 @@ type
 
   { TBCRoundedImage }
 
-  TBCRoundedImage = class(TGraphicControl)
+  TBCRoundedImage = class(TCustomBGRAGraphicControl)
   private
     FBorderStyle: TRoundRectangleOptions;
     FOnPaintEvent: TBCRoundedImagePaintEvent;
     FPicture: TPicture;
+    FImageBitmap: TBGRABitmap;
     FQuality: TResampleFilter;
     FStyle: TBCRoundedImageStyle;
     FRounding: single;
+    FProportional: Boolean;
+    FOnChange: TNotifyEvent;
+    FAlignment: TAlignment;
+    FStretch: Boolean;
+    FVerticalAlignment: TTextLayout;
+
+    function GetOnPaintEvent: TBCRoundedImagePaintEvent;
+    procedure SetAlignment(AValue: TAlignment);
+    procedure SetBitmap(AValue: TBGRABitmap);
     procedure SetBorderStyle(AValue: TRoundRectangleOptions);
+    procedure SetOnPaintEvent(AValue: TBCRoundedImagePaintEvent);
     procedure SetPicture(AValue: TPicture);
+    procedure SetProportional(AValue: Boolean);
     procedure SetQuality(AValue: TResampleFilter);
+    procedure SetStretch(AValue: Boolean);
     procedure SetStyle(AValue: TBCRoundedImageStyle);
     procedure SetRounding(AValue: single);
+    procedure SetVerticalAlignment(AValue: TTextLayout);
+
   protected
+    procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: boolean); override;
+
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     procedure Paint; override;
+
+    procedure Draw(ABitmap: TBGRABitmap);
+
+    property Bitmap: TBGRABitmap read FImageBitmap write setBitmap;
+
   published
     // The image that's used as background
     property Picture: TPicture read FPicture write SetPicture;
@@ -61,9 +88,19 @@ type
     property Rounding: single read FRounding write SetRounding;
     // The quality when resizing the image
     property Quality: TResampleFilter read FQuality write SetQuality;
+    // Stretch Proportianally
+    property Proportional: Boolean read FProportional write SetProportional;
+    property Stretch: Boolean read FStretch write SetStretch default True;
+
+    // Alignments of the Image inside the Control
+    property Alignment: TAlignment read FAlignment write SetAlignment default taCenter;
+    property VerticalAlignment: TTextLayout read FVerticalAlignment write SetVerticalAlignment default tlCenter;
+
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+
     // You can paint before the bitmap is drawn on canvas
-    property OnPaintEvent: TBCRoundedImagePaintEvent read FOnPaintEvent write FOnPaintEvent;
-  published
+    property OnPaintEvent: TBCRoundedImagePaintEvent read GetOnPaintEvent write SetOnPaintEvent; deprecated 'Use OnRedraw instead';
+
     property Anchors;
     property Align;
     property OnMouseEnter;
@@ -71,20 +108,65 @@ type
     property OnClick;
   end;
 
+
+{ #todo -oMaxM : we could move it to a common unit and use it in BGRAImageList too }
+function CalcProportionalRect(AWidth, AHeight, AImageWidth, AImageHeight: Integer;
+                               AHorizAlign: TAlignment; AVertAlign: TTextLayout): TRect;
+
+
 procedure Register;
 
 implementation
 
+function CalcProportionalRect(AWidth, AHeight, AImageWidth, AImageHeight: Integer; AHorizAlign: TAlignment;
+  AVertAlign: TTextLayout): TRect;
+var
+  rW, rH:Single;
+  newWidth,
+  newHeight:Integer;
+
+begin
+  FillChar(Result, sizeof(Result), 0);
+  if (AImageWidth > 0) and (AImageHeight > 0) then
+  begin
+    rW := AImageWidth / AWidth;
+    rH := AImageHeight / AHeight;
+
+    if (rW > rH)
+    then begin
+           newHeight:= round(AImageHeight / rW);
+           newWidth := AWidth;
+           end
+    else begin
+           newWidth := round(AImageWidth / rH);
+           newHeight := AHeight;
+         end;
+
+    case AHorizAlign of
+    taCenter: Result.Left:= (AWidth-newWidth) div 2;
+    taRightJustify: Result.Left:= AWidth-newWidth;
+    end;
+    case AVertAlign of
+    tlCenter: Result.Top:= (AHeight-newHeight) div 2;
+    tlBottom: Result.Top:= AHeight-newHeight;
+    end;
+
+    Result.Right:= Result.Left+newWidth;
+    Result.Bottom:= Result.Top+newHeight;
+  end;
+end;
+
 procedure Register;
 begin
   RegisterComponents('BGRA Controls', [TBCRoundedImage]);
 end;
 
-procedure TBCRoundedImage.SetPicture(AValue: TPicture);
+procedure TBCRoundedImage.SetProportional(AValue: Boolean);
 begin
-  if FPicture = AValue then
-    Exit;
-  FPicture := AValue;
+  if FProportional=AValue then Exit;
+  FProportional:=AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
   Invalidate;
 end;
 
@@ -92,14 +174,78 @@ procedure TBCRoundedImage.SetBorderStyle(AValue: TRoundRectangleOptions);
 begin
   if FBorderStyle=AValue then Exit;
   FBorderStyle:=AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
   Invalidate;
 end;
 
+function TBCRoundedImage.GetOnPaintEvent: TBCRoundedImagePaintEvent;
+begin
+  Result:= OnRedraw;
+end;
+
+procedure TBCRoundedImage.SetAlignment(AValue: TAlignment);
+begin
+  if FAlignment=AValue then Exit;
+  FAlignment:=AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBCRoundedImage.SetBitmap(AValue: TBGRABitmap);
+begin
+  if (AValue <> FImageBitmap) then
+  begin
+    // Clear actual image
+    FImageBitmap.Free;
+
+    FImageBitmap :=TBGRABitmap.Create(Width, Height, BGRAPixelTransparent);
+
+    if (AValue<>nil) then FImageBitmap.Assign(AValue, True); // Associate the new bitmap
+
+    if Assigned(FOnChange) then FOnChange(Self);
+    Invalidate;
+  end;
+end;
+
+procedure TBCRoundedImage.SetPicture(AValue: TPicture);
+begin
+  if (AValue <> FPicture) then
+  begin
+    // Clear actual Picture
+    FPicture.Free;
+
+    FPicture :=TPicture.Create;
+
+    if (AValue<>nil) then FPicture.Assign(AValue); // Associate the new Picture
+
+    if Assigned(FOnChange) then FOnChange(Self);
+    Invalidate;
+  end;
+end;
+
+procedure TBCRoundedImage.SetOnPaintEvent(AValue: TBCRoundedImagePaintEvent);
+begin
+  OnRedraw:= AValue;
+end;
+
 procedure TBCRoundedImage.SetQuality(AValue: TResampleFilter);
 begin
   if FQuality = AValue then
     Exit;
   FQuality := AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBCRoundedImage.SetStretch(AValue: Boolean);
+begin
+  if FStretch=AValue then Exit;
+  FStretch:=AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
   Invalidate;
 end;
 
@@ -108,6 +254,8 @@ begin
   if FStyle = AValue then
     Exit;
   FStyle := AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
   Invalidate;
 end;
 
@@ -116,53 +264,126 @@ begin
   if FRounding = AValue then
     Exit;
   FRounding := AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBCRoundedImage.SetVerticalAlignment(AValue: TTextLayout);
+begin
+  if FVerticalAlignment=AValue then Exit;
+  FVerticalAlignment:=AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
   Invalidate;
 end;
 
+{$hints off}
+procedure TBCRoundedImage.CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: boolean);
+begin
+  PreferredWidth  := 100;
+  PreferredHeight := 100;
+end;
+
 constructor TBCRoundedImage.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
+
+  FAlignment:= taCenter;
+  FVerticalAlignment:= tlCenter;
+  FStretch:= True;
+
+  // Create the Image Bitmap
   FPicture := TPicture.Create;
+  FImageBitmap := TBGRABitmap.Create;
+
   FRounding := 10;
   FQuality := rfBestQuality;
+  FBGRA.FillTransparent;
 end;
 
 destructor TBCRoundedImage.Destroy;
 begin
   FPicture.Free;
+  FImageBitmap.Free;
+
   inherited Destroy;
 end;
 
 procedure TBCRoundedImage.Paint;
+begin
+  if (ClientWidth <> FBGRA.Width) or (ClientHeight <> FBGRA.Height)
+  then FBGRA.SetSize(ClientWidth, ClientHeight);
+
+  Draw(FBGRA);
+
+  if Assigned(OnRedraw) then OnRedraw(Self, FBGRA);
+
+  FBGRA.Draw(Canvas, 0, 0, False);
+end;
+
+procedure TBCRoundedImage.Draw(ABitmap: TBGRABitmap);
 var
-  bgra: TBGRABitmap;
-  image: TBGRABitmap;
+  image,
+  imageD: TBGRABitmap;
+  imgRect: TRect;
+
 begin
-  if (FPicture.Width = 0) or (FPicture.Height = 0) then
-    Exit;
-  // Picture
-  image := TBGRABitmap.Create(FPicture.Bitmap);
-  bgra := TBGRABitmap.Create(Width, Height, BGRAPixelTransparent);
+  ABitmap.FillTransparent;
+
+  if ((FPicture.Width = 0) or (FPicture.Height = 0)) and
+      FImageBitmap.Empty then exit;
+
   try
-    // Quality
-    image.ResampleFilter := FQuality;
-    BGRAReplace(image, image.Resample(Width, Height));
+    if FImageBitmap.Empty
+    then image := TBGRABitmap.Create(FPicture.Bitmap)
+    else image := TBGRABitmap.Create(FImageBitmap.Bitmap);
+
+    imageD:= TBGRABitmap.Create(Width, Height, BGRAPixelTransparent);
+
+    if FProportional
+    then imgRect:= CalcProportionalRect(Width, Height, image.Width, image.Height,
+                                        FAlignment, FVerticalAlignment)
+    else begin
+           if FStretch
+           then imgRect:= Rect(0,0,Width,Height)
+           else begin
+                  case FAlignment of
+                  taLeftJustify: imgRect.Left:= 0;
+                  taCenter: imgRect.Left:= (Width-image.Width) div 2;
+                  taRightJustify: imgRect.Left:= Width-image.Width;
+                  end;
+                  case FVerticalAlignment of
+                  tlTop: imgRect.Top:= 0;
+                  tlCenter: imgRect.Top:= (Height-image.Height) div 2;
+                  tlBottom: imgRect.Top:= Height-image.Height;
+                  end;
+
+                  imgRect.Right:= imgRect.Left+image.Width;
+                  imgRect.Bottom:= imgRect.Top+image.Height;
+                end;
+         end;
+
+    if FStretch or FProportional then
+    begin
+      // Stretch with Quality
+      image.ResampleFilter := FQuality;
+      BGRAReplace(image, image.Resample(imgRect.Width, imgRect.Height));
+    end;
+
+    imageD.PutImage(imgRect.Left, imgRect.Top, image, dmDrawWithTransparency);
+
     // Style
     case FStyle of
-      isCircle: bgra.FillEllipseAntialias(Width div 2, Height div 2,
-          Width div 2, Height div 2, image);
-      // Rounding, BorderStyle
-      isRoundedRectangle: bgra.FillRoundRectAntialias(0, 0, Width,
-          Height, FRounding, FRounding, image, FBorderStyle);
-      else
-        bgra.PutImage(0, 0, image, dmDrawWithTransparency);
+    isCircle: ABitmap.FillEllipseAntialias(Width div 2, Height div 2,
+                          (Width div 2)-FRounding, (Height div 2)-FRounding, imageD);
+    isRoundedRectangle: ABitmap.FillRoundRectAntialias(0, 0, Width,
+                                    Height, FRounding, FRounding, imageD, FBorderStyle);
+    else ABitmap.PutImage(0, 0, imageD, dmDrawWithTransparency);
     end;
-    // OnPaintEvent
-    if Assigned(FOnPaintEvent) then
-      FOnPaintEvent(Self, bgra);
-    bgra.Draw(Canvas, 0, 0, False);
+
   finally
-    bgra.Free;
+    imageD.Free;
     image.Free;
   end;
 end;

test/test_bcroundedimage_pictdialogs/test_bcroundedimage_pictdialogs.lpi

@@ -0,0 +1,83 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="test_bcroundedimage_pictdialogs"/>
+      <Scaled Value="True"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
+      <Icon Value="0"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <RequiredPackages>
+      <Item>
+        <PackageName Value="bgracontrols"/>
+      </Item>
+      <Item>
+        <PackageName Value="LCL"/>
+      </Item>
+    </RequiredPackages>
+    <Units>
+      <Unit>
+        <Filename Value="test_bcroundedimage_pictdialogs.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="test_bcroundedimage_pictdialogs_main.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="test_bcroundedimage_pictdialogs"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf3"/>
+      </Debugging>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

test/test_bcroundedimage_pictdialogs/test_bcroundedimage_pictdialogs.lpr

@@ -0,0 +1,28 @@
+program test_bcroundedimage_pictdialogs;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}
+  cthreads,
+  {$ENDIF}
+  {$IFDEF HASAMIGA}
+  athreads,
+  {$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, test_bcroundedimage_pictdialogs_main
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource:=True;
+  Application.Scaled:=True;
+  {$PUSH}{$WARN 5044 OFF}
+  Application.MainFormOnTaskbar:=True;
+  {$POP}
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+

test/test_bcroundedimage_pictdialogs/test_bcroundedimage_pictdialogs_main.lfm

@@ -0,0 +1,193 @@
+object Form1: TForm1
+  Left = 297
+  Height = 315
+  Top = 250
+  Width = 500
+  Caption = 'Form1'
+  ClientHeight = 315
+  ClientWidth = 500
+  object rgStyle: TRadioGroup
+    Left = 320
+    Height = 66
+    Top = 136
+    Width = 137
+    AutoFill = True
+    Caption = 'Style'
+    ChildSizing.LeftRightSpacing = 6
+    ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+    ChildSizing.EnlargeVertical = crsHomogenousChildResize
+    ChildSizing.ShrinkHorizontal = crsScaleChilds
+    ChildSizing.ShrinkVertical = crsScaleChilds
+    ChildSizing.Layout = cclLeftToRightThenTopToBottom
+    ChildSizing.ControlsPerLine = 1
+    ClientHeight = 46
+    ClientWidth = 133
+    ItemIndex = 2
+    Items.Strings = (
+      'Circle'
+      'Rounded Rectangle'
+      'Square'
+    )
+    ParentBackground = False
+    TabOrder = 0
+    OnClick = rgStyleClick
+  end
+  object Label1: TLabel
+    Left = 320
+    Height = 15
+    Top = 211
+    Width = 55
+    Caption = 'Rounding:'
+  end
+  object edRounding: TFloatSpinEdit
+    Left = 384
+    Height = 23
+    Top = 208
+    Width = 50
+    MaxValue = 100
+    TabOrder = 1
+    Value = 10
+    OnChange = edRoundingChange
+  end
+  object btLoad: TButton
+    Left = 320
+    Height = 25
+    Top = 240
+    Width = 75
+    Caption = 'Load (BGRA)'
+    TabOrder = 2
+    OnClick = btLoadClick
+  end
+  object cbProportional: TCheckBox
+    Left = 320
+    Height = 19
+    Top = 32
+    Width = 84
+    Caption = 'Proportional'
+    TabOrder = 3
+    OnChange = cbProportionalChange
+  end
+  object Panel1: TPanel
+    Left = 8
+    Height = 302
+    Top = 8
+    Width = 302
+    ClientHeight = 302
+    ClientWidth = 302
+    TabOrder = 4
+    object BCRoundedImage1: TBCRoundedImage
+      Left = 0
+      Height = 300
+      Top = 0
+      Width = 300
+      Style = isSquare
+      BorderStyle = []
+      Rounding = 10
+      Quality = rfLinear
+      OnPaintEvent = BCRoundedImage1PaintEvent
+    end
+  end
+  object rgAlign: TRadioGroup
+    Left = 320
+    Height = 65
+    Top = 56
+    Width = 79
+    AutoFill = True
+    Caption = 'Align'
+    ChildSizing.LeftRightSpacing = 6
+    ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+    ChildSizing.EnlargeVertical = crsHomogenousChildResize
+    ChildSizing.ShrinkHorizontal = crsScaleChilds
+    ChildSizing.ShrinkVertical = crsScaleChilds
+    ChildSizing.Layout = cclLeftToRightThenTopToBottom
+    ChildSizing.ControlsPerLine = 1
+    ClientHeight = 45
+    ClientWidth = 75
+    ItemIndex = 2
+    Items.Strings = (
+      'Left'
+      'Right'
+      'Center'
+    )
+    TabOrder = 5
+    OnClick = rgAlignClick
+  end
+  object rgAlignV: TRadioGroup
+    Left = 400
+    Height = 65
+    Top = 56
+    Width = 79
+    AutoFill = True
+    Caption = 'Align Vert'
+    ChildSizing.LeftRightSpacing = 6
+    ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+    ChildSizing.EnlargeVertical = crsHomogenousChildResize
+    ChildSizing.ShrinkHorizontal = crsScaleChilds
+    ChildSizing.ShrinkVertical = crsScaleChilds
+    ChildSizing.Layout = cclLeftToRightThenTopToBottom
+    ChildSizing.ControlsPerLine = 1
+    ClientHeight = 45
+    ClientWidth = 75
+    ItemIndex = 1
+    Items.Strings = (
+      'Top'
+      'Center'
+      'Bottom'
+    )
+    TabOrder = 6
+    OnClick = rgAlignVClick
+  end
+  object cbStretch: TCheckBox
+    Left = 320
+    Height = 19
+    Top = 8
+    Width = 55
+    Caption = 'Stretch'
+    Checked = True
+    State = cbChecked
+    TabOrder = 7
+    OnChange = cbStretchChange
+  end
+  object btLoadT: TButton
+    Left = 400
+    Height = 25
+    Top = 240
+    Width = 88
+    Caption = 'Load (TPicture)'
+    TabOrder = 8
+    OnClick = btLoadTClick
+  end
+  object btLoad2: TButton
+    Left = 320
+    Height = 25
+    Top = 269
+    Width = 75
+    Caption = 'Save (BGRA)'
+    TabOrder = 9
+    OnClick = btLoadClick
+  end
+  object btLoad3: TButton
+    Left = 400
+    Height = 25
+    Top = 269
+    Width = 88
+    Caption = 'Save (TPicture)'
+    TabOrder = 10
+    OnClick = btLoadClick
+  end
+  object lbDetails: TLabel
+    Left = 320
+    Height = 15
+    Top = 296
+    Width = 36
+    Caption = 'image:'
+  end
+  object openPict: TOpenPictureDialog
+    Left = 472
+    Top = 48
+  end
+  object savePict: TSavePictureDialog
+    Left = 472
+    Top = 99
+  end
+end

test/test_bcroundedimage_pictdialogs/test_bcroundedimage_pictdialogs_main.pas

@@ -0,0 +1,114 @@
+unit test_bcroundedimage_pictdialogs_main;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Spin, StdCtrls, ExtDlgs,
+  BCRoundedImage, BGRABitmap;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    BCRoundedImage1: TBCRoundedImage;
+    btLoad: TButton;
+    btLoadT: TButton;
+    btLoad2: TButton;
+    btLoad3: TButton;
+    cbProportional: TCheckBox;
+    cbStretch: TCheckBox;
+    edRounding: TFloatSpinEdit;
+    Label1: TLabel;
+    lbDetails: TLabel;
+    openPict: TOpenPictureDialog;
+    Panel1: TPanel;
+    rgAlign: TRadioGroup;
+    rgAlignV: TRadioGroup;
+    rgStyle: TRadioGroup;
+    savePict: TSavePictureDialog;
+    procedure BCRoundedImage1PaintEvent(const Sender: TBCRoundedImage; const Bitmap: TBGRABitmap);
+    procedure btLoadClick(Sender: TObject);
+    procedure btLoadTClick(Sender: TObject);
+    procedure cbProportionalChange(Sender: TObject);
+    procedure cbStretchChange(Sender: TObject);
+    procedure edRoundingChange(Sender: TObject);
+    procedure rgAlignClick(Sender: TObject);
+    procedure rgAlignVClick(Sender: TObject);
+    procedure rgStyleClick(Sender: TObject);
+  private
+
+  public
+
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+{ TForm1 }
+
+procedure TForm1.BCRoundedImage1PaintEvent(const Sender: TBCRoundedImage; const Bitmap: TBGRABitmap);
+begin
+  //
+end;
+
+procedure TForm1.btLoadClick(Sender: TObject);
+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);
+  end;
+end;
+
+procedure TForm1.btLoadTClick(Sender: TObject);
+begin
+  if openPict.Execute then
+  begin
+    BCRoundedImage1.Bitmap:= nil;
+    BCRoundedImage1.Picture.LoadFromFile(openPict.FileName); //'c:\tmp\Acquisitions Book 1.03.01, Byzantine.jpg'
+    BCRoundedImage1.Invalidate;
+    lbDetails.Caption:= 'image: PICT '+IntToStr(BCRoundedImage1.Picture.Width)+' x '+IntToStr(BCRoundedImage1.Picture.Height);
+  end;
+end;
+
+procedure TForm1.cbProportionalChange(Sender: TObject);
+begin
+  BCRoundedImage1.Proportional:= cbProportional.Checked;
+end;
+
+procedure TForm1.cbStretchChange(Sender: TObject);
+begin
+  BCRoundedImage1.Stretch:= cbStretch.Checked;
+end;
+
+procedure TForm1.edRoundingChange(Sender: TObject);
+begin
+  BCRoundedImage1.Rounding:= edRounding.Value;
+end;
+
+procedure TForm1.rgAlignClick(Sender: TObject);
+begin
+  BCRoundedImage1.Alignment:= TAlignment(rgAlign.ItemIndex);
+end;
+
+procedure TForm1.rgAlignVClick(Sender: TObject);
+begin
+  BCRoundedImage1.VerticalAlignment:= TTextLayout(rgAlignV.ItemIndex);
+end;
+
+procedure TForm1.rgStyleClick(Sender: TObject);
+begin
+  BCRoundedImage1.Style:= TBCRoundedImageStyle(rgStyle.ItemIndex);
+end;
+
+end.
+