Added BCRoundedImage

bcroundedimage.pas

@@ -0,0 +1,169 @@
+{
+  BCRoundedImage
+  by Lainz
+
+  Last modified: 2020-09-06 19:16 GMT-3
+
+  Changelog:
+  - 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.
+}
+unit BCRoundedImage;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
+  BGRABitmap, BGRABitmapTypes;
+
+type
+  TBCRoundedImage = class;
+
+  // Event to draw before the image is sent to canvas
+  TBCRoundedImagePaintEvent = procedure (const Sender: TBCRoundedImage; const Bitmap: TBGRABitmap) of object;
+  // Supported styles are circle, rounded rectangle and square
+  TBCRoundedImageStyle = (isCircle, isRoundedRectangle, isSquare);
+
+  // Control that draws an image within a rounded border
+
+  { TBCRoundedImage }
+
+  TBCRoundedImage = class(TGraphicControl)
+  private
+    FBorderStyle: TRoundRectangleOptions;
+    FOnPaintEvent: TBCRoundedImagePaintEvent;
+    FPicture: TPicture;
+    FQuality: TResampleFilter;
+    FStyle: TBCRoundedImageStyle;
+    FRounding: single;
+    procedure SetBorderStyle(AValue: TRoundRectangleOptions);
+    procedure SetPicture(AValue: TPicture);
+    procedure SetQuality(AValue: TResampleFilter);
+    procedure SetStyle(AValue: TBCRoundedImageStyle);
+    procedure SetRounding(AValue: single);
+  protected
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure Paint; override;
+  published
+    // The image that's used as background
+    property Picture: TPicture read FPicture write SetPicture;
+    // The style can be circle, rounded rectangle or square
+    property Style: TBCRoundedImageStyle read FStyle write SetStyle;
+    // The style of the rounded rectangle
+    property BorderStyle: TRoundRectangleOptions read FBorderStyle write SetBorderStyle;
+    // Rounding is used when you choose the rounded rectangle style
+    property Rounding: single read FRounding write SetRounding;
+    // The quality when resizing the image
+    property Quality: TResampleFilter read FQuality write SetQuality;
+    // You can paint before the bitmap is drawn on canvas
+    property OnPaintEvent: TBCRoundedImagePaintEvent read FOnPaintEvent write FOnPaintEvent;
+  published
+    property Anchors;
+    property Align;
+    property OnMouseEnter;
+    property OnMouseLeave;
+    property OnClick;
+  end;
+
+procedure Register;
+
+implementation
+
+procedure Register;
+begin
+  RegisterComponents('BGRA Controls', [TBCRoundedImage]);
+end;
+
+procedure TBCRoundedImage.SetPicture(AValue: TPicture);
+begin
+  if FPicture = AValue then
+    Exit;
+  FPicture := AValue;
+  Invalidate;
+end;
+
+procedure TBCRoundedImage.SetBorderStyle(AValue: TRoundRectangleOptions);
+begin
+  if FBorderStyle=AValue then Exit;
+  FBorderStyle:=AValue;
+  Invalidate;
+end;
+
+procedure TBCRoundedImage.SetQuality(AValue: TResampleFilter);
+begin
+  if FQuality = AValue then
+    Exit;
+  FQuality := AValue;
+  Invalidate;
+end;
+
+procedure TBCRoundedImage.SetStyle(AValue: TBCRoundedImageStyle);
+begin
+  if FStyle = AValue then
+    Exit;
+  FStyle := AValue;
+  Invalidate;
+end;
+
+procedure TBCRoundedImage.SetRounding(AValue: single);
+begin
+  if FRounding = AValue then
+    Exit;
+  FRounding := AValue;
+  Invalidate;
+end;
+
+constructor TBCRoundedImage.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FPicture := TPicture.Create;
+  FRounding := 10;
+  FQuality := rfBestQuality;
+end;
+
+destructor TBCRoundedImage.Destroy;
+begin
+  FPicture.Free;
+  inherited Destroy;
+end;
+
+procedure TBCRoundedImage.Paint;
+var
+  bgra: TBGRABitmap;
+  image: TBGRABitmap;
+begin
+  if (FPicture.Width = 0) or (FPicture.Height = 0) then
+    Exit;
+  // Picture
+  image := TBGRABitmap.Create(FPicture.Bitmap);
+  bgra := TBGRABitmap.Create(Width, Height, BGRAPixelTransparent);
+  try
+    // Quality
+    image.ResampleFilter := FQuality;
+    BGRAReplace(image, image.Resample(Width, Height));
+    // 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);
+    end;
+    // OnPaintEvent
+    if Assigned(FOnPaintEvent) then
+      FOnPaintEvent(Self, bgra);
+    bgra.Draw(Canvas, 0, 0, False);
+  finally
+    bgra.Free;
+    image.Free;
+  end;
+end;
+
+end.

bgracontrols.lpk

@@ -34,289 +34,294 @@
     <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="6" Minor="8"/>
-    <Files Count="58">
+    <Files Count="59">
       <Item1>
+        <Filename Value="atshapelinebgra.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="atshapelinebgra"/>
+      </Item1>
+      <Item2>
         <Filename Value="bcbasectrls.pas"/>
         <AddToUsesPkgSection Value="False"/>
         <UnitName Value="BCBaseCtrls"/>
-      </Item1>
-      <Item2>
+      </Item2>
+      <Item3>
         <Filename Value="bcbrightandcontrast.pas"/>
         <AddToUsesPkgSection Value="False"/>
         <UnitName Value="BCBrightAndContrast"/>
-      </Item2>
-      <Item3>
+      </Item3>
+      <Item4>
         <Filename Value="bcbutton.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCButton"/>
-      </Item3>
-      <Item4>
+      </Item4>
+      <Item5>
         <Filename Value="bcbuttonfocus.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCButtonFocus"/>
-      </Item4>
-      <Item5>
+      </Item5>
+      <Item6>
         <Filename Value="bccombobox.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCComboBox"/>
-      </Item5>
-      <Item6>
+      </Item6>
+      <Item7>
         <Filename Value="bcdefaultthememanager.pas"/>
         <AddToUsesPkgSection Value="False"/>
         <UnitName Value="BCDefaultThemeManager"/>
-      </Item6>
-      <Item7>
-        <Filename Value="bceffect.pas"/>
-        <UnitName Value="BCEffect"/>
       </Item7>
       <Item8>
-        <Filename Value="bcfilters.pas"/>
-        <UnitName Value="bcfilters"/>
+        <Filename Value="bceffect.pas"/>
+        <UnitName Value="BCEffect"/>
       </Item8>
       <Item9>
+        <Filename Value="bcfilters.pas"/>
+        <UnitName Value="bcfilters"/>
+      </Item9>
+      <Item10>
         <Filename Value="bcgamegrid.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCGameGrid"/>
-      </Item9>
-      <Item10>
+      </Item10>
+      <Item11>
         <Filename Value="bcgradientbutton.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCGradientButton"/>
-      </Item10>
-      <Item11>
+      </Item11>
+      <Item12>
         <Filename Value="bcimagebutton.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCImageButton"/>
-      </Item11>
-      <Item12>
+      </Item12>
+      <Item13>
         <Filename Value="bckeyboard.pas"/>
         <AddToUsesPkgSection Value="False"/>
         <UnitName Value="BCKeyboard"/>
-      </Item12>
-      <Item13>
+      </Item13>
+      <Item14>
         <Filename Value="bclabel.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCLabel"/>
-      </Item13>
-      <Item14>
+      </Item14>
+      <Item15>
         <Filename Value="bclistbox.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCListBox"/>
-      </Item14>
-      <Item15>
+      </Item15>
+      <Item16>
         <Filename Value="bcmaterialdesignbutton.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCMaterialDesignButton"/>
-      </Item15>
-      <Item16>
+      </Item16>
+      <Item17>
         <Filename Value="bcmdbutton.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCMDButton"/>
-      </Item16>
-      <Item17>
+      </Item17>
+      <Item18>
         <Filename Value="bcmdbuttonfocus.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCMDButtonFocus"/>
-      </Item17>
-      <Item18>
+      </Item18>
+      <Item19>
         <Filename Value="bcnumerickeyboard.pas"/>
         <AddToUsesPkgSection Value="False"/>
         <UnitName Value="BCNumericKeyboard"/>
-      </Item18>
-      <Item19>
+      </Item19>
+      <Item20>
         <Filename Value="bcpanel.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCPanel"/>
-      </Item19>
-      <Item20>
+      </Item20>
+      <Item21>
         <Filename Value="bcradialprogressbar.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCRadialProgressBar"/>
-      </Item20>
-      <Item21>
-        <Filename Value="bcrtti.pas"/>
-        <UnitName Value="BCRTTI"/>
       </Item21>
       <Item22>
-        <Filename Value="bcsamples.pas"/>
-        <UnitName Value="BCSamples"/>
+        <Filename Value="bcroundedimage.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="BCRoundedImage"/>
       </Item22>
       <Item23>
-        <Filename Value="bcstylesform.pas"/>
-        <UnitName Value="BCStylesForm"/>
+        <Filename Value="bcrtti.pas"/>
+        <UnitName Value="BCRTTI"/>
       </Item23>
       <Item24>
+        <Filename Value="bcsamples.pas"/>
+        <UnitName Value="BCSamples"/>
+      </Item24>
+      <Item25>
+        <Filename Value="bcstylesform.pas"/>
+        <UnitName Value="BCStylesForm"/>
+      </Item25>
+      <Item26>
         <Filename Value="bcsvgbutton.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCSVGButton"/>
-      </Item24>
-      <Item25>
+      </Item26>
+      <Item27>
         <Filename Value="bcsvgviewer.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCSVGViewer"/>
-      </Item25>
-      <Item26>
+      </Item27>
+      <Item28>
         <Filename Value="bcthememanager.pas"/>
         <AddToUsesPkgSection Value="False"/>
         <UnitName Value="BCThemeManager"/>
-      </Item26>
-      <Item27>
+      </Item28>
+      <Item29>
         <Filename Value="bctoolbar.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCToolBar"/>
-      </Item27>
-      <Item28>
+      </Item29>
+      <Item30>
         <Filename Value="bctools.pas"/>
         <AddToUsesPkgSection Value="False"/>
         <UnitName Value="BCTools"/>
-      </Item28>
-      <Item29>
+      </Item30>
+      <Item31>
         <Filename Value="bctrackbarupdown.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCTrackbarUpdown"/>
-      </Item29>
-      <Item30>
+      </Item31>
+      <Item32>
         <Filename Value="bctypes.pas"/>
         <AddToUsesPkgSection Value="False"/>
         <UnitName Value="BCTypes"/>
-      </Item30>
-      <Item31>
+      </Item32>
+      <Item33>
         <Filename Value="bgracolortheme.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRAColorTheme"/>
-      </Item31>
-      <Item32>
+      </Item33>
+      <Item34>
         <Filename Value="bgracontrolsinfo.pas"/>
         <UnitName Value="bgracontrolsinfo"/>
-      </Item32>
-      <Item33>
+      </Item34>
+      <Item35>
         <Filename Value="bgracustomdrawn.pas"/>
         <UnitName Value="BGRACustomDrawn"/>
-      </Item33>
-      <Item34>
+      </Item35>
+      <Item36>
+        <Filename Value="bgradrawerflashprogressbar.pas"/>
+        <UnitName Value="bgradrawerflashprogressbar"/>
+      </Item36>
+      <Item37>
         <Filename Value="bgraflashprogressbar.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRAFlashProgressBar"/>
-      </Item34>
-      <Item35>
+      </Item37>
+      <Item38>
         <Filename Value="bgragraphiccontrol.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRAGraphicControl"/>
-      </Item35>
-      <Item36>
+      </Item38>
+      <Item39>
         <Filename Value="bgraimagelist.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRAImageList"/>
-      </Item36>
-      <Item37>
+      </Item39>
+      <Item40>
         <Filename Value="bgraimagemanipulation.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRAImageManipulation"/>
-      </Item37>
-      <Item38>
+      </Item40>
+      <Item41>
         <Filename Value="bgraimagetheme.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRAImageTheme"/>
-      </Item38>
-      <Item39>
+      </Item41>
+      <Item42>
         <Filename Value="bgraknob.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRAKnob"/>
-      </Item39>
-      <Item40>
+      </Item42>
+      <Item43>
         <Filename Value="bgraresizespeedbutton.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRAResizeSpeedButton"/>
-      </Item40>
-      <Item41>
+      </Item43>
+      <Item44>
         <Filename Value="bgrashape.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRAShape"/>
-      </Item41>
-      <Item42>
+      </Item44>
+      <Item45>
         <Filename Value="bgraspeedbutton.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRASpeedButton"/>
-      </Item42>
-      <Item43>
+      </Item45>
+      <Item46>
         <Filename Value="bgraspriteanimation.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRASpriteAnimation"/>
-      </Item43>
-      <Item44>
+      </Item46>
+      <Item47>
         <Filename Value="bgratheme.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRATheme"/>
-      </Item44>
-      <Item45>
+      </Item47>
+      <Item48>
         <Filename Value="bgrathemebutton.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRAThemeButton"/>
-      </Item45>
-      <Item46>
+      </Item48>
+      <Item49>
         <Filename Value="bgrathemecheckbox.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="bgrathemecheckbox"/>
-      </Item46>
-      <Item47>
+      </Item49>
+      <Item50>
         <Filename Value="bgrathemeradiobutton.pas"/>
         <HasRegisterProc Value="True"/>
         <AddToUsesPkgSection Value="False"/>
         <UnitName Value="BGRAThemeRadioButton"/>
-      </Item47>
-      <Item48>
+      </Item50>
+      <Item51>
         <Filename Value="bgravirtualscreen.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRAVirtualScreen"/>
-      </Item48>
-      <Item49>
+      </Item51>
+      <Item52>
         <Filename Value="colorspeedbutton.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="ColorSpeedButton"/>
-      </Item49>
-      <Item50>
+      </Item52>
+      <Item53>
         <Filename Value="dtanalogclock.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="DTAnalogClock"/>
-      </Item50>
-      <Item51>
+      </Item53>
+      <Item54>
         <Filename Value="dtanalogcommon.pas"/>
         <UnitName Value="DTAnalogCommon"/>
-      </Item51>
-      <Item52>
+      </Item54>
+      <Item55>
         <Filename Value="dtanaloggauge.pas"/>
         <HasRegisterProc Value="True"/>
         <AddToUsesPkgSection Value="False"/>
         <UnitName Value="DTAnalogGauge"/>
-      </Item52>
-      <Item53>
+      </Item55>
+      <Item56>
         <Filename Value="dtthemedclock.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="dtthemedclock"/>
-      </Item53>
-      <Item54>
+      </Item56>
+      <Item57>
         <Filename Value="dtthemedgauge.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="dtthemedgauge"/>
-      </Item54>
-      <Item55>
+      </Item57>
+      <Item58>
         <Filename Value="materialcolors.pas"/>
         <UnitName Value="MaterialColors"/>
-      </Item55>
-      <Item56>
+      </Item58>
+      <Item59>
         <Filename Value="mouseandkeyinput/mouseandkeyinput.pas"/>
         <AddToUsesPkgSection Value="False"/>
         <UnitName Value="MouseAndKeyInput"/>
-      </Item56>
-      <Item57>
-        <Filename Value="bgradrawerflashprogressbar.pas"/>
-        <UnitName Value="bgradrawerflashprogressbar"/>
-      </Item57>
-      <Item58>
-        <Filename Value="atshapelinebgra.pas"/>
-        <HasRegisterProc Value="True"/>
-        <UnitName Value="atshapelinebgra"/>
-      </Item58>
+      </Item59>
     </Files>
     <CompatibilityMode Value="True"/>
     <LazDoc Paths="fpdoc"/>

bgracontrols.pas

@@ -8,23 +8,24 @@ unit bgracontrols;
 interface
 
 uses
-  BCButton, BCButtonFocus, BCComboBox, BCEffect, bcfilters, BCGameGrid, 
-  BCGradientButton, BCImageButton, BCLabel, BCListBox, BCMaterialDesignButton, 
-  BCMDButton, BCMDButtonFocus, BCPanel, BCRadialProgressBar, BCRTTI, 
-  BCSamples, BCStylesForm, BCSVGButton, BCSVGViewer, BCToolBar, 
-  BCTrackbarUpdown, BGRAColorTheme, bgracontrolsinfo, BGRACustomDrawn, 
+  atshapelinebgra, BCButton, BCButtonFocus, BCComboBox, BCEffect, bcfilters, 
+  BCGameGrid, BCGradientButton, BCImageButton, BCLabel, BCListBox, 
+  BCMaterialDesignButton, BCMDButton, BCMDButtonFocus, BCPanel, 
+  BCRadialProgressBar, BCRoundedImage, BCRTTI, BCSamples, BCStylesForm, 
+  BCSVGButton, BCSVGViewer, BCToolBar, BCTrackbarUpdown, BGRAColorTheme, 
+  bgracontrolsinfo, BGRACustomDrawn, BGRADrawerFlashProgressBar, 
   BGRAFlashProgressBar, BGRAGraphicControl, BGRAImageList, 
   BGRAImageManipulation, BGRAImageTheme, BGRAKnob, BGRAResizeSpeedButton, 
   BGRAShape, BGRASpeedButton, BGRASpriteAnimation, BGRATheme, BGRAThemeButton, 
   BGRAThemeCheckBox, BGRAThemeRadioButton, BGRAVirtualScreen, 
   ColorSpeedButton, DTAnalogClock, DTAnalogCommon, DTAnalogGauge, 
-  dtthemedclock, dtthemedgauge, MaterialColors, BGRADrawerFlashProgressBar, 
-  atshapelinebgra, LazarusPackageIntf;
+  dtthemedclock, dtthemedgauge, MaterialColors, LazarusPackageIntf;
 
 implementation
 
 procedure Register;
 begin
+  RegisterUnit('atshapelinebgra', @atshapelinebgra.Register);
   RegisterUnit('BCButton', @BCButton.Register);
   RegisterUnit('BCButtonFocus', @BCButtonFocus.Register);
   RegisterUnit('BCComboBox', @BCComboBox.Register);
@@ -38,6 +39,7 @@ begin
   RegisterUnit('BCMDButtonFocus', @BCMDButtonFocus.Register);
   RegisterUnit('BCPanel', @BCPanel.Register);
   RegisterUnit('BCRadialProgressBar', @BCRadialProgressBar.Register);
+  RegisterUnit('BCRoundedImage', @BCRoundedImage.Register);
   RegisterUnit('BCSVGButton', @BCSVGButton.Register);
   RegisterUnit('BCSVGViewer', @BCSVGViewer.Register);
   RegisterUnit('BCToolBar', @BCToolBar.Register);
@@ -63,7 +65,6 @@ begin
   RegisterUnit('DTAnalogGauge', @DTAnalogGauge.Register);
   RegisterUnit('dtthemedclock', @dtthemedclock.Register);
   RegisterUnit('dtthemedgauge', @dtthemedgauge.Register);
-  RegisterUnit('atshapelinebgra', @atshapelinebgra.Register);
 end;
 
 initialization