ajaltermenu.pas

是不是天天看見MS的注冊表看膩了

unit ajAlterMenu;


interface

uses
  Windows, Graphics, Controls;

type
  TajAlterMenu = class(TObject)                             // The AlterMenu component.
  private
    fOwner    : TWinControl;
    fEnabled  : boolean;
  protected
    procedure   SetfEnabled     (Value : boolean);
    procedure   DrawMenuItem  (Sender : TObject; ACanvas : TCanvas; ARect : TRect; State : TOwnerDrawState);
  public
    constructor Create        (AOwner : TWinControl);
    procedure   ConnectDrawItemEventHandlers;
    property    Enabled       : boolean   read  fEnabled  write SetfEnabled;
  end;

implementation

uses
  Menus, Classes;

{--------------------------------------------------------------------------------------------------}

constructor TajAlterMenu.Create(AOwner : TWinControl);
begin
  fOwner    := AOwner;
  fEnabled  := false;
  Enabled   := true;
end; {constructor}

{--------------------------------------------------------------------------------------------------}

procedure TajAlterMenu.SetfEnabled(Value : boolean);
var
  lp1, lp2  : integer;
begin
  if (fEnabled <> Value) then begin

    fEnabled  := Value;

    with fOwner do begin

      ConnectDrawItemEventHandlers;

      for lp1 := 0 to pred(ComponentCount) do begin                // Scan for all TMenus and
                                                                   // set OwnerDraw as appropriate.
        if (Components[lp1] is TMenu) then
          TMenu(Components[lp1]).OwnerDraw  := fEnabled;

        if (Components[lp1] is TMainMenu) then begin               // This is a kludge but need to
          with TMainMenu(Components[lp1]) do begin                 // get the main menu items to
            for lp2 := 0 to pred(Items.Count) do begin             // redraw themselves.
              if Items[lp2].Visible then begin                     // (There must be a better way !)
                Items[lp2].Visible  := false;
                Items[lp2].Visible  := true;
              end; {if}
            end; {for}
          end; {with}
        end; {if}

      end; {for}

    end; {with}

  end; {if}

end; {SetfEnabled}

{--------------------------------------------------------------------------------------------------}

procedure TajAlterMenu.ConnectDrawItemEventHandlers;

  {................................................................................................}
  procedure Connect(MenuItem : TMenuItem);
  var
    lp1 : integer;
  begin
    if fEnabled then                                          // If we're allowed to then
      MenuItem.OnAdvancedDrawItem := DrawMenuItem             // connect our draw routine
    else                                                      // otherwise ...
      MenuItem.OnAdvancedDrawItem := nil;                     // just set me back to nil.
    for lp1 := 0 to pred(MenuItem.Count) do                   // Recursively check our children too.
      Connect(MenuItem.Items[lp1]);
  end; {Connect}
  {................................................................................................}

var
  lp1, lp2  : integer;
  Menu      : TMenu;
begin
  with fOwner do begin
    for lp1 := 0 to pred(ComponentCount) do begin             // Scan for all TMenuItems and
      if (Components[lp1] is TMenu) then begin                // connect their OnDrawItem event
        Menu  := TMenu(Components[lp1]);
        for lp2 := 0 to pred(Menu.Items.Count) do
          Connect(Menu.Items[lp2]);
      end; {if}
    end; {for}
  end; {with}
end; {ConnectDrawItemHandlers}

{--------------------------------------------------------------------------------------------------}

procedure TajAlterMenu.DrawMenuItem(Sender : TObject; ACanvas : TCanvas; ARect : TRect; State : TOwnerDrawState);
var
  Text              : string;
  Bitmap            : TBitmap;
  IconRect          : TRect;
  TextRect          : TRect;
  BackColor         : TColor;
  IconBackColor     : TColor;
  SelectedBkColor   : TColor;
  FontColor         : TColor;
  SelectedFontColor : TColor;
  DisabledFontColor : TColor;
  SeparatorColor    : TColor;
  CheckedColor      : TColor;
  lp1               : integer;
  X1, X2            : integer;
  TextFormat        : integer;
  MenuItem          : TMenuItem;
  Menu              : TMenu;
begin
  MenuItem          := TMenuItem(Sender);
  Menu              := MenuItem.Parent.GetParentMenu;
  BackColor         := $00E1E1E1;
  IconBackColor     := $00D1D1D1;
  SelectedBkColor   := $00DCCFC7;
  FontColor         := clBlack;
  SelectedFontColor := clNavy;
  DisabledFontColor := clGray;
  SeparatorColor    := $00D1D1D1;
  CheckedColor      := clGray;

  if Menu.IsRightToLeft then begin
    X1  := aRect.Right - 20;
    X2  := aRect.Right;
  end else begin
    X1  := aRect.Left;
    X2  := aRect.Left + 20;
  end; {if}

  IconRect  := Rect(X1, aRect.Top, X2, aRect.Bottom);

  TextRect  := aRect;
  Text      := ' ' + MenuItem.Caption;

  Bitmap              := TBitmap.Create;
  Bitmap.Transparent  := true;

  if (MenuItem.Parent.GetParentMenu.Images <>  nil) or
       (MenuItem.Parent.SubMenuImages <> nil) then begin
    if (MenuItem.ImageIndex <> -1) then begin
      if (MenuItem.Parent.SubMenuImages <> nil) then
        MenuItem.Parent.SubMenuImages.GetBitmap(MenuItem.ImageIndex, Bitmap)
      else
        MenuItem.Parent.GetParentMenu.Images.GetBitmap(MenuItem.ImageIndex, Bitmap)
    end else
  //    if (MenuItem.Bitmap.Width > 0) then
  //      Bitmap.Assign(MenuItem.Bitmap);
  end;{if}

  if Menu.IsRightToLeft then begin
    X1  := aRect.Left;
    X2  := aRect.Right - 20;
  end else begin
    X1  := aRect.Left + 20;
    X2  := aRect.Right;
  end; {if}

  TextRect  := Rect(X1, aRect.Top, X2, aRect.Bottom);

  aCanvas.Brush.Color := BackColor;
  aCanvas.FillRect(TextRect);

  if (Menu is TMainMenu) then begin
    for lp1 := 0 to pred(MenuItem.GetParentMenu.Items.Count) do begin
      if (MenuItem.GetParentMenu.Items[lp1] = MenuItem) then begin
        aCanvas.Brush.Color := IconBackColor;
        aCanvas.FillRect(aRect);
        if (MenuItem.ImageIndex = -1) and (MenuItem.Bitmap.Width = 0) then begin
          TextRect  := aRect;
          Break;
        end; {if}
      end; {if}
    end; {for}
  end; {if}

  aCanvas.Brush.Color := IconBackColor;
  aCanvas.FillRect(IconRect);

  if MenuItem.Enabled then
    aCanvas.Font.Color  := FontColor
  else
    aCanvas.Font.Color  := DisabledFontColor;

  if (odSelected in State) or (odHotLight in State) then begin
    aCanvas.Brush.Style := bsSolid;
    aCanvas.Brush.Color := SelectedBkColor;
    aCanvas.FillRect(TextRect);
    aCanvas.Pen.Color   := SelectedFontColor;
    aCanvas.Brush.Style := bsClear;
    aCanvas.RoundRect(TextRect.Left, TextRect.Top, TextRect.Right, TextRect.Bottom, 6, 6);
    if MenuItem.Enabled then
      aCanvas.Font.Color  := SelectedFontColor;
  end; {if}

  X1  := IconRect.Left + 2;

  if (Bitmap <> nil) then
    aCanvas.Draw(X1, succ(IconRect.Top), Bitmap);

  if MenuItem.Checked then begin
    aCanvas.Pen.Color   := CheckedColor;
    aCanvas.Brush.Style := bsClear;
    aCanvas.RoundRect(IconRect.Left, IconRect.Top, IconRect.Right, IconRect.Bottom, 3, 3);
  end; {if}

  if not MenuItem.IsLine then begin
    SetBkMode(aCanvas.Handle, TRANSPARENT);
    aCanvas.Font.Name := 'Tahoma';
    if Menu.IsRightToLeft then
      aCanvas.Font.Charset  := ARABIC_CHARSET;
    if Menu.IsRightToLeft then
      TextFormat            := DT_RIGHT + DT_RTLREADING
    else
      TextFormat            := 0;

    if MenuItem.Default then begin
      inc(TextRect.Left,  1);
      inc(TextRect.Right, 1);
      inc(TextRect.Top,   1);
      aCanvas.Font.Color  := clGray;
      DrawTextEx(aCanvas.Handle, PChar(Text), Length(Text), TextRect, TextFormat, nil);
      dec(TextRect.Left,  1);
      dec(TextRect.Right, 1);
      dec(TextRect.Top,   1);
      aCanvas.Font.color  := FontColor;
    end; {if}

    inc(TextRect.Left,  2);
    inc(TextRect.Top,   2);

    DrawTextEx(aCanvas.Handle, PChar(Text), Length(Text), TextRect, TextFormat, nil);
    Text  := ShortCutToText(MenuItem.ShortCut) + ' ';

    if Menu.IsRightToLeft then
      TextFormat  := DT_LEFT
    else
      TextFormat  := DT_RIGHT;

    DrawTextEx(aCanvas.Handle, PChar(Text), Length(Text), TextRect, TextFormat, nil);

  end else begin

    aCanvas.Pen.Color := SeparatorColor;
    aCanvas.MoveTo(ARect.Left + 10, TextRect.Top + Round((TextRect.Bottom - TextRect.Top) / 2));
    aCanvas.LineTo(ARect.Right - 2, TextRect.Top + Round((TextRect.Bottom - TextRect.Top) / 2))

  end; {if}

  Bitmap.Free;

end; {DrawMenuItem}

{--------------------------------------------------------------------------------------------------}
{ajAlterMenu}
end.