sstyleutil.pas

AlphaControls是一个Delphi标准控件的集合

unit sStyleUtil;
{$I sDefs.inc}

interface

uses
  windows, Graphics, Classes, Controls,
  sUtils, SysUtils, StdCtrls, sStyleSimply,
  {$IFNDEF ALITE}
    sControlsManager,
  {$ENDIF}
  sStyleActive, sGradient, 
  Dialogs, Forms, Messages, sConst, extctrls, IniFiles;

type
  TsPaintStyle = class;
  TsPassiveBGStyle = class;

  TsPainting = class(TPersistent)
  private
    FParentColor : boolean;
    procedure SetColors (Index: Integer; Value: TColor);
    procedure SetParentColor (Value: Boolean);
    procedure SetTransparency(const Value: integer);
    procedure SetBevel(const Value: TsControlBevel);
    procedure SetBevelWidth(const Value: integer);
  public
    FColor : TColor;
    FBevelWidth : integer;
    FBevel : TsControlBevel;
    FOwner : TsGenStyle;
    FTransparency: integer;
    constructor Create(AOwner : TsPaintStyle);
    property BevelWidth : integer read FBevelWidth write SetBevelWidth;
  published
    property Bevel : TsControlBevel read FBevel write SetBevel default cbRaisedSoft;
    property Transparency: integer read FTransparency write SetTransparency default 0;
    property Color: TColor index 3 read FColor write SetColors default $00CAC2B7;
    property ParentColor: Boolean read FParentColor write SetParentColor default True;
  end;

  TsPaintStyle = class(TsGenStyle)
  private
    FGroupIndex: integer;
  protected
    FPainting : TsPainting;
  public
    FBorderWidth : integer;

{$IFNDEF ALITE}
    sC : TsControlsManager;
    procedure AssignByManager(sC : TComponent);
{$ENDIF}
    constructor Create(AOwner : TControl); override;
    destructor Destroy; override;
    procedure WndProc(var Message: TMessage); override;
    procedure sStyleMessage(var Message: TMessage); //override;
    procedure PaintBevel(Bmp: TBitmap; aRect: TRect; BevelWidth: integer; Bevel: TsControlBevel; Soft : boolean);
    procedure PaintShadow(aCanvas: TCanvas; X, Y : integer); override;
  published
    property Painting: TsPainting read FPainting write FPainting;
    property GroupIndex: integer read FGroupIndex write FGroupIndex;
  end;

  TsPassiveBGStyle=class(TsPaintStyle)
  private
  protected
    FBackground : TsBackground;
    FRegion : hrgn;
    function MouseAllow : boolean;
  public
{$IFNDEF ALITE}
    procedure AssignByManager(sC : TComponent);
{$ENDIF}
    constructor Create(AOwner : TControl); override;
    destructor Destroy; override;
    function ActiveColor : TColor; virtual;

    function ActualBevel : TsControlBevel; virtual;
    function ActualBevelWidth : integer; virtual;
    function ActualGradPercent : integer; virtual;
    function ActualGradArray : TsGradArray; virtual;
    function ActualImagePercent : integer; virtual;
    function ActualImage : TGraphic; virtual;

    procedure PaintBG(BGBmp : TBitmap); dynamic;
    procedure sStyleMessage(var Message: TMessage);
    procedure WndProc(var Message: TMessage); override;
  published
    property Background: TsBackground read FBackground write FBackground;
  end;

  TsActiveBGStyle = class(TsPassiveBGStyle)
  private
    FHotStyle: TsHotStyle;
    FBtnEffects: TsActiveEffects;
  protected
  public
    constructor Create(AOwner : TControl); override;
    procedure CreateRgn; override;
    destructor Destroy; override;
    procedure WndProc(var Message: TMessage); override;
    procedure PaintBG(BGBmp : TBitmap); override;
    procedure PaintActiveBG;
    procedure sStyleMessage(var Message: TMessage);
    function ActiveColor : TColor; override;

    function ActualBevel : TsControlBevel; override;
    function ActualBevelWidth : integer; override;
    function ActualGradPercent : integer; override;
    function ActualGradArray : TsGradArray; override;
    function ActualImagePercent : integer; override;
    function ActualImage : TGraphic; override;
    function ActualFadingEnabled : boolean;
    function ActualFadingIn : integer;
    function ActualFadingOut : integer;
    function ActualFadingIter : integer;
    function ActualHotfontcolor : TColor;

    procedure PaintBorder(DC : hWnd; aRect : TsRect);
  published
    property HotStyle : TsHotStyle read FHotStyle write FHotStyle;
    property BtnEffects : TsActiveEffects read FBtnEffects write FBtnEffects;
  end;

implementation

uses
  {$IFNDEF ALITE}
    sRadioButton, sPageControl, sStoreUtils, sShowMessages, sBevel,
    sHintManager, sGroupBox, sStatusBar, sCustomMenuManager,
    sToolEdit, sCustomLabel,
  {$ENDIF}
  sCheckBox, sPanel, sCheckedControl, sGraphUtils, sVclUtils, sMessages,
  comctrls, sButtonControl, sCustomButton, sMaskData, sSkinProps, math, sAlphaGraph;

{ TsPaintStyle }

constructor TsPaintStyle.Create(AOwner : TControl);
begin
  inherited Create(AOwner);

  Painting := TsPainting.Create(Self);

  FBorderWidth := 2;
{$IFNDEF ALITE}
  if (sC = nil) and (csDesigning in FOwner.ComponentState) then sC := GetsControlsManager(GetOwnerForm(AOwner), GroupIndex);
  if not Assigned(sC) then begin
    FGroupIndex := 0;
  end
  else begin
    AssignByManager(sC);
  end;
{$ENDIF}
end;

destructor TsPaintStyle.Destroy;
begin
  FreeAndNil(FPainting);
  {$IFNDEF ALITE}
  sC := nil;
  {$ENDIF}
  inherited Destroy;
end;

procedure TsPaintStyle.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    SM_OFFSET..SM_SHARED, EM_CHANGEALL + 1..SM_LAST : begin
//        alert;
      if Message.Msg = SM_GETSTYLEINFO then begin
        TSMGetStyleInfo(Message).WParam := tos_SPAINTSTYLE;
        TSMGetStyleInfo(Message).LParam := Longint(Self);
      end
      else sStyleMessage(Message);
    end;
    CM_SYSCOLORCHANGE, CM_PARENTCOLORCHANGED: begin
      if Painting.ParentColor and Assigned(FOwner.Parent) then begin
        Painting.FColor := TsHackedControl(FOwner.Parent).Color;
        Invalidate;
      end;
    end
  end;
  inherited;
end;

procedure TsPaintStyle.sStyleMessage(var Message: TMessage);
{$IFNDEF ALITE}
var
  sSC : TsControlsManager;
{$ENDIF}  
begin
  if Assigned(Self) and (Message.WParam = GroupIndex) then begin
    case Message.Msg of
      CM_SETCOLOR:  begin
        Painting.Color := TSMSetColor(Message).Value;
      end;

    {$IFNDEF ALITE}
      CM_CHANGEALL : begin
        sSC := TCMChangeAll(Message).sStyleControl;
        if not (COC in sNoShadow)
           and FOwner.Visible
           and not Effects.Shadow.DontUse then begin
          Effects.Shadow.FEnabled := sSC.Shadow.Enabled;
        end
        else begin
          Effects.Shadow.FEnabled := False;
        end;
      end;
    {$ENDIF}
    end;
  end;
end;

procedure TsPaintStyle.PaintShadow(aCanvas: TCanvas; X, Y : integer);
var
  aRect: TRect;
  ss: TsShadowingShape;
  tr: integer;
begin
  ss := ssRectangle;
  if SkinIndex > -1 then begin
    if gd[SkinIndex].ShadowEnabled then begin
      {$IFNDEF ALITE}
      case COC of
        COC_TsPageControl : begin
          aRect.Top := FOwner.Top + gd[SkinIndex].ShadowOffset + TsPageControl(FOwner).TabHeight;
          aRect.Bottom := aRect.Top + FOwner.Height - TsPageControl(FOwner).TabHeight;
          aRect.Left := FOwner.Left + gd[SkinIndex].ShadowOffset;
          aRect.Right := aRect.Left + FOwner.Width;
        end
        else
      {$ENDIF}
        begin
          if (gd[SkinIndex].PaintingTransparency > 100) {and (ActualBevel = cbNone)} then exit;

          aRect.Top := FOwner.Top + gd[SkinIndex].ShadowOffset;
          aRect.Bottom := aRect.Top + FOwner.Height;
          aRect.Left := FOwner.Left + gd[SkinIndex].ShadowOffset;
          aRect.Right := aRect.Left + FOwner.Width;
        end;
      {$IFNDEF ALITE}
      end;
      {$ENDIF}
      if FOwner.Parent is TsTabSheet then begin
        if aRect.Right > FOwner.Parent.Width + FOwner.Parent.Left - X then
            aRect.Right := FOwner.Parent.Width + FOwner.Parent.Left - X;
        if aRect.Bottom > FOwner.Parent.Height + FOwner.Parent.Top - Y then
            aRect.Bottom := FOwner.Parent.Height + FOwner.Parent.Top - Y;
        if aRect.Bottom < aRect.Top then Exit;
        if aRect.Right < aRect.Left then Exit;
      end;

      tr := gd[SkinIndex].PaintingTransparency * integer((COC in sHaveBG) and (gd[SkinIndex].PaintingTransparency > 0));
      tr := SumTrans(tr, gd[SkinIndex].ShadowTransparency);

      OffsetRect(aRect, X, Y);
      FadeRect(aCanvas, aRect, aCanvas.Handle,
           Point(aRect.Left, aRect.Top),
           tr,
           ColorToRGB(gd[SkinIndex].ShadowColor),
           gd[SkinIndex].ShadowBlur, ss, 6 * integer(SoftControl));
    end;
  end
  else begin
    {$IFNDEF ALITE}
    case COC of
      COC_TsPageControl : begin
        aRect.Top := FOwner.Top + Effects.Shadow.Offset + TsPageControl(FOwner).TabHeight;
        aRect.Bottom := aRect.Top + FOwner.Height - TsPageControl(FOwner).TabHeight;
        aRect.Left := FOwner.Left + Effects.Shadow.Offset;
        aRect.Right := aRect.Left + FOwner.Width;
      end
      else
    {$ENDIF}
      begin
        if (Painting.Transparency > 100) {and (ActualBevel = cbNone)} then exit;

        aRect.Top := FOwner.Top + Effects.Shadow.Offset;
        aRect.Bottom := aRect.Top + FOwner.Height;
        aRect.Left := FOwner.Left + Effects.Shadow.Offset;
        aRect.Right := aRect.Left + FOwner.Width;
      end;
    {$IFNDEF ALITE}
    end;
    {$ENDIF}

    tr := Painting.Transparency * integer((COC in sHaveBG) and (Painting.Transparency > 0));
    tr := SumTrans(tr, Effects.Shadow.Transparency);

    OffsetRect(aRect, X, Y);
    FadeRect(aCanvas, aRect, aCanvas.Handle,
         Point(aRect.Left, aRect.Top),
         tr,
         ColorToRGB(Effects.Shadow.Color),
         Effects.Shadow.Blur, ss, 6 * integer(SoftControl));
  end;
end;

procedure TsPaintStyle.PaintBevel(Bmp: TBitmap; aRect: TRect; BevelWidth: integer; Bevel: TsControlBevel; Soft: boolean);
begin
  sGraphUtils.PaintBevel(Bmp, aRect, BevelWidth, Bevel, Soft);
end;

{$IFNDEF ALITE}
procedure TsPaintStyle.AssignByManager(sC: TComponent);
begin
  inherited;
  Painting.ParentColor := False;

  Effects.Shadow.FEnabled := not Effects.Shadow.FDontUse and TsControlsManager(sC).Shadow.Enabled;
  Effects.Shadow.FColor := TsControlsManager(sC).Shadow.Color;
  Effects.Shadow.FBlur := TsControlsManager(sC).Shadow.Blur;
  Effects.Shadow.FOffset := TsControlsManager(sC).Shadow.Offset;
  Effects.Shadow.Transparency := TsControlsManager(sC).Shadow.Transparency;
end;
{$ENDIF}

{ TsPainting }

constructor TsPainting.Create(AOwner: TsPaintStyle);
begin
  FColor := $00CAC2B7;
  FParentColor := True;
  FTransparency := 0;
  FOwner := AOwner;
  FBevel := cbRaisedSoft;
end;

procedure TsPainting.SetBevel(const Value: TsControlBevel);
begin
  if FBevel <> Value then begin
    FBevel := Value;
    if (FOwner.FOwner is TsCustomPanel) and (TsCustomPanel(FOwner.FOwner).BevelOuter <> Value) then
      TsCustomPanel(FOwner.FOwner).BevelOuter := Value;
    FOwner.Invalidate;
  end;
end;

procedure TsPainting.SetBevelWidth(const Value: integer);
begin
  if FBevelWidth <> Value then begin
    FBevelWidth := Value;
    FOwner.Invalidate;
  end;
end;

procedure TsPainting.SetColors(Index: Integer; Value: TColor);
begin
  case Index of
    3: begin
      if FColor <> Value then begin
        FColor := Value;
        FParentColor := False;
        TsHackedControl(FOwner.FOwner).Color := Value;
        FOwner.Invalidate;
      end;
    end;
  end;
end;

procedure TsPainting.SetParentColor(Value: Boolean);
begin
  if Value <> FParentColor then begin
    FParentColor := Value;
    TsHackedControl(FOwner.FOwner).ParentColor := Value;
    if FParentColor then begin
      if Assigned(FOwner.FOwner.Parent) and (FColor <> TsHackedControl(FOwner.FOwner.Parent).Color) then begin
        FColor := TsHackedControl(FOwner.FOwner.Parent).Color;
        FOwner.Invalidate;
      end;
    end;
  end;
end;

procedure TsPainting.SetTransparency(const Value: integer);
begin
  if FTransparency <> Value then begin
    FTransparency := Value;