sskinprovider.pas

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

unit sSkinProvider;
{$I sDefs.inc}

interface

{.$DEFINE LOCALDEBUG}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  sStylePassive, menus, sSkinMenus, sSkinManager, sConst, sScrollBar, sPanel;

type
  TsBorderIcon = (biSystemMenu, biMinimize, biMaximize, biHelp);
  TsBorderIcons = set of TsBorderIcon;

  TsCaptionButton = record
    State : integer;
    ImageIndex : integer;
    Rect : TRect;
  end;

  TsSystemMenu = class;

  TsSkinProvider = class(TComponent)
  private
    FsStyle: TsPassivePaintStyle;
    FsBorderIcons: TsBorderIcons;
    OldCaption : string;
    OldCaption1 : string;
    FMakeSkinMenu: boolean;

    procedure SetBorderIcons(const Value: TsBorderIcons);
    procedure OnVSBChange(Sender : TObject; OldValue : integer);
    procedure OnHSBChange(Sender : TObject; OldValue : integer);
    procedure ScrollBy(x, y : integer);
  protected
    MenusInitialized : boolean;
    RegionChanged : boolean;
    CaptChanged : boolean;
    CaptRgnChanged : boolean;

    VertOffset : integer;
    HorzOffset : integer;
    RangeY : integer;
    RangeX : integer;
    Scrolling : boolean;
    procedure RefreshScrolls;
    function GetVScrollInfo : TsScrollInfo;
    function GetHScrollInfo : TsScrollInfo;
    function Range(Kind : TScrollBarKind) : integer;
    procedure ClearOffset(Kind : TScrollBarKind);
  public
    ArOR : TAOR;
    RgnChanging : boolean;
    Rgnchanged : boolean;
    AutoScroll : boolean;
    VSBar : TsScrollBar;
    HSBar : TsScrollBar;
    Grip : TsGrip;
    Frozen : boolean;

    BoundsNormal : TRect;
    BoundsIconic : TRect;

    CurrentHT : integer;
    FormActive : boolean;
    Ready : boolean;
    TempBmp : TBitmap;
    MenuLineBmp : TBitmap;
    SkinManager : TsSkinManager;

    BGChanged : boolean;
    Form : TForm;
    NewInstance : Pointer;
    OldInstance : Pointer;
    Region : hrgn;
    LinesCount : integer;

    ButtonMin : TsCaptionButton;
    ButtonMax : TsCaptionButton;
    ButtonClose : TsCaptionButton;
    ButtonHelp : TsCaptionButton;

    MDIMin : TsCaptionButton;
    MDIMax : TsCaptionButton;
    MDIClose : TsCaptionButton;

    SystemMenu : TsSystemMenu;

    OldBorderIcons : TBorderIcons;

    MDIForm : TObject;
    OldBorderStyle : TFormBorderStyle;

    Activated : boolean;

    constructor Create(AOwner : TCOmponent); override;
    destructor Destroy; override;
    procedure AfterConstruction; override;
    procedure DoHook;

    function FillScrollInfo(bar : integer; var si : TScrollInfo) : boolean;
    function LastControlBottom : integer;
    function LastControlRight : integer;
    function VertBarVisible : boolean;
    function HorzBarVisible : boolean;

    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure NewWndProc(var Message: TMessage);
    function HTProcess(Message : TWMNCHitTest) : integer;
    function AboveBorder(Message : TWMNCHitTest) : boolean;

    function MaxWidth: Integer;
    function MaxHeight: Integer;

    function MDIButtonsNeeded : boolean;

    function CursorToPoint(x, y : integer) : TPoint;

    procedure PaintForm(DC : hdc);
    procedure PaintCaption(dc : hdc);
    procedure PaintAll;
    procedure PaintBG;
    procedure PaintBorderIcons;
    procedure UpdateRgn;
    procedure OurPaintHandler(Msg : TWMPaint);

    procedure SetHotHT(i : integer);
    procedure SetPressedHT(i : integer);
    procedure RepaintButton(i : integer);
    procedure DropSysMenu(x, y : integer);
    function OffsetX : integer;
    function OffsetY : integer;
    procedure RepaintMenuItem(mi : TMenuItem; R : TRect; State : TOwnerDrawState);

    function GetItemUnderMouse(p : TSmallPoint; var CurR : TRect) : TMenuItem;
    function FormChanged : boolean;
    function CaptionHeight : integer;

    function HeaderHeight : integer;
    function BorderWidth : integer;
    function BorderHeight : integer;
    function IconRect : TRect;
    function FormLeftTop : TPoint;
    function MenuPresent : boolean;
    function BtnMaxVisible : boolean;
    function IconVisible : boolean;

    function MenuHeight : integer;
    function GetLinesCount : integer;
    function ButtonsCount : integer;
    function ButtonWidth : integer;
    function SmallButtonWidth : integer;
    function ButtonHeight : integer;
    function SmallButtonHeight : integer;
    function BarWidth(i : integer) : integer;
    procedure InitFormSizes;
    procedure UpdateMenu;
    property sStyle : TsPassivePaintStyle read FsStyle write FsStyle;
  published
    property BorderIcons: TsBorderIcons read FsBorderIcons write SetBorderIcons default [biSystemMenu, biMinimize, biMaximize];
    property MakeSkinMenu : boolean read FMakeSkinMenu write FMakeSkinMenu default True;
  end;

  TsSystemMenu = class(TPopupMenu)
  public
    FOwner : TsSkinProvider;
    FForm : TCustomForm;
    ItemRestore : TMenuItem;
    ItemMove : TMenuItem;
    ItemSize : TMenuItem;
    ItemMinimize : TMenuItem;
    ItemMaximize : TMenuItem;
    ItemClose : TMenuItem;
    constructor Create(AOwner : TComponent); override;
    procedure AfterConstruction; override;
    destructor Destroy; override;
    procedure UpdateItems;
    procedure MakeSkinItems;

    function VisibleRestore : boolean;
    function VisibleMove : boolean;
    function VisibleSize : boolean;
    function VisibleMin : boolean;
    function VisibleMax : boolean;
    function VisibleClose : boolean;

    function EnabledRestore : boolean;
    function EnabledMove    : boolean;
    function EnabledSize    : boolean;
    function EnabledMin     : boolean;
    function EnabledMax     : boolean;
    function EnabledClose   : boolean;

    procedure RestoreClick(Sender: TObject);
    procedure MoveClick(Sender: TObject);
    procedure SizeClick(Sender: TObject);
    procedure MinClick(Sender: TObject);
    procedure MaxClick(Sender: TObject);
    procedure CloseClick(Sender: TObject);

    procedure SkinSelect(Sender: TObject);
  end;

const
  ScrollWidth = 18;
  IconicHeight = 26;
  IconicWidth = 160;

var
  Offs : integer;
  RM_TaskBarCreated : DWord;
  HotItem : TMenuItemData;
  SymbolWidth : integer;

function GetSkinProvider(Cmp : TComponent) : TsSkinProvider;

implementation

uses math, sVclUtils, sBorders, sGraphUtils, sSkinProps, sGradient,
{$IFNDEF ALITE}
sShowMessages,
{$ENDIF}
  sMaskData, sUtils, sMessages, sStyleSimply{$IFDEF LOCALDEBUG}, sShowMessages,
  Unit1{$ENDIF}, sStrings, sMDIForm, sAlphaGraph;

function GetSkinProvider(Cmp : TComponent) : TsSkinProvider;
var
  c : TComponent;
  sp : integer;
begin
  Result := nil;
  c := Cmp;
  while Assigned(c) and not (c is TCustomForm) do begin
    c := c.Owner;
  end;
  if (c is TCustomForm) then begin
    sp := SendMessage(TCustomForm(c).Handle, SM_GETPROVIDER, 0, 0);
    if sp <> 0 then
      Result := TsSkinProvider(sp);
  end;
end;

{ TsSkinProvider }

procedure TsSkinProvider.AfterConstruction;
begin
  inherited;
{
  OldInstance := nil;
  NewInstance := nil;
  OldInstance := Pointer(GetWindowLong(Form.Handle, GWL_WNDPROC));
  NewInstance := MakeObjectInstance(NewWndProc);
  SetWindowLong(Form.Handle, GWL_WNDPROC, LongInt(NewInstance));
}
  DoHook;

  RM_TaskBarCreated      := RegisterWindowMessage('TaskbarCreated');
  sStyle.SkinIndex       := sStyle.GetSkinIndex;
  sStyle.BorderIndex     := sStyle.GetMaskIndex(BordersMask);
  ButtonMin.ImageIndex   := sStyle.GetMaskIndex(BorderIconMinimize);
  ButtonMax.ImageIndex   := sStyle.GetMaskIndex(BorderIconMaximize);
  ButtonClose.ImageIndex := sStyle.GetMaskIndex(BorderIconClose);
  ButtonHelp.ImageIndex  := sStyle.GetMaskIndex(BorderIconHelp);
  MDIMin.ImageIndex      := sStyle.GetMaskIndex(SmallIconMinimize);
  MDIMax.ImageIndex      := sStyle.GetMaskIndex(SmallIconMaximize);
  MDIClose.ImageIndex    := sStyle.GetMaskIndex(SmallIconClose);
  InitFormSizes;

  if (Form.FormStyle = fsMDIForm) and not (csDesigning in ComponentState) then begin
    MDISkinProvider := Self;
    TsMDIForm(MDIForm) := TsMDIForm.Create(Self);
  end;

  // If form is MDIChild and menus are merged then
  if (Form.FormStyle = fsMDIChild) {and Assigned(Form.Menu)} then begin
    if Assigned(MDISkinProvider) and
         not (csDestroying in TsSkinProvider(MDISkinProvider).ComponentState) and
           not (csDestroying in TsSkinProvider(MDISkinProvider).Form.ComponentState) and sSkinData.Active
             then begin
      TsSkinProvider(MDISkinProvider).BGChanged := True;
      SendMessage(TsSkinProvider(MDISkinProvider).Form.Handle, WM_NCPAINT, 0, 0);

      TsMDIForm(TsSkinProvider(MDISkinProvider).MDIForm).RefreshScrolls;
    end;
  end;

{  SystemMenu := TsSystemMenu.Create(Self);
  SystemMenu.FForm := Form;
  SystemMenu.UpdateItems;}
end;

function TsSkinProvider.BarWidth(i : integer): integer;
begin
  Result := (ma[i].Bmp.Width div 9) * 2 + ButtonsCount * ButtonWidth;
//  Result := (ma[i].Bmp.Width div 3);
end;

function TsSkinProvider.BorderHeight: integer;
begin
  Result := GetSystemMetrics(SM_CYFRAME);// * integer(Form.BorderStyle = bsNone);
  case Form.BorderStyle of
    {bsToolWindow,} bsSingle, bsDialog : begin
      dec(Result)
    end;
    bsNone : Result := 0;
  end;
end;

function TsSkinProvider.BorderWidth: integer;
begin
  Result := GetSystemMetrics(SM_CXFRAME);// * integer(Form.BorderStyle = bsNone);
  case Form.BorderStyle of
    bsToolWindow, bsSingle, bsDialog : begin
      dec(Result)
    end;
    bsNone : Result := 0;
  end;
end;

function TsSkinProvider.ButtonHeight: integer;
begin
  if IsValidImgIndex(ButtonClose.ImageIndex) then begin
     Result := ma[ButtonClose.ImageIndex].Bmp.Height div 2;
  end
  else Result := 21;
end;

function TsSkinProvider.ButtonsCount: integer;
begin
  Result := 0;
  if (biSystemMenu in BorderIcons) then begin
    inc(Result);
    if SystemMenu.VisibleMax then begin
      inc(Result);
    end;
    if SystemMenu.VisibleMin then begin
      inc(Result);
    end;
    if (biHelp in BorderIcons) then begin
      inc(Result);
    end;