Fix TButtonColor Bug – VCL Style - نسخة قابلة للطباعة

PHP كود :
(*
 Fix TButtonColor Bug when enabling VCL Style
 VCLButtonColorFix by .::. SMP3 .::.
 My Blog : DelphiNews.WordPress.Com


*)
unit VCLButtonColorFix;

interface
uses
WinApi.Windows,Vcl.StdCtrls,VCL.Graphics,VCL.Themes,VCL.Styles,VCLTee.TeCanvas;

type
 TButtonColorStyleHookFix = class(TButtonStyleHook)
 protected
 procedure Paint(Canvas: TCanvas); override;
 end;
// to access to all TButton fields such : SymboleRectangle
TButtonColor =class(VCLTee.TeCanvas.TButtonColor);

implementation
 procedure TButtonColorStyleHookFix.Paint(Canvas: TCanvas);
var
 ThemeDetails : TThemedElementDetails;
 sButtonColor:TButtonColor;
 sRect:TRect;
 sStyle : TCustomStyleServices;

begin

sStyle:=StyleServices;
if sStyle.IsSystemStyle then exit;

sButtonColor:=TButtonColor(Control);

if FPressed then
ThemeDetails := sStyle.GetElementDetails(tbPushButtonPressed)
else
if MouseInControl then
ThemeDetails := sStyle.GetElementDetails(tbPushButtonHot)
else
if Focused then
ThemeDetails := sStyle.GetElementDetails(tbPushButtonDefaulted)
else
if Self.Control.Enabled then
ThemeDetails := sStyle.GetElementDetails(tbPushButtonNormal)
else
ThemeDetails := sStyle.GetElementDetails(tbPushButtonDisabled);

sStyle.DrawElement(Canvas.Handle, ThemeDetails, Control.ClientRect );

sRect:=Control.ClientRect ;
// Draw Text
sStyle.DrawText(Canvas.Handle, ThemeDetails, self.Text ,sRect , [tfCenter, tfSingleLine, tfVerticalCenter]);

Canvas.Brush.Color := sButtonColor.SymbolColor ;
Canvas.Pen.Color := clBlack;
// Draw Color Rectangle
canvas.Rectangle(sButtonColor.SymbolRectangle) ;

//canvas.FillRect(sButtonColor.SymbolRectangle );

end;
initialization
 // Register The new Style for TButtonColor (The Fix)
TStyleManager.Engine.RegisterStyleHook(TButtonColor, TButtonColorStyleHookFix);

end.