sskinprovider.pas

Alpha Controls.v5.46b Source

unit sSkinProvider;
{$I sDefs.inc}
{.$DEFINE LOGGED}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Forms, Dialogs, sDefaults, menus, sSkinMenus, sSkinManager,
  sConst, sCommondata, Controls, acSBUtils{$IFDEF TNTUNICODE}, TntWideStrUtils, TntMenus, TntStdCtrls{$ENDIF};

type

{$IFNDEF NOTFORHELP}
  TacCtrlAdapter = class;
  TacAdapterItem = class(TPersistent)
  public
    Ctrl : TWinControl;
    SkinData : TsCommonData;
    OldFontColor : integer;
    Adapter : TacCtrlAdapter;
    ScrollWnd : TacMainWnd;
    constructor Create; virtual;
    destructor Destroy; override;
    procedure DoHook(Control : TWinControl); virtual;
  end;
{$ENDIF} // NOTFORHELP

  TAddItemEvent = procedure(Item: TComponent; var CanBeAdded: boolean; var SkinSection: string) of object;
  TsSkinProvider = class;

  TsGripMode = (gmNone, gmRightBottom);
  TsResizeMode = (rmStandard, rmBorder); // MarkB

{$IFNDEF NOTFORHELP}
  TsSystemMenu = class;
  TsCaptionButton = record
    State : integer;
    ImageIndex : integer;
    Rect : TRect;
  end;
{$ENDIF} // NOTFORHELP

  TsTitleButton = class(TCollectionItem)
{$IFNDEF NOTFORHELP}
  private
    FUseSkinData: boolean;
    FName: string;
    FGlyph: TBitmap;
    FOnMouseUp: TMouseEvent;
    FOnMouseDown: TMouseEvent;
    FEnabled: boolean;
    procedure SetGlyph(const Value: TBitmap);
    procedure SetName(const Value: string);
    procedure MouseDown(BtnIndex : integer; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure MouseUp(BtnIndex : integer; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  public
    BtnData : TsCaptionButton;
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    function GetDisplayName: string; override;
  published
{$ENDIF} // NOTFORHELP
    property Enabled : boolean read FEnabled write FEnabled default True;
    property Glyph : TBitmap read FGlyph write SetGlyph;
    property Name : string read FName write SetName;
    property UseSkinData : boolean read FUseSkinData write FUseSkinData default True;
    property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
    property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
  end;

  TsTitleButtons = class(TCollection)
{$IFNDEF NOTFORHELP}
  private
    FOwner: TsSkinProvider;
    function GetItem(Index: Integer): TsTitleButton;
    procedure SetItem(Index: Integer; Value: TsTitleButton);
  protected
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(AOwner: TsSkinProvider);
    destructor Destroy; override;
{$ENDIF} // NOTFORHELP
    property Items[Index: Integer]: TsTitleButton read GetItem write SetItem; default;
  end;

  TsTitleIcon = class (TPersistent)
{$IFNDEF NOTFORHELP}
  private
    FGlyph: TBitmap;
    FHeight: integer;
    FWidth: integer;
    procedure SetGlyph(const Value: TBitmap);
    procedure SetHeight(const Value: integer);
    procedure SetWidth(const Value: integer);
  public
    constructor Create;
    destructor Destroy; override;
  published
{$ENDIF} // NOTFORHELP
    property Glyph : TBitmap read FGlyph write SetGlyph;
    property Height : integer read FHeight write SetHeight default 0;
    property Width : integer read FWidth write SetWidth default 0;
  end;

  TsSkinProvider = class(TComponent)
{$IFNDEF NOTFORHELP}
  private
    ArOR : TAOR;
    Rgnchanged : boolean;
    CurrentHT : integer;
    TempBmp : TBitmap;

    FMakeSkinMenu: boolean;
    FShowAppIcon: boolean;
    ControlsChanged : boolean;

    FCaptionAlignment: TAlignment;
    FTitleIcon: TsTitleIcon;
    FTitleButtons: TsTitleButtons;
    FGripMode: TsGripMode;
    FCommonData: TsCommonData;
    FResizeMode: TsResizeMode;
    FirstInitialized : boolean;
    FScreenSnap: boolean;
    FSnapBuffer: integer;
    FUseGlobalColor: boolean;
    FTitleSkin: TsSkinSection;
    FMenuLineSkin: TsSkinSection;
    UserBtnIndex : integer;
    FOnSkinItem: TAddItemEvent;

    procedure SetCaptionAlignment(const Value: TAlignment);
    procedure SetShowAppIcon(const Value: boolean);
    procedure SetTitleButtons(const Value: TsTitleButtons);
    procedure SetUseGlobalColor(const Value: boolean);
    function GetLinesCount : integer; // Returns a count of menu lines
    procedure SetTitleSkin(const Value: TsSkinSection);
    procedure SetMenuLineSkin(const Value: TsSkinSection);
  protected
    ClearButtons : boolean;
    MenusInitialized : boolean;
    RegionChanged : boolean;
    CaptChanged : boolean;
    CaptRgnChanged : boolean;

    ButtonMin : TsCaptionButton;
    ButtonMax : TsCaptionButton;
    ButtonClose : TsCaptionButton;
    ButtonHelp : TsCaptionButton;
    MDIMin : TsCaptionButton;
    MDIMax : TsCaptionButton;
    MDIClose : TsCaptionButton;

    procedure AdapterRemove;
    procedure AdapterCreate;
    procedure SendToAdapter(Message : TMessage);
    // Painting procedures <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    procedure PaintAll;
    procedure PaintForm(DC : hdc; SendUpdated : boolean = True);
    procedure PaintCaption(dc : hdc);
    procedure PrepareCaption(CI : TCacheInfo; R : TRect);
    procedure PaintBorderIcons;
    procedure RepaintButton(i : integer);
    procedure RepaintMenuItem(mi : TMenuItem; R : TRect; State : TOwnerDrawState);
    procedure MakeTitleBG;
    procedure SaveBGForBtns(Full : boolean = False);
    procedure RestoreBtnsBG;
    procedure OurPaintHandler(Msg : TWMPaint);

    // Special calculations <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    function HTProcess(Message : TWMNCHitTest) : integer;
    function AboveBorder(Message : TWMNCHitTest) : boolean;
    function CursorToPoint(x, y : integer) : TPoint;
    function MDIButtonsNeeded : boolean;
    function RBGripPoint(ImgIndex : integer) : TPoint;
    function IconRect : TRect;
    function FormLeftTop : TPoint;
    function SysButtonsCount : integer;
    function SmallButtonWidth : integer;
    function ButtonHeight : integer;
    function SmallButtonHeight : integer;

    function SysButtonWidth(Btn : TsCaptionButton) : integer;
    function TitleBtnsWidth : integer;
    function UserButtonWidth(Btn : TsTitleButton) : integer;
    function BarWidth(i : integer) : integer;
    // >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

    procedure UpdateIconsIndexes;

    procedure StartMove(X, Y: Integer);                             // MarkB
    procedure StopMove(X, Y: Integer);                              // MarkB
    procedure DrawFormBorder(X, Y: Integer);                        // MarkB

    procedure SetHotHT(i : integer; Repaint : boolean = True);
    procedure SetPressedHT(i : integer);
    procedure DropSysMenu(x, y : integer);

    function FormChanged : boolean;
    function IconVisible : boolean;
    function TitleSkinSection : string;
  public
    InMenu : boolean;

    fAnimating : boolean;
    ListSW : TacScrollWnd;
    Adapter : TacCtrlAdapter;

    RgnChanging : boolean;

    MenuChanged : boolean;
    OldWndProc: TWndMethod;
    MDIForm : TObject;
    FormActive : boolean;

    MenuLineBmp : TBitmap;

    Form : TForm;
    FLinesCount : integer;
    SystemMenu : TsSystemMenu;
    TitleBG : TBitmap;
    CaptForm : TForm;
    OldCaptFormProc : TWndMethod;

    constructor Create(AOwner : TCOmponent); override;
    destructor Destroy; override;
    procedure AfterConstruction; override;
    procedure Loaded; override;
    procedure PrepareForm;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

    function OffsetX : integer;
    function OffsetY : integer;

    procedure NewWndProc(var Message: TMessage); // Main window procedure hook
    procedure DsgnWndProc(var Message: TMessage); // Main window procedure hook for design-time
    procedure HookMDI(Active : boolean = True);
    function HeaderHeight : integer;  // Height of the header + menu lines
    function SysBorderWidth : integer;
    function SysBorderHeight : integer;
    function BorderHeight: integer;
    function BorderWidth: integer;
    function CaptionHeight : integer;
    function CaptionWidth : integer;
    function MenuHeight : integer;
    function MenuPresent : boolean;

    procedure MdiIcoFormPaint(Sender : TObject);
    procedure CaptFormPaint(Sender : TObject);
    procedure NewCaptFormProc(var Message: TMessage);

    procedure UpdateMenu;
    procedure InitMenuItems(A: boolean);
    procedure RepaintMenu;
    property LinesCount : integer read GetLinesCount;
  published
{$ENDIF} // NOTFORHELP
    property CaptionAlignment : TAlignment read FCaptionAlignment write SetCaptionAlignment default taLeftJustify;
    property SkinData : TsCommonData read FCommonData write FCommonData;
    property GripMode : TsGripMode read FGripMode write FGripMode default gmNone;
    property MakeSkinMenu : boolean read FMakeSkinMenu write FMakeSkinMenu default DefMakeSkinMenu;
    property MenuLineSkin : TsSkinSection read FMenuLineSkin write SetMenuLineSkin;
    property ResizeMode : TsResizeMode read FResizeMode write FResizeMode default rmStandard; // MarkB
    property ScreenSnap : boolean read FScreenSnap write FScreenSnap default False;
    property SnapBuffer : integer read FSnapBuffer write FSnapBuffer default 10;
    property ShowAppIcon : boolean read FShowAppIcon write SetShowAppIcon default True;
    property TitleButtons : TsTitleButtons read FTitleButtons write SetTitleButtons;
    property TitleIcon : TsTitleIcon read FTitleIcon write FTitleIcon;
    property TitleSkin : TsSkinSection read FTitleSkin write SetTitleSkin;
    property UseGlobalColor : boolean read FUseGlobalColor write SetUseGlobalColor default True;
    property OnSkinItem: TAddItemEvent read FOnSkinItem write FOnSkinItem;
  end;

{$IFNDEF NOTFORHELP}
{$IFDEF TNTUNICODE}
  TsSystemMenu = class(TTntPopupMenu)
{$ELSE}
  TsSystemMenu = class(TPopupMenu)
{$ENDIF}
  public
    FOwner : TsSkinProvider;
    FForm : TCustomForm;
    ItemRestore : TMenuItem;
    ItemMove : TMenuItem;
    ItemSize : TMenuItem;
    ItemMinimize : TMenuItem;
    ItemMaximize : TMenuItem;
    ItemClose : TMenuItem;

    constructor Create(AOwner : TComponent); override;
    procedure UpdateItems;
    procedure MakeSkinItems;

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

    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;

{$IFNDEF NOTFORHELP}
  TacAdapterItems = array of TacAdapterItem;