Merge pull request #168 from bgrabitmap/dev-bgracontrols

Dev bgracontrols

BCExpandPanels.txt

@@ -0,0 +1,65 @@
+//  ExpandPanels   Version 3.0
+
+2024-01-31 MaxM: First port from original code in BGRAControls (formally Ver. 3.0)
+
+//  ExpandPanels   Version 2.2
+
+30-06-2016 MaxM :
+     Added Button.Style as bbsLineTop,bbsLineBottom,bbsLineDoubleTop,bbsLineDoubleBottom
+     Fixed Some Paint Coordinate position of Button elements and Lines
+
+21-06-2016 MaxM :
+     Added Button.GlyphKind (default to gkArrows)
+     Added gkClose (EXP_PANEL_CLOSE.png),
+           gkMinMax (EXP_PANEL_MIN_*.png, EXP_PANEL_MAX_*.png) Glyphs
+     Added TExpandPanels properties ButtonGlyphLayout,ButtonGlyphKind,ButtonStyle,ButtonTextLayout,ButtonTabWidth
+
+15-06-2016 MaxM :
+     Added Button.Style as bbsLine and bbsLineDouble
+
+09-06-2016 MaxM :
+     Completed Painting of Button.Style as bbsTab
+
+05-2016 MaxM :
+     Added Owner Draw of Panel so we can Draw Rounded Borders and don't draw Borders when Collapsed  
+     Added Style property on Button (bbsButton, bbsTab) (bbsTab paint is incomplete do not use)
+     Deleted BevenInner/Outer redefinition no more needed because now we draw the borders
+     Changed using of writeln with debugln because strange exceptions under Windows
+     Moved TMyRollOut.Loaded Code to CreateWnd because on RunTime creation is never Called
+     Fixed More OnCollapsed events
+     Fixed PositionButton is called only after Loaded is complete
+     Updated Copyright and Created separeted txt files
+     Added development test with only one panel (to simplify my life)
+
+//  ExpandPanels   Version 2.1
+
+23-07-2015 MaxM :
+     Added Owner Draw of Button so we can Draw Vertically when ButtonPosition is akLeft or akRight
+     Added Glyphs Support (Automatically Loaded from Resources or User Passed)
+     Solved Bugs About BevelOuter and Starting in Collapsed State
+     Moved Colors inside Button
+
+// TO-DO:
+
+- MaxM:
+
+Fix User components have 2 Pixels visible over the Button when Button Position
+      is akRight and is Collapsed SEE PROJECT1 DEVELOPMENT - ONLY ADDED IN TExpandPanels?
+Fix Shadows incoerence when Button.Style is bbsTab, the Panel attached side may not have borders.
+
+
+- Alex
+
+simplyfy everything with verctor addition and scalar multiplication (orthogonal basis vectors... and so on)
+      if horizonatal and vertical would be described by a unity vector, I could calculate if a certain operation should be performed
+      and I could just multiply the basis vector  with an operation to get a delta movement (or none)
+
+
+
+Known Bugs:
+
+- the TExpandPanels lacks a arrange on bottom and right
+
+- (Solved?) Button.Color Setted to clBtnFace at DesignTime -> Color = clSkyBlue in RunTime
+    (is not Loaded because is The inherited Default Color of TCustomSpeedButton)
+

bcfluentprogressring.pas

@@ -0,0 +1,252 @@
+{
+ 2024 by hedgehog
+}
+
+unit BCFluentProgressRing;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Controls, Graphics, ExtCtrls,
+  BGRAGraphicControl, BGRABitmapTypes;
+
+type
+
+  { TBCFluentProgressRing }
+
+  TBCFluentProgressRing = class(TBGRAGraphicControl)
+  private
+    FPeriod: Int64;
+    FIndeterminate: boolean;
+    FStartTickCount: QWord;
+    FAnimationTime: Int64;
+    FTimer: TTimer;
+    FMaxValue: integer;
+    FMinValue: integer;
+    FValue: integer;
+    FLineColor: TColor;
+    FLineBkgColor: TColor;
+    FLineWidth: integer;
+
+    procedure SetIndeterminate(AValue: boolean);
+    procedure SetLineBkgColor(AValue: TColor);
+    procedure SetLineColor(AValue: TColor);
+    procedure SetMaxValue(AValue: integer);
+    procedure SetMinValue(AValue: integer);
+    procedure SetValue(AValue: integer);
+    procedure SetLineWidth(AValue: integer);
+  protected
+    procedure SetEnabled(Value: Boolean); override;
+    procedure SetVisible(Value: Boolean); override;
+    procedure RedrawBitmapContent; override;
+
+    procedure TimerEvent({%H-}Sender: TObject);
+    procedure TimerStart({%H-}Sender: TObject);
+  public
+    constructor Create(AOwner: TComponent); override;
+  published
+    property MinValue: integer read FMinValue write SetMinValue default 0;
+    property MaxValue: integer read FMaxValue write SetMaxValue default 100;
+    property Value: integer read FValue write SetValue default 0;
+    property LineColor: TColor read FLineColor write SetLineColor default
+      TColor($009E5A00);
+    property LineBkgColor: TColor read FLineBkgColor write SetLineBkgColor default
+      TColor($00D3D3D3);
+    property LineWidth: integer read FLineWidth write SetLineWidth default 0;
+    property Indeterminate: boolean read FIndeterminate write SetIndeterminate default false;
+  end;
+
+procedure Register;
+
+implementation
+
+procedure Register;
+begin
+  RegisterComponents('BGRA Controls', [TBCFluentProgressRing]);
+end;
+
+{ TBCFluentProgressRing }
+
+procedure TBCFluentProgressRing.SetMaxValue(AValue: integer);
+begin
+  if FMaxValue = AValue then
+    exit;
+  FMaxValue := AValue;
+  if FValue > FMaxValue then
+    FValue := FMaxValue;
+  if FMinValue > FMaxValue then
+    FMinValue := FMaxValue;
+  DiscardBitmap;
+end;
+
+procedure TBCFluentProgressRing.SetLineBkgColor(AValue: TColor);
+begin
+  if FLineBkgColor = AValue then
+    Exit;
+  FLineBkgColor := AValue;
+  DiscardBitmap;
+end;
+
+procedure TBCFluentProgressRing.SetIndeterminate(AValue: boolean);
+begin
+  if FIndeterminate=AValue then Exit;
+  FIndeterminate:=AValue;
+  if Enabled and Visible then
+  begin
+    FTimer.Enabled:= FIndeterminate;
+    DiscardBitmap;
+  end;
+end;
+
+procedure TBCFluentProgressRing.SetLineColor(AValue: TColor);
+begin
+  if FLineColor = AValue then
+    Exit;
+  FLineColor := AValue;
+  DiscardBitmap;
+end;
+
+procedure TBCFluentProgressRing.SetMinValue(AValue: integer);
+begin
+  if FMinValue = AValue then
+    exit;
+  FMinValue := AValue;
+  if FValue < FMinValue then
+    FValue := FMinValue;
+  if FMaxValue < FMinValue then
+    FMaxValue := FMinValue;
+  DiscardBitmap;
+end;
+
+procedure TBCFluentProgressRing.SetValue(AValue: integer);
+begin
+  if FValue = AValue then
+    exit;
+  FValue := AValue;
+  if FValue < FMinValue then
+    FValue := FMinValue;
+  if FValue > FMaxValue then
+    FValue := FMaxValue;
+  DiscardBitmap;
+end;
+
+procedure TBCFluentProgressRing.SetLineWidth(AValue: integer);
+begin
+  if FLineWidth = AValue then exit;
+  FLineWidth := AValue;
+  if Visible then DiscardBitmap;
+end;
+
+procedure TBCFluentProgressRing.SetEnabled(Value: Boolean);
+begin
+  inherited SetEnabled(Value);
+  FTimer.Enabled := Value and Visible and FIndeterminate;
+  DiscardBitmap;
+end;
+
+procedure TBCFluentProgressRing.SetVisible(Value: Boolean);
+begin
+  inherited SetVisible(Value);
+  FTimer.Enabled := Enabled and Value and FIndeterminate;
+  DiscardBitmap;
+end;
+
+procedure TBCFluentProgressRing.RedrawBitmapContent;
+const
+  pi2= 2*pi;
+  pi15 = pi*1.5;
+var
+  EffectiveSize: integer;
+  EffectiveLineWidth: single;
+  a, da, r: single;
+
+  procedure DoDrawArc(a, b: single; c: TColor);
+  begin
+    Bitmap.Canvas2D.strokeStyle(c);
+    Bitmap.Canvas2D.beginPath;
+    Bitmap.Canvas2D.arc(0, 0, r, a, b, false);
+    Bitmap.Canvas2D.stroke;
+  end;
+
+begin
+  if Width< Height then
+    EffectiveSize:= Width
+  else
+    EffectiveSize:= Height;
+
+  if EffectiveSize<2 then exit;
+
+
+  Bitmap.Canvas2D.resetTransform;
+  Bitmap.Canvas2D.translate(Bitmap.Width/2, Bitmap.Height/2);
+  Bitmap.Canvas2D.rotate(pi15);
+
+
+  if FLineWidth=0 then
+    EffectiveLineWidth:=EffectiveSize / 12
+  else
+    EffectiveLineWidth:= FLineWidth;
+  r:= (EffectiveSize -EffectiveLineWidth)/2;
+
+   Bitmap.Canvas2D.lineWidth:= EffectiveLineWidth;
+  // background line
+  if (FValue < FMaxValue) and (FLineBkgColor<>clNone) then
+    DoDrawArc(0, pi2, FLineBkgColor);
+  Bitmap.Canvas2D.lineCapLCL:= pecRound;
+
+  if FIndeterminate and FTimer.Enabled then
+  begin
+    a:= 3*FAnimationTime*pi2/FPeriod - pi;
+    da:= 2*abs(1 - 2*FAnimationTime/FPeriod);
+    if da>0.005 then
+      DoDrawArc(a-da, a+da, FLineColor);
+  end
+  else if FValue > FMinValue then
+  begin
+    if Enabled then
+      DoDrawArc(0, pi2 * FValue / FMaxValue, FLineColor)
+    else
+      DoDrawArc(0, pi2 * FValue / FMaxValue, clGray);
+  end;
+end;
+
+procedure TBCFluentProgressRing.TimerEvent(Sender: TObject);
+var
+  TickCount: QWord;
+begin
+  TickCount:= GetTickCount64;
+  FAnimationTime:= (TickCount - FStartTickCount) mod FPeriod;
+  DiscardBitmap;
+end;
+
+procedure TBCFluentProgressRing.TimerStart(Sender: TObject);
+begin
+  FStartTickCount:= GetTickCount64;
+  FAnimationTime:=0;
+end;
+
+constructor TBCFluentProgressRing.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FPeriod:= 2400;
+  FTimer:= TTimer.Create(self);
+  FTimer.Interval := 15;
+  FTimer.Enabled := false;
+  FTimer.OnTimer := @TimerEvent;
+  FTimer.OnStartTimer:= @TimerStart;
+
+  with GetControlClassDefaultSize do
+    SetInitialBounds(0, 0, 100, 100);
+  FMaxValue := 100;
+  FMinValue := 0;
+  FValue := 0;
+  FLineWidth:=0;
+  FLineColor := TColor($009E5A00);
+  FLineBkgColor := TColor($00D3D3D3);
+end;
+
+
+end.
+

bclistbox.pas

@@ -176,5 +176,6 @@ constructor TBCListBox.Create(TheOwner: TComponent);
 end;
 
 initialization
+{$I bcpaperlistbox.lrs}
 
 end.

bcmaterialdesignbutton.pas

@@ -72,6 +72,7 @@   TBCMaterialDesignButton = class(TBGRAGraphicCtrl)
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
+    procedure ClickMe;
   published
     property RoundBorders: single read FRoundBorders write SetFRoundBorders {$IFDEF FPC}default 5{$ENDIF};
     property NormalColor: TColor read FNormalColor write SetFNormalColor default clWhite;
@@ -518,4 +519,11 @@ destructor TBCMaterialDesignButton.Destroy;
   inherited Destroy;
 end;
 
+procedure TBCMaterialDesignButton.ClickMe;
+begin
+  FMousePos := Point(Width div 2, Height div 2);
+  FTimer.Enabled := True;
+  inherited Click;
+end;
+
 end.