{*******************************************************************}
{                                                                   }
{       Almediadev Visual Component Library                         }         
{       BusinessSkinForm                                            }
{       Version 6.15                                                }
{                                                                   }
{       Copyright (c) 2000-2008 Almediadev                          }
{       ALL RIGHTS RESERVED                                         }
{                                                                   }
{       Home:  http://www.almdev.com                                }
{       Support: support@almdev.com                                 }
{                                                                   }
{*******************************************************************}

Unit BusinessSkinForm;


{$P+,S-,W-,R-}
{$WARNINGS OFF}
{$HINTS OFF}
//{$DEFINE TNTUNICODE}


interface

uses
  Windows, Messages, Classes, Graphics, Controls, Forms,
  ExtCtrls, bsSkinData, Menus, bsSkinMenus, bsSkinCtrls, bsUtils, bsSkinTabs,
  bsSkinBoxCtrls, bsTrayIcon, bsSkinHint, bsSkinExCtrls;

type

  TbsBorderIcon = (biSystemMenu, biMinimize, biMaximize, biRollUp, biMinimizeToTray);
  TbsBorderIcons = set of TbsBorderIcon;

  TbsCaptionPaintEvent = procedure (Cnvs: TCanvas; R: TRect; AActive: Boolean) of object;

  TbsPaintEvent = procedure (IDName: String; Canvas: TCanvas;
                           ObjectRect: TRect) of object;
  TbsMouseEnterEvent= procedure (IDName: String) of object;
  TbsMouseLeaveEvent = procedure (IDName: String) of object;

  TbsMouseUpEvent = procedure (IDName: String;
                             X, Y: Integer; ObjectRect: TRect;
                             Button: TMouseButton) of object;
  TbsMouseDownEvent = procedure (IDName: String;
                               X, Y: Integer; ObjectRect: TRect;
                               Button: TMouseButton) of object;
  TbsMouseMoveEvent = procedure (IDName: String; X, Y: Integer;
                               ObjectRect: TRect) of object;

  TbsActivateCustomObjectEvent = procedure (IDName: String; var ObjectVisible: Boolean) of object;

  TbsBusinessSkinForm = class;


  TbsSkinComponent = class (TComponent)
  protected
    FSkinData: TbsSkinData;
    procedure SetSkinData(Value: TbsSkinData); virtual;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure BeforeChangeSkinData; virtual;
    procedure ChangeSkinData; virtual;
  published
    property SkinData: TbsSkinData read FSkinData write SetSkinData;
  end;

  TbsActiveSkinObject = class(TObject)
  protected
    Parent: TbsBusinessSkinForm;
    FMorphKf: Double;
    FMouseIn: Boolean;
    Picture, ActivePicture: TBitMap;
    procedure SetMorphKf(Value: Double);
    procedure Redraw;
  public
    SD: TbsSkinData;
    IDName: String;
    Hint: String;
    SkinRect: TRect;
    ActiveSkinRect: TRect;
    InActiveSkinRect: TRect;
    ObjectRect: TRect;
    Active: Boolean;
    Morphing: Boolean;
    MorphKind: TbsMorphKind;
    Enabled: Boolean;
    Visible: Boolean;
    SkinRectInAPicture: Boolean;
    function EnableMorphing: Boolean; 
    function CanMorphing: Boolean; virtual;
    procedure DoMorphing;
    property MorphKf: Double read FMorphKf write SetMorphKf;
    constructor Create(AParent: TbsBusinessSkinForm; AData: TbsDataSkinObject);
    procedure Draw(Cnvs: TCanvas; UpDate: Boolean); virtual;
    procedure DblClick; virtual;
    procedure MouseDown(X, Y: Integer; Button: TMouseButton); virtual;
    procedure MouseUp(X, Y: Integer; Button: TMouseButton); virtual;
    procedure MouseMove(X, Y: Integer); virtual;
    procedure MouseEnter; virtual;
    procedure MouseLeave; virtual;
  end;

  TbsSkinAnimateObject = class(TbsActiveSkinObject)
  protected
    FFrame: Integer;
    FInc: Integer;
    TimerInterval: Integer;
    MenuItem: TMenuItem;
    FPopupUp: Boolean;
    FDown: Boolean;
    FMenuTracking: Boolean;
    procedure SetFrame(Value: Integer);
    procedure DoMinToTray;
    procedure DoMax;
    procedure DoMin;
    procedure DoRollUp;
    procedure DoClose;
    procedure DoCommand;
    procedure TrackMenu;
  public
    CountFrames: Integer;
    Cycle: Boolean;
    ButtonStyle: Boolean;
    Increment: Boolean;
    Command: TbsStdCommand;
    DownSkinRect: TRect;
    RestoreRect, RestoreActiveRect, RestoreInActiveRect,
    RestoreDownRect: TRect;
    procedure ChangeFrame;
    procedure Start;
    procedure Stop;
    constructor Create(AParent: TbsBusinessSkinForm;
      AData: TbsDataSkinObject);
    procedure DblCLick; override;
    procedure MouseUp(X, Y: Integer; Button: TMouseButton); override;
    procedure MouseDown(X, Y: Integer; Button: TMouseButton); override;
    property Frame: Integer read FFrame write SetFrame;
    procedure Draw(Cnvs: TCanvas; UpDate: Boolean); override;
    procedure MouseEnter; override;
    procedure MouseLeave; override;
  end;

  TbsUserObject = class(TbsActiveSkinObject)
  public
    procedure Draw(Cnvs: TCanvas; UpDate: Boolean); override;
  end;

  TbsSkinButtonObject = class(TbsActiveSkinObject)
  protected
    FDown: Boolean;
    FPopupUp: Boolean;
    procedure SetDown(Value: Boolean);
    procedure TrackMenu;
  public
    DisableSkinRect: TRect;
    DownRect: TRect;
    MenuItem: TMenuItem;
    constructor Create(AParent: TbsBusinessSkinForm;
      AData: TbsDataSkinObject);
    property Down: Boolean read FDown write SetDown;
    procedure Draw(Cnvs: TCanvas; UpDate: Boolean); override;
    procedure MouseDown(X, Y: Integer; Button: TMouseButton); override;
    procedure MouseUp(X, Y: Integer; Button: TMouseButton); override;
    procedure MouseEnter; override;
    procedure MouseLeave; override;
    function CanMorphing: Boolean; override;
  end;

  TbsSkinStdButtonObject = class(TbsSkinButtonObject)
  protected
    procedure DoMax;
    procedure DoMin;
    procedure DoClose;
    procedure DoRollUp;
    procedure DoCommand;
    procedure DoMinimizeToTray;
  public
    FSkinSupport: Boolean;
    Command: TbsStdCommand;
    RestoreRect, RestoreActiveRect, RestoreInActiveRect,
    RestoreDownRect: TRect;
    procedure DblClick; override;
    procedure MouseDown(X, Y: Integer; Button: TMouseButton); override;
    procedure MouseUp(X, Y: Integer; Button: TMouseButton); override;
    constructor Create(AParent: TbsBusinessSkinForm;
      AData: TbsDataSkinObject);
    procedure Draw(Cnvs: TCanvas; UpDate: Boolean); override;
    procedure DefaultDraw(Cnvs: TCanvas);
    function CanMorphing: Boolean; override;
  end;

  TbsSkinCaptionObject = class(TbsActiveSkinObject)
  public
    FontName: String;
    FontStyle: TFontStyles;
    FontHeight: Integer;
    FontColor: TColor;
    ActiveFontColor: TColor;
    ShadowColor: TColor;
    ActiveShadowColor: TColor;
    Shadow: Boolean;
    LightColor: TColor;
    ActiveLightColor: TColor;
    Light: Boolean;
    Alignment: TAlignment;
    TextRct: TRect;
    FrameRect, ActiveFrameRect: TRect;
    FrameLeftOffset, FrameRightOffset: Integer;
    FrameTextRect: TRect;
    StretchEffect: Boolean;
    FullFrame: Boolean;
    // animation
    FIncTime: Integer;
    //
    AnimateSkinRect: TRect;
    FrameCount: Integer;
    AnimateInterval: Integer;
    CurrentFrame: Integer;
    InActiveAnimation: Boolean;
    //
    constructor Create(AParent: TbsBusinessSkinForm;
      AData: TbsDataSkinObject);
    procedure MouseEnter; override;
    procedure MouseLeave; override;
    procedure MouseDown(X, Y: Integer; Button: TMouseButton); override;
    procedure MouseUp(X, Y: Integer; Button: TMouseButton); override;
    procedure Draw(Cnvs: TCanvas; UpDate: Boolean); override;
    function EnableAnimation: Boolean;
  end;

  TbsSkinMainMenu = class(TMainMenu)
  protected
    BSF: TbsBusinessSkinForm;
    FSD: TbsSkinData;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property SkinData: TbsSkinData read FSD write FSD;
  end;

  // Menu Bar //
  TbsSkinMainMenuBar = class;

  TbsMenuBarObject = class(TObject)
  protected
    Parent: TbsSkinMainMenuBar;
    FMouseIn: Boolean;
    Picture: TBitMap;
    FDown: Boolean;
    FMorphKf: Double;
    procedure Redraw; virtual;
    procedure SetMorphKf(Value: Double);
  public
    IDName: String;
    SkinRect: TRect;
    ActiveSkinRect: TRect;
    DownRect: TRect;
    ObjectRect: TRect;
    Active: Boolean;
    Enabled: Boolean;
    Visible: Boolean;
    Morphing: Boolean;
    MorphKind: TbsMorphKind;
    constructor Create(AParent: TbsSkinMainMenuBar; AData: TbsDataSkinObject);
    function EnableMorphing: Boolean;
    procedure Draw(Cnvs: TCanvas); virtual;
    procedure MouseDown(X, Y: Integer; Button: TMouseButton); virtual;
    procedure MouseUp(X, Y: Integer; Button: TMouseButton); virtual;
    procedure DblClick; virtual; 
    procedure MouseEnter; virtual;
    procedure MouseLeave; virtual;
    function CanMorphing: Boolean; virtual;
    procedure DoMorphing;
    property MorphKf: Double read FMorphKf write SetMorphKf;
  end;

  TbsSkinMainMenuBarButton = class(TbsMenuBarObject)
  protected
    FSkinSupport: Boolean;
    procedure DoCommand;
  public
    Command: TbsStdCommand;
    constructor Create(AParent: TbsSkinMainMenuBar; AData: TbsDataSkinObject);
    procedure DefaultDraw(Cnvs: TCanvas);
    procedure Draw(Cnvs: TCanvas); override;
    procedure DblClick; override;
    procedure MouseDown(X, Y: Integer; Button: TMouseButton); override;
    procedure MouseUp(X, Y: Integer; Button: TMouseButton); override;
    procedure MouseEnter; override;
    procedure MouseLeave; override;
  end;


  TbsSkinMainMenuBarItem = class(TbsMenuBarObject)
  protected
    FSkinSupport: Boolean;
    TempObjectRect: TRect;
    OldEnabled: Boolean;
    Visible: Boolean;

    function SearchDown: Boolean;
    procedure SearchActive;
    procedure SetDown(Value: Boolean);
    procedure TrackMenu;
    procedure Redraw; override;
  public
    MenuItem: TMenuItem;
    FontName: String;
    FontHeight: Integer;
    FontStyle: TFontStyles;
    UnEnabledFontColor, FontColor,
    ActiveFontColor, DownFontColor: TColor;
    TextRct: TRect;
    DownRect: TRect;
    LO, RO: Integer;
    StretchEffect: Boolean;
    AnimateSkinRect: TRect;
    FrameCount: Integer;
    AnimateInterval: Integer;
    CurrentFrame: Integer;
    InActiveAnimation: Boolean;
    function EnableAnimation: Boolean;
    constructor Create(AParent: TbsSkinMainMenuBar; AData: TbsDataSkinObject);
    procedure DefaultDraw(Cnvs: TCanvas);
    procedure Draw(Cnvs: TCanvas); override;
    procedure MouseEnter; override;
    procedure MouseDown(X, Y: Integer; Button: TMouseButton); override;
    procedure MouseLeave; override;
  end;

  TbsItemEnterEvent = procedure (MenuItem: TMenuItem) of object;
  TbsItemLeaveEvent = procedure (MenuItem: TMenuItem) of object;

  TbsSkinMainMenuBar = class(TbsSkinControl)
  protected
    FOnItemMouseEnter: TbsItemEnterEvent;
    FOnItemMouseLeave: TbsItemLeaveEvent;
    FScrollMenu: Boolean;
    FDefItemFont: TFont;
    FUseSkinFont: Boolean;
    FSkinSupport: Boolean;
    ButtonsCount: Integer;
    FMDIChildMax: Boolean;
    FPopupToUp: Boolean;
    MenuActive: Boolean;
    Scroll: Boolean;
    MarkerActive: Boolean;
    BSF: TbsBusinessSkinForm;
    FMainMenu: TMainMenu;
    MouseTimer: TTimer;
    MorphTimer: TTimer;
    AnimateTimer: TTimer;
    ActiveObject, OldActiveObject, MouseCaptureObject: Integer;
    FOnMouseEnter, FOnMouseLeave: TNotifyEvent;
    NewItemsRect: TRect;
    FDefaultWidth: Integer;
    FDefaultHeight: Integer;
    FMergeMenu: TMainMenu;
    procedure TestMorph(Sender: TObject);
    procedure TestAnimate(Sender: TObject);
    procedure SetDefaultWidth(Value: Integer);
    procedure SetDefaultHeight(Value: Integer);
    procedure SetDefItemFont(Value: TFont);
    procedure CloseSysMenu;
    procedure AddButtons;
    procedure DeleteButtons;
    procedure CheckButtons(BI: TbsBorderIcons);

    procedure TrackScrollMenu;
    procedure CalcRects;
    procedure SetMainMenu(Value: TMainMenu);
    procedure TestMouse(Sender: TObject);
      procedure PaintMenuBar(Cnvs: TCanvas);
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMCloseSkinMenu(var Message: TMessage); message WM_CLOSESKINMENU; 
    procedure WMSize(var Message: TWMSIZE); message WM_SIZE;
    procedure WMMOVE(var Msg: TWMMOVE); message WM_MOVE;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure WMCHECKPARENTBG(var Msg: TWMEraseBkgnd); message WM_CHECKPARENTBG;
    procedure TestActive(X, Y: Integer);

    procedure Notification(AComponent: TComponent;
                           Operation: TOperation); override;

    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure ClearObjects;
    procedure DrawSkinObject(AObject: TbsMenuBarObject);
    procedure MenuEnter;
    procedure MenuExit;
    procedure MenuClose;
    function CheckReturnKey: Boolean;
    procedure NextMainMenuItem;
    procedure PriorMainMenuItem;
    function FindHotKeyItem(CharCode: Integer): Boolean;
    function GetMarkerRect: TRect;
    procedure DrawMarker(Cnvs: TCanvas);