scustommenumanager.pas

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

unit sCustomMenuManager;

{$I sDefs.inc}

interface

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

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

  TsCustomMenuManager = class(TComponent)
  private
    { Private declarations }
    FsStyle : TsHotPaintStyle;
    FActive : boolean;
//    FLeftLineWidth : integer;
    FFont : TFont;
    FMargin : integer;
    FAlignment: TAlignment;
    FBevelWidth: integer;
    FBorderWidth: integer;
    FCaptionFont: TFont;
    procedure SetActive(const Value: boolean);
    procedure SetFont(const Value: TFont);
    procedure SetCaptionFont(const Value: TFont);
    procedure SetAlignment(const Value: TAlignment);
    procedure SetBevelWidth(const Value: integer);
    procedure SetBorderWidth(const Value: integer);
  protected
    { Protected declarations }
    FOnDrawItem: TsMenuManagerDrawItemEvent;
    procedure sMeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
    procedure sAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); dynamic;
    function ParentHeight(aCanvas: TCanvas; Item: TMenuItem): integer;
    function GetItemHeight(aCanvas: TCanvas; Item: TMenuItem): integer;
    function IsDivText(Item: TMenuItem): boolean;
    function IsTopLine(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: TCustomForm;
    { Public declarations }
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
//    procedure Invalidate;
    procedure InitMenus(A: boolean);
    procedure InitItems(A: boolean);
    procedure HookMenu(MainMenu: TMainMenu; FActive: boolean);
    procedure HookItem(MenuItem: TMenuItem; FActive: boolean);
    procedure Loaded; override;
    procedure PaintBorder(Bmp : TBitmap; aRect : TsRect; Hot : boolean);
    procedure UpdateMenus;
  published
    { Published declarations }
    property Active: boolean read FActive write SetActive default True;
    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 LeftLineWidth: integer read FLeftLineWidth write FLeftLineWidth;
    property Margin: integer read FMargin write FMargin default 4;
    property sStyle : TsHotPaintStyle read FsStyle write FsStyle;
    property OnDrawItem: TsMenuManagerDrawItemEvent read FOnDrawItem write FOnDrawItem;
  end;

  TsMenuManager = class(TsCustomMenuManager)
  private
    { Private declarations }
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create (AOwner: TComponent); override;
  published
    { Published declarations }
  end;

{$IFDEF SINGLE}
{.$R *.DCR}
procedure Register;
{$ENDIF}
function GlyphSize(Item: TMenuItem; Top: boolean): TSize;

implementation

uses sDefaults, math, sStyleSimply, sAlphaGraph;

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

{ TsCustomMenuManager }

function GlyphSize(Item: TMenuItem; Top: boolean): TSize;
begin
  Result.cx := 0;
  Result.cy := 0;
  if Top then begin
    if Item.ImageIndex >= 0 then 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 * integer(Item.ImageIndex >= 0);
        Result.cy := 16 * integer(Item.ImageIndex >= 0);
      end;
    end
    else begin
      Result.cx := 0;
      Result.cy := 0;
    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 TsCustomMenuManager.Create(AOwner: TComponent);
begin
  inherited;
  FsStyle := TsHotPaintStyle.Create(Self);
  FsStyle.COC := COC_TsCustomMenuManager;
  FForm := GetParentForm(TControl(AOwner));
  FFont := TFont.Create;
  FCaptionFont := TFont.Create;
  FMargin := 4;
  FActive := True;
  FBevelWidth := 0;
  if (csDesigning in ComponentState) and (sStyle.HotStyle.HotBackground.Gradient.Data = '') then begin
    sStyle.HotStyle.HotBackground.Gradient.Data := GradientTsMenuManagerHot;
  end;
//  FLeftLineWidth := 24;
end;

procedure TsCustomMenuManager.sAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
var
//  P : TPoint;
  R, gRect, cRect : TRect;
  i: integer;
  ci : TCacheInfo;
  Item : TMenuItem;
  Text: string;
  TransColor : TsColor;
  TempBmp : TBitmap;
  function TextRect: TRect; begin
    Result := aRect;
    inc(Result.Left, Margin * 2 + GlyphSize(Item, False).cx);
    dec(Result.Right, Margin + GlyphSize(Item, False).cx);
    if Item.Parent.Items[0] = Item then Result.Top := Result.Top + max(BevelWidth * integer(FsStyle.Painting.Bevel <> cbNone), BorderWidth);
    if Item.Parent.Items[Item.Parent.Count - 1] = Item then Result.Bottom := Result.Bottom - max(BevelWidth * integer(FsStyle.Painting.Bevel <> cbNone), BorderWidth);
    Result.Left := Result.Left + max(BevelWidth * integer(FsStyle.Painting.Bevel <> cbNone), max(BevelWidth * integer(FsStyle.Painting.Bevel <> cbNone), BorderWidth));
    Result.Right := Result.Right - max(BevelWidth * integer(FsStyle.Painting.Bevel <> cbNone), max(BevelWidth * integer(FsStyle.Painting.Bevel <> cbNone), BorderWidth));
  end;
  function ShortCutRect: TRect; begin
    Result := aRect;
    Result.Left := WidthOf(TextRect);
    if Item.Parent.Items[0] = Item then Result.Top := Result.Top + max(BevelWidth * integer(FsStyle.Painting.Bevel <> cbNone), BorderWidth);
    if Item.Parent.Items[Item.Parent.Count - 1] = Item then Result.Bottom := Result.Bottom - max(BevelWidth * integer(FsStyle.Painting.Bevel <> cbNone), BorderWidth);
    Result.Left := Result.Left + max(BevelWidth * integer(FsStyle.Painting.Bevel <> cbNone), BorderWidth);
    Result.Right := Result.Right - max(BevelWidth * integer(FsStyle.Painting.Bevel <> cbNone), BorderWidth);
  end;
begin
  Item := TMenuItem(Sender);
  it := smNormal;       

  gRect := Rect(0, 0, WidthOf(ARect), ParentHeight(sStyle.FCacheBmp.Canvas, Item));

  // Paint background...
  sStyle.FCacheBmp.Width := WidthOf(gRect);
  sStyle.FCacheBmp.Height := HeightOf(gRect);
  sStyle.PaintBG(sStyle.FCacheBmp, gRect);
  PaintBorder(sStyle.FCacheBmp, gRect, False);

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

  // Hot background
  if (odSelected in State) then begin
    gRect := ItemRect(Item, aRect);

    TempBmp := TBitmap.Create;
    TempBmp.PixelFormat := pf24Bit;
    TempBmp.Width := WidthOf(gRect) - 1;
    TempBmp.Height := HeightOf(gRect) - 1;
    try
      ci.Bmp := sStyle.FCacheBmp;
      ci.X := 0;
      ci.Y := 0;
      ci.Ready := True;

      sStyle.PaintActiveBG(TempBmp, Rect(0, 0, TempBmp.Width, TempBmp.Height), ci); //??

      TransColor.A := 0;
      TransColor.R := sStyle.HotStyle.HotPainting.Transparency * 255 div 100;
      TransColor.G := TransColor.R;
      TransColor.B := TransColor.R;
      SumBmpRect(sStyle.FCacheBmp, TempBmp, TransColor, Rect(0, 0, TempBmp.Width, TempBmp.Height), Point(gRect.Left, gRect.Top));
      PaintBorder(sStyle.FCacheBmp, gRect, True);
    finally
      FreeAndNil(TempBmp)
    end;

  end;

  if odChecked in State then begin
    cRect.Top    := gRect.Top + (HeightOf(gRect) - GlyphSize(Item, False).cy) div 2;
    cRect.Left   := gRect.Left + Margin;
    cRect.Right  := cRect.Left + GlyphSize(Item, False).cx;
    cRect.Bottom := cRect.Top + GlyphSize(Item, False).cy;
    BlendColorRect(sStyle.FCacheBmp,
             cRect,
             50, clWhite);
{
    FadeRect(sStyle.FCacheBmp.Canvas,
             cRect,
             sStyle.FCacheBmp.Canvas.Handle,
             Point(cRect.Left, cRect.Top),
             50,
             clWhite, 0, ssRectangle);
}
    i := 1;
    DrawRectangleOnDC(sStyle.FCacheBmp.Canvas.Handle,
                      cRect,
                      ColorToRGB(clGray),
                      ColorToRGB(clWhite),
                      i);
    PaintCheck(sStyle.FCacheBmp.Canvas, cRect, Item.Enabled, clBlack);
  end;

  if Assigned(Item.GetParentMenu.Images) and (Item.ImageIndex >= 0) then begin
    gRect := ItemRect(Item, aRect);
    Item.GetParentMenu.Images.Draw(sStyle.FCacheBmp.Canvas,
                                   gRect.Left + Margin,
                                   gRect.Top + (HeightOf(gRect) - GlyphSize(Item, False).cy) div 2,
                                   Item.ImageIndex,
                                   not (odDisabled in State));
  end;

  // Text writing
  if Assigned(FFont) then sStyle.FCacheBmp.Canvas.Font.Assign(FFont);

  if odSelected in State then begin
    sStyle.FCacheBmp.Canvas.Font.Color := FsStyle.HotStyle.HotPainting.FontColor;
    sStyle.FCacheBmp.Canvas.Font.Style := FsStyle.HotStyle.HotPainting.FontStyle;
  end
  else begin
    sStyle.FCacheBmp.Canvas.Font.Color := FFont.Color;
    sStyle.FCacheBmp.Canvas.Font.Style := FFont.Style;
  end;
  if odDefault in State then begin
    sStyle.FCacheBmp.Canvas.Font.Style := sStyle.FCacheBmp.Canvas.Font.Style + [fsBold];
  end
  else begin
    sStyle.FCacheBmp.Canvas.Font.Style := sStyle.FCacheBmp.Canvas.Font.Style - [fsBold];
  end;
  sStyle.FCacheBmp.Canvas.Brush.Style := bsClear;
  sStyle.FCacheBmp.Canvas.Pen.Style := psClear;
  R := TextRect;

  sGraphUtils.WriteText(sStyle.FCacheBmp.Canvas, PChar(Item.Caption), Item.Enabled, R, DT_VCENTER or AlignToInt[Alignment]);//DT_LEFT);
  Text := ShortCutToText(TMenuItem(Sender).ShortCut);
  r := ShortCutRect;
  dec(r.Right, 8);
  sGraphUtils.WriteText(sStyle.FCacheBmp.Canvas, PChar(Text), Item.Enabled, R, DT_VCENTER or DT_RIGHT);

  if Assigned(FOnDrawItem) then begin
    FOnDrawItem(Item, sStyle.FCacheBmp.Canvas, ARect, State, it);
  end;

//  gRect := ItemRect(Item, aRect);
  BitBlt(ACanvas.Handle, aRect.Left, aRect.Top, WidthOf(aRect), HeightOf(aRect),
            sStyle.FCacheBmp.Canvas.Handle, aRect.Left, aRect.Top, SrcCopy);
end;

procedure TsCustomMenuManager.InitItems(A: boolean);
var
  i : integer;
  procedure ShowComponent(c: TComponent);
  var
    i: integer;
  begin
    try
      if (c <> nil) then begin
        if (c is TMainMenu) or (c is TPopupMenu) then begin
          TMainMenu(c).OwnerDraw := FActive;
{
          if (c is TMainMenu) then begin
            for i := 0 to TMainMenu(c).Items.Count - 1 do begin
              if FActive then begin
                TMainMenu(c).Items[i].OnAdvancedDrawItem := sAdvancedDrawItem;
                TMainMenu(c).Items[i].OnMeasureItem := sMeasureItem;
              end
              else begin
                if addr(TMainMenu(c).Items[i].OnAdvancedDrawItem) = addr(TsCustomMenuManager.sAdvancedDrawItem) then
                  TMainMenu(c).Items[i].OnAdvancedDrawItem := nil;
                if addr(TMainMenu(c).Items[i].OnMeasureItem) = addr(TsCustomMenuManager.sMeasureItem) then
                  TMainMenu(c).Items[i].OnMeasureItem := nil;
              end;
            end;
          end;
}
        end
        else if c is TMenuItem then begin
          HookItem(TMenuItem(c), A);
        end;
        for i := 0 to c.ComponentCount - 1 do begin
          ShowComponent(c.Components[i]);
        end;
      end;
    except
      ShowWarning(c.ClassName);
    end;
  end;
begin
  for i := 0 to Application.ComponentCount - 1 do begin
    ShowComponent(Application.Components[i]);
  end;
end;


procedure TsCustomMenuManager.InitMenus(A: boolean);
var
  i{, j} : integer;
begin
  for i := 0 to FForm.ComponentCount - 1 do begin
    if (FForm.Components[i] is TMainMenu) or (FForm.Components[i] is TPopupMenu) {or (FForm.Components[i] is TMenuItem)} then begin
      HookMenu(TMainMenu(FForm.Components[i]), A);
    end
  end;
end;

procedure TsCustomMenuManager.SetActive(const Value: boolean);
begin
  if not (csDesigning in ComponentState) then begin
    InitItems(Value);
  end;