Merge pull request #191 from bgrabitmap/dev-bgracontrols

Merge 9.0.1.6 to master

bcleaboard.pas

@@ -89,7 +89,7 @@   TBCLeaBoard = class(TCustomControl)
     property OnContextPopup;
     property FrameColor: TColor read FFrameColor write SetFrameColor default clBtnFace;
     property BoardColor: TColor read FBoardColor write SetBoardColor default clBtnFace;
-    property BackgroundColor: TColor read FBkgColor write SetBkgColor default clWhite;
+    property BackgroundColor: TColor read FBkgColor write SetBkgColor default clBtnFace;
     property FrameStyle: TZStyle read FFrameStyle write SetFrameStyle default zsRaised;
     property BoardStyle: TZStyle read FBoardStyle write SetBoardStyle default zsFlat;
     property Theme: TBCLeaTheme read FTheme write SetTheme;
@@ -114,8 +114,8 @@ constructor TBCLeaBoard.Create(AOwner: TComponent);
   with GetControlClassDefaultSize do
     SetInitialBounds(0, 0, 200, 150);
   ControlStyle := [csAcceptsControls, csReplicatable, csClickEvents];
-  FBitmap := TBGRABitmap.Create(Width, Height, FBkgColor);
   ApplyDefaultTheme;
+  FBitmap := TBGRABitmap.Create(Width, Height, FBkgColor);
 end;
 
 destructor TBCLeaBoard.Destroy;

bcleaqled.pas

@@ -142,9 +142,9 @@ constructor TBCLeaQLED.Create(AOwner: TComponent);
   with GetControlClassDefaultSize do
     SetInitialBounds(0, 0, 50, 50);
   FValue := False;
+  ApplyDefaultTheme;
   FBitmap := TBGRABitmap.Create(Width, Height, FBkgColor);
   FClickable := False;
-  ApplyDefaultTheme;
 end;
 
 destructor TBCLeaQLED.Destroy;

bclearingslider.pas

@@ -37,6 +37,8 @@   TBCLeaRingSlider = class(TCustomControl)
     FLineWidth: integer;
     FVerticalPos: single;
     FDeltaPos: single;
+    FDirection: integer;
+    FPrevCurrPosition: single;
     FSettingVerticalPos: boolean;
     FSensitivity: integer;
     FMinAngle: integer;
@@ -308,6 +310,7 @@ procedure TBCLeaRingSlider.Redraw;
   EffectiveLineWidth: single;
   r: single;
   RMinAngle, RMaxAngle: single;
+  RValue: single;
   Blur: TBGRABitmap;
   Mask, Mask2: TBGRABitmap;
   Phong: TPhongShading;
@@ -365,24 +368,25 @@ procedure TBCLeaRingSlider.Redraw;
   FBitmap.Canvas2D.lineWidth := EffectiveLineWidth;
 
   RMinAngle := (180 + FMinAngle) * pi / 180;
-  RMaxAngle := ((180 + FMaxAngle) * pi / 180) - RMinAngle;
+  RMaxAngle := ((180 + FMaxAngle) * pi / 180);
+  RValue := ((180 + FMinAngle + ((FMaxAngle - FMinAngle) / FMaxValue * FValue)) * pi / 180);
 
   FBitmap.Canvas2D.lineCapLCL := pecRound;
   // background line
   if FLineBkgColor <> clNone then
-    DoDrawArc(RMinAngle, (RMaxAngle + RMinAngle), FLineBkgColor);
+    DoDrawArc(RMinAngle, RMaxAngle, FLineBkgColor);
 
   if Enabled then
   begin
     if FValue > FMinValue then
     begin
-      DoDrawArc(RMinAngle, (RMaxAngle / (FMaxValue + FOffset)) * ((FValue + FOffset) - ((FMaxValue + FOffset) / 2)), FLineColor);
+      DoDrawArc(RMinAngle, RValue, FLineColor);
       if FDrawPointer then
-        DoDrawPointer((RMaxAngle / (FMaxValue + FOffset)) * ((FValue + FOffset) - ((FMaxValue + FOffset) / 2)), FPointerColor);
+        DoDrawPointer(RValue, FPointerColor);
     end;
   end
   else
-    DoDrawArc(RMinAngle, (RMaxAngle / (FMaxValue + FOffset)) * ((FValue + FOffset) - ((FMaxValue + FOffset) / 2)), clGray);
+    DoDrawArc(RMinAngle, RMaxAngle, clGray);
 
   if FDrawText and FDrawTextPhong then
   begin
@@ -455,20 +459,22 @@ constructor TBCLeaRingSlider.Create(AOwner: TComponent);
 
   with GetControlClassDefaultSize do
     SetInitialBounds(0, 0, 100, 100);
+  TabStop := True;
   FMaxValue := 100;
   FMinValue := 0;
   FOffset := 0;
   FMinAngle := 20;
   FMaxAngle := 340;
   FValue := 0;
   FDeltaPos := 0;
+  FDirection := 0;
   FSensitivity := 10;
   Font.Color := clBlack;
   Font.Height := 20;
   FDrawText := True;
   FDrawPointer := False;
-  FBitmap := TBGRABitmap.Create(Width, Height, FBkgColor);
   ApplyDefaultTheme;
+  FBitmap := TBGRABitmap.Create(Width, Height, FBkgColor);
 end;
 
 destructor TBCLeaRingSlider.Destroy;
@@ -483,6 +489,9 @@ procedure TBCLeaRingSlider.MouseDown(Button: TMouseButton; Shift: TShiftState; X
   if Button = mbLeft then
   begin
     FDeltaPos := ((ClientHeight / FSensitivity) - (Y / FSensitivity)) * (FMaxValue / ClientHeight);
+    FDirection := 0;
+    FPrevCurrPosition := 0;
+    FVerticalPos := FValue;
     FSettingVerticalPos := True;
   end;
 end;
@@ -505,10 +514,24 @@ procedure TBCLeaRingSlider.UpdateVerticalPos(X, Y: integer);
 var
   FPreviousPos: single;
   FCurrPos: single;
+  FNewDirection: integer;
 begin
+  {The whole code here is for beter control of the slider with the mouse movements}
   FPreviousPos := FVerticalPos;
   FCurrPos := ((ClientHeight / FSensitivity) - (Y / FSensitivity)) * (FMaxValue / ClientHeight);
 
+  if FPrevCurrPosition <> 0 then
+  begin
+    if FCurrPos < FPrevCurrPosition then FNewDirection := -1;
+    if FCurrPos > FPrevCurrPosition then FNewDirection := 1;
+    if FNewDirection <> FDirection then
+    begin
+      FDirection := FNewDirection;
+      FDeltaPos := ((ClientHeight / FSensitivity) - (Y / FSensitivity)) * (FMaxValue / ClientHeight);
+    end;
+  end;
+  FPrevCurrPosition := FCurrPos;
+
   FVerticalPos := FVerticalPos - FDeltaPos + FCurrPos;
   if FVerticalPos < FMinValue then FVerticalPos := FMinValue;
   if FVerticalPos > FMaxValue then FVerticalPos := FMaxValue;

bcleaselector.pas

@@ -29,7 +29,6 @@   TBCLeaSelector = class(TCustomControl)
     FTheme: TBCLeaTheme;
     FOnChangeValue: TNotifyEvent;
     FTicksCount: integer;
-    FOffset: integer;
     FValue: integer;
     FLineColor: TColor;
     FLineBkgColor: TColor;
@@ -398,12 +397,12 @@ procedure TBCLeaSelector.Redraw;
   begin
     for i := 0 to FTicksCount - 1 do
     begin
-      RAngle := (RMaxTicksAngle / (FTicksCount - 1 + FOffset)) * ((i + FOffset) - ((FTicksCount - 1 + FOffset) / 2));
+      RAngle := (RMaxTicksAngle / (FTicksCount - 1)) * (i - ((FTicksCount - 1) / 2));
       DoDrawTicks(RAngle - FPointerSize / 200, RAngle + FPointerSize / 200, clBlack);
     end;
   end;
 
-  RAngle := (RMaxTicksAngle / (FTicksCount - 1 + FOffset)) * ((FValue + FOffset) - ((FTicksCount - 1 + FOffset) / 2));
+  RAngle := (RMaxTicksAngle / (FTicksCount - 1)) * (FValue - ((FTicksCount - 1) / 2));
   if Enabled then
   begin
     if FValue >= 0 then
@@ -491,8 +490,8 @@ constructor TBCLeaSelector.Create(AOwner: TComponent);
 
   with GetControlClassDefaultSize do
     SetInitialBounds(0, 0, 100, 100);
+  TabStop:=True;
   FTicksCount := 3;
-  FOffset := 0;
   FMinAngle := 20;
   FMaxAngle := 340;
   FMinTicksAngle := 150;
@@ -502,6 +501,7 @@ constructor TBCLeaSelector.Create(AOwner: TComponent);
   FSensitivity := 10;
   FDrawText := True;
   FDrawTicks := False;
+  ApplyDefaultTheme;
   FBitmap := TBGRABitmap.Create(Width, Height, FBkgColor);
   FItems := TStringList.Create;
   FItems.Add('Item 1');
@@ -510,7 +510,6 @@ constructor TBCLeaSelector.Create(AOwner: TComponent);
   TStringList(FItems).OnChange := @ItemsChanged;
   Font.Color := clBlack;
   Font.Height := 20;
-  ApplyDefaultTheme;
 end;
 
 destructor TBCLeaSelector.Destroy;
@@ -528,6 +527,7 @@ procedure TBCLeaSelector.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
   begin
     FDeltaPos := ((ClientHeight / FSensitivity) - (Y / FSensitivity)) * ((FTicksCount - 1) / ClientHeight);
     FSettingVerticalPos := True;
+    FVerticalPos := FValue;
   end;
 end;
 

bgraimagemanipulation.pas

@@ -75,6 +75,12 @@
              - CropArea Rotate and Flip
              - CropArea Duplicate and SetSize
              - NewCropAreaDefault property (to Cm); ResolutionUnitConvert function; SetEmptyImageSizeToCropAreas
+      -10    - Load/Save XML Path Parameters, ContextMenu, UserData in GetAllBitmapCallback, CropArea Icons
+  2024-01    - Added CopyProperties to GetBitmap methods
+      -06    - Solved Bugs when load/save from xml
+      -08    - Removed EmptyImage.Allow, so is always allowed
+               CopyPropertiesToArea and Icons in NewCropAreaDefault
+               Updated Component icon
   ============================================================================
 }
 
@@ -292,7 +298,6 @@   TCropAreaList = class(TObjectList)
   TBGRAEmptyImage = class(TPersistent)
   private
     fOwner: TBGRAImageManipulation;
-    rAllow: Boolean;
     rResolutionHeight: Single;
     rResolutionUnit: TResolutionUnit;
     rResolutionWidth: Single;
@@ -309,7 +314,6 @@   TBGRAEmptyImage = class(TPersistent)
     constructor Create(AOwner: TBGRAImageManipulation);
 
   published
-    property Allow: Boolean read rAllow write rAllow default False;
     property ResolutionUnit: TResolutionUnit read rResolutionUnit write SetResolutionUnit default ruPixelsPerCentimeter;
     property ResolutionWidth: Single read rResolutionWidth write rResolutionWidth;
     property ResolutionHeight: Single read rResolutionHeight write rResolutionHeight;
@@ -322,13 +326,17 @@   TBGRANewCropAreaDefault = class(TPersistent)
   private
     fOwner: TBGRAImageManipulation;
     rAspectRatio: string;
+    rIcons: TCropAreaIcons;
     rKeepAspectRatio: BoolParent;
     rResolutionUnit: TResolutionUnit;
 
   public
     constructor Create(AOwner: TBGRAImageManipulation);
 
+    procedure CopyPropertiesToArea(ANewArea: TCropArea);
+
   published
+    property Icons: TCropAreaIcons read rIcons write rIcons;
     property ResolutionUnit: TResolutionUnit read rResolutionUnit write rResolutionUnit default ruPixelsPerCentimeter;
     property AspectRatio: string read rAspectRatio write rAspectRatio;
     property KeepAspectRatio: BoolParent read rKeepAspectRatio write rKeepAspectRatio default bFalse;
@@ -1854,7 +1862,6 @@ constructor TBGRAEmptyImage.Create(AOwner: TBGRAImageManipulation);
 begin
   inherited Create;
   fOwner :=AOwner;
-  rAllow :=False;
   rShowBorder :=False;
   rResolutionUnit:=ruPixelsPerCentimeter;
 end;
@@ -1868,6 +1875,14 @@ constructor TBGRANewCropAreaDefault.Create(AOwner: TBGRAImageManipulation);
   rKeepAspectRatio:=bFalse;
   rAspectRatio:='3:4';
   rResolutionUnit:=ruPixelsPerCentimeter;
+  rIcons:= [];
+end;
+
+procedure TBGRANewCropAreaDefault.CopyPropertiesToArea(ANewArea: TCropArea);
+begin
+  ANewArea.rIcons:= Self.rIcons;
+  ANewArea.rAspectRatio:= Self.rAspectRatio;
+  ANewArea.KeepAspectRatio:= Self.rKeepAspectRatio;
 end;
 
 { TBGRAImageManipulation }
@@ -2678,7 +2693,7 @@ procedure TBGRAImageManipulation.Loaded;
 begin
   inherited Loaded;
 
-  if Self.Empty and rEmptyImage.Allow then
+  if Self.Empty then
   begin
     CreateEmptyImage;
     CreateResampledBitmap;
@@ -2875,15 +2890,15 @@ procedure TBGRAImageManipulation.Resize;
   inherited Resize;
 
   //MaxM: Maybe csLoading in ComponentState but it does not work
-  if rLoading then exit;
+  //if rLoading then exit;
 
   if (fVirtualScreen <> nil) then
   begin
     fVirtualScreen.SetSize(min(Self.Width, (fBorderSize * 2 + fAnchorSize + fMinWidth)),
       min(Self.Height, (fBorderSize * 2 + fAnchorSize + fMinHeight)));
     fVirtualScreen.InvalidateBitmap;
 
-    if Self.Empty and rEmptyImage.Allow
+    if Self.Empty
     then CreateEmptyImage;
 
     CreateResampledBitmap;
@@ -2941,7 +2956,7 @@ procedure TBGRAImageManipulation.Render;
     FillColor := BGRA(0, 0, 0, 128);
     Mask := TBGRABitmap.Create(WorkRect.Right - WorkRect.Left, WorkRect.Bottom - WorkRect.Top, FillColor);
 
-    if Self.Empty and rEmptyImage.Allow and rEmptyImage.ShowBorder then
+    if Self.Empty and rEmptyImage.ShowBorder then
     begin
       emptyRect :=Rect(0,0,fResampledBitmap.Width-1, fResampledBitmap.Height-1);
       Mask.CanvasBGRA.Frame3d(emptyRect, 1, bvRaised, BGRA(255, 255, 255, 180), BGRA(0, 0, 0, 160));
@@ -2979,6 +2994,7 @@ procedure TBGRAImageManipulation.Render;
           BorderColor, BGRAPixelTransparent, 1, False);
 
       //Draw Icons
+      { #todo 1 -oMaxM : Draw Other Icons }
       if (cIcoIndex in curCropArea.Icons) then
       begin
         TextS.Alignment:=taCenter;
@@ -3192,11 +3208,7 @@ procedure TBGRAImageManipulation.setBitmap(const Value: TBGRABitmap);
   begin
     try
       if Value.Empty or (Value.Width = 0) or (Value.Height = 0)
-      then begin
-             if EmptyImage.Allow
-             then CreateEmptyImage
-             else exit;
-           end
+      then CreateEmptyImage
       else begin
              // Clear actual image
              fImageBitmap.Free;
@@ -3234,9 +3246,8 @@ procedure TBGRAImageManipulation.rotateLeft(ACopyProperties: Boolean=False);
 
 begin
   try
-    // Prevent empty image if not Allowed
-    if Self.Empty and not(rEmptyImage.Allow)
-    then exit;
+    // Prevent empty image
+    if Self.Empty then exit;
 
     // Rotate bitmap
     TempBitmap := fImageBitmap.RotateCCW(ACopyProperties);
@@ -3272,9 +3283,8 @@ procedure TBGRAImageManipulation.rotateRight(ACopyProperties: Boolean=False);
 
 begin
   try
-    // Prevent empty image if not Allowed
-    if Self.Empty and not(rEmptyImage.Allow)
-    then exit;
+    // Prevent empty image
+    if Self.Empty then exit;
 
     // Rotate bitmap
     TempBitmap := fImageBitmap.RotateCW(ACopyProperties);
@@ -3317,7 +3327,10 @@ function TBGRAImageManipulation.addCropArea(AArea: TRectF; AAreaUnit: TResolutio
 begin
   try
      newCropArea :=TCropArea.Create(Self, AArea, AAreaUnit, AUserData);
-     newCropArea.BorderColor :=BGRAWhite;
+
+     newCropArea.BorderColor:= BGRAWhite;
+     rNewCropAreaDefault.CopyPropertiesToArea(newCropArea);
+
      rCropAreas.add(newCropArea);
 
      if (rSelectedCropArea = nil)
@@ -3340,8 +3353,6 @@ function TBGRAImageManipulation.addCropArea(AArea: TRectF; AAreaUnit: TResolutio
 function TBGRAImageManipulation.addScaledCropArea(AArea: TRect; AUserData: Integer): TCropArea;
 begin
      Result :=Self.addCropArea(RectF(0,0,0,0), rNewCropAreaDefault.rResolutionUnit, AUserData);
-     Result.rAspectRatio:=rNewCropAreaDefault.rAspectRatio;
-     Result.KeepAspectRatio:=rNewCropAreaDefault.rKeepAspectRatio;
      Result.ScaledArea :=AArea;
 
      if (fMouseCaught)
@@ -3430,7 +3441,7 @@ procedure TBGRAImageManipulation.SetEmptyImageSizeToCropAreas(ReduceLarger: Bool
    xRatio, yRatio, resX :Single;
 
 begin
-  if Self.Empty and rEmptyImage.Allow and (rCropAreas.Count>0) then
+  if Self.Empty and (rCropAreas.Count>0) then
   begin
      if ReduceLarger
      then begin

images/bgracontrols_images_list.txt

@@ -76,6 +76,7 @@ tbgratheme_200.png
 tbgracolortheme.png
 tbgracolortheme_150.png
 tbgracolortheme_200.png
+tbgraimagemanipulation.png
 tbgraimagetheme.png
 tbgraimagetheme_150.png
 tbgraimagetheme_200.png