rm_jvthemes.pas

这是一个功能强大

function DrawThemedFrameControl(Control: TControl; DC: HDC; const Rect: TRect;
  uType, uState: UINT): BOOL;

{$IFDEF VCL}
{ PerformEraseBackground sends a WM_ERASEBKGND message to the Control's parent. }
procedure PerformEraseBackground(Control: TControl; DC: HDC; Offset: TPoint); overload;
procedure PerformEraseBackground(Control: TControl; DC: HDC; Offset: TPoint; const R: TRect); overload;
procedure PerformEraseBackground(Control: TControl; DC: HDC); overload;
procedure PerformEraseBackground(Control: TControl; DC: HDC; const R: TRect); overload;
{$ENDIF VCL}

{$IFDEF VisualCLX}
type
  TButtonStyle = (bsAutoDetect, bsWin31, bsNew);
{$ENDIF VisualCLX}

{ DrawThemedButtonFace draws a themed button when theming is enabled. }
function DrawThemedButtonFace(Control: TControl; Canvas: TCanvas; const Client: TRect;
  BevelWidth: Integer; Style: TButtonStyle; IsRounded, IsDown,
  IsFocused, IsHot: Boolean): TRect;

{ IsMouseOver returns True if the mouse is over the control. }
function IsMouseOver(Control: TControl): Boolean;
{$IFDEF VCL}
{ GetParentBackground returns True if the Control has the csParentPackground
  ControlStyle }
function GetParentBackground(Control: TWinControl): Boolean;
{ SetParentBackground sets the Control's csParentPackground ControlStyle }
procedure SetParentBackground(Control: TWinControl; Value: Boolean);
{$ENDIF VCL}

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile$';
    Revision: '$Revision: 10228 $';
    Date: '$Date: 2006-01-24 09:42:03 -0800 (Tue, 24 Jan 2006) $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation


procedure DrawThemedBackground(Control: TControl; Canvas: TCanvas;
  const R: TRect; NeedsParentBackground: Boolean = True);
begin
  DrawThemedBackground(Control, Canvas, R, Canvas.Brush.Color,
    NeedsParentBackground);
end;

procedure DrawThemedBackground(Control: TControl; Canvas: TCanvas;
  const R: TRect; Color: TColor; NeedsParentBackground: Boolean = True);
var
  Cl: TColor;
begin
  {$IFDEF JVCLThemesEnabled}
  if (not (csDesigning in Control.ComponentState)) and
    (Control.Parent <> nil) and
    ((Color = TWinControlThemeInfo(Control.Parent).Color) or
    (ColorToRGB(Color) = ColorToRGB(TWinControlThemeInfo(Control.Parent).Color))) and
    (ThemeServices.ThemesEnabled) and
    ((not NeedsParentBackground) or
    (csParentBackground in GetThemeStyle(Control))) then
  begin
    if Control is TWinControl then
    begin
      if TWinControl(Control).DoubleBuffered then
        PerformEraseBackground(Control, Canvas.Handle, R)
      else
        ThemeServices.DrawParentBackground(TWinControl(Control).Handle, Canvas.Handle, nil, False, @R);
    end
    else
      PerformEraseBackground(Control, Canvas.Handle, R)
  end
  else
  {$ENDIF JVCLThemesEnabled}
  begin
    Cl := Canvas.Brush.Color;
    if Cl <> Color then
      Canvas.Brush.Color := Color;
    Canvas.FillRect(R);
    if Cl <> Canvas.Brush.Color then
      Canvas.Brush.Color := Cl;
  end;
end;

procedure DrawThemedBackground(Control: TControl; DC: HDC; const R: TRect;
  Brush: HBRUSH; NeedsParentBackground: Boolean = True);
{$IFDEF JVCLThemesEnabled}
var
  LogBrush: TLogBrush;
{$ENDIF JVCLThemesEnabled}
begin
  {$IFDEF JVCLThemesEnabled}
  GetObject(Brush, SizeOf(LogBrush), @LogBrush);
  if (not (csDesigning in Control.ComponentState)) and
    (Control.Parent <> nil) and
    (LogBrush.lbColor = Cardinal(ColorToRGB(TWinControlThemeInfo(Control.Parent).Color))) and
    (ThemeServices.ThemesEnabled) and
    ((not NeedsParentBackground) or
    (csParentBackground in GetThemeStyle(Control))) then
  begin
    if Control is TWinControl then
    begin
      if TWinControl(Control).DoubleBuffered then
        PerformEraseBackground(Control, DC, R)
      else
        ThemeServices.DrawParentBackground(TWinControl(Control).Handle, DC, nil, False, @R);
    end
    else
      PerformEraseBackground(Control, DC, R)
  end
  else
  {$ENDIF JVCLThemesEnabled}
    FillRect(DC, R, Brush);
end;

function DrawThemedFrameControl(Control: TControl; DC: HDC; const Rect: TRect; uType, uState: UINT): BOOL;
{$IFDEF JVCLThemesEnabled}
const
  Mask = $00FF;
var
  Btn: TThemedButton;
  ComboBox: TThemedComboBox;
  ScrollBar: TThemedScrollBar;
  R: TRect;
  Details: TThemedElementDetails;
{$ENDIF JVCLThemesEnabled}
begin
  Result := False;
  {$IFDEF JVCLThemesEnabled}
  if ((Control = nil) or (not (csDesigning in Control.ComponentState))) and
    ThemeServices.ThemesEnabled then
  begin
    R := Rect;
    case uType of
      DFC_BUTTON:
        case uState and Mask of
          DFCS_BUTTONPUSH:
            begin
              if uState and (DFCS_TRANSPARENT or DFCS_FLAT) = 0 then
              begin
                if uState and DFCS_INACTIVE <> 0 then
                  Btn := tbPushButtonDisabled
                else
                if uState and DFCS_PUSHED <> 0 then
                  Btn := tbPushButtonPressed
                else
                if uState and DFCS_HOT <> 0 then
                  Btn := tbPushButtonHot
                else
                if uState and DFCS_MONO <> 0 then
                  Btn := tbPushButtonDefaulted
                else
                  Btn := tbPushButtonNormal;

                Details := ThemeServices.GetElementDetails(Btn);
                ThemeServices.DrawElement(DC, Details, R);
                Result := True;
              end;
            end;
          DFCS_BUTTONCHECK:
            begin
              if uState and DFCS_CHECKED <> 0 then
              begin
                if uState and DFCS_INACTIVE <> 0 then
                  Btn := tbCheckBoxCheckedDisabled
                else
                if uState and DFCS_PUSHED <> 0 then
                  Btn := tbCheckBoxCheckedPressed
                else
                if uState and DFCS_HOT <> 0 then
                  Btn := tbCheckBoxCheckedHot
                else
                  Btn := tbCheckBoxCheckedNormal;
              end
              else
              if uState and DFCS_MONO <> 0 then
              begin
                if uState and DFCS_INACTIVE <> 0 then
                  Btn := tbCheckBoxMixedDisabled
                else
                if uState and DFCS_PUSHED <> 0 then
                  Btn := tbCheckBoxMixedPressed
                else
                if uState and DFCS_HOT <> 0 then
                  Btn := tbCheckBoxMixedHot
                else
                  Btn := tbCheckBoxMixedNormal;
              end
              else
              begin
                if uState and DFCS_INACTIVE <> 0 the