From f3bf78a2f6ad0ce832a00c41b523fade2d9b21d5 Mon Sep 17 00:00:00 2001 From: Massimo Magnano Date: Fri, 9 Aug 2024 16:18:03 +0200 Subject: [PATCH 1/4] Removed EmptyImage.Allow, so is always allowed (bug #189), CopyPropertiesToArea and Icons in NewCropAreaDefault, Updated Component icon and Demo) Removed EmptyImage.Allow, so is always allowed (bug #189), CopyPropertiesToArea and Icons in NewCropAreaDefault, Updated Component icon and Demo --- bgraimagemanipulation.pas | 55 +++++++++++------- images/bgracontrols_images.res | Bin 244499 -> 245547 bytes images/bgracontrols_images_list.txt | 1 + images/tbgraimagemanipulation.png | Bin 288 -> 972 bytes .../unitbgraimagemanipulationdemo.lfm | 40 +++++++++---- .../unitbgraimagemanipulationdemo.pas | 19 ++++-- 6 files changed, 78 insertions(+), 37 deletions(-) diff --git a/bgraimagemanipulation.pas b/bgraimagemanipulation.pas index c1854fc..9b221ce 100644 --- a/bgraimagemanipulation.pas +++ b/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,7 +2890,7 @@ 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 @@ -2883,7 +2898,7 @@ procedure TBGRAImageManipulation.Resize; 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 diff --git a/images/bgracontrols_images.res b/images/bgracontrols_images.res index 68aa26353a9f66194f3b6b8336274bbc8b46ecd8..23968bca7f051e8fba6e8e85c3d719f43283fc24 100644 GIT binary patch delta 996 zcmVk6Nkl_w(dXWkq6#tiqhecDd zv1nn%V8mK!Xso-NoypG3dmd(HXSQim2;?1x-!N}}-{0>$-|z2@s8lMJO&7$w%odPl^|GPcGeJvApnl!V2r^S zgHoy+JC4KX=x7AcYVBv&u7}oCP%5SIwtx1+gUg(sdjn&BMF;_aF$MrBWlwBv#JmLP zbUJ9Q34$QvEmMh7Dnc-eV4H+th<`B#Ap}B*`vNF{LZQIGKtIsG4xs3A_d5flqHS%`-7kVyJW&9fr8plJ8qV=m3AIh|TBeTUbCIXz=+rF+jWhIER7hxPS1^fIrI5 zGFx~LY!MLf6X1jIm&xaMGBh^Ut=w9RwH9Z@VatK709>6u4N687Nh$dV7~B04Si!qD zC6}fya{9+%cvZkY;2pq=5@w~Da2$+&I0q{Hzr4)ri0oQd2YJbZprSNLC6d=*`jT=u=E;q4O#4q=)(URjhXss!gwyb&9 zpAn(Vf13gf4qjt!PN4N(g5Xi4lx*L=gy#*=Xk6~fuhIAy-~SD*9|qt$FqCBUfIorV z(QP57P63=b^9xd5BM1Vdlt?Mp9R-IDwE_45IFSHc1dampz+Py2UVrL?#PZ2Ux}Q@Q z7e8bP_zw7z_;NH(bOKm{+}7VW4zOp>3;YLs0$c&YpUWxvUjQ!X)yH}Plv3-?qGS|A zzG-t7c%pTLH*delLHA=?9ElR02S%X1va<0Glv2D7JXblz-`mbodu1n;XHG!{cs|Of zbGeNJBpyJfhoL-ZA%AmjCEd!bzVD`-tW%S?)9J*8h}5~E=r!c(YAVz0Oi4_4=SrSg zYrCBsJN7b@lcl(;#$ASc1|U1nv(+XuCJ}*@5Zbj+{133;$Bigqq&ENn01g02MNUMnLSTaB0{{R# SmqDQdC5J+t0=Gh)1JNA~3d`64 delta 33 pcmZ4ek8kofzJ?aYEld(~r_bnO5}U3!mx-%AU?J1?fQ8JrWdZKW4I2Oe diff --git a/images/bgracontrols_images_list.txt b/images/bgracontrols_images_list.txt index 9153211..f7ec49b 100644 --- a/images/bgracontrols_images_list.txt +++ b/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 diff --git a/images/tbgraimagemanipulation.png b/images/tbgraimagemanipulation.png index 2a12bb60a5a1b535793c41a932ae89178860bc24..c0a900f6cebed29b2e5a08317965123c9ba76025 100644 GIT binary patch delta 962 zcmV;z13mnp0?Y@H7=H)`0002scRlz3000JJOGiWimjIUlmkd(q?EnA(32;bRa{vGi z!~g&e!~vBn4jTXf18hk|K~zY`wU$q499100KkvKd`rGN3ZfA+(J%bcHk17m(g2mydG1^_8#Pi$?(yaecUI%us4f*|58Q;AY4 zLNJS9n}lJAF$N(7LWuhUD1bttz`#I1(7z6&5%`4*@1vCJQj`=E1VK;iI8NF@viT8U zBAas{SsKgyEi45rY>^&$65-QrGJ@l9fl!N$}YQRd_1M7)9GM=uB9Ka2*CLsc&+zS`@WCsx@fHd@H`Kt6ooVw4c$w#`MQx_LMWC{2V_>%Z?G){B^ zSc2Tv-!~4hXU_}#2Ydot0m7flDfwRjF6h&~KN6hyvha~61_b%Zx>zsN!N zV}Dv4i4vU$Mxed2vhfa-QoIg4S2@Ms+s;yZWha$qPC*5DKFX(axs3xP9zdptp*(0I zb8aQw%B;Tcrkt!(lep9A#D$2|xuNJao>^WsGSd#Wcos@r+?)xXzV&3@|e@vk6E3 kQ*bFh^sCkCrv0}353u0JjVNKHHvj+t07*qoM6N<$f+@eg)Bpeg literal 288 zcmeAS@N?(olHy`uVBq!ia0vp^5+KaN3?zjj6;1;w#^NA%Cx&(BWL^R}1_3@Hu0Xm0 zj2pmI1CZAM0tXHp_zx8S&+s2i0cju$2&&~b9s!DT7I;J!Gca%qgD@k*tT`a7*h@Tp zUDV!GXj{-#WAAHjkTK>qt1>MSRq3m80I{an^L HB{Ts53aDXv diff --git a/test/test_bgraimagemanipulation/unitbgraimagemanipulationdemo.lfm b/test/test_bgraimagemanipulation/unitbgraimagemanipulationdemo.lfm index 624cb45..d218376 100644 --- a/test/test_bgraimagemanipulation/unitbgraimagemanipulationdemo.lfm +++ b/test/test_bgraimagemanipulation/unitbgraimagemanipulationdemo.lfm @@ -1,10 +1,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo - Left = 291 - Height = 513 - Top = 220 + Left = 262 + Height = 543 + Top = 84 Width = 926 Caption = 'Demonstration of TBGRAImageManipulation' - ClientHeight = 513 + ClientHeight = 543 ClientWidth = 926 ShowHint = True LCLVersion = '3.99.0.0' @@ -12,7 +12,7 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo OnCreate = FormCreate object Background: TBCPanel Left = 678 - Height = 513 + Height = 543 Top = 0 Width = 248 Align = alRight @@ -1615,7 +1615,7 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo end object BGRAImageManipulation: TBGRAImageManipulation Left = 198 - Height = 513 + Height = 543 Top = 0 Width = 480 Align = alClient @@ -1623,10 +1623,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo AspectRatio = '3:4' MinHeight = 40 MinWidth = 30 - EmptyImage.Allow = True EmptyImage.ResolutionWidth = 21 EmptyImage.ResolutionHeight = 29.7000007629395 EmptyImage.ShowBorder = True + NewCropAreaDefault.Icons = [cIcoIndex] NewCropAreaDefault.AspectRatio = '3:4' OnCropAreaAdded = AddedCrop OnCropAreaDeleted = DeletedCrop @@ -1635,7 +1635,7 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo end object BCPanelCropAreas: TBCPanel Left = 0 - Height = 513 + Height = 543 Top = 0 Width = 198 Align = alLeft @@ -1722,7 +1722,7 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo object BCPanelCropAreaLoad: TBCPanel Left = 1 Height = 106 - Top = 406 + Top = 436 Width = 196 Align = alBottom Background.Color = clBtnFace @@ -2206,7 +2206,7 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo end object BCPanelCropArea: TBCPanel Left = 0 - Height = 360 + Height = 384 Top = 48 Width = 186 Background.Color = clBtnFace @@ -2279,7 +2279,7 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo Left = 20 Height = 15 Top = 95 - Width = 26 + Width = 25 Background.Gradient1.StartColor = clWhite Background.Gradient1.EndColor = clBlack Background.Gradient1.GradientType = gtLinear @@ -3134,6 +3134,24 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo } GroupIndex = 1 end + object cbIconIndex: TCheckBox + Left = 48 + Height = 19 + Top = 359 + Width = 47 + Caption = 'Index' + Checked = True + State = cbChecked + TabOrder = 8 + OnChange = cbIconIndexChange + end + object Label4: TLabel + Left = 7 + Height = 15 + Top = 359 + Width = 34 + Caption = 'Icons :' + end end object btCropDuplicate: TSpeedButton Left = 172 diff --git a/test/test_bgraimagemanipulation/unitbgraimagemanipulationdemo.pas b/test/test_bgraimagemanipulation/unitbgraimagemanipulationdemo.pas index 383b1ea..3f1c370 100644 --- a/test/test_bgraimagemanipulation/unitbgraimagemanipulationdemo.pas +++ b/test/test_bgraimagemanipulation/unitbgraimagemanipulationdemo.pas @@ -43,6 +43,7 @@ 2013-10-13 - Massimo Magnano - Add multi crop demo 2023-08 - Resolution, Save in various formats, Z Order + 2024-08 - Icons in CropArea ============================================================================ } @@ -55,7 +56,7 @@ interface Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, ExtDlgs, ComCtrls, ExtCtrls, Menus, Spin, {$IFDEF FPC} FPImage,{$ENDIF} BGRAImageManipulation, - BGRABitmap, BGRABitmapTypes, BCPanel, BCButton, BGRASpeedButton, BCLabel, Laz2_XMLCfg; + BGRABitmap, BGRABitmapTypes, BCPanel, BCButton, BGRASpeedButton, BCLabel; type @@ -96,6 +97,7 @@ TFormBGRAImageManipulationDemo = class(TForm) btCRotateRight: TSpeedButton; btCRotateLeft: TSpeedButton; cbBoxList: TComboBox; + cbIconIndex: TCheckBox; chkFullSize: TCheckBox; cbSaveFormat: TComboBox; chkCopyProperties: TCheckBox; @@ -111,6 +113,7 @@ TFormBGRAImageManipulationDemo = class(TForm) Label1: TLabel; Label2: TLabel; Label3: TLabel; + Label4: TLabel; lbResolution: TLabel; lbAspectRatio: TLabel; lbOptions: TLabel; @@ -150,6 +153,7 @@ TFormBGRAImageManipulationDemo = class(TForm) procedure btZDownClick(Sender: TObject); procedure btZFrontClick(Sender: TObject); procedure btZUpClick(Sender: TObject); + procedure cbIconIndexChange(Sender: TObject); procedure edNameChange(Sender: TObject); procedure edUnit_TypeChange(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); @@ -192,7 +196,7 @@ implementation {$R *.lfm} -uses BGRAWriteBMP, BGRAReadWriteConfig; +//uses BGRAWriteBMP, BGRAReadWriteConfig; const ResUnitStr :array[TResolutionUnit] of String = ('ruNone', 'ruPixelsPerInch', 'ruPixelsPerCentimeter'); @@ -529,6 +533,13 @@ procedure TFormBGRAImageManipulationDemo.btZUpClick(Sender: TObject); end; end; +procedure TFormBGRAImageManipulationDemo.cbIconIndexChange(Sender: TObject); +begin + if cbIconIndex.Checked + then BGRAImageManipulation.NewCropAreaDefault.Icons:= [cIcoIndex] + else BGRAImageManipulation.NewCropAreaDefault.Icons:= []; +end; + procedure TFormBGRAImageManipulationDemo.edNameChange(Sender: TObject); var CropArea :TCropArea; @@ -756,12 +767,12 @@ procedure TFormBGRAImageManipulationDemo.SelectedChangedCrop(Sender: TBGRAImageM end; procedure TFormBGRAImageManipulationDemo.SpeedButton1Click(Sender: TObject); -var +(*var img, img2:TBGRABitmap; wr:TBGRAWriterBMP; wp:TFPPalette; ReadWriteConfig, ReadWriteConfig2: TBGRAReadWriteConfig; - +*) begin //BGRAImageManipulation.SetEmptyImageSizeToCropAreas(False); (* From fa1b185269800bafd995178963d82a024799797a Mon Sep 17 00:00:00 2001 From: Boban Spasic Date: Mon, 12 Aug 2024 22:20:23 +0200 Subject: [PATCH 2/4] Better position calculation in BCLeaRingSlider and BCLeaSelector; Small improvements in Create methods of all the components --- bcleaboard.pas | 4 ++-- bcleaqled.pas | 2 +- bclearingslider.pas | 35 ++++++++++++++++++++++++----- bcleaselector.pas | 10 ++++----- test/test_bclea/untThemeBuilder.lfm | 8 ++++++- 5 files changed, 44 insertions(+), 15 deletions(-) diff --git a/bcleaboard.pas b/bcleaboard.pas index 14e378c..af39b66 100644 --- a/bcleaboard.pas +++ b/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; diff --git a/bcleaqled.pas b/bcleaqled.pas index 6385c44..de75c7a 100644 --- a/bcleaqled.pas +++ b/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; diff --git a/bclearingslider.pas b/bclearingslider.pas index 4f293c0..95b59f1 100644 --- a/bclearingslider.pas +++ b/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,6 +459,7 @@ constructor TBCLeaRingSlider.Create(AOwner: TComponent); with GetControlClassDefaultSize do SetInitialBounds(0, 0, 100, 100); + TabStop := True; FMaxValue := 100; FMinValue := 0; FOffset := 0; @@ -462,13 +467,14 @@ constructor TBCLeaRingSlider.Create(AOwner: TComponent); 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; diff --git a/bcleaselector.pas b/bcleaselector.pas index 3a31628..777d21f 100644 --- a/bcleaselector.pas +++ b/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; diff --git a/test/test_bclea/untThemeBuilder.lfm b/test/test_bclea/untThemeBuilder.lfm index fb5f3ca..ec3e01a 100644 --- a/test/test_bclea/untThemeBuilder.lfm +++ b/test/test_bclea/untThemeBuilder.lfm @@ -1858,6 +1858,7 @@ object frmMain: TfrmMain AnchorSideLeft.Side = asrCenter AnchorSideTop.Side = asrCenter AnchorSideRight.Side = asrCenter + Cursor = crHandPoint Left = 0 Height = 101 Top = 50 @@ -1892,6 +1893,7 @@ object frmMain: TfrmMain AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = LCDDisplay AnchorSideTop.Side = asrCenter + Cursor = crHandPoint Left = 600 Height = 50 Top = 75 @@ -1907,6 +1909,7 @@ object frmMain: TfrmMain AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = LCDDisplay AnchorSideTop.Side = asrCenter + Cursor = crHandPoint Left = 700 Height = 100 Top = 50 @@ -1917,6 +1920,7 @@ object frmMain: TfrmMain TabOrder = 3 TabStop = False OnClick = BSelectorClick + Value = 1 DrawTicks = True Items.Strings = ( 'Item 1' @@ -1933,6 +1937,7 @@ object frmMain: TfrmMain AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = LCDDisplay AnchorSideTop.Side = asrCenter + Cursor = crHandPoint Left = 800 Height = 100 Top = 50 @@ -1980,6 +1985,7 @@ object frmMain: TfrmMain AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = LCDDisplay AnchorSideTop.Side = asrCenter + Cursor = crHandPoint Left = 650 Height = 50 Top = 75 @@ -1995,6 +2001,7 @@ object frmMain: TfrmMain AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = LCDDisplay AnchorSideTop.Side = asrCenter + Cursor = crHandPoint Left = 900 Height = 150 Top = 25 @@ -2002,7 +2009,6 @@ object frmMain: TfrmMain TabOrder = 6 TabStop = False OnClick = BCLeaBoardClick - BackgroundColor = clBtnFace Theme = BTheme end end From ce52dfaa81893c052fcc89bac5b278a798935746 Mon Sep 17 00:00:00 2001 From: Boban Spasic <68187526+BobanSpasic@users.noreply.github.com> Date: Wed, 14 Aug 2024 18:49:23 +0200 Subject: [PATCH 3/4] 9.0.16 --- update_bgracontrols_force.json | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/update_bgracontrols_force.json b/update_bgracontrols_force.json index 7dbe019..a33edac 100644 --- a/update_bgracontrols_force.json +++ b/update_bgracontrols_force.json @@ -8,13 +8,13 @@ "ForceNotify" : true, "InternalVersion" : 25, "Name" : "bgracontrols.lpk", - "Version" : "9.0.1.5" + "Version" : "9.0.1.6" }, { "ForceNotify" : false, "InternalVersion" : 1, "Name" : "bgrapascalscriptcomponent.lpk", - "Version" : "9.0.1.5" + "Version" : "9.0.1.6" } ] -} \ No newline at end of file +} From 745f337b4397c73ddf491902409d3ac81548fe8b Mon Sep 17 00:00:00 2001 From: Boban Spasic <68187526+BobanSpasic@users.noreply.github.com> Date: Wed, 14 Aug 2024 18:50:37 +0200 Subject: [PATCH 4/4] 9.0.1.6