Add VCL styling support to NewProgressBar.

Components/NewProgressBar.pas

@@ -17,7 +17,7 @@ unit NewProgressBar;
 interface
 
 uses
-  Messages, Classes, Controls, ComCtrls;
+  Windows, Messages, Classes, Controls, ComCtrls, Themes, ExtCtrls, Types, Graphics;
 
 type
   TNewProgressBarState = (npbsNormal, npbsError, npbsPaused);
@@ -31,6 +31,8 @@ type
     FPosition: LongInt;
     FState: TNewProgressBarState;
     FStyle: TNewProgressBarStyle;
+    class constructor Create;
+    class destructor Destroy;
     procedure SetMin(Value: LongInt);
     procedure SetMax(Value: LongInt);
     procedure SetPosition(Value: LongInt);
@@ -52,18 +54,54 @@ type
     property Visible default True;
   end;
 
+  TNewProgressBarStyleHook = class(TStyleHook)
+  strict private
+    FMarqueeTimer: TTimer;
+    FMarqueeStep: Integer;
+    procedure MarqueeAction(Sender: TObject);
+    function GetBarRect: TRect;
+    function GetBorderWidth: Integer;
+    function GetMax: Integer;
+    function GetMin: Integer;
+    function GetOrientation: TProgressBarOrientation;
+    function GetPercent: Single;
+    function GetPosition: Integer;
+    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
+  strict protected
+    procedure PaintBar(Canvas: TCanvas); virtual;
+    procedure PaintFrame(Canvas: TCanvas); virtual;
+    procedure Paint(Canvas: TCanvas); override;
+    procedure WndProc(var Message: TMessage); override;
+    property BarRect: TRect read GetBarRect;
+    property BorderWidth: Integer read GetBorderWidth;
+    property Max: Integer read GetMax;
+    property Min: Integer read GetMin;
+    property Orientation: TProgressBarOrientation read GetOrientation;
+    property Position: Integer read GetPosition;
+  public
+    constructor Create(AControl: TWinControl); override;
+    destructor Destroy; override;
+  end;
+
 procedure Register;
 
 implementation
 
 uses
-  Windows, CommCtrl;
+  CommCtrl, SysUtils, GraphUtil;
 
 procedure Register;
 begin
   RegisterComponents('JR', [TNewProgressBar]);
 end;
 
+{ TNewProgressBar }
+
+class constructor TNewProgressBar.Create;
+begin
+  TCustomStyleEngine.RegisterStyleHook(TNewProgressBar, TNewProgressBarStyleHook);
+end;
+
 constructor TNewProgressBar.Create(AOwner: TComponent);
 begin
   inherited;
@@ -97,6 +135,11 @@ begin
   SendMessage(Handle, PBM_SETMARQUEE, WPARAM(FStyle = npbstMarquee), 0);
 end;
 
+class destructor TNewProgressBar.Destroy;
+begin
+  TCustomStyleEngine.UnRegisterStyleHook(TNewProgressBar, TNewProgressBarStyleHook);
+end;
+
 procedure TNewProgressBar.SetMin(Value: LongInt);
 begin
   FMin := Value;
@@ -152,4 +195,203 @@ begin
   DefaultHandler(Message);
 end;
 
+{ TNewProgressBarStyleHook - same as Vcl.ComCtrls' TProgressBarStyleHook
+  except that it accesses the Control property as a TNewProgressBar instead
+  of a TProgressBar }
+
+constructor TNewProgressBarStyleHook.Create(AControl: TWinControl);
+const
+  cDefaultMarqueeInterval = 10;
+begin
+  inherited;
+  OverridePaint := True;
+  DoubleBuffered := True;
+  FMarqueeTimer := TTimer.Create(nil);
+  FMarqueeTimer.Interval := cDefaultMarqueeInterval;
+  FMarqueeTimer.OnTimer := MarqueeAction;
+  FMarqueeTimer.Enabled := (TNewProgressBar(Control).Style = npbstMarquee) and
+    not (csDesigning in Control.ComponentState);
+end;
+
+function TNewProgressBarStyleHook.GetPercent: Single;
+var
+  LMin, LMax, LPos: Integer;
+begin
+  LMin := Min;
+  LMax := Max;
+  LPos := Position;
+  if (LPos >= LMin) and (LMax >= LPos) and (LMax - LMin <> 0) then
+    Result := (LPos - LMin) / (LMax - LMin)
+  else
+    Result := 0;
+end;
+
+destructor TNewProgressBarStyleHook.Destroy;
+begin
+  FreeAndNil(FMarqueeTimer);
+  inherited;
+end;
+
+function TNewProgressBarStyleHook.GetBarRect: TRect;
+begin
+  Result := TRect.Create(0, 0, Control.Width, Control.Height);
+  InflateRect(Result, -BorderWidth, -BorderWidth);
+end;
+
+procedure TNewProgressBarStyleHook.WMNCCalcSize(var Message: TWMNCCalcSize);
+begin
+  Message.Result := 0;
+  Handled := True;
+end;
+
+procedure TNewProgressBarStyleHook.WndProc(var Message: TMessage);
+begin
+  // Reserved for potential updates
+  inherited;
+end;
+
+procedure TNewProgressBarStyleHook.PaintFrame(Canvas: TCanvas);
+var
+  R: TRect;
+  Details: TThemedElementDetails;
+  LStyle: TCustomStyleServices;
+begin
+  LStyle := StyleServices;
+  if not LStyle.Available then
+    Exit;
+
+  R := BarRect;
+  if Orientation = pbHorizontal then
+    Details := LStyle.GetElementDetails(tpBar)
+  else
+    Details := LStyle.GetElementDetails(tpBarVert);
+  LStyle.DrawElement(Canvas.Handle, Details, R);
+end;
+
+procedure TNewProgressBarStyleHook.MarqueeAction(Sender: TObject);
+begin
+  if StyleServices.Available and Control.Visible and (Control is TNewProgressBar) and
+    (TNewProgressBar(Control).Style = npbstMarquee) and not (csDesigning in Control.ComponentState) then
+    Invalidate
+  else
+    FMarqueeTimer.Enabled := False;
+end;
+
+procedure TNewProgressBarStyleHook.PaintBar(Canvas: TCanvas);
+const
+  cStateColorAlpha = 130;
+  cStateErrorColor = clRed;
+  cStatePausedColor = clYellow;
+  cMarqueeSize = 125;
+  cMarqueeSteps = 5;//cMarqueeSize div 3;
+var
+  FillR, R: TRect;
+  W, Pos: Integer;
+  Details: TThemedElementDetails;
+  LStyle: TCustomStyleServices;
+  LIsMarquee: Boolean;
+  LBuffer: TBitmap;
+begin
+  LStyle := StyleServices;
+  if not LStyle.Available then
+    Exit;
+  R := BarRect;
+  InflateRect(R, -1, -1);
+  if Orientation = pbHorizontal then
+    W := R.Width
+  else
+    W := R.Height;
+
+  LIsMarquee := (Control is TNewProgressBar) and
+    (TNewProgressBar(Control).Style = npbstMarquee) and not (csDesigning in Control.ComponentState);
+  if LIsMarquee then
+    Pos := Control.ScaleValue(cMarqueeSize)
+  else
+    Pos := Round(W * GetPercent);
+  FillR := R;
+  if Orientation = pbHorizontal then
+  begin
+    FillR.Right := FillR.Left + Pos;
+    Details := LStyle.GetElementDetails(tpChunk);
+  end
+  else
+  begin
+    FillR.Top := FillR.Bottom - Pos;
+    Details := LStyle.GetElementDetails(tpChunkVert);
+  end;
+
+  if LIsMarquee then
+  begin
+    FillR.SetLocation(FMarqueeStep, FillR.Top);
+    Inc(FMarqueeStep, cMarqueeSteps);
+    if FMarqueeStep >= Control.Width then
+      FMarqueeStep := -cMarqueeSize;
+  end;
+
+  LStyle.DrawElement(Canvas.Handle, Details, FillR);
+
+  if not FillR.IsEmpty and not LIsMarquee and (Control is TNewProgressBar) and (TNewProgressBar(Control).State <> npbsNormal) then
+  begin
+    LBuffer := TBitmap.Create;
+    try
+      LBuffer.PixelFormat := pf32bit;
+      LBuffer.SetSize(FillR.Width, FillR.Height);
+      InitAlpha(LBuffer, 0);
+      LStyle.DrawElement(LBuffer.Canvas.Handle, Details, TRect.Create(0, 0, LBuffer.Width, LBuffer.Height));
+      case TNewProgressBar(Control).State of
+        npbsError:
+          SetPreMutipliedColor(LBuffer, cStateErrorColor);
+        npbsPaused:
+          SetPreMutipliedColor(LBuffer, cStatePausedColor);
+      end;
+      Canvas.Draw(FillR.Left, FillR.Top, LBuffer, cStateColorAlpha);
+    finally
+      LBuffer.Free;
+    end;
+  end
+end;
+
+procedure TNewProgressBarStyleHook.Paint(Canvas: TCanvas);
+var
+  Details: TThemedElementDetails;
+  LStyle: TCustomStyleServices;
+begin
+  LStyle := StyleServices;
+  if LStyle.Available then
+  begin
+    Details.Element := teProgress;
+    if LStyle.HasTransparentParts(Details) then
+      LStyle.DrawParentBackground(Handle, Canvas.Handle, Details, False);
+  end;
+  PaintFrame(Canvas);
+  PaintBar(Canvas);
+end;
+
+function TNewProgressBarStyleHook.GetMax: Integer;
+begin
+  Result := SendMessage(Handle, PBM_GetRange, 0, 0);
+end;
+
+function TNewProgressBarStyleHook.GetMin: Integer;
+begin
+  Result := SendMessage(Handle, PBM_GetRange, 1, 0);
+end;
+
+function TNewProgressBarStyleHook.GetOrientation: TProgressBarOrientation;
+begin
+  Result := pbHorizontal;
+  if (Handle <> 0) and (GetWindowLong(Handle, GWL_STYLE) and PBS_VERTICAL = PBS_VERTICAL) then
+    Result := pbVertical;
+end;
+
+function TNewProgressBarStyleHook.GetPosition: Integer;
+begin
+  Result := SendMessage(Handle, PBM_GETPOS, 0, 0);
+end;
+
+function TNewProgressBarStyleHook.GetBorderWidth: Integer;
+begin
+  Result := 0;
+end;
+
 end.