فهرست منبع

Added Draw of Caption and TextLayouts to LeaRingSlider; Added TextLayout to LeaSelector.

Added Draw of Caption and TextLayouts to LeaRingSlider;
Added TextLayout to LeaSelector.
Massimo Magnano 1 سال پیش
والد
کامیت
7089ecd63e
2فایلهای تغییر یافته به همراه148 افزوده شده و 7 حذف شده
  1. 111 4
      bclearingslider.pas
  2. 37 3
      bcleaselector.pas

+ 111 - 4
bclearingslider.pas

@@ -7,6 +7,8 @@
  Author: Boban Spasic
  Credits to: hedgehog, circular and lainz from Lazarus forum
  Based on TFluentProgressRing from hedgehog
+
+ 2024-11-20 Massimo Magnano Added Draw of Caption and TextLayouts
 }
 
 unit BCLeaRingSlider;
@@ -80,10 +82,19 @@ type
     FLightPositionX: integer;
     FLightPositionY: integer;
     FLightPositionZ: integer;
+    rCaptionLayout: TTextLayout;
+    rDrawCaption: Boolean;
+    rDrawCaptionPhong: Boolean;
+    rTextLayout: TTextLayout;
+
+    procedure SetCaptionLayout(AValue: TTextLayout);
+    procedure SetDrawCaption(AValue: Boolean);
+    procedure SetDrawCaptionPhong(AValue: Boolean);
     procedure SetLineBkgColor(AValue: TColor);
     procedure SetLineColor(AValue: TColor);
     procedure SetMaxValue(AValue: integer);
     procedure SetMinValue(AValue: integer);
+    procedure SetTextLayout(AValue: TTextLayout);
     procedure SetValue(AValue: integer);
     procedure SetLineWidth(AValue: integer);
     procedure UpdateVerticalPos(X, Y: integer);
@@ -112,6 +123,7 @@ type
     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
     procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
+
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -120,6 +132,7 @@ type
     procedure SaveThemeToFile(AFileName: string);
     procedure LoadThemeFromFile(AFileName: string);
     procedure ApplyDefaultTheme;
+
   published
     property Align;
     property Caption;
@@ -175,6 +188,10 @@ type
     property PointerSize: integer read FPointerSize write SetPointerSize default 2;
     property Altitude: integer read FAltitude write SetAltitude default 2;
     property Theme: TBCLeaTheme read FTheme write SetTheme;
+    property TextLayout: TTextLayout read rTextLayout write SetTextLayout default tlCenter;
+    property DrawCaption: Boolean read rDrawCaption write SetDrawCaption default False;
+    property DrawCaptionPhong: Boolean read rDrawCaptionPhong write SetDrawCaptionPhong default False;
+    property CaptionLayout: TTextLayout read rCaptionLayout write SetCaptionLayout default tlBottom;
   end;
 
 procedure Register;
@@ -242,6 +259,27 @@ begin
   Invalidate;
 end;
 
+procedure TBCLeaRingSlider.SetCaptionLayout(AValue: TTextLayout);
+begin
+  if rCaptionLayout=AValue then Exit;
+  rCaptionLayout:=AValue;
+  Invalidate;
+end;
+
+procedure TBCLeaRingSlider.SetDrawCaption(AValue: Boolean);
+begin
+  if rDrawCaption=AValue then Exit;
+  rDrawCaption:=AValue;
+  Invalidate;
+end;
+
+procedure TBCLeaRingSlider.SetDrawCaptionPhong(AValue: Boolean);
+begin
+  if rDrawCaptionPhong=AValue then Exit;
+  rDrawCaptionPhong:=AValue;
+  Invalidate;
+end;
+
 procedure TBCLeaRingSlider.SetLineColor(AValue: TColor);
 begin
   if FLineColor = AValue then
@@ -263,6 +301,13 @@ begin
   Invalidate;
 end;
 
+procedure TBCLeaRingSlider.SetTextLayout(AValue: TTextLayout);
+begin
+  if rTextLayout=AValue then Exit;
+  rTextLayout:=AValue;
+  Invalidate;
+end;
+
 procedure TBCLeaRingSlider.SetValue(AValue: integer);
 begin
   if FValue = AValue then
@@ -314,6 +359,7 @@ var
   Blur: TBGRABitmap;
   Mask, Mask2: TBGRABitmap;
   Phong: TPhongShading;
+  TextSize: TSize;
 
   procedure DoDrawArc(a, b: single; c: TColor);
   begin
@@ -392,9 +438,38 @@ begin
   begin
     TextStr := IntToStr(FValue);
     TextBmp := TextShadow(EffectiveSize, EffectiveSize, TextStr, Font.Height,
-      Font.Color, FontShadowColor, FontShadowOFfsetX,
+      Font.Color, FontShadowColor, FontShadowOffsetX,
       FontShadowOffsetY, FontShadowRadius, Font.Style, Font.Name) as TBGRABitmap;
-    FBitmap.PutImage(0, 0, TextBmp, dmDrawWithTransparency);
+    TextSize:= TextBmp.TextSize(TextStr);
+    TextSize.cy:= TextSize.cy+FontShadowOffsetY; //+2*FontShadowRadius ?
+
+    Case rTextLayout of
+    tlTop: FBitmap.PutImage(0, -(HalfUp(((EffectiveSize-TextSize.cy) / 2))-Trunc(EffectiveLineWidth)),
+                            TextBmp, dmDrawWithTransparency);
+    tlCenter: FBitmap.PutImage(0, 0, TextBmp, dmDrawWithTransparency);
+    tlBottom: FBitmap.PutImage(0, +(HalfUp(((EffectiveSize-TextSize.cy) / 2))-Trunc(EffectiveLineWidth)),
+                               TextBmp, dmDrawWithTransparency);
+    end;
+
+    TextBmp.Free;
+  end;
+
+  if rDrawCaption and rDrawCaptionPhong then
+  begin
+    TextBmp := TextShadow(EffectiveSize, EffectiveSize, Caption, Font.Height,
+                          Font.Color, FontShadowColor, FontShadowOffsetX,
+                          FontShadowOffsetY, FontShadowRadius, Font.Style, Font.Name) as TBGRABitmap;
+    TextSize:= TextBmp.TextSize(Caption);
+    TextSize.cy:= TextSize.cy+FontShadowOffsetY; //+2*FontShadowRadius ?
+
+    Case rCaptionLayout of
+    tlTop: FBitmap.PutImage(0, -(HalfUp(((EffectiveSize-TextSize.cy) / 2))-Trunc(EffectiveLineWidth)),
+                            TextBmp, dmDrawWithTransparency);
+    tlCenter: FBitmap.PutImage(0, 0, TextBmp, dmDrawWithTransparency);
+    tlBottom: FBitmap.PutImage(0, +(HalfUp(((EffectiveSize-TextSize.cy) / 2))-Trunc(EffectiveLineWidth)),
+                               TextBmp, dmDrawWithTransparency);
+    end;
+
     TextBmp.Free;
   end;
 
@@ -444,9 +519,38 @@ begin
   begin
     TextStr := IntToStr(FValue);
     TextBmp := TextShadow(EffectiveSize, EffectiveSize, TextStr, Font.Height,
-      Font.Color, FontShadowColor, FontShadowOFfsetX,
+      Font.Color, FontShadowColor, FontShadowOffsetX,
       FontShadowOffsetY, FontShadowRadius, Font.Style, Font.Name) as TBGRABitmap;
-    FBitmap.PutImage(0, 0, TextBmp, dmDrawWithTransparency);
+    TextSize:= TextBmp.TextSize(TextStr);
+    TextSize.cy:= TextSize.cy+FontShadowOffsetY; //+2*FontShadowRadius ?
+
+    Case rTextLayout of
+    tlTop: FBitmap.PutImage(0, -(HalfUp(((EffectiveSize-TextSize.cy) / 2))-Trunc(EffectiveLineWidth)),
+                            TextBmp, dmDrawWithTransparency);
+    tlCenter: FBitmap.PutImage(0, 0, TextBmp, dmDrawWithTransparency);
+    tlBottom: FBitmap.PutImage(0, +(HalfUp(((EffectiveSize-TextSize.cy) / 2))-Trunc(EffectiveLineWidth)),
+                               TextBmp, dmDrawWithTransparency);
+    end;
+
+    TextBmp.Free;
+  end;
+
+  if rDrawCaption and not(rDrawCaptionPhong) then
+  begin
+    TextBmp := TextShadow(EffectiveSize, EffectiveSize, Caption, Font.Height,
+                          Font.Color, FontShadowColor, FontShadowOffsetX,
+                          FontShadowOffsetY, FontShadowRadius, Font.Style, Font.Name) as TBGRABitmap;
+    TextSize:= TextBmp.TextSize(Caption);
+    TextSize.cy:= TextSize.cy+FontShadowOffsetY; //+2*FontShadowRadius ?
+
+    Case rCaptionLayout of
+    tlTop: FBitmap.PutImage(0, -(HalfUp(((EffectiveSize-TextSize.cy) / 2))-Trunc(EffectiveLineWidth)),
+                            TextBmp, dmDrawWithTransparency);
+    tlCenter: FBitmap.PutImage(0, 0, TextBmp, dmDrawWithTransparency);
+    tlBottom: FBitmap.PutImage(0, +(HalfUp(((EffectiveSize-TextSize.cy) / 2))-Trunc(EffectiveLineWidth)),
+                               TextBmp, dmDrawWithTransparency);
+    end;
+
     TextBmp.Free;
   end;
 
@@ -472,7 +576,10 @@ begin
   Font.Color := clBlack;
   Font.Height := 20;
   FDrawText := True;
+  rTextLayout:= tlCenter;
   FDrawPointer := False;
+  rDrawCaption:= False;
+  rCaptionLayout:= tlBottom;
   ApplyDefaultTheme;
   FBitmap := TBGRABitmap.Create(Width, Height, FBkgColor);
 end;

+ 37 - 3
bcleaselector.pas

@@ -7,6 +7,8 @@
  Author: Boban Spasic
  Credits to: hedgehog, circular and lainz from Lazarus forum
  Based on TFluentProgressRing from hedgehog
+
+ 2024-11-20 Massimo Magnano Added TextLayout
 }
 
 unit BCLeaSelector;
@@ -78,8 +80,10 @@ type
     FLightPositionX: integer;
     FLightPositionY: integer;
     FLightPositionZ: integer;
+    rTextLayout: TTextLayout;
     procedure SetLineBkgColor(AValue: TColor);
     procedure SetLineColor(AValue: TColor);
+    procedure SetTextLayout(AValue: TTextLayout);
     procedure SetTicksCount(AValue: integer);
     procedure SetValue(AValue: integer);
     procedure SetLineWidth(AValue: integer);
@@ -102,7 +106,7 @@ type
     procedure SetStyle(AValue: TZStyle);
     procedure SetDrawTextPhong(AValue: boolean);
     procedure SetTheme(AValue: TBCLeaTheme);
-    procedure SetAltitude(Avalue: integer);
+    procedure SetAltitude(AValue: integer);
   protected
     procedure SetEnabled(Value: boolean); override;
     procedure SetVisible(Value: boolean); override;
@@ -173,6 +177,7 @@ type
     property DrawTextPhong: boolean read FDrawTextPhong write SetDrawTextPhong default False;
     property Theme: TBCLeaTheme read FTheme write SetTheme;
     property Altitude: integer read FAltitude write SetAltitude default 2;
+    property TextLayout: TTextLayout read rTextLayout write SetTextLayout default tlCenter;
   end;
 
 
@@ -261,6 +266,13 @@ begin
   Invalidate;
 end;
 
+procedure TBCLeaSelector.SetTextLayout(AValue: TTextLayout);
+begin
+  if rTextLayout=AValue then Exit;
+  rTextLayout:=AValue;
+  Invalidate;
+end;
+
 procedure TBCLeaSelector.SetTicksCount(AValue: integer);
 begin
   if FTicksCount = AValue then
@@ -340,6 +352,7 @@ var
   Phong: TPhongShading;
   ScaledPhongSize: int64;
   i: integer;
+  TextSize: TSize;
 
   procedure DoDrawArc(a, b: single; c: TColor);
   begin
@@ -421,7 +434,17 @@ begin
     TextBmp := TextShadow(EffectiveSize, EffectiveSize, TextStr, Font.Height,
       Font.Color, FontShadowColor, FontShadowOFfsetX,
       FontShadowOffsetY, FontShadowRadius, Font.Style, Font.Name) as TBGRABitmap;
-    FBitmap.PutImage(0, 0, TextBmp, dmDrawWithTransparency);
+    TextSize:= TextBmp.TextSize(TextStr);
+    TextSize.cy:= TextSize.cy+FontShadowOffsetY; //+2*FontShadowRadius ?
+
+    Case rTextLayout of
+    tlTop: FBitmap.PutImage(0, -(HalfUp(((EffectiveSize-TextSize.cy) / 2))-Trunc(EffectiveLineWidth)),
+                            TextBmp, dmDrawWithTransparency);
+    tlCenter: FBitmap.PutImage(0, 0, TextBmp, dmDrawWithTransparency);
+    tlBottom: FBitmap.PutImage(0, +(HalfUp(((EffectiveSize-TextSize.cy) / 2))-Trunc(EffectiveLineWidth)),
+                               TextBmp, dmDrawWithTransparency);
+    end;
+
     TextBmp.Free;
   end;
 
@@ -477,7 +500,17 @@ begin
     TextBmp := TextShadow(EffectiveSize, EffectiveSize, TextStr, Font.Height,
       Font.Color, FontShadowColor, FontShadowOFfsetX,
       FontShadowOffsetY, FontShadowRadius, Font.Style, Font.Name) as TBGRABitmap;
-    FBitmap.PutImage(0, 0, TextBmp, dmDrawWithTransparency);
+    TextSize:= TextBmp.TextSize(TextStr);
+    TextSize.cy:= TextSize.cy+FontShadowOffsetY; //+2*FontShadowRadius ?
+
+    Case rTextLayout of
+    tlTop: FBitmap.PutImage(0, -(HalfUp(((EffectiveSize-TextSize.cy) / 2))-Trunc(EffectiveLineWidth)),
+                            TextBmp, dmDrawWithTransparency);
+    tlCenter: FBitmap.PutImage(0, 0, TextBmp, dmDrawWithTransparency);
+    tlBottom: FBitmap.PutImage(0, +(HalfUp(((EffectiveSize-TextSize.cy) / 2))-Trunc(EffectiveLineWidth)),
+                               TextBmp, dmDrawWithTransparency);
+    end;
+
     TextBmp.Free;
   end;
 
@@ -500,6 +533,7 @@ begin
   FDeltaPos := 0;
   FSensitivity := 10;
   FDrawText := True;
+  rTextLayout:= tlCenter;
   FDrawTicks := False;
   ApplyDefaultTheme;
   FBitmap := TBGRABitmap.Create(Width, Height, FBkgColor);