xpbarmenu.pas

xpmenu,一个可以使界面美化的控件.你可以设置成你自己所喜欢的.

  InitMenueItems(FForm, False);
  FFont.Free;

  /// Under Lines Add By Kingron
  FBarFont.Free;
  FreeAndNil(FBarBitmap);
  /// End Add

  inherited;
end;

procedure TXPBarMenu.ActivateMenuItem(MenuItem: TMenuItem);

  procedure Activate(MenuItem: TMenuItem);
  begin
    if addr(MenuItem.OnDrawItem) <> addr(TXPBarMenu.DrawItem) then
    begin
      if (not assigned(MenuItem.OnDrawItem)) or (FOverrideOwnerDraw) then
        MenuItem.OnDrawItem := DrawItem;
      if (not assigned(MenuItem.OnMeasureItem)) or (FOverrideOwnerDraw) then
        MenuItem.OnMeasureItem := MeasureItem;
    end
  end;

var
  i, j              : integer;
begin

  Activate(MenuItem);
  for i := 0 to MenuItem.Parent.Count - 1 do
  begin
    Activate(MenuItem.Parent.Items[i]);
    for j := 0 to MenuItem.Parent.Items[i].Count - 1 do
      ActivateMenuItem(MenuItem.Parent.Items[i].Items[j]);
  end;

end;

procedure TXPBarMenu.InitMenueItems(Form: TScrollingWinControl; Enable: boolean);

  procedure Activate(MenuItem: TMenuItem);
  begin
    if Enable then
    begin
      if (not assigned(MenuItem.OnDrawItem)) or (FOverrideOwnerDraw) then
        MenuItem.OnDrawItem := DrawItem;
      if (not assigned(MenuItem.OnMeasureItem)) or (FOverrideOwnerDraw) then
        MenuItem.OnMeasureItem := MeasureItem;
    end
    else
    begin
      if addr(MenuItem.OnDrawItem) = addr(TXPBarMenu.DrawItem) then
        MenuItem.OnDrawItem := nil;
      if addr(MenuItem.OnMeasureItem) = addr(TXPBarMenu.MeasureItem) then
        MenuItem.OnMeasureItem := nil;
    end;
  end;

 procedure ItrateMenu(MenuItem: TMenuItem);
  var
    i: integer;
  begin
    Activate(MenuItem);
    for i := 0 to MenuItem.Count - 1 do
      ItrateMenu(MenuItem.Items[i]);
  end;


var
  i, x              : integer;
begin
  for i := 0 to Form.ComponentCount - 1 do
  begin
    if Form.Components[i] is TMainMenu then
    begin
      for x := 0 to TMainMenu(Form.Components[i]).Items.Count - 1 do
      begin
        TMainMenu(Form.Components[i]).OwnerDraw := Enable;
        Activate(TMainMenu(Form.Components[i]).Items[x]);
        ItrateMenu(TMainMenu(Form.Components[i]).Items[x]);
      end;
    end;
    if Form.Components[i] is TPopupMenu then
    begin
      for x := 0 to TPopupMenu(Form.Components[i]).Items.Count - 1 do
      begin
        TPopupMenu(FForm.Components[i]).OwnerDraw := Enable;
        Activate(TMainMenu(Form.Components[i]).Items[x]);
        ItrateMenu(TMainMenu(Form.Components[i]).Items[x]);
      end;
    end;

{$IFDEF VER5U}
    if Form.Components[i] is TToolBar then
      if not (csDesigning in ComponentState) then
      begin
        if not TToolBar(Form.Components[i]).Flat then
          TToolBar(Form.Components[i]).Flat := true;

        if Enable then
        begin
          for x := 0 to TToolBar(FForm.Components[i]).ButtonCount - 1 do
            if (not assigned(TToolBar(Form.Components[i]).OnCustomDrawButton))
              or (FOverrideOwnerDraw) then
            begin
              TToolBar(FForm.Components[i]).OnCustomDrawButton :=
                ToolBarDrawButton;

            end;
        end
        else
        begin
          if addr(TToolBar(Form.Components[i]).OnCustomDrawButton) =
            addr(TXPBarMenu.ToolBarDrawButton) then
            TToolBar(Form.Components[i]).OnCustomDrawButton := nil;

        end;
      end;
{$ENDIF}

  end;
end;

procedure TXPBarMenu.DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
  Selected: Boolean);
begin
  if FActive then
  begin
    MenueDrawItem(Sender, ACanvas, ARect, Selected);
    /// Under Line Add By Kingron, Add OnDrawItem Event Process
    if Assigned(FOnDrawItem) then
      FOnDrawItem(Sender, ACanvas, ARect, Selected);
    /// End Add
  end;
end;

function TXPBarMenu.GetImageExtent(MenuItem: TMenuItem): TPoint;
var
  HasImgLstBitmap   : boolean;
  B                 : TBitmap;
  FTopMenu          : boolean;
begin
  FTopMenu := false;
  B := TBitmap.Create;
  B.Width := 0;
  B.Height := 0;
  Result.x := 0;
  Result.Y := 0;
  HasImgLstBitmap := false;

  if FForm.Menu <> nil then
    if MenuItem.GetParentComponent.Name = FForm.Menu.Name then
    begin
      FTopMenu := true;
      if FForm.Menu.Images <> nil then
        if MenuItem.ImageIndex <> -1 then
          HasImgLstBitmap := true;

    end;

  if (MenuItem.Parent.GetParentMenu.Images <> nil)
{$IFDEF VER5U}
  or (MenuItem.Parent.SubMenuImages <> nil)
{$ENDIF}
  then
  begin
    if MenuItem.ImageIndex <> -1 then
      HasImgLstBitmap := true
    else
      HasImgLstBitmap := false;
  end;

  if HasImgLstBitmap then
  begin
{$IFDEF VER5U}
    if MenuItem.Parent.SubMenuImages <> nil then
      MenuItem.Parent.SubMenuImages.GetBitmap(MenuItem.ImageIndex, B)
    else
{$ENDIF}
      MenuItem.Parent.GetParentMenu.Images.GetBitmap(MenuItem.ImageIndex, B)
  end
  else
    if MenuItem.Bitmap.Width > 0 then
      B.Assign(MenuItem.Bitmap);

  Result.x := B.Width;
  Result.Y := B.Height;

  if not FTopMenu and not HasImgLstBitmap then
    if Result.x < FIconWidth then
      Result.x := FIconWidth;

  B.Free;
end;

procedure TXPBarMenu.MeasureItem(Sender: TObject; ACanvas: TCanvas;
  var Width, Height: Integer);
var
  s                 : string;
  W, H              : integer;
  P                 : TPoint;
  IsLine            : boolean;

  /// Under Lines Add By Kingron
  FMenu             : TMenu;
  FMenuItem         : TMenuItem;
  i                 : integer;
  FTopMenu          : boolean;
  /// End Add
begin
  if FActive then
  begin
    FMenuItem := TMenuItem(Sender);
    S := FMenuItem.Caption;
      //------
    if S = '-' then IsLine := true else IsLine := false;
    /// Under Lines Comment By Kingron
///    if IsLine then
    /// End Comment

      //------
    if IsLine then
      S := '';

    if Trim(ShortCutToText(FMenuItem.ShortCut)) <> '' then
      S := S + ShortCutToText(FMenuItem.ShortCut) + 'WWW';

    ACanvas.Font.Assign(FFont);
    W := ACanvas.TextWidth(s);
    if pos('&', s) > 0 then
      W := W - ACanvas.TextWidth('&');

    P := GetImageExtent(FMenuItem);

    W := W + P.x + 10;

    if Width < W then
      Width := W;

    if IsLine then
      Height := 4
    else
    begin
      H := ACanvas.TextHeight(s) + Round(ACanvas.TextHeight(s) * 0.75);
      if P.y + 4 > H then
        H := P.y + 4;

      if Height < H then
        Height := H;
    end;
  ///Under Lines Add By Kingron
  //// 这个地方有待于改进算法，看看能不能不使用循环？否则速度太慢~~~~~~
    if CanDrawBar then /// Should Draw the Bar
    begin
      FTopMenu := False;
      FMenu := FMenuItem.Parent.GetParentMenu;

      if FMenu is TMainMenu then /// Search For Top Level Item?
      begin
        for i := 0 to FMenuItem.GetParentMenu.Items.Count - 1 do
          if FMenuItem.GetParentMenu.Items[i] = FMenuItem then /// Yes!
          begin
            FTopMenu := True;
            break;
          end;
      end;
      if not FTopMenu then /// Should Not be the TOP Level Item!
        Inc(Width, FBarWidth + 2); /// Add Width For the Bar

      if FItemHeight <> 0 then /// User Define Item Height!
        Height := FItemHeight;
    end;

    if Assigned(FOnMeasureItem) then
      FOnMeasureItem(Sender, ACanvas, Width, Height);

  /// End Add

  end;
end;

procedure TXPBarMenu.MenueDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
  Selected: Boolean);
var
  txt               : string;
  B                 : TBitmap;
  IconRect, TextRect, CheckedRect: TRect;
  i, X1, X2         : integer;
  TextFormat        : integer;
  HasImgLstBitmap   : boolean;
  FMenuItem         : TMenuItem;
  FMenu             : TMenu;
  FTopMenu          : boolean;
  ISLine            : boolean;
  ImgListHandle     : HImageList; {Commctrl.pas}
  ImgIndex          : integer;
  hWndM             : HWND;
  hDcM              : HDC;
  /// Under Add By Kingron
  FBarHeight        : integer;
  BarRect           : TRect;
  /// End Add

  /// Under Function Add By Kingron

  function GetItemHeigth(Sender: TObject): integer;
  var
    Width, Height   : Integer;
  begin
    Height := 0;
    MeasureItem(Sender, ACanvas, Width, Height);
    Result := Height;
  end;
  /// End Function Add

begin
  FTopMenu := false;
  FMenuItem := TMenuItem(Sender);

  SetGlobalColor(ACanvas);

  if FMenuItem.Caption = '-' then IsLine := true else IsLine := false;

  FMenu := FMenuItem.Parent.GetParentMenu;

  if FMenu is TMainMenu then
    for i := 0 to FMenuItem.GetParentMenu.Items.Count - 1 do
      if FMenuItem.GetParentMenu.Items[i] = FMenuItem then
      begin
        FTopMenu := True;
        break;
      end;

  /// Under Lines Add By Kingron
  if not FTopMenu and CanDrawBar then
  begin
    FBarHeight := 0; /// Count For the Bar height
    for i := 0 to FMenuItem.Parent.Count - 1 do
      if FMenuItem.Parent.Items[i].Visible then
        if FItemHeight <> 0 then /// if User Define the Item Height?
          Inc(FBarHeight, FItemHeight) /// Yes,Should Add the Define ItemHeight
        else
          if FMenuItem.Parent.Items[i].IsLine then /// Is -------?
            Inc(FBarHeight, 4) /// The Line's Default Height!
          else
            Inc(FBarHeight, GetItemHeigth(FMenuItem.Parent.Items[i])); /// Add Default ItemHeight;

    Dec(ARect.Right, FBarWidth); /// Adjust RECT for the Bar!
    /// if You wan't Left a room for bar between,please modify: FBarWidth to FBarWidth - 1
    OffsetRect(ARect, FBarWidth, 0);

    BarRect := Rect(1, 1, FBarWidth, FBarHeight);
    if Assigned(FOnMeasureBar) then
      FOnMeasureBar(Sender, ACanvas, ARect, BarRect);

    DrawBar(Sender, ACanvas, BarRect); /// Draw the Bar
  end;
  /// End Add

  ACanvas.Font.Assign(FFont);
  if FMenu.IsRightToLeft then
    ACanvas.Font.Charset := ARABIC_CHARSET;

  Inc(ARect.Bottom, 1);
  TextRect := ARect;
  txt := ' ' + FMenuItem.Caption;

  B := TBitmap.Create;

  HasImgLstBitmap := false;

  if FMenuItem.Bitmap.Width > 0 then
    B.Assign(TBitmap(FMenuItem.Bitmap));

  if (FMenuItem.Parent.GetParentMenu.Images <> nil)
{$IFDEF VER5U}
  or (FMenuItem.Parent.SubMenuImages <> nil)
{$ENDIF}
  then
  begin
    if FMenuItem.ImageIndex <> -1 then
      HasImgLstBitmap := true
    else
      HasImgLstBitmap := false;
  end;

  if FMenu.IsRightToLeft then
  begin
    X1 := ARect.Right - FIconWidth;
    X2 := ARect.Right;
  end
  else
  begin
    X1 := ARect.Left;
    X2 := ARect.Left + FIconWidth;
  end;
  IconRect := Rect(X1, ARect.Top , X2, ARect.Bottom );

  if HasImgLstBitmap then
  begin
    CheckedRect := IconRect;
    Inc(CheckedRect.Left, 1);
    Inc(CheckedRect.Top, 2);
    Dec(CheckedRect.Right, 3);
    Dec(CheckedRect.Bottom, 2);
  end
  else
  begin
    CheckedRect.Left := IconRect.Left +
      (IConRect.Right - IconRect.Left - 10) div 2;
    CheckedRect.Top := IconRect.Top +
      (IConRect.Bottom - IconRect.Top - 10) div 2;
    CheckedRect.Right := CheckedRect.Left + 10;
    CheckedRect.Bottom := CheckedRect.Top + 10;
  end;

  if FMenu.IsRightToLeft then
  begin
    X1 := ARect.Left;
    X2 := ARect.Right - FIconWidth;
    if B.Width > FIconWidth then
      X2 := ARect.Right - B.Width - 4;
  end
  else
  begin
    X1 := ARect.Left + FIconWidth;
    if B.Width > X1 then
      X1 := B.Width + 4;
    X2 := ARect.Right;
  end;

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

  if FTopMenu then
  begin
    if not HasImgLstBitmap then
    begin
      TextRect := ARect;
    end
    else
    begin
      if FMenu.IsRightToLeft then
        TextRect.Right := TextRect.Right + 5
      else