Merge pull request #158 from bgrabitmap/dev-bgracontrols

Dev bgracontrols

bcpanel.pas

@@ -122,6 +122,7 @@ type
     property Border;
     property BorderBCStyle;
     property Caption;
+    property Color;
     property Constraints;
     property DockSite;
     property DragCursor;

bgracontrols.lpk

@@ -361,7 +361,7 @@
     <RequiredPkgs Count="2">
       <Item1>
         <PackageName Value="BGRABitmapPack"/>
-        <MinVersion Major="11" Minor="5" Release="4" Valid="True"/>
+        <MinVersion Major="11" Minor="5" Release="5" Valid="True"/>
       </Item1>
       <Item2>
         <PackageName Value="IDEIntf"/>

bgraknob.pas

@@ -160,7 +160,7 @@ begin
         v.x := v.x /(tx / 2 + 1);
         v.y := v.y / (ty / 2 + 1);
         //compute squared distance with scalar product
-        d2 := v ** v;
+        d2 := v {$if FPC_FULLVERSION < 030301}*{$ELSE}**{$ENDIF} v;
         //interpolate as quadratic curve and apply power function
         if d2 > 1 then
           h := 0

bgravirtualscreen.pas

@@ -61,11 +61,13 @@ type
   public
     { Public declarations }
     constructor Create(TheOwner: TComponent); override;
+    function BitmapRectToClient(ARect: TRect): TRect;
     procedure RedrawBitmap; overload;
     procedure RedrawBitmap(ARect: TRect); overload;
     procedure RedrawBitmap(ARectArray: array of TRect); overload;
     procedure DiscardBitmap; overload;
     procedure DiscardBitmap(ARect: TRect); overload;
+    procedure InvalidateBitmap(ARect: TRect);
     destructor Destroy; override;
   public
     property OnRedraw: TBGRARedrawEvent Read FOnRedraw Write FOnRedraw;
@@ -379,6 +381,15 @@ begin
   Color := clWhite;
 end;
 
+function TCustomBGRAVirtualScreen.BitmapRectToClient(ARect: TRect): TRect;
+var
+  scale: Double;
+begin
+  scale := BitmapScale;
+  result := rect(floor(ARect.Left/scale), floor(ARect.Top/scale),
+      ceil(ARect.Right/scale), ceil(ARect.Bottom/scale));
+end;
+
 procedure TCustomBGRAVirtualScreen.RedrawBitmap;
 begin
   RedrawBitmapContent;
@@ -389,7 +400,6 @@ end;
 procedure TCustomBGRAVirtualScreen.RedrawBitmap(ARect: TRect);
 var
   All, displayRect: TRect;
-  scale: Double;
 begin
   if Assigned(FBGRA) then
   begin
@@ -413,9 +423,7 @@ begin
       FBGRA.ClipRect := ARect;
       RedrawBitmapContent;
       FBGRA.NoClip;
-      scale := BitmapScale;
-      displayRect := rect(round(ARect.Left/scale), round(ARect.Top/scale),
-        round(ARect.Right/scale), round(ARect.Bottom/scale));
+      displayRect := BitmapRectToClient(ARect);
       {$IFDEF LINUX}
       FBGRA.DrawPart(ARect, Canvas, displayRect, True);
       {$ELSE}
@@ -533,7 +541,6 @@ end;
 
 procedure TCustomBGRAVirtualScreen.DiscardBitmap(ARect: TRect);
 var
-  scale: Double;
   displayRect: TRect;
 begin
   ARect.Intersect(rect(0,0,FBGRA.Width,FBGRA.Height));
@@ -544,13 +551,19 @@ begin
       FDiscardedRect := ARect
     else
       FDiscardedRect.Union(ARect);
-    scale := BitmapScale;
-    displayRect := rect(round(ARect.Left/scale), round(ARect.Top/scale),
-      round(ARect.Right/scale), round(ARect.Bottom/scale));
+    displayRect := BitmapRectToClient(ARect);
     InvalidateRect(self.Handle, @displayRect, false);
   end;
 end;
 
+procedure TCustomBGRAVirtualScreen.InvalidateBitmap(ARect: TRect);
+var
+  displayRect: TRect;
+begin
+  displayRect := BitmapRectToClient(ARect);
+  InvalidateRect(self.Handle, @displayRect, false);
+end;
+
 destructor TCustomBGRAVirtualScreen.Destroy;
 begin
   FBGRA.Free;

styles/windows11-panel-light.bcpnl

@@ -0,0 +1,115 @@
+[HEADER]
+Author=Me
+Description=
+ControlClass=TBCPanel
+
+[PROPERTIES]
+Align = alNone
+AnchorSideBottom.Side = asrTop
+AnchorSideLeft.Side = asrTop
+AnchorSideRight.Side = asrTop
+AnchorSideTop.Side = asrTop
+Anchors = akTop,akLeft,akRight
+AutoSize = 0
+Background.Color = 16514043
+Background.ColorOpacity = 255
+Background.Gradient1.ColorCorrection = 1
+Background.Gradient1.DrawMode = dmSet
+Background.Gradient1.EndColor = 0
+Background.Gradient1.EndColorOpacity = 255
+Background.Gradient1.GradientType = gtLinear
+Background.Gradient1.Point1XPercent = 0
+Background.Gradient1.Point1YPercent = 0
+Background.Gradient1.Point2XPercent = 0
+Background.Gradient1.Point2YPercent = 100
+Background.Gradient1.Sinus = 0
+Background.Gradient1.StartColor = 16777215
+Background.Gradient1.StartColorOpacity = 255
+Background.Gradient1EndPercent = 35
+Background.Gradient2.ColorCorrection = 1
+Background.Gradient2.DrawMode = dmSet
+Background.Gradient2.EndColor = 0
+Background.Gradient2.EndColorOpacity = 255
+Background.Gradient2.GradientType = gtLinear
+Background.Gradient2.Point1XPercent = 0
+Background.Gradient2.Point1YPercent = 0
+Background.Gradient2.Point2XPercent = 0
+Background.Gradient2.Point2YPercent = 100
+Background.Gradient2.Sinus = 0
+Background.Gradient2.StartColor = 16777215
+Background.Gradient2.StartColorOpacity = 255
+Background.Style = bbsColor
+BevelInner = bvNone
+BevelOuter = bvNone
+BevelWidth = 1
+Border.Color = 15066597
+Border.ColorOpacity = 255
+Border.LightColor = 16777215
+Border.LightOpacity = 255
+Border.LightWidth = 0
+Border.Style = bboSolid
+Border.Width = 1
+BorderBCStyle = bpsBorder
+BorderSpacing.Around = 0
+BorderSpacing.Bottom = 0
+BorderSpacing.CellAlignHorizontal = ccaFill
+BorderSpacing.CellAlignVertical = ccaFill
+BorderSpacing.InnerBorder = 0
+BorderSpacing.Left = 0
+BorderSpacing.Right = 0
+BorderSpacing.Top = 0
+ChildSizing.ControlsPerLine = 0
+ChildSizing.EnlargeHorizontal = crsAnchorAligning
+ChildSizing.EnlargeVertical = crsAnchorAligning
+ChildSizing.HorizontalSpacing = 0
+ChildSizing.Layout = cclNone
+ChildSizing.LeftRightSpacing = 0
+ChildSizing.ShrinkHorizontal = crsAnchorAligning
+ChildSizing.ShrinkVertical = crsAnchorAligning
+ChildSizing.TopBottomSpacing = 0
+ChildSizing.VerticalSpacing = 0
+Color = 15987699
+Constraints.MaxHeight = 0
+Constraints.MaxWidth = 0
+Constraints.MinHeight = 0
+Constraints.MinWidth = 0
+Cursor = 0
+DockSite = 0
+DragCursor = -12
+DragKind = dkDrag
+DragMode = dmManual
+Enabled = 1
+FontEx.Color = 536870912
+FontEx.DisabledColor = 536870911
+FontEx.EndEllipsis = 0
+FontEx.FontQuality = fqSystemClearType
+FontEx.Height = 0
+FontEx.Name = default
+FontEx.PaddingBottom = 0
+FontEx.PaddingLeft = 0
+FontEx.PaddingRight = 0
+FontEx.PaddingTop = 0
+FontEx.Shadow = 0
+FontEx.ShadowColor = 0
+FontEx.ShadowColorOpacity = 255
+FontEx.ShadowOffsetX = 5
+FontEx.ShadowOffsetY = 5
+FontEx.ShadowRadius = 5
+FontEx.SingleLine = 1
+FontEx.Style = 
+FontEx.TextAlignment = bcaCenter
+FontEx.WordBreak = 0
+HelpContext = 0
+HelpKeyword = 
+HelpType = htContext
+Hint = 
+ParentBackground = 0
+Rounding.RoundOptions = 
+Rounding.RoundX = 5
+Rounding.RoundY = 5
+ShowHint = 0
+TabOrder = 0
+TabStop = 0
+Tag = 0
+UseDockManager = 1
+Visible = 1

styles/windows11-panel-text-light.bclbl

@@ -0,0 +1,89 @@
+[HEADER]
+Author=Me
+Description=
+ControlClass=TBCLabel
+
+[PROPERTIES]
+Align = alNone
+AnchorSideBottom.Side = asrTop
+AnchorSideLeft.Side = asrTop
+AnchorSideRight.Side = asrTop
+AnchorSideTop.Side = asrTop
+Anchors = akTop,akLeft
+AutoSize = 1
+Background.Color = 0
+Background.ColorOpacity = 255
+Background.Gradient1.ColorCorrection = 1
+Background.Gradient1.DrawMode = dmSet
+Background.Gradient1.EndColor = 0
+Background.Gradient1.EndColorOpacity = 255
+Background.Gradient1.GradientType = gtLinear
+Background.Gradient1.Point1XPercent = 0
+Background.Gradient1.Point1YPercent = 0
+Background.Gradient1.Point2XPercent = 0
+Background.Gradient1.Point2YPercent = 100
+Background.Gradient1.Sinus = 0
+Background.Gradient1.StartColor = 16777215
+Background.Gradient1.StartColorOpacity = 255
+Background.Gradient1EndPercent = 35
+Background.Gradient2.ColorCorrection = 1
+Background.Gradient2.DrawMode = dmSet
+Background.Gradient2.EndColor = 0
+Background.Gradient2.EndColorOpacity = 255
+Background.Gradient2.GradientType = gtLinear
+Background.Gradient2.Point1XPercent = 0
+Background.Gradient2.Point1YPercent = 0
+Background.Gradient2.Point2XPercent = 0
+Background.Gradient2.Point2YPercent = 100
+Background.Gradient2.Sinus = 0
+Background.Gradient2.StartColor = 16777215
+Background.Gradient2.StartColorOpacity = 255
+Background.Style = bbsClear
+Border.Color = 0
+Border.ColorOpacity = 255
+Border.LightColor = 16777215
+Border.LightOpacity = 255
+Border.LightWidth = 0
+Border.Style = bboNone
+Border.Width = 1
+BorderSpacing.Around = 0
+BorderSpacing.Bottom = 0
+BorderSpacing.CellAlignHorizontal = ccaFill
+BorderSpacing.CellAlignVertical = ccaFill
+BorderSpacing.InnerBorder = 0
+BorderSpacing.Left = 0
+BorderSpacing.Right = 0
+BorderSpacing.Top = 0
+Cursor = 0
+Enabled = 1
+FontEx.Color = 6250335
+FontEx.DisabledColor = 536870911
+FontEx.EndEllipsis = 0
+FontEx.FontQuality = fqSystemClearType
+FontEx.Height = 14
+FontEx.Name = default
+FontEx.PaddingBottom = 0
+FontEx.PaddingLeft = 0
+FontEx.PaddingRight = 0
+FontEx.PaddingTop = 0
+FontEx.Shadow = 0
+FontEx.ShadowColor = 0
+FontEx.ShadowColorOpacity = 255
+FontEx.ShadowOffsetX = 5
+FontEx.ShadowOffsetY = 5
+FontEx.ShadowRadius = 5
+FontEx.SingleLine = 1
+FontEx.Style = 
+FontEx.TextAlignment = bcaCenter
+FontEx.WordBreak = 0
+HelpContext = 0
+HelpKeyword = 
+HelpType = htContext
+Hint = 
+InnerMargin = 0
+Rounding.RoundOptions = 
+Rounding.RoundX = 1
+Rounding.RoundY = 1
+ShowHint = 0
+Tag = 0
+Visible = 1

styles/windows11-panel-title-light.bclbl

@@ -0,0 +1,89 @@
+[HEADER]
+Author=Me
+Description=
+ControlClass=TBCLabel
+
+[PROPERTIES]
+Align = alNone
+AnchorSideBottom.Side = asrTop
+AnchorSideLeft.Side = asrTop
+AnchorSideRight.Side = asrTop
+AnchorSideTop.Side = asrTop
+Anchors = akTop,akLeft
+AutoSize = 1
+Background.Color = 0
+Background.ColorOpacity = 255
+Background.Gradient1.ColorCorrection = 1
+Background.Gradient1.DrawMode = dmSet
+Background.Gradient1.EndColor = 0
+Background.Gradient1.EndColorOpacity = 255
+Background.Gradient1.GradientType = gtLinear
+Background.Gradient1.Point1XPercent = 0
+Background.Gradient1.Point1YPercent = 0
+Background.Gradient1.Point2XPercent = 0
+Background.Gradient1.Point2YPercent = 100
+Background.Gradient1.Sinus = 0
+Background.Gradient1.StartColor = 16777215
+Background.Gradient1.StartColorOpacity = 255
+Background.Gradient1EndPercent = 35
+Background.Gradient2.ColorCorrection = 1
+Background.Gradient2.DrawMode = dmSet
+Background.Gradient2.EndColor = 0
+Background.Gradient2.EndColorOpacity = 255
+Background.Gradient2.GradientType = gtLinear
+Background.Gradient2.Point1XPercent = 0
+Background.Gradient2.Point1YPercent = 0
+Background.Gradient2.Point2XPercent = 0
+Background.Gradient2.Point2YPercent = 100
+Background.Gradient2.Sinus = 0
+Background.Gradient2.StartColor = 16777215
+Background.Gradient2.StartColorOpacity = 255
+Background.Style = bbsClear
+Border.Color = 0
+Border.ColorOpacity = 255
+Border.LightColor = 16777215
+Border.LightOpacity = 255
+Border.LightWidth = 0
+Border.Style = bboNone
+Border.Width = 1
+BorderSpacing.Around = 0
+BorderSpacing.Bottom = 0
+BorderSpacing.CellAlignHorizontal = ccaFill
+BorderSpacing.CellAlignVertical = ccaFill
+BorderSpacing.InnerBorder = 0
+BorderSpacing.Left = 0
+BorderSpacing.Right = 0
+BorderSpacing.Top = 0
+Cursor = 0
+Enabled = 1
+FontEx.Color = 1776411
+FontEx.DisabledColor = 536870911
+FontEx.EndEllipsis = 0
+FontEx.FontQuality = fqSystemClearType
+FontEx.Height = 20
+FontEx.Name = default
+FontEx.PaddingBottom = 0
+FontEx.PaddingLeft = 0
+FontEx.PaddingRight = 0
+FontEx.PaddingTop = 0
+FontEx.Shadow = 0
+FontEx.ShadowColor = 0
+FontEx.ShadowColorOpacity = 255
+FontEx.ShadowOffsetX = 5
+FontEx.ShadowOffsetY = 5
+FontEx.ShadowRadius = 5
+FontEx.SingleLine = 1
+FontEx.Style = fsBold
+FontEx.TextAlignment = bcaCenter
+FontEx.WordBreak = 0
+HelpContext = 0
+HelpKeyword = 
+HelpType = htContext
+Hint = 
+InnerMargin = 0
+Rounding.RoundOptions = 
+Rounding.RoundX = 1
+Rounding.RoundY = 1
+ShowHint = 0
+Tag = 0
+Visible = 1

test/test_bgraimagemanipulation/ProjectBGRAImageManipulationDemo.lpi

@@ -7,6 +7,7 @@
         <CompatibilityMode Value="True"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
+      <Scaled Value="True"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
       <XPManifest>

test/test_bgraimagemanipulation/ProjectBGRAImageManipulationDemo.lpr

@@ -12,6 +12,8 @@ uses
 {$R *.res}
 
 begin
+  Application.Scaled:=True;
+  Application.Title:='';
   Application.Initialize;
   Application.CreateForm(TFormBGRAImageManipulationDemo, FormBGRAImageManipulationDemo);
   Application.Run;

test/test_bgraimagemanipulation/unitbgraimagemanipulationdemo.pas

@@ -42,6 +42,7 @@ unit UnitBGRAImageManipulationDemo;
 
   2013-10-13 - Massimo Magnano
              - Add multi crop demo
+  2023-08    - Resolution, Save in various formats, Z Order
 
   ============================================================================
 }
@@ -52,9 +53,9 @@ interface
 
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
-  Buttons, ExtDlgs, ComCtrls, ExtCtrls, Menus, BGRAImageManipulation,
-  BGRABitmap, BGRABitmapTypes, BCPanel, BCButton, BGRASpeedButton, BCLabel,
-  BCTrackbarUpdown{, BGRATrackBar};
+  Buttons, ExtDlgs, ComCtrls, ExtCtrls, Menus, Spin,
+  {$IFDEF FPC} FPImage,{$ENDIF} BGRAImageManipulation,
+  BGRABitmap, BGRABitmapTypes, BCPanel, BCButton, BGRASpeedButton, BCLabel, Laz2_XMLCfg;
 
 type
 
@@ -68,12 +69,19 @@ type
     BCLabel4: TBCLabel;
     BCLabel5: TBCLabel;
     BCLabel6: TBCLabel;
+    BCLabel7: TBCLabel;
     BCPanelCropAreaLoad: TBCPanel;
     BCPanelCropArea: TBCPanel;
     BCPanelCropAreas: TBCPanel;
     btApplyAspectRatio: TSpeedButton;
     btBox_Add: TBGRASpeedButton;
     btBox_Del: TBGRASpeedButton;
+    btCFlipHLeft: TSpeedButton;
+    btCFlipHRight: TSpeedButton;
+    btCFlipVUp: TSpeedButton;
+    btCFlipVDown: TSpeedButton;
+    btCropDuplicate: TSpeedButton;
+    btnEmptyImage: TBCButton;
     btnLoadCropList: TBCButton;
     btnSaveCropList: TBCButton;
     btnSavePictureAll: TBCButton;
@@ -85,17 +93,24 @@ type
     btnSetAspectRatio: TBCButton;
     btnRotateLeft:     TBCButton;
     btnRotateRight:    TBCButton;
+    btCRotateRight: TSpeedButton;
+    btCRotateLeft: TSpeedButton;
     cbBoxList: TComboBox;
     chkFullSize: TCheckBox;
+    cbSaveFormat: TComboBox;
     edAspectPersonal: TEdit;
     edAspectRatio:     TEdit;
-    edHeight: TBCTrackbarUpdown;
-    edLeft: TBCTrackbarUpdown;
+    edHeight: TFloatSpinEdit;
+    edLeft: TFloatSpinEdit;
     edName: TEdit;
-    edTop: TBCTrackbarUpdown;
+    edTop: TFloatSpinEdit;
     edUnit_Type: TComboBox;
-    edWidth: TBCTrackbarUpdown;
+    edWidth: TFloatSpinEdit;
     KeepAspectRatio:   TCheckBox;
+    Label1: TLabel;
+    Label2: TLabel;
+    Label3: TLabel;
+    lbResolution: TLabel;
     lbAspectRatio:     TLabel;
     lbOptions:         TLabel;
     lbCompression:     TLabel;
@@ -108,6 +123,19 @@ type
     RateCompression:   TTrackBar;
     SelectDirectoryDialog1: TSelectDirectoryDialog;
     SpeedButton1: TSpeedButton;
+    btZFront: TSpeedButton;
+    btZBack: TSpeedButton;
+    btZDown: TSpeedButton;
+    btZUp: TSpeedButton;
+    btCropDuplicateOp: TSpeedButton;
+    procedure btCFlipHLeftClick(Sender: TObject);
+    procedure btCFlipHRightClick(Sender: TObject);
+    procedure btCFlipVDownClick(Sender: TObject);
+    procedure btCFlipVUpClick(Sender: TObject);
+    procedure btCropDuplicateClick(Sender: TObject);
+    procedure btCRotateLeftClick(Sender: TObject);
+    procedure btCRotateRightClick(Sender: TObject);
+    procedure btnEmptyImageClick(Sender: TObject);
     procedure btnGetAspectRatioFromImageClick(Sender: TObject);
     procedure btnLoadCropListClick(Sender: TObject);
     procedure btnOpenPictureClick(Sender: TObject);
@@ -117,7 +145,12 @@ type
     procedure btnSavePictureAllClick(Sender: TObject);
     procedure btnSavePictureClick(Sender: TObject);
     procedure btnSetAspectRatioClick(Sender: TObject);
+    procedure btZBackClick(Sender: TObject);
+    procedure btZDownClick(Sender: TObject);
+    procedure btZFrontClick(Sender: TObject);
+    procedure btZUpClick(Sender: TObject);
     procedure edNameChange(Sender: TObject);
+    procedure edUnit_TypeChange(Sender: TObject);
     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
     procedure KeepAspectRatioClick(Sender: TObject);
 
@@ -132,18 +165,21 @@ type
     procedure rgAspectSelectionChanged(Sender: TObject);
     procedure btApplyAspectRatioClick(Sender: TObject);
 
-    procedure AddedCrop(AOwner: TBGRAImageManipulation; CropArea: TCropArea);
-    procedure DeletedCrop(AOwner: TBGRAImageManipulation; CropArea: TCropArea);
-    procedure ChangedCrop(AOwner: TBGRAImageManipulation; CropArea: TCropArea);
-    procedure SelectedChangedCrop(AOwner: TBGRAImageManipulation; CropArea: TCropArea);
+    procedure AddedCrop(Sender: TBGRAImageManipulation; CropArea: TCropArea);
+    procedure DeletedCrop(Sender: TBGRAImageManipulation; CropArea: TCropArea);
+    procedure ChangedCrop(Sender: TBGRAImageManipulation; CropArea: TCropArea);
+    procedure SelectedChangedCrop(Sender: TBGRAImageManipulation; CropArea: TCropArea);
     procedure SpeedButton1Click(Sender: TObject);
   private
     { private declarations }
     lastNewBoxNum :Word;
-    changingAspect, closing:Boolean;
+    changingAspect, closing,
+    inFillBoxUI :Boolean;
 
+    function GetCurrentCropArea: TCropArea;
     procedure FillBoxUI(ABox :TCropArea);
     procedure SaveCallBack(Bitmap :TBGRABitmap; CropArea: TCropArea);
+    procedure UpdateBoxList;
   public
     { public declarations }
   end;
@@ -160,6 +196,8 @@ implementation
 procedure TFormBGRAImageManipulationDemo.btnOpenPictureClick(Sender: TObject);
 var
   Bitmap: TBGRABitmap;
+  test:Integer;
+
 begin
   // To put a new image in the component, you will simply need execute open
   // picture dialog to locate an image...
@@ -171,11 +209,22 @@ begin
     // Finally, associate the image into component
     BGRAImageManipulation.Bitmap := Bitmap;
     Bitmap.Free;
-    edLeft.MaxValue:=BGRAImageManipulation.Bitmap.Width;
-    edTop.MaxValue:=BGRAImageManipulation.Bitmap.Height;
-    edWidth.MaxValue:=BGRAImageManipulation.Bitmap.Width;
-    edHeight.MaxValue:=BGRAImageManipulation.Bitmap.Height;
-    BGRAImageManipulation.addCropArea(Rect(100,100,220,260));
+
+    lbResolution.Caption:='Resolution : '+#13#10+'  '+
+          FloatToStr(BGRAImageManipulation.Bitmap.ResolutionX)+' x '+
+          FloatToStr(BGRAImageManipulation.Bitmap.ResolutionY)+' '+edUnit_Type.Items[Integer(BGRAImageManipulation.Bitmap.ResolutionUnit)]+#13#10+
+          '  '+FloatToStr(BGRAImageManipulation.Bitmap.ResolutionWidth)+' x '+FloatToStr(BGRAImageManipulation.Bitmap.ResolutionHeight)+#13#10+
+          '  pixels '+IntToStr(BGRAImageManipulation.Bitmap.Width)+' x '+IntToStr(BGRAImageManipulation.Bitmap.Height);
+
+    if (BGRAImageManipulation.SelectedCropArea=nil)
+    then begin
+           edUnit_Type.ItemIndex:=Integer(BGRAImageManipulation.Bitmap.ResolutionUnit);
+           edLeft.MaxValue:=BGRAImageManipulation.Bitmap.ResolutionWidth;
+           edTop.MaxValue:=BGRAImageManipulation.Bitmap.ResolutionHeight;
+           edWidth.MaxValue:=BGRAImageManipulation.Bitmap.ResolutionWidth;
+           edHeight.MaxValue:=BGRAImageManipulation.Bitmap.ResolutionHeight;
+         end
+    else FillBoxUI(BGRAImageManipulation.SelectedCropArea);
   end;
 end;
 
@@ -199,6 +248,134 @@ begin
   end;
 end;
 
+procedure TFormBGRAImageManipulationDemo.btnEmptyImageClick(Sender: TObject);
+var
+   emptyImg :TBGRABitmap;
+
+begin
+  try
+     emptyImg :=TBGRABitmap.Create(0, 0);
+     BGRAImageManipulation.Bitmap :=emptyImg;
+  finally
+     emptyImg.Free;
+  end;
+end;
+
+procedure TFormBGRAImageManipulationDemo.btCRotateLeftClick(Sender: TObject);
+var
+   CropArea :TCropArea;
+
+begin
+  CropArea :=GetCurrentCropArea;
+  if CropArea<>nil then
+  begin
+    if btCropDuplicateOp.Down then
+    begin
+      CropArea :=TCropArea.Create(BGRAImageManipulation, CropArea, True);
+      BGRAImageManipulation.SelectedCropArea :=CropArea;
+    end;
+    CropArea.RotateLeft;
+  end;
+end;
+
+procedure TFormBGRAImageManipulationDemo.btCFlipVDownClick(Sender: TObject);
+var
+   CropArea :TCropArea;
+
+begin
+  CropArea :=GetCurrentCropArea;
+  if CropArea<>nil then
+  begin
+    if btCropDuplicateOp.Down then
+    begin
+      CropArea :=TCropArea.Create(BGRAImageManipulation, CropArea, True);
+      BGRAImageManipulation.SelectedCropArea :=CropArea;
+    end;
+    CropArea.FlipVDown;
+  end;
+end;
+
+procedure TFormBGRAImageManipulationDemo.btCFlipHLeftClick(Sender: TObject);
+var
+   CropArea :TCropArea;
+
+begin
+  CropArea :=GetCurrentCropArea;
+  if CropArea<>nil then
+  begin
+    if btCropDuplicateOp.Down then
+    begin
+      CropArea :=TCropArea.Create(BGRAImageManipulation, CropArea, True);
+      BGRAImageManipulation.SelectedCropArea :=CropArea;
+    end;
+    CropArea.FlipHLeft;
+  end;
+end;
+
+procedure TFormBGRAImageManipulationDemo.btCFlipHRightClick(Sender: TObject);
+var
+   CropArea :TCropArea;
+
+begin
+  CropArea :=GetCurrentCropArea;
+  if CropArea<>nil then
+  begin
+    if btCropDuplicateOp.Down then
+    begin
+      CropArea :=TCropArea.Create(BGRAImageManipulation, CropArea, True);
+      BGRAImageManipulation.SelectedCropArea :=CropArea;
+    end;
+    CropArea.FlipHRight;
+  end;
+end;
+
+procedure TFormBGRAImageManipulationDemo.btCFlipVUpClick(Sender: TObject);
+var
+   CropArea :TCropArea;
+
+begin
+  CropArea :=GetCurrentCropArea;
+  if CropArea<>nil then
+  begin
+    if btCropDuplicateOp.Down then
+    begin
+      CropArea :=TCropArea.Create(BGRAImageManipulation, CropArea, True);
+      BGRAImageManipulation.SelectedCropArea :=CropArea;
+    end;
+    CropArea.FlipVUp;
+  end;
+end;
+
+procedure TFormBGRAImageManipulationDemo.btCropDuplicateClick(Sender: TObject);
+var
+   newCropArea :TCropArea;
+
+begin
+  if BGRAImageManipulation.SelectedCropArea<>nil then
+  begin
+    newCropArea :=TCropArea.Create(BGRAImageManipulation, BGRAImageManipulation.SelectedCropArea, True);
+    BGRAImageManipulation.SelectedCropArea :=newCropArea;
+    newCropArea.BorderColor :=VGALime;
+  end;
+end;
+
+procedure TFormBGRAImageManipulationDemo.btCRotateRightClick(Sender: TObject);
+var
+   CropArea :TCropArea;
+
+begin
+  CropArea :=GetCurrentCropArea;
+  if CropArea<>nil then
+  begin
+    if btCropDuplicateOp.Down then
+    begin
+      CropArea :=TCropArea.Create(BGRAImageManipulation, CropArea, True);
+      BGRAImageManipulation.SelectedCropArea :=CropArea;
+    end;
+    CropArea.RotateRight;
+  end;
+end;
+
 procedure TFormBGRAImageManipulationDemo.btnLoadCropListClick(Sender: TObject);
 begin
   try
@@ -219,45 +396,55 @@ end;
 
 procedure TFormBGRAImageManipulationDemo.btnSavePictureClick(Sender: TObject);
 var
-  JpegImage: TJpegImage;
-begin
-  // This example save image compress in JPEG format
+  curBitmap :TBGRABitmap;
 
-  // Execute our Save Picture Dialog
-  SavePictureDialog.Filter := 'JPEG Image File (*.jpg, *.jpeg)';
+begin
   if SavePictureDialog.Execute then
   begin
     try
-      // Compress
-      JpegImage := TJpegImage.Create;
       if (chkFullSize.Checked)
-      then JpegImage.Assign(BGRAImageManipulation.getBitmap)
-      else JpegImage.Assign(BGRAImageManipulation.getResampledBitmap);
-      JpegImage.CompressionQuality := RateCompression.Position;
+      then curBitmap :=BGRAImageManipulation.getBitmap
+      else curBitmap :=BGRAImageManipulation.getResampledBitmap;
 
-      // And save to file
-      JpegImage.SaveToFile(SavePictureDialog.FileName);
+      curBitmap.SaveToFile(SavePictureDialog.FileName);
     finally
-      JpegImage.Free;
+      curBitmap.Free;
     end;
   end;
 end;
 
 procedure TFormBGRAImageManipulationDemo.SaveCallBack(Bitmap :TBGRABitmap; CropArea: TCropArea);
 var
-  JpegImage: TJpegImage;
+  ext:String;
+  i:Integer;
+
 begin
-    try
-      // Compress
-      JpegImage := TJpegImage.Create;
-      JpegImage.Assign(Bitmap);
-      JpegImage.CompressionQuality := RateCompression.Position;
+   ext:=ImageHandlers.Extensions[cbSaveFormat.Items[cbSaveFormat.ItemIndex]];
+   i :=Pos(';', ext);
+   if (i>0) then ext :=Copy(ext, 1, i-1);
+   Bitmap.SaveToFile(SelectDirectoryDialog1.FileName+DirectorySeparator+CropArea.Name+'.'+ext);
+end;
 
-      // And save to file
-      JpegImage.SaveToFile(SelectDirectoryDialog1.FileName+DirectorySeparator+CropArea.Name+'.jpg');
-    finally
-      JpegImage.Free;
-    end;
+procedure TFormBGRAImageManipulationDemo.UpdateBoxList;
+var
+   i :Integer;
+   CropArea,
+   SelArea:TCropArea;
+
+begin
+  cbBoxList.OnChange:=nil;
+
+  //SelArea :=BGRAImageManipulation.SelectedCropArea;
+  cbBoxList.Clear;
+  for i:=0 to BGRAImageManipulation.CropAreas.Count-1 do
+  begin
+    CropArea :=BGRAImageManipulation.CropAreas.items[i];
+    cbBoxList.AddItem(CropArea.Name, CropArea);
+  end;
+  //BGRAImageManipulation.SelectedCropArea :=SelArea;
+  cbBoxList.ItemIndex:=cbBoxList.Items.IndexOfObject(BGRAImageManipulation.SelectedCropArea);
+
+  cbBoxList.OnChange:=@cbBoxListChange;
 end;
 
 procedure TFormBGRAImageManipulationDemo.btnSavePictureAllClick(Sender: TObject);
@@ -283,13 +470,79 @@ begin
   end;
 end;
 
+procedure TFormBGRAImageManipulationDemo.btZBackClick(Sender: TObject);
+var
+   CropArea :TCropArea;
+
+begin
+  CropArea :=GetCurrentCropArea;
+  if CropArea<>nil
+  then begin
+         CropArea.BringToBack;
+         UpdateBoxList;
+       end;
+end;
+
+procedure TFormBGRAImageManipulationDemo.btZDownClick(Sender: TObject);
+var
+   CropArea :TCropArea;
+
+begin
+  CropArea :=GetCurrentCropArea;
+  if CropArea<>nil
+  then begin
+         CropArea.BringBackward;
+         UpdateBoxList;
+       end;
+end;
+
+procedure TFormBGRAImageManipulationDemo.btZFrontClick(Sender: TObject);
+var
+   CropArea :TCropArea;
+
+begin
+  CropArea :=GetCurrentCropArea;
+  if CropArea<>nil
+  then begin
+         CropArea.BringToFront;
+         UpdateBoxList;
+       end;
+end;
+
+procedure TFormBGRAImageManipulationDemo.btZUpClick(Sender: TObject);
+var
+   CropArea :TCropArea;
+
+begin
+  CropArea :=GetCurrentCropArea;
+  if CropArea<>nil
+  then begin
+         CropArea.BringForward;
+         UpdateBoxList;
+       end;
+end;
+
 procedure TFormBGRAImageManipulationDemo.edNameChange(Sender: TObject);
 var
    CropArea :TCropArea;
 
 begin
-  CropArea :=TCropArea(cbBoxList.Items.Objects[cbBoxList.ItemIndex]);
-  CropArea.Name :=edName.Text;
+  CropArea :=GetCurrentCropArea;
+  if CropArea<>nil
+  then CropArea.Name :=edName.Text;
+end;
+
+procedure TFormBGRAImageManipulationDemo.edUnit_TypeChange(Sender: TObject);
+var
+   CropArea :TCropArea;
+
+begin
+  CropArea :=GetCurrentCropArea;
+  if CropArea<>nil then
+  begin
+    CropArea.AreaUnit:=TResolutionUnit(edUnit_Type.ItemIndex);
+    FillBoxUI(CropArea);
+  end;
 end;
 
 procedure TFormBGRAImageManipulationDemo.FormCloseQuery(Sender: TObject;
@@ -310,7 +563,10 @@ var
    newCropArea :TCropArea;
 
 begin
-  newCropArea :=BGRAImageManipulation.addCropArea(Rect(50, 50, 100, 100), 0 (*, Integer(newBox)*));
+  if edUnit_Type.ItemIndex=0
+  then newCropArea :=BGRAImageManipulation.addCropArea(Rect(50, 50, 100, 100))
+  else newCropArea :=BGRAImageManipulation.addCropArea(Rect(1, 1, 2, 2), TResolutionUnit(edUnit_Type.ItemIndex));
+
   newCropArea.BorderColor :=VGALime;
 end;
 
@@ -321,13 +577,13 @@ var
 
 begin
   curIndex :=cbBoxList.ItemIndex;
-  CropArea :=TCropArea(cbBoxList.Items.Objects[curIndex]);
-  BGRAImageManipulation.delCropArea(CropArea);
-  cbBoxList.Items.Delete(curIndex);
-(*  if (BGRAImageManipulation.SelectedCropArea <> nil)
-  then cbBoxList.ItemIndex:=BGRAImageManipulation.SelectedCropArea.Index
-  else cbBoxList.ItemIndex:=-1;
-  FillBoxUI(BGRAImageManipulation.SelectedCropArea);*)
+  if (curIndex>-1) then
+  begin
+    CropArea :=TCropArea(cbBoxList.Items.Objects[curIndex]);
+    BGRAImageManipulation.delCropArea(CropArea);
+    cbBoxList.ItemIndex:=cbBoxList.Items.IndexOfObject(BGRAImageManipulation.SelectedCropArea);
+  end;
+  FillBoxUI(BGRAImageManipulation.SelectedCropArea);
 end;
 
 procedure TFormBGRAImageManipulationDemo.cbBoxListChange(Sender: TObject);
@@ -340,12 +596,11 @@ var
    CropArea :TCropArea;
 
 begin
-  if AByUser then
-  begin
-    CropArea :=TCropArea(cbBoxList.Items.Objects[cbBoxList.ItemIndex]);
-    if (CropArea<>nil)
-    then CropArea.Height:=edHeight.Value;
-  end;
+  if inFillBoxUI then exit;
+
+  CropArea :=GetCurrentCropArea;
+  if (CropArea<>nil)
+  then CropArea.Height:=edHeight.Value;
 end;
 
 procedure TFormBGRAImageManipulationDemo.edLeftChange(Sender: TObject; AByUser: boolean);
@@ -353,12 +608,11 @@ var
    CropArea :TCropArea;
 
 begin
-  if AByUser then
-  begin
-    CropArea :=TCropArea(cbBoxList.Items.Objects[cbBoxList.ItemIndex]);
-    if (CropArea<>nil)
-    then CropArea.Left :=edLeft.Value;
-  end;
+  if inFillBoxUI then exit;
+
+  CropArea :=GetCurrentCropArea;
+  if (CropArea<>nil)
+  then CropArea.Left :=edLeft.Value;
 end;
 
 procedure TFormBGRAImageManipulationDemo.edTopChange(Sender: TObject; AByUser: boolean);
@@ -366,12 +620,11 @@ var
    CropArea :TCropArea;
 
 begin
-  if AByUser then
-  begin
-    CropArea :=TCropArea(cbBoxList.Items.Objects[cbBoxList.ItemIndex]);
-    if (CropArea<>nil)
-    then CropArea.Top :=edTop.Value;
-  end;
+  if inFillBoxUI then exit;
+
+  CropArea :=GetCurrentCropArea;
+  if (CropArea<>nil)
+  then CropArea.Top :=edTop.Value;
 end;
 
 procedure TFormBGRAImageManipulationDemo.edWidthChange(Sender: TObject; AByUser: boolean);
@@ -379,23 +632,36 @@ var
    CropArea :TCropArea;
 
 begin
-  if AByUser then
-  begin
-    CropArea :=TCropArea(cbBoxList.Items.Objects[cbBoxList.ItemIndex]);
-    if (CropArea<>nil)
-    then CropArea.Width:=edWidth.Value;
-  end;
+  if inFillBoxUI then exit;
+
+  CropArea :=GetCurrentCropArea;
+  if (CropArea<>nil)
+  then CropArea.Width:=edWidth.Value;
 end;
 
 procedure TFormBGRAImageManipulationDemo.FormCreate(Sender: TObject);
 var
-   i :Integer;
+   i,j :Integer;
+   t,e:String;
 
 begin
    closing :=False;
    changingAspect :=False;
+   inFillBoxUI :=False;
    lastNewBoxNum :=0;
    TStringList(cbBoxList.Items).OwnsObjects:=False;
+   j:=0;
+   for i :=0 to ImageHandlers.Count-1 do
+   begin
+     t :=ImageHandlers.TypeNames[i];
+     e :=ImageHandlers.Extensions[t];
+     if (ImageHandlers.ImageWriter[t]<>nil) then
+     begin
+       cbSaveFormat.Items.Add(t);
+       if (Pos('jpg', e)>0) then j:=i;
+     end;
+   end;
+   cbSaveFormat.ItemIndex:=j-1;
 end;
 
 procedure TFormBGRAImageManipulationDemo.rgAspectSelectionChanged(Sender: TObject);
@@ -425,7 +691,7 @@ begin
         end;
 end;
 
-procedure TFormBGRAImageManipulationDemo.AddedCrop(AOwner: TBGRAImageManipulation; CropArea: TCropArea);
+procedure TFormBGRAImageManipulationDemo.AddedCrop(Sender: TBGRAImageManipulation; CropArea: TCropArea);
 var
   curIndex :Integer;
 
@@ -437,10 +703,11 @@ begin
 
    cbBoxList.AddItem(CropArea.Name, CropArea);
    cbBoxList.ItemIndex:=cbBoxList.Items.IndexOfObject(CropArea);
+   //CropArea.AreaUnit:=BGRAImageManipulation.Bitmap.ResolutionUnit;
    FillBoxUI(CropArea);
 end;
 
-procedure TFormBGRAImageManipulationDemo.DeletedCrop(AOwner: TBGRAImageManipulation; CropArea: TCropArea);
+procedure TFormBGRAImageManipulationDemo.DeletedCrop(Sender: TBGRAImageManipulation; CropArea: TCropArea);
 var
    delIndex :Integer;
 begin
@@ -450,13 +717,14 @@ begin
          delIndex :=cbBoxList.Items.IndexOfObject(CropArea);
          if (delIndex<>-1)
          then cbBoxList.Items.Delete(delIndex);
+         BCPanelCropArea.Enabled:=(cbBoxList.Items.Count>0);
     end;
   except
   end;
   //MessageDlg('Deleting Crop Area', 'Deleting '+CropArea.Name, mtInformation, [mbOk], 0);
 end;
 
-procedure TFormBGRAImageManipulationDemo.ChangedCrop(AOwner: TBGRAImageManipulation; CropArea: TCropArea);
+procedure TFormBGRAImageManipulationDemo.ChangedCrop(Sender: TBGRAImageManipulation; CropArea: TCropArea);
 begin
   if (cbBoxList.Items.Objects[cbBoxList.ItemIndex] = CropArea) then
   begin
@@ -468,7 +736,7 @@ begin
   end;
 end;
 
-procedure TFormBGRAImageManipulationDemo.SelectedChangedCrop(AOwner: TBGRAImageManipulation; CropArea: TCropArea);
+procedure TFormBGRAImageManipulationDemo.SelectedChangedCrop(Sender: TBGRAImageManipulation; CropArea: TCropArea);
 var
    newIndex :Integer;
 begin
@@ -482,15 +750,43 @@ end;
 
 procedure TFormBGRAImageManipulationDemo.SpeedButton1Click(Sender: TObject);
 begin
-  BGRAImageManipulation.tests;
+  BGRAImageManipulation.SetEmptyImageSizeToCropAreas(False);
+end;
+
+function TFormBGRAImageManipulationDemo.GetCurrentCropArea: TCropArea;
+begin
+   if (cbBoxList.ItemIndex<0)
+   then Result :=nil
+   else Result :=TCropArea(cbBoxList.Items.Objects[cbBoxList.ItemIndex]);
 end;
 
 procedure TFormBGRAImageManipulationDemo.FillBoxUI(ABox: TCropArea);
 begin
    if (ABox<>nil)
    then begin
+           inFillBoxUI :=True;
            BCPanelCropArea.Enabled :=True;
            edName.Text :=ABox.Name;
+           edUnit_Type.ItemIndex :=Integer(ABox.AreaUnit);
+
+           if (ABox.AreaUnit=ruNone)
+           then begin
+                  edLeft.DecimalPlaces:=0;
+                  edTop.DecimalPlaces:=0;
+                  edWidth.DecimalPlaces:=0;
+                  edHeight.DecimalPlaces:=0;
+                end
+           else begin
+                  edLeft.DecimalPlaces:=3;
+                  edTop.DecimalPlaces:=3;
+                  edWidth.DecimalPlaces:=3;
+                  edHeight.DecimalPlaces:=3;
+                end;
+           edLeft.MaxValue:=ABox.MaxWidth;
+           edTop.MaxValue:=ABox.MaxHeight;
+           edWidth.MaxValue:=edLeft.MaxValue;
+           edHeight.MaxValue:=edTop.MaxValue;
+
            edLeft.Value :=ABox.Left;
            edTop.Value :=ABox.Top;
            edWidth.Value :=ABox.Width;
@@ -505,8 +801,7 @@ begin
            end;
            edAspectPersonal.Text:=ABox.AspectRatio;
            changingAspect:=False;
-
-           //edUnit_Type.ItemIndex :=Integer(ABox^.UnitType);
+           inFillBoxUI :=False;
         end
    else BCPanelCropArea.Enabled :=False;
 end;

test/test_checklistbox/project1.lpi

@@ -0,0 +1,80 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="project1"/>
+      <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="project1.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="unit1.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="Unit1"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="project1"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <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_checklistbox/project1.lpr

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

test/test_checklistbox/unit1.lfm

@@ -0,0 +1,30 @@
+object Form1: TForm1
+  Left = 285
+  Height = 240
+  Top = 31
+  Width = 320
+  Caption = 'Form1'
+  ClientHeight = 240
+  ClientWidth = 320
+  OnCreate = FormCreate
+  LCLVersion = '2.2.6.0'
+  object CheckListBox1: TCheckListBox
+    Left = 48
+    Height = 174
+    Top = 32
+    Width = 198
+    ItemHeight = 32
+    OnDrawItem = CheckListBox1DrawItem
+    Style = lbOwnerDrawFixed
+    TabOrder = 0
+  end
+  object BGRAThemeCheckBox1: TBGRAThemeCheckBox
+    Left = 48
+    Height = 19
+    Top = 8
+    Width = 165
+    Caption = 'BGRAThemeCheckBox1'
+    Checked = False
+    TabOrder = 1
+  end
+end

test/test_checklistbox/unit1.pas

@@ -0,0 +1,125 @@
+unit Unit1;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, CheckLst, Types,
+  StdCtrls, BGRAThemeCheckBox, BGRABitmap, BGRABitmapTypes, BGRATheme;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    BGRAThemeCheckBox1: TBGRAThemeCheckBox;
+    CheckListBox1: TCheckListBox;
+    procedure CheckListBox1DrawItem(Control: TWinControl; Index: Integer;
+      ARect: TRect; State: TOwnerDrawState);
+    procedure FormCreate(Sender: TObject);
+  private
+    procedure DrawCheckBox(aCaption: string; State: TBGRAThemeButtonState;
+      aFocused: boolean; Checked: boolean; ARect: TRect;
+      ASurface: TBGRAThemeSurface);
+
+  public
+
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+{ TForm1 }
+
+procedure TForm1.CheckListBox1DrawItem(Control: TWinControl; Index: Integer;
+  ARect: TRect; State: TOwnerDrawState);
+var
+  surface: TBGRAThemeSurface;
+  parentForm: TCustomForm;
+  lclDPI: Integer;
+begin
+  parentForm := GetParentForm(Control, False);
+  if Assigned(parentForm) then
+    lclDPI := parentForm.PixelsPerInch
+    else lclDPI := Screen.PixelsPerInch;
+  surface := TBGRAThemeSurface.Create(ARect, TCheckListBox(Control).Canvas, Control.GetCanvasScaleFactor, lclDPI);
+  try
+    DrawCheckBox(TCheckListBox(Control).Items[Index], btbsNormal, False, TCheckListBox(Control).Checked[Index], ARect, surface);
+  finally
+    surface.Free;
+  end;
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  CheckListBox1.AddItem('Red', nil);
+  CheckListBox1.AddItem('Green', nil);
+  CheckListBox1.AddItem('Blue', nil);
+  CheckListBox1.AddItem('Alpha', nil);
+end;
+
+procedure TForm1.DrawCheckBox(aCaption: string; State: TBGRAThemeButtonState;
+  aFocused: boolean; Checked: boolean; ARect: TRect; ASurface: TBGRAThemeSurface
+  );
+var
+  Style: TTextStyle;
+  aColor: TBGRAPixel;
+  aleft, atop, aright, abottom: integer;
+  penWidth: single;
+begin
+  with ASurface do
+  begin
+    DestCanvas.Font.Color := clBlack;
+    case State of
+      btbsHover: aColor := BGRA(0, 120, 215);
+      btbsActive: aColor := BGRA(0, 84, 153);
+      btbsDisabled:
+      begin
+        DestCanvas.Font.Color := clGray;
+        aColor := BGRA(204, 204, 204);
+      end;
+      else {btbsNormal}
+        aColor := BGRABlack;
+    end;
+
+    Bitmap.Fill(BGRAWhite);
+    BitmapRect := ARect;
+    penWidth := ASurface.ScaleForBitmap(10) / 10;
+    aleft := round(penWidth);
+    aright := Bitmap.Height-round(penWidth);
+    atop := round(penWidth);
+    abottom := Bitmap.Height-round(penWidth);
+    Bitmap.RectangleAntialias(aleft-0.5+penWidth/2, atop-0.5+penWidth/2,
+      aright-0.5-penWidth/2, abottom-0.5-penWidth/2,
+      aColor, penWidth);
+    aleft := round(penWidth*2);
+    aright := Bitmap.Height-round(penWidth*2);
+    atop := round(penWidth*2);
+    abottom := Bitmap.Height-round(penWidth*2);
+    if Checked then
+      Bitmap.DrawPolyLineAntialias(Bitmap.ComputeBezierSpline(
+        [BezierCurve(pointF(aleft + 2, atop + 3), PointF((aleft + aright - 1) / 2, abottom - 3)),
+        BezierCurve(PointF((aleft + aright - 1) / 2, abottom - 3), PointF(
+        (aleft + aright - 1) / 2, (atop * 2 + abottom - 1) / 3), PointF(aright - 2, atop))]),
+        Color, penWidth*1.5);
+    DrawBitmap;
+
+    if aCaption <> '' then
+    begin
+      fillchar(Style, sizeof(Style), 0);
+      Style.Alignment := taLeftJustify;
+      Style.Layout := tlCenter;
+      Style.Wordbreak := True;
+      DestCanvas.TextRect(ARect,
+        ARect.Height, 0, aCaption, Style);
+    end;
+  end;
+end;
+
+end.
+

test/test_windows_theme/umain.lfm

@@ -0,0 +1,123 @@
+object frmWindowsTheme: TfrmWindowsTheme
+  Left = 63
+  Height = 480
+  Top = 225
+  Width = 848
+  Caption = 'Windows Theme'
+  ClientHeight = 480
+  ClientWidth = 848
+  Color = 15987699
+  DesignTimePPI = 192
+  Position = poScreenCenter
+  LCLVersion = '3.99.0.0'
+  OnCreate = FormCreate
+  object BCPanel1: TBCPanel
+    Left = 16
+    Height = 224
+    Top = 16
+    Width = 816
+    Anchors = [akTop, akLeft, akRight]
+    Background.Color = 16514043
+    Background.Gradient1.StartColor = clWhite
+    Background.Gradient1.EndColor = clBlack
+    Background.Gradient1.GradientType = gtLinear
+    Background.Gradient1.Point1XPercent = 0
+    Background.Gradient1.Point1YPercent = 0
+    Background.Gradient1.Point2XPercent = 0
+    Background.Gradient1.Point2YPercent = 100
+    Background.Gradient2.StartColor = clWhite
+    Background.Gradient2.EndColor = clBlack
+    Background.Gradient2.GradientType = gtLinear
+    Background.Gradient2.Point1XPercent = 0
+    Background.Gradient2.Point1YPercent = 0
+    Background.Gradient2.Point2XPercent = 0
+    Background.Gradient2.Point2YPercent = 100
+    Background.Gradient1EndPercent = 35
+    Background.Style = bbsColor
+    BevelInner = bvNone
+    BevelOuter = bvNone
+    BevelWidth = 1
+    Border.Color = 15066597
+    Border.Style = bboSolid
+    BorderBCStyle = bpsBorder
+    FontEx.Color = clDefault
+    FontEx.FontQuality = fqSystemClearType
+    FontEx.Shadow = False
+    FontEx.ShadowRadius = 5
+    FontEx.ShadowOffsetX = 5
+    FontEx.ShadowOffsetY = 5
+    FontEx.Style = []
+    ParentBackground = False
+    Rounding.RoundX = 5
+    Rounding.RoundY = 5
+    TabOrder = 0
+    object BCLabel1: TBCLabel
+      Left = 48
+      Height = 28
+      Top = 48
+      Width = 267
+      Background.Gradient1.StartColor = clWhite
+      Background.Gradient1.EndColor = clBlack
+      Background.Gradient1.GradientType = gtLinear
+      Background.Gradient1.Point1XPercent = 0
+      Background.Gradient1.Point1YPercent = 0
+      Background.Gradient1.Point2XPercent = 0
+      Background.Gradient1.Point2YPercent = 100
+      Background.Gradient2.StartColor = clWhite
+      Background.Gradient2.EndColor = clBlack
+      Background.Gradient2.GradientType = gtLinear
+      Background.Gradient2.Point1XPercent = 0
+      Background.Gradient2.Point1YPercent = 0
+      Background.Gradient2.Point2XPercent = 0
+      Background.Gradient2.Point2YPercent = 100
+      Background.Gradient1EndPercent = 35
+      Background.Style = bbsClear
+      Border.Style = bboNone
+      Caption = 'Configuración recomendada'
+      FontEx.Color = 1776411
+      FontEx.FontQuality = fqSystemClearType
+      FontEx.Height = 20
+      FontEx.Shadow = False
+      FontEx.ShadowRadius = 5
+      FontEx.ShadowOffsetX = 5
+      FontEx.ShadowOffsetY = 5
+      FontEx.Style = [fsBold]
+      Rounding.RoundX = 1
+      Rounding.RoundY = 1
+    end
+    object BCLabel2: TBCLabel
+      Left = 48
+      Height = 19
+      Top = 128
+      Width = 280
+      Background.Gradient1.StartColor = clWhite
+      Background.Gradient1.EndColor = clBlack
+      Background.Gradient1.GradientType = gtLinear
+      Background.Gradient1.Point1XPercent = 0
+      Background.Gradient1.Point1YPercent = 0
+      Background.Gradient1.Point2XPercent = 0
+      Background.Gradient1.Point2YPercent = 100
+      Background.Gradient2.StartColor = clWhite
+      Background.Gradient2.EndColor = clBlack
+      Background.Gradient2.GradientType = gtLinear
+      Background.Gradient2.Point1XPercent = 0
+      Background.Gradient2.Point1YPercent = 0
+      Background.Gradient2.Point2XPercent = 0
+      Background.Gradient2.Point2YPercent = 100
+      Background.Gradient1EndPercent = 35
+      Background.Style = bbsClear
+      Border.Style = bboNone
+      Caption = 'Configuración reciente y usada habitualmente'
+      FontEx.Color = 6250335
+      FontEx.FontQuality = fqSystemClearType
+      FontEx.Height = 14
+      FontEx.Shadow = False
+      FontEx.ShadowRadius = 5
+      FontEx.ShadowOffsetX = 5
+      FontEx.ShadowOffsetY = 5
+      FontEx.Style = []
+      Rounding.RoundX = 1
+      Rounding.RoundY = 1
+    end
+  end
+end

test/test_windows_theme/umain.pas

@@ -0,0 +1,42 @@
+unit umain;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, BCPanel, BCLabel;
+
+type
+
+  { TfrmWindowsTheme }
+
+  TfrmWindowsTheme = class(TForm)
+    BCLabel1: TBCLabel;
+    BCLabel2: TBCLabel;
+    BCPanel1: TBCPanel;
+    procedure FormCreate(Sender: TObject);
+  private
+
+  public
+
+  end;
+
+var
+  frmWindowsTheme: TfrmWindowsTheme;
+
+implementation
+
+{$R *.lfm}
+
+{ TfrmWindowsTheme }
+
+procedure TfrmWindowsTheme.FormCreate(Sender: TObject);
+begin
+  BCLabel1.FontEx.Height := ScaleY(BCLabel1.FontEx.Height, 96);
+  BCLabel2.FontEx.Height := ScaleY(BCLabel2.FontEx.Height, 96);
+  BCPanel1.Border.Width := ScaleY(BCPanel1.Border.Width, 96);
+end;
+
+end.
+

test/test_windows_theme/windowstheme.lpi

@@ -0,0 +1,140 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="windowstheme"/>
+      <Scaled Value="True"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
+    </General>
+    <BuildModes>
+      <Item Name="Debug" Default="True"/>
+      <Item Name="Release">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <PathDelim Value="\"/>
+          <Target>
+            <Filename Value="windowstheme"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir)"/>
+            <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+          </SearchPaths>
+          <CodeGeneration>
+            <SmartLinkUnit Value="True"/>
+            <Optimizations>
+              <OptimizationLevel Value="3"/>
+            </Optimizations>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <GenerateDebugInfo Value="False"/>
+              <RunWithoutDebug Value="True"/>
+            </Debugging>
+            <LinkSmart Value="True"/>
+            <Options>
+              <Win32>
+                <GraphicApplication Value="True"/>
+              </Win32>
+            </Options>
+          </Linking>
+          <Other>
+            <ConfigFile>
+              <WriteConfigFilePath Value=""/>
+            </ConfigFile>
+          </Other>
+        </CompilerOptions>
+      </Item>
+    </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="windowstheme.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="umain.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="frmWindowsTheme"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="windowstheme"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <IncludeAssertionCode Value="True"/>
+      </SyntaxOptions>
+    </Parsing>
+    <CodeGeneration>
+      <Checks>
+        <IOChecks Value="True"/>
+        <RangeChecks Value="True"/>
+        <OverflowChecks Value="True"/>
+        <StackChecks Value="True"/>
+      </Checks>
+      <VerifyObjMethodCallValidity Value="True"/>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf3"/>
+        <UseHeaptrc Value="True"/>
+        <TrashVariables Value="True"/>
+        <UseExternalDbgSyms Value="True"/>
+      </Debugging>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <ConfigFile>
+        <WriteConfigFilePath Value=""/>
+      </ConfigFile>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

test/test_windows_theme/windowstheme.lpr

@@ -0,0 +1,25 @@
+program windowstheme;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}
+  cthreads,
+  {$ENDIF}
+  {$IFDEF HASAMIGA}
+  athreads,
+  {$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, umain
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource:=True;
+  Application.Scaled:=True;
+  Application.Initialize;
+  Application.CreateForm(TfrmWindowsTheme, frmWindowsTheme);
+  Application.Run;
+end.
+