sskinmenus.pas

Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。

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

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, sConst,
  Menus, ExtCtrls{$IFDEF LOGGED}, sDebugMsgs{$ENDIF} {$IFDEF TNTUNICODE}, TntMenus {$ENDIF};

type
  TsMenuItemType = (smCaption, smDivider, smNormal, smTopLine);
  TsMenuManagerDrawItemEvent = procedure (Sender: TObject; ACanvas: TCanvas;
    ARect: TRect; State: TOwnerDrawState; ItemType: TsMenuItemType) of object;

  TacMenuSupport = class(TPersistent)
  private
    FIcoLineSkin: TsSkinSection;
    FUseExtraLine: boolean;
    FExtraLineWidth: integer;
    FExtraLineFont: TFont;
    procedure SetExtraLineFont(const Value: TFont);
  public
    constructor Create;
    destructor Destroy; override;
  published
    property IcoLineSkin : TsSkinSection read FIcoLineSkin write FIcoLineSkin;
    property UseExtraLine : boolean read FUseExtraLine write FUseExtraLine default False;
    property ExtraLineWidth : integer read FExtraLineWidth write FExtraLineWidth default 32;
    property ExtraLineFont : TFont read FExtraLineFont write SetExtraLineFont;
  end;

  TMenuBG = record
    Bmp : TBitmap;
    FirstItem : TMenuItem;
  end;
  TMenuBGArray = array of TMenuBG;

  TMenuItemData = record
    Item : TMenuItem;
    R : TRect;
  end;

  TsSkinableMenus = class(TPersistent)
  private
    FMargin : integer;
    FAlignment: TAlignment;
    FBevelWidth: integer;
    FBorderWidth: integer;
    FCaptionFont: TFont;
    FSkinBorderWidth: integer;
    FSpacing: integer;
    procedure SetCaptionFont(const Value: TFont);
    procedure SetAlignment(const Value: TAlignment);
    procedure SetBevelWidth(const Value: integer);
    procedure SetBorderWidth(const Value: integer);
    function GetSkinBorderWidth: integer;
  protected
    FOnDrawItem: TsMenuManagerDrawItemEvent;

    function ParentHeight(aCanvas: TCanvas; Item: TMenuItem): integer;
    function GetItemHeight(aCanvas: TCanvas; Item: TMenuItem): integer;
    function ParentWidth(aCanvas: TCanvas; Item: TMenuItem): integer;
    function GetItemWidth(aCanvas: TCanvas; Item: TMenuItem): integer;
    function IsDivText(Item: TMenuItem): boolean;

    procedure PaintDivider(aCanvas : TCanvas; aRect : TRect; Item: TMenuItem; MenuBmp : TBitmap);
    procedure PaintCaption(aCanvas : TCanvas; aRect : TRect; Item : TMenuItem);

    function CursorMarginH : integer;
    function CursorMarginV : integer;
    function ItemRect(Item : TMenuItem; aRect : TRect) : TRect;
  public
    ArOR : TAOR;
    FActive : boolean;
    FOwner : TComponent;
    Pressed : boolean;
    BorderDrawing : boolean;

    function IsTopLine(Item: TMenuItem): boolean;
    procedure sMeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
    procedure sAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); dynamic;
    procedure DrawWndBorder(Wnd : hWnd; MenuBmp : TBitmap);
    procedure PrepareMenuBG(Item: TMenuItem; Width, Height : integer; Wnd : hwnd = 0);

    procedure sMeasureLineItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
    procedure sAdvancedDrawLineItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); dynamic;

    procedure SetActive(const Value: boolean);
    constructor Create (AOwner: TComponent);
    destructor Destroy; override;
    procedure InitItem(Item : TMenuItem; A : boolean);
    procedure InitItems(A: boolean);
    procedure InitMenuLine(Menu : TMainMenu; A : boolean);
    procedure HookItem(MenuItem: TMenuItem; FActive: boolean);//!!!!
    procedure HookPopupMenu(Menu: TPopupMenu; Active: boolean);
    procedure UpdateMenus;
    function LastItem(Item : TMenuItem) : boolean;
    function IsPopupItem(Item : TMenuItem) : boolean;

    function ExtraWidth(Update : boolean = False) : integer;
  published
    property Alignment: TAlignment read FAlignment write SetAlignment;
    property BevelWidth : integer read FBevelWidth write SetBevelWidth default 0;
    property BorderWidth : integer read FBorderWidth write SetBorderWidth default 3;
    property CaptionFont : TFont read FCaptionFont write SetCaptionFont;
    property SkinBorderWidth : integer read GetSkinBorderWidth write FSkinBorderWidth;
    property Margin: integer read FMargin write FMargin default 3;
    property Spacing : integer read FSpacing write FSpacing default 6;
    property OnDrawItem: TsMenuManagerDrawItemEvent read FOnDrawItem write FOnDrawItem;
  end;

function Breaked(MenuItem : TMenuItem) : boolean;
function GlyphSize(Item: TMenuItem; Top: boolean): TSize;
function GetFirstItem(Item : TMenuItem) : TMenuItem;
procedure DeleteUnusedBmps(DeleteAll : boolean);
function ChildIconPresent : boolean;
procedure ClearCache;

var
  MDISkinProvider : TObject;
  MenuBGBmp : TBitmap;
  acCanHookMenu : boolean = False;
  CustomMenuFont : TFont = nil;

implementation

uses sDefaults, math, sStyleSimply, sSkinProvider, sMaskData, sSkinProps, sGraphUtils,
  sGradient, acntUtils, sAlphaGraph, sSkinManager, sMDIForm, sVclUtils, sMessages;

const
  DontForget = 'Don`t forget OnGetExtraLineData event...';

var
  Measuring : boolean = False;
  it : TsMenuItemType;
  AlignToInt: array[TAlignment] of Cardinal = (DT_LEFT, DT_RIGHT, DT_CENTER);
  CurrentFirstItem : TMenuItem = nil;

  // Temp data
  IcoLineWidth : integer = 0;
  GlyphSizeCX : integer = 0;
//  ic : integer;

  ExtraCaption : string;
  ExtraSection : string;
  ExtraVisible : boolean;
  ExtraGlyph : TBitmap;
  ExtraDefined : boolean = False;

function ChildIconPresent : boolean;
begin
  Result := (MDISkinProvider <> nil) and
     (TsSkinProvider(MDISkinProvider).Form <> nil) and
       (TsSkinProvider(MDISkinProvider).Form.FormStyle = fsMDIForm) and
         (TsSkinProvider(MDISkinProvider).Form.ActiveMDIChild <> nil) and
           (TsSkinProvider(MDISkinProvider).Form.ActiveMDIChild.WindowState = wsMaximized) and
             Assigned(TsSkinProvider(MDISkinProvider).Form.ActiveMDIChild.Icon);
end;

function GetFirstItem(Item : TMenuItem) : TMenuItem;
begin
  Result := Item.Parent.Items[0];
end;

procedure DeleteUnusedBmps(DeleteAll : boolean);
begin
  if Assigned(MenuBGBmp) then FreeAndNil(MenuBGBmp);
end;

{ TsSkinableMenus }

function Breaked(MenuItem : TMenuItem) : boolean;
var
  i : integer;
begin
  Result := False;
  if not ExtraDefined then Exit;
  for i := 0 to MenuItem.MenuIndex do if MenuItem.Parent.Items[i].Break <> mbNone then begin
    Result := True;
    Break;
  end;
end;

function GlyphSize(Item: TMenuItem; Top: boolean): TSize;
var
  mi : TMenu;
begin
  Result.cx := 0;
  Result.cy := 0;
  if Top then begin
    if not Item.Bitmap.Empty then begin
      Result.cx := Item.Bitmap.Width;
      Result.cy := Item.Bitmap.Height;
    end;
  end
  else begin
    if not Item.Bitmap.Empty then begin
      Result.cx := Item.Bitmap.Width;
      Result.cy := Item.Bitmap.Height;
    end
    else begin
      mi := Item.GetParentMenu;
      if Assigned(mi) and Assigned(mi.Images) then begin
        Result.cx := Item.GetParentMenu.Images.Width;
        Result.cy := Item.GetParentMenu.Images.Height;
      end
      else begin
        Result.cx := 16;
        Result.cy := 16;
      end;
    end;
  end;
end;

constructor TsSkinableMenus.Create(AOwner: TComponent);
begin
  FOwner := AOwner;
  FActive := False;
  FCaptionFont := TFont.Create;
  FMargin := 3;
  FBevelWidth := 0;
  FBorderWidth := 3;
  BorderDrawing := False;
  FSpacing := 6
end;

procedure TsSkinableMenus.sAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
var
  R, gRect, cRect : TRect;
  i, {Index, }j: integer;
  ci : TCacheInfo;
  Item : TMenuItem;

  {$IFDEF TNTUNICODE}
  Text : WideString;
  {$ELSE}
  Text: string;
  {$ENDIF}
  ItemBmp : TBitmap;
  DrawStyle : longint;
  C : TsColor;
  Wnd : hwnd;
  NewDC : hdc;
  aMsg: TMSG;
  Br : integer;
  f : TCustomForm;
  function TextRect: TRect; begin
    Result := aRect;
    OffsetRect(Result, - aRect.Left, - aRect.Top);
    if SysLocale.MiddleEast and (Item.GetParentMenu.BiDiMode = bdRightToLeft) then begin
      dec(Result.Right, Margin * 2 + GlyphSize(Item, False).cx + Spacing);
    end
    else begin
      inc(Result.Left, Margin * 2 + GlyphSize(Item, False).cx + Spacing);
    end;
  end;
  function ShortCutRect(const s : acString): TRect;
  var
    tr : TRect;
  begin
    Result := aRect;
    tR := Rect(0, 0, 1, 0);
    acDrawText(ACanvas.Handle, PacChar(Text), tR, DT_EXPANDTABS or DT_SINGLELINE or DT_CALCRECT);
    OffsetRect(Result, - aRect.Left, - aRect.Top);
    if SysLocale.MiddleEast and (Item.GetParentMenu.BiDiMode = bdRightToLeft) then begin
      Result.Left := 6;
    end
    else Result.Left := aRect.Right - WidthOf(tr) - 8;
  end;
  function IsTopVisible(Item : TMenuItem) : boolean; var i : integer; begin
    Result := False;
    for i := 0 to Item.Parent.Count - 1 do if Item.Parent.Items[i].Visible then begin
      if Item.Parent.Items[i] = Item then Result := True;
      Break
    end;
  end;
  function IsBtmVisible(Item : TMenuItem) : boolean; var i : integer; begin
    Result := False;
    for i := 0 to Item.Parent.Count - 1 do if Item.Parent.Items[Item.Parent.Count - 1 - i].Visible then begin
      if Item.Parent.Items[Item.Parent.Count - 1 - i] = Item then Result := True;
      Break
    end;
  end;
begin
  if FOwner = nil then Exit;

  Item := TMenuItem(Sender);
  Br := integer(not Breaked(Item));
  if (CurrentFirstItem <> Item.Parent.Items[0]) then ClearCache;
  if TempControl <> nil then begin
    if ShowHintStored then Application.ShowHint := AppShowHint;
    SendAMessage(TControl(TempControl), WM_MOUSELEAVE);
    TempControl := nil;
  end;
  try
    if IsNT then Wnd := WindowFromDC(ACanvas.Handle) else Wnd := 0;
    if Wnd <> 0 then begin
      GetWindowRect(Wnd, R);
    end
    else begin
      R.TopLeft := Point(0, 0);
      R.Right := ParentWidth(ACanvas, Item) + BorderWidth * 2;
      R.Bottom := ParentHeight(ACanvas, Item) + BorderWidth * 2;
    end;
    PrepareMenuBG(Item.Parent.Items[0], WidthOf(R), HeightOf(R), Wnd);

    if IsNT and (Wnd <> 0) then begin
      NewDC := GetWindowDC(Wnd);
      try
        if IsTopVisible(Item) then // First item
          BitBlt(NewDC, 0, 0, MenuBGBmp.Width, BorderWidth, MenuBGBmp.Canvas.Handle, 0, 0, SRCCOPY);
        if IsBtmVisible(Item) then // Last item
          BitBlt(NewDC, 0, MenuBGBmp.Height - BorderWidth, MenuBGBmp.Width, BorderWidth, MenuBGBmp.Canvas.Handle, 0, MenuBGBmp.Height - BorderWidth, SRCCOPY);
        // Left border
        BitBlt(NewDC, 0, aRect.Top + BorderWidth, ExtraWidth * Br + max(SkinBorderWidth, BorderWidth), HeightOf(aRect),
               MenuBGBmp.Canvas.Handle, 0, aRect.Top + BorderWidth, SRCCOPY);
        // Right border
        BitBlt(NewDC, MenuBGBmp.Width - BorderWidth, aRect.Top + BorderWidth, BorderWidth, HeightOf(aRect),
               MenuBGBmp.Canvas.Handle, MenuBGBmp.Width - BorderWidth, aRect.Top + BorderWidth, SRCCOPY);
      finally
        ReleaseDC(Wnd, NewDC);
      end;
    end;
    if (Wnd = 0) then begin
      if (Application.Handle <> 0) then begin
        if not PeekMessage(aMsg, Application.Handle, WM_DRAWMENUBORDER, WM_DRAWMENUBORDER2, PM_NOREMOVE)
          then PostMessage(Application.Handle, WM_DRAWMENUBORDER, 0, Integer(Item));
      end
      else begin
{        if GetMenuItemRect(PopupList.Window, Item.Parent.Handle, Item.MenuIndex, R) then begin
          Wnd := WindowFromPoint(Point(r.Left + WidthOf(r) div 2, r.Top + HeightOf(r) div 2));
          if (Wnd <> 0) then DefaultManager.SkinableMenus.DrawWndBorder(Wnd, MenuBGBmp);
        end; problem of LC, must be checked}
      end;
    end;

    if Item.Caption = '-' then begin
      PaintDivider(aCanvas, aRect, Item, MenuBGBmp);
      Exit;
    end