skinmenus.pas

DynamicSkinForm.v9.15.For.Delphi.BCB 很好的皮肤控件

{*******************************************************************}
{                                                                   }
{       Almediadev Visual Component Library                         }     
{       DynamicSkinForm                                             }
{       Version 9.15                                                }
{                                                                   }
{       Copyright (c) 2000-2008 Almediadev                          }
{       ALL RIGHTS RESERVED                                         }
{                                                                   }
{       Home:  http://www.almdev.com                                }
{       Support: [e-mail]                                 }
{                                                                   }
{*******************************************************************}

unit SkinMenus;

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

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ExtCtrls, ImgList, SkinData, SPUtils, spEffBMp, SkinHint;

type

  TspSkinPopupWindow = class;
  TspSkinMenuItem = class(TObject)
  protected
    Parent: TspSkinPopupWindow;
    MI: TspDataSkinMenuItem;
    ActivePicture: TBitMap;
    FMorphKf: Double;
    procedure SetMorphKf(Value: Double);
    procedure Redraw;
    procedure DrawSkinCheckImage(Cnvs: TCanvas; R: TRect; AActive: Boolean);
    procedure DrawSkinRadioImage(Cnvs: TCanvas; R: TRect; AActive: Boolean);
    procedure DrawSkinArrowImage(Cnvs: TCanvas; R: TRect; AActive: Boolean);
   public
    MenuItem: TMenuItem;
    ObjectRect: TRect;
    Active: Boolean;
    Down: Boolean;
    FVisible: Boolean;
    WaitCommand: Boolean;
    //
    CurrentFrame: Integer;
    //
    constructor Create(AParent: TspSkinPopupWindow; AMenuItem: TMenuItem;
                       AData: TspDataSkinMenuItem);
    function EnableMorphing: Boolean;
    function EnableAnimation: Boolean;
    procedure Draw(Cnvs: TCanvas);
    procedure DefaultDraw(Cnvs: TCanvas);
    function CanMorphing: Boolean; virtual;
    procedure DoMorphing;
    property MorphKf: Double read FMorphKf write SetMorphKf;
    procedure MouseDown(X, Y: Integer);
    procedure MouseEnter(Kb: Boolean);
    procedure MouseLeave;
  end;

  TspSkinMenu = class;

  TspSkinPopupWindow = class(TCustomControl)
  private
    DSMI: TspDataSkinMenuItem;
    VisibleCount: Integer;
    VisibleStartIndex: Integer;
    Scroll: Boolean;
    Scroll2: Boolean;
    ScrollCode: Integer;
    NewLTPoint, NewRTPoint,
    NewLBPoint, NewRBPoint: TPoint;
    NewItemsRect: TRect;
    FRgn: HRGN;
    ShowX, ShowY: Integer;
    WT: TTimer;
    OMX, OMY: Integer;
    procedure WTProc(Sender: TObject);
    procedure WMMouseActivate(var Message: TMessage); message WM_MOUSEACTIVATE;
    procedure WMEraseBkGrnd(var Message: TMessage); message WM_ERASEBKGND;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CreateMenu(Item: TMenuItem; StartIndex: Integer);
    procedure CreateMenu2(Item, Item2: TMenuItem; StartIndex: Integer);
    procedure CreateRealImage(B: TBitMap; ADrawClient: Boolean);
    procedure SetMenuWindowRegion;
    procedure DrawUpMarker(Cnvs: TCanvas);
    procedure DrawDownMarker(Cnvs: TCanvas);
    procedure StartScroll;
    procedure StopScroll;
  protected
    ImgL: TCustomImageList;
    GlyphWidth: Integer;
    WindowPicture, MaskPicture: TBitMap;
    OldActiveItem: Integer;
    MouseTimer, MorphTimer: TTimer;
    ParentMenu: TspSkinMenu;
    SD: TspSkinData;
    PW: TspDataSkinPopupWindow;
    procedure WMTimer(var Message: TWMTimer); message WM_Timer;
    function CanScroll(AScrollCode: Integer): Boolean;
    procedure ScrollUp(Cycle: Boolean);
    procedure ScrollDown(Cycle: Boolean);
    function GetEndStartVisibleIndex: Integer;
    procedure CalcItemRects;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure TestMouse(Sender: TObject);
    procedure TestActive(X, Y: Integer);
    function InWindow(P: TPoint): Boolean;
    procedure TestMorph(Sender: TObject);
    procedure UpDatePW;
    function GetActive(X, Y: Integer): Boolean;
    procedure DrawScrollArea(Cnvs: TCanvas; R: TRect);
  public
    Sc: TBitMap;
    ESc: TspEffectBmp;
    AlphaBlend: Boolean;
    AlphaBlendValue: Byte;
    AlphaBlendAnimation: Boolean;
    ItemList: TList;
    ActiveItem: Integer;
    FPaintBuffer: TBitMap;
    constructor CreateEx(AOwner: TComponent; AParentMenu: TspSkinMenu;
                       AData: TspDataSkinPopupWindow);
    destructor Destroy; override;
     procedure Hide;
    procedure Show(R: TRect; AItem: TMenuItem; StartIndex: Integer;
                   PopupByItem: Boolean;  PopupUp: Boolean);
    procedure Show2(R: TRect; AItem, AItem2: TMenuItem; StartIndex: Integer;
                   PopupByItem: Boolean;  PopupUp: Boolean);
    procedure PaintMenu(DC: HDC);
    procedure PopupKeyDown(CharCode: Integer);
  end;

  TspSkinMenu = class(TComponent)
  protected
    FUseSkinFont: Boolean;
    FFirst: Boolean;
    FDefaultMenuItemHeight: Integer;
    FDefaultMenuItemFont: TFont;
    PopupCtrl, DCtrl: TControl;
    FForm: TForm;
    WaitTimer: TTimer;
    WItem: TspSkinMenuItem;
    WorkArea: TRect;
    FVisible: Boolean;
    SkinData: TspSkinData;
    FOnMenuClose: TNotifyEvent;
    procedure SetDefaultMenuItemFont(Value: TFont);
    function GetWorkArea: TRect;
    function GetPWIndex(PW: TspSkinPopupWindow): Integer;
    procedure CheckItem(PW: TspSkinPopupWindow; MI: TspSkinMenuItem; Down: Boolean; Kb: Boolean);
    procedure CloseMenu(EndIndex: Integer);
    procedure PopupSub(R: TRect; AItem: TMenuItem; StartIndex: Integer;
                       PopupByItem, PopupUp: Boolean);
    procedure PopupSub2(R: TRect; AItem, AItem2: TMenuItem; StartIndex: Integer;
                       PopupByItem, PopupUp: Boolean);
    procedure WaitItem(Sender: TObject);
  public
    { Public declarations }
    FPopupList: TList;
    AlphaBlend: Boolean;
    AlphaBlendValue: Byte;
    AlphaBlendAnimation: Boolean;
    MaxMenuItemsInWindow: Integer;
    property Visible: Boolean read FVisible;
    constructor CreateEx(AOwner: TComponent; AForm: TForm);
    destructor Destroy; override;
    procedure Popup(APopupCtrl: TControl; ASkinData: TspSkinData; StartIndex: Integer;
                    R: TRect; AItem: TMenuItem; PopupUp: Boolean);
    procedure Popup2(APopupCtrl: TControl; ASkinData: TspSkinData; StartIndex: Integer;
                    R: TRect; AItem, AItem2: TMenuItem; PopupUp: Boolean);
    procedure Hide;
    property First: Boolean read FFirst;
    property DefaultMenuItemFont: TFont
      read FDefaultMenuItemFont write SetDefaultMenuItemFont;
    property DefaultMenuItemHeight: Integer
      read FDefaultMenuItemHeight write FDefaultMenuItemHeight;
    property UseSkinFont: Boolean
     read FUseSkinFont write FUseSkinFont;
    property OnMenuClose: TNotifyEvent read FOnMenuClose write FOnMenuClose;  
  end;

  TspSkinPopupMenu = class(TPopupMenu)
  private
    FPopupPoint: TPoint;
  protected
    FSD: TspSkinData;
    FComponentForm: TForm;
    FOnMenuClose: TNotifyEvent;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    property PopupPoint: TPoint read FPopupPoint;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Popup(X, Y: Integer); override;
    procedure PopupFromRect(R: TRect; APopupUp: Boolean);
    procedure Popup2(ACtrl: TControl; X, Y: Integer);
    procedure PopupFromRect2(ACtrl: TControl; R: TRect; APopupUp: Boolean);
    property ComponentForm: TForm read FComponentForm write FComponentForm;
  published
    property SkinData: TspSkinData read FSD write FSD;
    property OnMenuClose: TNotifyEvent read FOnMenuClose write FOnMenuClose;
  end;


  // Images menu ---------------------------------------------------------------
  TspSkinImagesMenu = class;

  TspImagesMenuItem = class(TCollectionItem)
  private
    FImageIndex: TImageIndex;
    FCaption: String;
    FOnClick: TNotifyEvent;
    FButton: Boolean;
    FHeader: Boolean;
    FHint: String;
  protected
    procedure SetImageIndex(const Value: TImageIndex); virtual;
    procedure SetCaption(const Value: String); virtual;
  public
    ItemRect: TRect;
    FColor: TColor;
    constructor Create(Collection: TCollection); override;
    procedure Assign(Source: TPersistent); override;
  published
    property Button: Boolean read FButton write FButton;
    property Header: Boolean read FHeader write FHeader;
    property Caption: String read FCaption write SetCaption;
    property Hint: String read FHint write FHint;
    property ImageIndex: TImageIndex read FImageIndex
      write SetImageIndex default -1;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
  end;

  TspImagesMenuItems = class(TCollection)
  private
    function GetItem(Index: Integer):  TspImagesMenuItem;
    procedure SetItem(Index: Integer; Value:  TspImagesMenuItem);
  protected
    function GetOwner: TPersistent; override;
  public
    ImagesMenu: TspSkinImagesMenu;
    constructor Create(AImagesMenu: TspSkinImagesMenu);
    property Items[Index: Integer]:  TspImagesMenuItem read GetItem write SetItem; default;
  end;

  TspSkinImagesMenuPopupWindow = class(TCustomControl)
  private
    FSkinSupport: Boolean;
    OldAppMessage: TMessageEvent;
    ImagesMenu: TspSkinImagesMenu;
    FRgn: HRGN;
    NewLTPoint, NewRTPoint,
    NewLBPoint, NewRBPoint: TPoint;
    NewItemsRect: TRect;
    WindowPicture, MaskPicture: TBitMap;
    MouseInItem, OldMouseInItem: Integer;
    FDown: Boolean;
    FItemDown: Boolean;
    procedure AssignItemRects;
    procedure CreateMenu;
    procedure HookApp;
    procedure UnHookApp;
    procedure NewAppMessage(var Msg: TMsg; var Handled: Boolean);
    procedure SetMenuWindowRegion;
    procedure DrawItems(ActiveIndex, SelectedIndex: Integer; C: TCanvas);
    function GetItemRect(Index: Integer): TRect;
    function GetItemFromPoint(P: TPoint): Integer;
    procedure DrawItemCaption(ACaption: String; R: TRect; C: TCanvas; AActive, ADown: Boolean);
    procedure DrawActiveItem(R: TRect; C: TCanvas; ASelected: Boolean);
    procedure TestActive(X, Y: Integer);
    function GetLabelDataControl: TspDataSkinLabelControl;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure WMMouseActivate(var Message: TMessage); message WM_MOUSEACTIVATE;
    procedure WMEraseBkGrnd(var Message: TMessage); message WM_ERASEBKGND;
    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 WndProc(var Message: TMessage); override;
    procedure ProcessKey(KeyCode: Integer);
    procedure FindLeft;
    procedure FindRight;
    procedure FindUp;
    procedure FindDown;
  public
    constructor Create(AOwner: TComponent);
    destructor Destroy; override;
    procedure Show(PopupRect: TRect);
    procedure Hide(AProcessEvents: Boolean);
    procedure Paint; override;
 end;

  TspSkinImagesMenu = class(TComponent)
  private
    FImages: TCustomImageList;
    FImagesItems: TspImagesMenuItems;
    FItemIndex: Integer;
    FColumnsCount: Integer;
    FOnItemClick: TNotifyEvent;
    FSkinData: TspSkinData;
    FPopupWindow: TspSkinImagesMenuPopupWindow;
    FShowSelectedItem: Boolean;
    FOldItemIndex: Integer;
    FOnChange: TNotifyEvent;
    FAlphaBlend: Boolean;
    FAlphaBlendAnimation: Boolean;
    FAlphaBlendValue: Byte;
    FOnInternalChange: TNotifyEvent;
    FOnMenuClose: TNotifyEvent;
    FOnMenuPopup: TNotifyEvent;
    FOnInternalMenuClose: TNotifyEvent;
    FDefaultFont: TFont;
    FUseSkinFont: Boolean;
    FSkinHint: TspSkinHint;
    FShowHints: Boolean;
    procedure SetDefaultFont(Value: TFont);
    procedure SetImagesItems(Value: TspImagesMenuItems);
    procedure SetImages(Value: TCustomImageList);
    procedure SetColumnsCount(Value: Integer);
    procedure SetSkinData(Value: TspSkinData);
    function GetSelectedItem: TspImagesMenuItem;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure ProcessEvents(ACanProcess: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Popup(X, Y: Integer);
    procedure PopupFromRect(R: TRect);
    procedure Hide;
    property SelectedItem: TspImagesMenuItem read GetSelectedItem;
    property OnInternalChange: TNotifyEvent read FOnInternalChange write FOnInternalChange;
    property OnInternalMenuClose: TNotifyEvent read FOnInternalMenuClose write FOnInternalMenuClose;
  published
    property Images: TCustomImageList read FImages write SetImages;
    property SkinHint: TspSkinHint read FSkinHint write FSkinHint;
    property ShowHints: Boolean read FShowHints write FShowHints;
    property ImagesItems: TspImagesMenuItems read FImagesItems write SetImagesItems;
    property ItemIndex: Integer read FItemIndex write FItemIndex;
    property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
    property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
    property ColumnsCount: Integer read FColumnsCount write SetColumnsCount;
    property SkinData: TspSkinData read FSkinData write SetSkinData;
    property ShowSelectedItem: Boolean read FShowSelectedItem write FShowSelectedItem;
    property AlphaBlend: Boolean read FAlphaBlend write FAlphaBlend;
    property AlphaBlendAnimation: Boolean
      read FAlphaBlendAnimation write FAlphaBlendAnimation;
    property AlphaBlendValue: Byte read FAlphaBlendValue write FAlphaBlendValue;
    property OnItemClick: TNotifyEvent read FOnItemClick write FOnItemClick;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnMenuPopup: TNotifyEvent read FOnMenuPopup write FOnMenuPopup;
    property OnMenuClose: TNotifyEvent read FOnMenuClose write FOnMenuClose;
  end;

  function CanMenuClose(Msg: Cardinal): Boolean;

const
    WM_CLOSESKINMENU = WM_USER + 204;
    WM_AFTERDISPATCH = WM_USER + 205;

implementation
   Uses DynamicSkinForm{$IFDEF TNTUNICODE}, TntMenus{$ENDIF};

const
    MorphInc = 0.2;
    MouseTimerInterval = 50;
    MorphTimerInterval = 20;
    WaitTimerInterval = 500;
    MarkerItemHeight = 10;
    ScrollTimerInterval = 100;

    MI_MINNAME = 'DSF_MINITEM';
    MI_MAXNAME = 'DSF_MAXITEM';
    MI_CLOSENAME = 'DSF_CLOSE';
    MI_RESTORENAME = 'DSF_RESTORE';
    MI_MINTOTRAYNAME = 'DSF_MINTOTRAY';
    MI_ROLLUPNAME = 'DSF_ROLLUP';

    TMI_RESTORENAME = 'TRAY_DSF_RESTORE';
    TMI_CLOSENAME = 'TRAY_DSF_CLOSE';

    CS_DROPSHADOW_ = $20000;

procedure DrawCheckImage(Cnvs: TCanvas; X, Y: Integer; Color: TColor);
var
  i: Integer;
begin
  with Cnvs do
  begin
    Pen.Color := Color;
    for i := 0 to 2 do
    begin
      MoveTo(X, Y + 5 - i);
      LineTo(X + 2, Y + 7 - i);
      LineTo(X + 7, Y + 2 - i);
    end;
  end;
end;

procedure DrawSubImage(Cnvs: TCanvas; X, Y: Integer; Color: TColor);
var
  i: Integer;
begin
  with Cnvs do
  begin
    Pen.Color := Color;
    for i := 0 to 3 do
    begin
      MoveTo(X + i, Y + i);
      LineTo(X + i, Y + 7 - i);
    end;
  end;
end;

procedure DrawRadioImage(Cnvs: TCanvas; X, Y: Integer; Color: TColor);
begin
  with Cnvs do
  begin
    Pen.Color := Color;
    Brush.Color := Color;
    Ellipse(X, Y, X + 6, Y + 6);
  end;
end;

function RectWidth(R: TRect): Integer;
begin
  Result := R.Right - R.Left;
end;

function RectHeight(R: TRect): Integer;