sskinmenus.pas

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

unit sSkinMenus;

{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, sConst,
  Menus, ExtCtrls, sGraphUtils;

const
  WM_DRAWMENUBORDER     = CN_NOTIFY + 101;
  WM_DRAWMENUBORDER2    = CN_NOTIFY + 102;  

type

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

  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;
    procedure SetCaptionFont(const Value: TFont);
    procedure SetAlignment(const Value: TAlignment);
    procedure SetBevelWidth(const Value: integer);
    procedure SetBorderWidth(const Value: integer);
  protected
    FOnDrawItem: TsMenuManagerDrawItemEvent;

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

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

    function CursorMarginH : integer;
    function CursorMarginV : integer;
    function ItemRect(Item : TMenuItem; aRect : TRect) : TRect;
  public
    FForm : TForm;
    FOwner : TComponent;
    Pressed : 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 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 HookPopups(Cmp : TComponent);
    procedure UpdateMenus;
    function LastItem(Item : TMenuItem) : boolean;
  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 0;
    property CaptionFont : TFont read FCaptionFont write SetCaptionFont;
//    property Font : TFont read FFont write SetFont;
    property Margin: integer read FMargin write FMargin default 4;
    property OnDrawItem: TsMenuManagerDrawItemEvent read FOnDrawItem write FOnDrawItem;
  end;

function GlyphSize(Item: TMenuItem; Top: boolean): TSize;
function GetItemIndex(Item : TMenuItem) : integer;
procedure DeleteUnusedBmps(DeleteAll : boolean);
function ChildIconPresent : boolean;

var
  MDISkinProvider : TObject;

implementation

uses sDefaults, math, sStyleSimply, sSkinProvider, sMaskData, sSkinProps,
  sGradient, sUtils, sAlphaGraph, sSkinManager;

var
  it : TsMenuItemType;
  AlignToInt: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
  mba : TMenuBGArray;

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 GetItemIndex(Item : TMenuItem) : integer;
var
  i : integer;
begin
  Result := -1;
  for i := 0 to Length(mba) - 1 do begin
    if mba[i].FirstItem = Item then begin
      Result := i;
      Break;
    end;
  end;
end;

procedure DeleteUnusedBmps(DeleteAll : boolean);
var
  i, j, last : integer;
begin
  i := 0;
  last := Length(mba) - 1;
  while i <= last do begin
    if DeleteAll {or ([odInactive] = mba[i].FirstItem.S)} then begin
      // Delete element
      FreeAndNil(mba[i].Bmp);
      for j := i to last - 1 do begin
        mba[j].FirstItem := mba[j + 1].FirstItem;
        mba[j].Bmp := mba[j + 1].Bmp;
      end;
      SetLength(mba, last);
      last := Length(mba) - 1;
    end else inc(i); // patch by Oscar Nava
  end;
end;

{ TsSkinableMenus }

function GlyphSize(Item: TMenuItem; Top: boolean): TSize;
begin
  Result.cx := 0;
  Result.cy := 0;
  if Top then begin
    if (Item.Bitmap <> nil) then begin
      Result.cx := Item.Bitmap.Width;
      Result.cy := Item.Bitmap.Height;
    end;
  end
  else begin
    if Assigned(Item.GetParentMenu.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;

constructor TsSkinableMenus.Create(AOwner: TComponent);
begin
  FOwner := AOwner;
  FForm := TForm(TsSkinManager(FOwner).ParentForm);
//  FFont := TFont.Create;
  FCaptionFont := TFont.Create;
  FMargin := 4;
  FBevelWidth := 0;
end;

procedure TsSkinableMenus.sAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
var
  R, gRect, cRect : TRect;
  i, {h,} Index{, Len}: integer;
  ci : TCacheInfo;
  Item : TMenuItem;
  Text: string;
  ItemBmp : TBitmap;
  function TextRect: TRect; begin
    Result := aRect;
    OffsetRect(Result, - aRect.Left, - aRect.Top);
    inc(Result.Left, Margin * 2 + GlyphSize(Item, False).cx);
  end;
  function ShortCutRect: TRect; begin
    Result := aRect;
    OffsetRect(Result, - aRect.Left, - aRect.Top);
    Result.Left := WidthOf(TextRect);
  end;
begin
  Item := TMenuItem(Sender);

  if Item.Caption = '-' then begin
    PaintDivider(aCanvas, aRect, Item);
    Exit;
  end;
  if IsDivText(Item) then begin
    PaintCaption(aCanvas, aRect, Item);
    Exit;
  end;
  it := smNormal;

  ItemBmp := TBitmap.Create;
  ItemBmp.Width := WidthOf(aRect);
  ItemBmp.Height := HeightOf(aRect);
  ItemBmp.PixelFormat := pf24bit;
  try

  // Search BG in array
  Index := GetItemIndex(Item.Parent.Items[0]);
  if not IsValidSkinIndex(Index) then begin
    ci.Bmp := nil;
    ci.Ready := False;
    // Prepare BG
    Index := Length(mba);
    SetLength(mba, Index + 1);
    mba[Index].FirstItem := Item;
    mba[Index].Bmp := TBitmap.Create;
    mba[Index].Bmp.PixelFormat := pf24bit;
    mba[Index].Bmp.Width := WidthOf(ARect);
    mba[Index].Bmp.Height := ParentHeight(mba[Index].Bmp.Canvas, Item);
    gRect := Rect(0, 0, mba[Index].Bmp.Width, mba[Index].Bmp.Height);
    i := GetSkinIndex(MainMenu);
    // Draw Menu
    if IsValidSkinIndex(i) then
      PaintItem(i, MainMenu, ci, False, 0, gRect, Point(0, 0), mba[Index].Bmp.Canvas.Handle);
  end;

  // Draw MenuItem
  ci.Bmp := mba[Index].Bmp;
  ci.X := 0;
  ci.Y := 0;
  ci.Ready := True;
  i := GetSkinIndex(MenuItem);
  if IsValidSkinIndex(i) then
    PaintItem(i, MenuItem, ci, True, integer(odSelected in State),
            Rect(0, 0, WidthOf(aRect), HeightOf(aRect)),
            Point(aRect.Left, aRect.Top), ItemBmp.Canvas.Handle
           );

  if odChecked in State then begin
    cRect.Top    := (HeightOf(aRect) - GlyphSize(Item, False).cy) div 2;
    cRect.Left   := Margin;
    cRect.Right  := cRect.Left + GlyphSize(Item, False).cx;
    cRect.Bottom := cRect.Top + GlyphSize(Item, False).cy;
    BlendColorRect(ItemBmp,
                 cRect,
                 50,
                 clWhite);
    i := 1;
    DrawRectangleOnDC(ItemBmp.Canvas.Handle,
                      cRect,
                      ColorToRGB(clGray),
                      ColorToRGB(clWhite),
                      i);
    if (Item.GetImageList = nil) or (Item.ImageIndex < 0) then PaintCheck(ItemBmp.Canvas, cRect, Item.Enabled, clBlack);
  end;


  if (Item.GetImageList <> nil) and (Item.ImageIndex >= 0) then begin
    gRect.Top := (ItemBmp.Height - Item.GetImageList.Height) div 2;
    gRect.Left := gRect.Top;
    gRect.Top := (ItemBmp.Height - Item.GetImageList.Height) div 2;
    gRect.Right := gRect.Left + Item.GetImageList.Width;
    gRect.Bottom := gRect.top + Item.GetImageList.Height;

    Item.GetImageList.Draw(ItemBmp.Canvas,
                                   gRect.Left,
                                   gRect.Top,
                                   Item.ImageIndex,
                                   not (odDisabled in State));
  end;


  // Text writing
  if Assigned(Screen.MenuFont) then ItemBmp.Canvas.Font.Assign(Screen.MenuFont);

  if odDefault in State then begin
    ACanvas.Font.Style := [fsBold];
  end
  else begin
    ACanvas.Font.Style := [];
  end;
  R := TextRect;

//  sGraphUtils.WriteTextEx(ItemBmp.Canvas, PChar(IntToStr(ACanvas.TextWidth('&'))), Item.Enabled, R, DT_VCENTER or AlignToInt[Alignment], i, ((odSelected in State) or (odHotLight in State)));
  sGraphUtils.WriteTextEx(ItemBmp.Canvas, PChar(Item.Caption), Item.Enabled, R, DT_VCENTER or AlignToInt[Alignment], i, ((odSelected in State) or (odHotLight in State)));
  Text := ShortCutToText(TMenuItem(Sender).ShortCut);
  if Text <> '' then begin
    r := ShortCutRect;
    dec(r.Right, 8);
//    sGraphUtils.WriteTextEx(ItemBmp.Canvas, PChar(IntToStr(WidthOf(arect))), Item.Enabled, R, DT_VCENTER or DT_RIGHT, i, ((odSelected in State) or (odHotLight in State)));
    sGraphUtils.WriteTextEx(ItemBmp.Canvas, PChar(Text), Item.Enabled, R, DT_VCENTER or DT_RIGHT, i, ((odSelected in State) or (odHotLight in State)));
  end;

  if Assigned(FOnDrawItem) then begin
    FOnDrawItem(Item, ItemBmp.Canvas, Rect(0, 0, ItemBmp.Width, ItemBmp.Height), State, it);
  end;

  BitBlt(ACanvas.Handle, aRect.Left, aRect.Top, ItemBmp.Width, ItemBmp.Height,
            ItemBmp.Canvas.Handle, 0, 0, SrcCopy);


  finally FreeAndNil(ItemBmp) end;
end;

procedure TsSkinableMenus.InitItems(A: boolean);
var
  i : integer;
  procedure ProcessComponent(c: TComponent);
  var
    i: integer;
  begin
    if (c <> nil) then begin
      if (c is TMainMenu) then begin
        InitMenuLine(TMainMenu(c), A);
      end else
      if (c is TPopupMenu) then begin
        HookPopupMenu(TPopupMenu(c), A);
      end
      else if c is TMenuItem then begin
        if not (TMenuItem(c).GetParentMenu is TMainMenu) then
          HookItem(TMenuItem(c), A);
      end;
      for i := 0 to c.ComponentCount - 1 do begin
        ProcessComponent(c.Components[i]);
      end;
    end;
  end;
begin
  if (csDesigning in Fowner.ComponentState) then Exit;
  for i := 0 to Application.ComponentCount - 1 do begin
    ProcessComponent(Application.Components[i]);
  end;
end;

procedure TsSkinableMenus.SetActive(const Value: boolean);
begin
  InitItems(Value);
end;

procedure TsSkinableMenus.HookItem(MenuItem: TMenuItem; FActive: boolean);
var
  i : integer;
  procedure HookSubItems(Item: TMenuItem);
  var
    i : integer;
  begin
    for i := 0 to Item.Count - 1 do begin
      if FActive then begin
        if not IsTopLine(Item.Items[i]) then begin
          if not Assigned(Item.Items[i].OnAdvancedDrawItem) then
            Item.Items[i].OnAdvancedDrawItem := sAdvancedDrawItem;
          if not Assigned(Item.Items[i].OnMeasureItem) then
            Item.Items[i].OnMeasureItem := sMeasureItem;
        end;
      end
      else begin
        if addr(Item.Items[i].OnAdvancedDrawItem) = addr(TsSkinableMenus.sAdvancedDrawItem) then
          Item.Items[i].OnAdvancedDrawItem := nil;
        if addr(Item.Items[i].OnMeasureItem) = addr(TsSkinableMenus.sMeasureItem) then
          Item.Items[i].OnMeasureItem := nil;
      end;
      HookSubItems(Item.Items[i]);
    end;
  end;
begin
  for i := 0 to MenuItem.Count - 1 do begin
    if FActive then begin
      if not IsTopLine(MenuItem.Items[i]) then begin
        if not Assigned(MenuItem.Items[i].OnAdvancedDrawItem) then
          MenuItem.Items[i].OnAdvancedDrawItem := sAdvancedDrawItem;
        if not Assigned(MenuItem.Items[i].OnMeasureItem) then
          MenuItem.Items[i].OnMeasureItem := sMeasureItem;
      end;
    end
    else begin
      if (addr(MenuItem.Items[i].OnAdvancedDrawItem) = addr(TsSkinableMenus.sAdvancedDrawItem)) then
        MenuItem.Items[i].OnAdvancedDrawItem := nil;
      if (addr(MenuItem.Items[i].OnMeasureItem) = addr(TsSkinableMenus.sMeasureItem)) then
        MenuItem.Items[i].OnMeasureItem := nil;
    end;
    HookSubItems(MenuItem.Items[i]);
  end;
end;

procedure TsSkinableMenus.sMeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
var
  Text: string;
  Item: TMenuItem;
begin
  Item := TMenuItem(Sender);
  if Item.Caption = '-' then begin it := smDivider; end
  else if IsdivText(Item) then begin it := smCaption; end
  else begin it := smNormal; end;

  if Assigned(Screen.MenuFont) then ACanvas.Font.Assign(Screen.MenuFont);

  case it of
    smDivider : begin
      Text := '';
      Width := Margin * 3 + ACanvas.TextWidth(Text) + GlyphSize(Item, False).cx * 2;
    end;
    smCaption : begin
      Text := '-' + Item.Caption + '-';
      Width := Margin * 3 + ACanvas.TextWidth(Text) + GlyphSize(Item, False).cx * 2;
    end
    else begin
      Text := Item.Caption + iff(ShortCutToText(Item.ShortCut) = '', '', ShortCutToText(Item.ShortCut));