sstylesimply.pas

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

unit sStyleSimply;

{.$DEFINE DEBUGGING}   

interface

{$I sDefs.inc}

uses
  windows, Graphics, Classes, Controls,
  {$IFDEF USEDB}db, {$ENDIF}
  sUtils, SysUtils, StdCtrls,  Dialogs, Forms, Messages, sConst, extctrls,
  IniFiles, sSkinManager;

type

  TsGenStyle = class;
  TsEffects = class;

  // Basic type for SStyle components border painting
  TsCustomBorder = class(TPersistent)
  protected
    FOwner : TPersistent;
    FWidth : integer;
    FBevel : TsBorderStyle;
    procedure SetWidth(const Value: integer);
    { @EXCLUDE}
  public
    constructor Create(AOwner: TPersistent); dynamic;
  published
    // Width of border. Default value - is 2
    property Width : integer read FWidth write SetWidth default 2;
    // Mode of border painting - (bsRaised, bsLowered, bsFlat1, bsFlat2)
    property Bevel : TsBorderStyle read FBevel write FBevel default sConst.bsFlat1;
  end;

  TsShadow = class(TPersistent)
  private
    procedure SetColor(const Value: TColor);
    procedure SetEnabled(const Value: boolean);
    procedure SetOffset(const Value: integer);
    procedure SetTransparency(const Value: integer);
    procedure SetBlur(const Value: integer);
    procedure SetDontUse(const Value: boolean);
//    procedure SetBoolean(Index: Integer; Value: boolean);
  public
    FColor : TColor;
    FOffset : integer;
    FOwner : TsEffects;
    FTransparency : integer;
    FBlur : integer;
    FDontUse : boolean;
    FEnabled : boolean;
    constructor Create(AOwner : TsEffects);
    destructor Destroy; override;
  published
    property Transparency: integer read FTransparency write SetTransparency default 60;
    property DontUse : boolean read FDontUse write SetDontUse default True;
    property Enabled : boolean read FEnabled write SetEnabled default False;
    property Color : TColor read FColor write SetColor default clBlack;
    property Offset : integer read FOffset write SetOffset default 8;
    property Blur : integer read FBlur write SetBlur default 4;
  end;

  TsEffects = class(TPersistent)
  protected
    FShadow: TsShadow;
  public
    FOwner : TsGenStyle;
    constructor Create(AOwner : TsGenStyle); dynamic;
    destructor Destroy; override;
  published
    property Shadow: TsShadow read FShadow write FShadow;
  end;

  TsGenStyle = class(TPersistent)
  private
{$IFDEF DEBUGGING}
    FLogged : boolean;
    FMesBox : TListBox;
{$ENDIF}
    FEffects: TsEffects;
    FSkinSection: string;
    procedure SetSoftControl(const Value: boolean);
    procedure SetSkinSection(const Value: string);
  protected
    FGroupIndex : integer;
    FMouseEnter : TNotifyEvent;
    FSoftControl: boolean;
{$IFDEF DEBUGGING}
    procedure SetLogged(Value : boolean);
{$ENDIF}
  public
    BorderIndex : integer;
    SkinIndex : integer;

    RegionChanged : boolean;
    BGChanged : boolean;
    FCurrent : boolean;
    FOwner : TControl;
    FCacheBmp : TBitmap;
    FRegion : hrgn;

    FScr: Pointer; //???
    cw, ch : integer; //???

    COC : integer;
    FFocused : boolean;
    FMouseAbove: Boolean;
    function ActualMaskedBorder : TBitmap; virtual;
    procedure AssignByManager(sC : TComponent);
    procedure CreateRgn; dynamic;
    procedure InitCacheBmp;
    constructor Create(AOwner : TControl); dynamic;
    destructor Destroy; override;
    procedure BeforeDestruction; override;
    function ControlIsActive: boolean;
    procedure WndProc(var Message: TMessage); dynamic;
    procedure sStyleMessage(var Message: TMessage);// dynamic;
    procedure RedrawBorder(DC: hWnd); overload; dynamic;
    procedure AlignShadow;
    function GetParentCache : TCacheInfo;

    procedure Invalidate; dynamic;
    procedure CopyFromCache(DC: hWnd; Left, Top, Right, Bottom: integer);
    procedure CopyToCache(DC: hWnd; Left, Top, Right, Bottom: integer);
    procedure Loaded; virtual;
    procedure PaintShadow(aCanvas: TCanvas; X, Y : integer); virtual;
//    property BorderIndex : integer read GetBorderIndex write SetBorderIndex;
  published
{$IFDEF DEBUGGING}
    property Logged : boolean read FLogged write FLogged default False;
    property MesBox : TListBox read FMesBox write FMesBox;
{$ENDIF}
    property Effects : TsEffects read FEffects write FEffects;
    property OnMouseEnter: TNotifyEvent read FMouseEnter write FMouseEnter;
    property SoftControl : boolean read FSoftControl write SetSoftControl default True;
    property GroupIndex: integer read FGroupIndex write FGroupIndex;
    property SkinSection : string read FSkinSection write SetSkinSection;
  end;

  TsSkinData = class (TObject)
    SkinManager : TsSkinManager;
    SkinFile : TMemIniFile;
    SkinPath : string;
    Active : boolean;
  end;

procedure AppBroadCastS(var Message);
procedure BroadCastS(Form: TWinControl; var Message); //overload;
function GetStyleInfo(Control : TComponent) : integer;
function GetsStyle(Control : TComponent) : TsGenStyle;

function GetMaskIndex(SkinIndex : integer; SkinSection, mask : string) : integer;
function GetPatternIndex(SkinIndex : integer; SkinSection, pattern : string) : integer;
function GetSkinIndex(SkinSection : string) : integer;
function SearchSkinManager(c : TComponent) : TsSkinManager;

procedure UpdateShadows(Form: TWinControl; GroupIndex: integer);

procedure UpdateControls(Form : TWinControl);
//procedure SendRanged(Control : TWinControl; Msg : TMessage);

var
  RestrictDrawing : boolean = False;
  sSkinData : TsSkinData;
  _TempBitmap : TBitmap;
  _TempPoint : TPoint;
  GlobalCacheInfo : TCacheInfo;
  GlobalSectionName : string;

implementation

uses
  {$IFNDEF ALITE}
    sCustomMenuManager, sHintManager, sPageControl, sTrackBar,
    sCustomComboBox, sEditorsManager, sControlsManager, sGroupBox,
    sScrollBox, sShowMessages,
  {$ENDIF}
  {$IFDEF DEBUGGING}
  sShowMessages,
  {$ENDIF}
  sStyleEdits, sStyleUtil,
  sCheckedControl, sScrollBar,
  sVclUtils, sMessages, sMaskData, sSkinProvider, sStylePassive,
  sButtonControl, sCustomButton, comctrls, sPanel, sSkinProps;


{
procedure SendRanged(Control : TWinControl; Msg : TMessage);
  procedure Update(Control : TControl);
  var
    i : integer;
  begin
    if (csDestroying in Control.ComponentState) or (csReading in Control.ComponentState) then Exit;
    if (Control is TWinControl) then begin
      SendMessage(TWinControl(Control).Handle, Msg.Msg, 0, 0);
      for i := 0 to TWinControl(Control).ControlCount - 1 do begin
        if (TWinControl(Control).Controls[i].Parent = Control) and
             (TWinControl(Control).Controls[i] is TWinControl) then begin
          Update(TWinControl(Control).Controls[i]);
        end;
      end;
    end
    else begin
      Control.Perform(Msg.Msg, 0, 0);
    end;
  end;
begin
  Update(Control);
end;
}
procedure UpdateControls(Form : TWinControl);
var
  i : integer;
  procedure Update(Control : TControl);
  var
    i : integer;
  begin
    if Control is TWinControl then begin
      for i := 0 to TWinControl(Control).ControlCount - 1 do begin
        if TWinControl(Control).Controls[i] is TWinControl then begin
          SendMessage(TWincontrol(TWinControl(Control).Controls[i]).Handle, SM_REFRESH, 0, 0);
          Update(TWinControl(Control).Controls[i]);
        end
        else begin
          TWinControl(Control).Controls[i].Perform(SM_REFRESH, 0, 0);
          Update(TWinControl(Control).Controls[i]);
        end;
      end;
    end
    else begin
      for i := 0 to Form.ControlCount - 1 do begin
        if Form.Controls[i].Parent = Control then begin
          Form.Controls[i].Perform(SM_REFRESH, 0, 0);
          Update(Form.Controls[i]);
        end;
      end;
    end;
  end;
begin
  for i := 0 to Form.ControlCount - 1 do begin
    SendMessage(Form.Handle, SM_REFRESH, 0, 0);
    Update(Form);
  end;
end;

function 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;

function SearchSkinManager(c : TComponent) : TsSkinManager;
var
  i : integer;
begin
  Result := nil;
  for i := 0 to c.ComponentCount - 1 do begin
    if (c.Components[i] is TsSkinManager) then begin
      Result := TsSkinManager(c.Components[i]);
      Break;
    end
    else begin
      Result := SearchSkinManager(c.Components[i]);
      if Result <> nil then Break;
    end;
  end;
end;

procedure UpdateShadows(Form: TWinControl; GroupIndex: integer);{Post message to control for updates of shadows drawing..}
var
  M : TSMSetBoolean;
begin
  M.GroupIndex := GroupIndex;
  M.Result := 0;
  m.Msg := EM_UPDATESHADOWS;
  if Assigned(Form) then begin
    BroadCastS(Form, M);
  end
  else begin
    AppBroadCasts(M);
  end;
  m.Msg := CM_UPDATESHADOWS;
  if Assigned(Form) then begin
    BroadCastS(Form, M);
  end
  else begin
    AppBroadCasts(M);
  end;
end;

procedure AppBroadCastS(var Message);
var
  i: integer;
begin
  for i := 0 to Application.ComponentCount - 1 do begin
    if Application.Components[i] is TCustomForm then begin
      if not (csDestroying in Application.Components[i].ComponentState) then
        BroadCastS(TCustomForm(Application.Components[i]), Message);
    end;
{
    if Application.Components[i] is TWinControl then begin
      BroadCastS(TWinControl(Application.Components[i]), Message);
    end;
}
  end;
end;

procedure BroadCastS(Form: TWinControl; var Message);
var
  i : integer;
//  sb : TsScrollBar;
begin
  try
    if (csDestroying in Form.ComponentState) {or (csReading in Form.ComponentState)} then Exit;

    SendMessage(Form.Handle, TMessage(Message).Msg, TMessage(Message).WParam, TMessage(Message).LParam);
    if TForm(Form).FormStyle = fsMDIForm then begin
      SendMessage(TForm(Form).ClientHandle, TMessage(Message).Msg, TMessage(Message).WParam, TMessage(Message).LParam);
    end;
    for i := 0 to Form.ComponentCount - 1 do begin
      if (csDestroying in Form.Components[i].ComponentState) or (csReading in Form.Components[i].ComponentState) then Exit;
{      if Form.Components[i] is TsScrollBar then begin
        sb := TsScrollBar(Form.Components[i]);
        TMessage(Message).Result := 0;
      end;}
      if (Form.Components[i] is TControl) and not ControlIsReady(TControl(Form.Components[i])) then Continue;
      if Form.Components[i] is TsSkinProvider then begin
        TsSkinProvider(Form.Components[i]).sStyle.WndProc(TMessage(Message));
      end
{$IFNDEF ALITE}
      else if Form.Components[i] is TWinControl then begin
        SendMessage(TWinControl(Form.Components[i]).Handle, TMessage(Message).Msg, TMessage(Message).WParam, TMessage(Message).LParam);
        if (Form.Components[i] is TsScrollBox) and (TsScrollBox(Form.Components[i]).Grip <> nil) then begin
          SendMessage(TsScrollBox(Form.Components[i]).Grip.Handle, TMessage(Message).Msg, TMessage(Message).WParam, TMessage(Message).LParam);
        end;
      end
{$ENDIF}
      else if Form.Components[i] is TControl then begin
        TControl(Form.Components[i]).Perform(TMessage(Message).Msg, TMessage(Message).WParam, TMessage(Message).LParam);
      end
{$IFNDEF ALITE}
      else if Form.Components[i] is TsHintManager then begin
        TsHintManager(Form.Components[i]).sStyle.WndProc(TMessage(Message));
      end
      else if Form.Components[i] is TsCustomMenuManager then begin
        TsCustomMenuManager(Form.Components[i]).sStyle.WndProc(TMessage(Message));
      end;
{$ENDIF}
//    end;
  end;
  except
  end;
end;

function GetsStyle(Control : TComponent) : TsGenStyle;
var
  m : TMessage;
begin
  Result := nil;
  if Control is TControl then begin
    m.LParam := 0;
    m.WParam := 0;
    m.Msg    := SM_GETSTYLEINFO;
    m.Result := 0;
    TControl(Control).WindowProc(m);//, 0, 0);
    Result := TsGenStyle(m.LParam);
  end;
end;

function GetPatternIndex(SkinIndex : integer; SkinSection, pattern : string) : integer;
var
  i, l : integer;
  s : string;
begin
  Result := -1;
  if not IsValidSkinIndex(SkinIndex) then Exit;
  l := Length(pa);
  if (l < 0) or not sSkinData.Active or (SkinSection = '' ) or (SkinIndex < 0) then Exit;


  for i := 0 to l - 1 do begin
    if (pa[i].PropertyName = pattern) and (pa[i].ClassName = UpperCase(skinSection)) then begin