sstylepassive.pas

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

unit sStylePassive;
{$I sDefs.inc}

interface

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

type
  TsPassivePaintStyle = class;

  TsPassivePainting = class(TPersistent)
  private
    FBevel : TsControlBevel;
    FColor : TColor;
    FColorBorderTop : TColor;
    FColorBorderBottom : TColor;
    FTransparency: integer;
    FOwner : TsPassivePaintStyle;
    procedure SetColors (Index: Integer; Value: Graphics.TColor);
    procedure SetTransparency(const Value: integer);
    procedure SetBevel(const Value: TsControlBevel);
  public
    constructor Create(AOwner : TPersistent);
  published
    property Bevel : TsControlBevel read FBevel write SetBevel default cbRaisedSoft;
    property Transparency: integer read FTransparency write SetTransparency default 50;
    property ColorBorderTop: Graphics.TColor index 0 read FColorBorderTop write SetColors default clWhite;
    property ColorBorderBottom: Graphics.TColor index 1 read FColorBorderBottom write SetColors default clBlack;
    property Color: Graphics.TColor index 3 read FColor write SetColors default clMenu;
  end;

  TsPassiveShadow = class(TPersistent)
  private
    FEnabled : boolean;
    FOffset : integer;
    FColor : TColor;
    FOwner : TsPassivePaintStyle;
    FTransparency : TPercent;
    FBlur : integer;

    procedure SetColor(const Value: TColor);
    procedure SetEnabled(const Value: boolean);
    procedure SetOffset(const Value: integer);
    procedure SetTransparency(const Value: TPercent);
    procedure SetBlur(const Value: integer);
  public
    constructor Create(AOwner : TPersistent);
  published
    property Transparency: TPercent read FTransparency write SetTransparency default 50;
    property Enabled : boolean read FEnabled write SetEnabled default True;
    property Color : TColor read FColor write SetColor default clBlack;
    property Offset : integer read FOffset write SetOffset default 10;
    property Blur : integer read FBlur write SetBlur default 6;
  end;

  TsPassivePaintStyle = class(TPersistent)
  private
    FSkinSection: string;
    procedure SetSkinSection(const Value: string);
  protected
    FGroupIndex : integer;
  public
    BorderIndex : integer;
    SkinIndex : integer;
    FOwner : TPersistent;
    FShadow : TsPassiveShadow;
    FPainting : TsPassivePainting;
    FBackground : TsBackground;
    FDrawingStop : boolean;
    FCacheBmp : Graphics.TBitmap;
    COC : integer;
    sC : TPersistent;
    function ActualGradPercent : integer;
    constructor Create(AOwner : TPersistent); dynamic;
    destructor Destroy; override;
    procedure OwnerInvalidate;
    function GetMaskIndex(mask : string) : integer; overload;
    function GetMaskIndex(skinsection, mask : string) : integer; overload;
    function GetSkinIndex : integer; overload;
    function GetSkinIndex(SkinSection : string) : integer; overload;
    procedure WndProc(var Message: TMessage); dynamic;
    procedure PaintBG(BGBmp : TBitmap; R : TRect); dynamic;
    procedure Update;
  published
    property Background : TsBackground read FBackground write FBackground;
    property Shadow: TsPassiveShadow read FShadow write FShadow;
    property Painting: TsPassivePainting read FPainting write FPainting;
    property GroupIndex: integer read FGroupIndex write FGroupIndex default 0;
    property SkinSection : string read FSkinSection write SetSkinSection;
  end;

  TsHotPaintStyle = class(TsPassivePaintStyle)
  private
    FHotStyle: TsHotStyle;
  protected
  public
    constructor Create(AOwner : TPersistent); override;
    destructor Destroy; override;
    procedure WndProc(var Message: TMessage); override;
    procedure PaintActiveBG(BGBmp : TBitmap; R : TRect; ci : TCacheInfo);
    procedure sStyleMessage(var Message: TMessage);
//    procedure PaintBorder(DC : longint; aRect : TsRect);
  published
    property HotStyle : TsHotStyle read FHotStyle write FHotStyle;
  end;

implementation

uses sMessages, sGraphUtils, sGradient,
{$IFNDEF ALITE}
  sHintManager,
{$ENDIF}
  sMaskData, sSkinProps,
  sSkinProvider, sSkinMenus, sAlphaGraph;

{ TsPassivePaintStyle }

function TsPassivePaintStyle.ActualGradPercent: integer;
begin
  Result := Background.Gradient.Percent;
end;

constructor TsPassivePaintStyle.Create(AOwner: TPersistent);
begin
  inherited Create;
  SkinIndex := -1;
  BorderIndex := -1;
  FOwner := AOwner;
  FCacheBmp := Graphics.TBitmap.Create;
  FCacheBmp.PixelFormat := pf24bit;

  FShadow := TsPassiveShadow.Create(Self);
  FPainting := TsPassivePainting.Create(Self);
  FBackground := TsBackground.Create(Self);

{IFNDEF ALITE
  sC := GetsControlsManager(GetParentForm(TControl(AOwner)), GroupIndex);
  if not Assigned(sC) then begin}
  FGroupIndex := 0;
{//  end;
$ELSE
  FGroupIndex := 0;
$ENDIF}
{$IFDEF RUNIDEONLY}
  if not IsIDERunning and not (csDesigning in TComponent(FOwner).ComponentState) and not sTerminated then begin
    sTerminated := True;
    ShowWarning(sIsRUNIDEONLYMessage);
  end;
{$ENDIF}
end;

destructor TsPassivePaintStyle.Destroy;
begin
  FreeAndNil(FPainting);
  FreeAndNil(FShadow);
  FreeAndNil(FBackground);
  FreeAndNil(FCacheBmp);
  inherited Destroy;
end;

function TsPassivePaintStyle.GetMaskIndex(mask: string): integer;
var
  i, l : integer;
//  s : string;
begin
  Result := -1;
  if not sSkinData.Active then Exit;
  if skinSection = '' then Exit;
  l := Length(ma);
  if l > 0 then begin
    for i := 0 to l - 1 do begin
      if (UpperCase(ma[i].PropertyName) = mask) and
         (UpperCase(ma[i].ClassName) = UpperCase(SkinSection))  then begin
        Result := i;
        Exit;
      end;
    end;

    if (SkinIndex < Length(gd)) and (SkinIndex >= 0) then begin
      for i := 0 to l - 1 do begin
        if (UpperCase(ma[i].PropertyName) = mask) and
           (UpperCase(ma[i].ClassName) = UpperCase(gd[SkinIndex].ParentClassName)) then begin
          Result := i;
          Exit;
        end;
      end
    end
    else begin
//        ShowWarning('Undefined skin section - <' + SkinSection + '>');
    end;

  end;
end;

function TsPassivePaintStyle.GetMaskIndex(skinsection, mask: string): integer;
var
  i, l : integer;
//  s : string;
begin
  Result := -1;
  if not sSkinData.Active then Exit;
  if skinSection = '' then Exit;
  l := Length(ma);
  if l > 0 then begin
    for i := 0 to l - 1 do begin
      if (UpperCase(ma[i].PropertyName) = mask) and
         (UpperCase(ma[i].ClassName) = UpperCase(SkinSection))  then begin
        Result := i;
        Exit;
      end;
    end;

    if (SkinIndex < Length(gd)) and (SkinIndex >= 0) then begin
      for i := 0 to l - 1 do begin
        if (UpperCase(ma[i].PropertyName) = mask) and
           (UpperCase(ma[i].ClassName) = UpperCase(gd[SkinIndex].ParentClassName)) then begin
          Result := i;
          Exit;
        end;
      end
    end
    else begin
//        ShowWarning('Undefined skin section - <' + SkinSection + '>');
    end;
  end;
end;

function TsPassivePaintStyle.GetSkinIndex: integer;
var
  i, l : integer;
//  s : string;
begin
  Result := -1;
  if not sSkinData.Active then Exit;
  l := Length(gd);
  if l > 0 then begin
    for i := 0 to l - 1 do begin
      if (UpperCase(gd[i].ClassName) = UpperCase(SkinSection)) then begin
        Result := i;
        Exit;
      end;
    end;
  end;
end;

function TsPassivePaintStyle.GetSkinIndex(SkinSection: string): integer;
var
  i, l : integer;
//  s : string;
begin
  Result := -1;
  if not sSkinData.Active then Exit;
  l := Length(gd);
  if l > 0 then begin
    for i := 0 to l - 1 do begin
      if (UpperCase(gd[i].ClassName) = UpperCase(SkinSection)) then begin
        Result := i;
        Exit;
      end;
    end;
  end;
end;

procedure TsPassivePaintStyle.OwnerInvalidate;
begin
{$IFNDEF ALITE}
  Case COC of
{$IFDEF TSHINTS}
    COC_TsHintManager : begin
      TsHintManager(FOwner).Invalidate;
    end;
{$ENDIF}
    COC_TsMDIForm : begin
//      TsMDIManager(FOwner).Invalidate;
    end;
{$IFDEF TSMENUS}
    COC_TsCustomMenuManager, COC_TsMenuManager : begin
//      TsCustomMenuManager(FOwner).Invalidate;
    end;
{$ENDIF}
  end;
{$ENDIF}
end;

procedure TsPassivePaintStyle.PaintBG(BGBmp: TBitmap; R : TRect);
var
  aRect: TRect;
  i : integer;
  wc: TWinControl;
  sc: TsGenStyle;
  bmp : TBitmap;
  TransColor : TsColor;
  iDrawed : boolean;
  procedure FillCanvas(bmp : TBitmap); begin
    BMP.Canvas.Pen.Style := psClear;
    BMP.Canvas.Brush.Style := bsSolid;
    BMP.Canvas.Brush.Color := ColorToRGB(Painting.Color);
    BMP.Canvas.Rectangle(aRect.Left, aRect.Top, aRect.Right + 1, aRect.Bottom + 1);
  end;
  procedure PaintAddons; begin
    iDrawed := False;
    // BGImage painting
    if (Background.Image.Percent > 0) then begin
      if Assigned(Background.Image.Image)
           and (Background.Image.Image.Width <> 0)
           and (Background.Image.Image.Height <> 0) then begin
        TileBitmap(BGBmp.Canvas, aRect, Background.Image.Image.Graphic);
        iDrawed := True;
      end
      else begin
        FillCanvas(BGBmp);
      end;
    end;
    // BGGradient painting
    if (Background.Gradient.Percent > 0) then begin
      if iDrawed then begin
        if Length(Background.Gradient.FGradArray) > 0 then begin
          PaintGrad(Bmp, aRect, Background.Gradient.FGradArray);
        end
        else begin
          FillCanvas(Bmp);
        end;

        TransColor.A := 0;
        TransColor.R := Background.Image.Percent * 256 div 100;
        TransColor.G := TransColor.R;
        TransColor.B := TransColor.R;

        SumBitmaps(BGBmp, Bmp, TransColor);
      end
      else begin
        if Length(Background.Gradient.FGradArray) > 0 then begin
          PaintGrad(BGBmp, aRect, Background.Gradient.FGradArray);
        end
        else begin
          FillCanvas(BGBmp);
        end;
      end;
    end;
    if Background.Gradient.Percent + Background.Image.Percent in [1..100] then begin
      BlendColorRect(BGBMP,
                                 Rect(0,
                                      0,
                                      BGBMP.Width - 1,
                                      BGBMP.Height - 1),
                         (Background.Gradient.Percent + Background.Image.Percent),
                 ColorToRGB(Painting.Color));
{      FadeRect(BGBMP.Canvas, Rect(0,
                                      0,
                                      BGBMP.Width,
                                      BGBMP.Height),
                         BGBMP.Canvas.Handle, Point(0, 0),
                         (Background.Gradient.Percent + Background.Image.Percent),
                         ColorToRGB(Painting.Color), 0, ssRectangle);
}                         
    end
    else begin
      BGBMP.Canvas.Pen.Style := psClear;
      BGBMP.Canvas.Brush.Style := bsSolid;
      BGBMP.Canvas.Brush.Color := ColorToRGB(Painting.Color);
      BGBMP.Canvas.Rectangle(R);
    end;
  end;
begin
  aRect := R;
  bmp := TBitmap.Create;
  bmp.PixelFormat := pf24bit;
  bmp.Width := BGBMP.Width;
  bmp.Height := BGBMP.Height;
  try

  PaintAddons;

  finally
    FreeAndNil(Bmp);
  end;

  if COC in sCanBeParent then begin
    wc := TWinControl(FOwner);
    for i := 0 to wc.ControlCount - 1 do begin
      sc := GetsStyle(wc.Controls[i]);
      if Assigned(sc) and (sc.COC > 0) and sc.Effects.Shadow.Enabled and wc.Controls[i].Visible then begin
        sc.PaintShadow(BGBmp.Canvas, 0, 0);
      end;
    end;
  end;