lazarus菜单栏在 Windows/macOS/GTK/Qt 下都是系统原生菜单,特别是在linux国产的银河麒麟系统,菜单的背景颜色默认是黑色的,和应用程序界面颜色明显不搭。
菜单样想用自绘方法,但自绘功能只有在Windows 下有效,在linux。
为了实现跨平台(Windows/Linux)且不依赖系统原生渲染,需要完全抛弃系统菜单栏的渲染机制,改用自定义控件(TCustomControl)来模拟菜单栏,并用一个无边框窗体(TForm)来模拟弹出菜单。
并充分利用原有的MainItem进行菜单设置,用一个单元文件
只需要有MainMenu的单元添加红代码部分就可以实现自定义背景、字体,高亮颜色及字体大小等。
菜单样想用自绘方法,但自绘功能只有在Windows 下有效,在linux。
为了实现跨平台(Windows/Linux)且不依赖系统原生渲染,需要完全抛弃系统菜单栏的渲染机制,改用自定义控件(TCustomControl)来模拟菜单栏,并用一个无边框窗体(TForm)来模拟弹出菜单。
并充分利用原有的MainItem进行菜单设置,用一个单元文件
StyledMenuUnit.pas,你可以将其放到窗体上,绑定原有的 TMainMenu,即可实现自定义背景色和项目样式。只需要有MainMenu的单元添加红代码部分就可以实现自定义背景、字体,高亮颜色及字体大小等。
unit Unit1;{$mode objfpc}{$H+}interfaceusesClasses, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Menus,StyledMenuUnit;type{ TForm1 }TForm1 = class(TForm)Edit1: TEdit;MainMenu1: TMainMenu;MenuItem1: TMenuItem;MenuItem10: TMenuItem;MenuItem11: TMenuItem;MenuItem12: TMenuItem;MenuItem2: TMenuItem;MenuItem3: TMenuItem;MenuItem4: TMenuItem;MenuItem5: TMenuItem;MenuItem6: TMenuItem;MenuItem7: TMenuItem;MenuItem8: TMenuItem;MenuItem9: TMenuItem;Separator1: TMenuItem;procedure FormCreate(Sender: TObject);procedure MenuItem2Click(Sender: TObject);privateFStyleBar:TStyledMenuBar;publicend;varForm1: TForm1;implementation{$R *.lfm}{ TForm1 }procedure TForm1.FormCreate(Sender: TObject); beginFStyleBar:=TStyledMenuBar.Create(Self);FStyleBar.parent:=Self;//FStyleBar.Align:=alBottom;// alTop;//FStyleBar.BarColor:=clGreen; FStyleBar.MainMenu:=MainMenu1;//FStyleBar.TextColor:=clBlack;//FStyleBar.ItemHoverColor:=clhighlight;//FStyleBar.TextHoverColor:=clYellow;//FStyleBar.PopupColor:=clGreen; FStyleBar.Font.Size := 12;FStyleBar.Font.Name := '微软雅黑';//FStyleBar.Font.Style := [fsBold];end;procedure TForm1.MenuItem2Click(Sender: TObject); beginShowMessage('itm2'); end;end.
这个截图是使用linux原生的:

下面截图是使用菜单扩展功能后的截图:

将下面的单元拷贝到project目录。
unit StyledMenuUnit;{$mode objfpc}{$H+}interfaceusesClasses, SysUtils, LResources, Forms, Controls, Graphics, Menus, LCLType, Dialogs,LCLIntf, LMessages, ExtCtrls, StdCtrls, GraphType, imglist, lclproc, ComCtrls;type{ TStyledMenuPopup }TStyledMenuPopup = class(TCustomForm)privateFMenuItems: TMenuItem;FImages: TCustomImageList;FHoverIndex: Integer;FOnClosePopup: TNotifyEvent;FMaxTextWidth: Integer;FMaxShortcutWidth: Integer;FItemHeight: Integer;FTextIndent: Integer;procedure SetMenuItems(AValue: TMenuItem);procedure CalculateLayout;procedure PaintItem(Index: Integer; ARect: TRect; IsHover: Boolean);procedure CMMouseLeave(var Msg: TLMessage); message CM_MOUSELEAVE;protectedprocedure Paint; override;procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;publicconstructor CreateNew(AOwner: TComponent; Num: Integer = 0); override;property MenuItems: TMenuItem read FMenuItems write SetMenuItems;property Images: TCustomImageList read FImages write FImages;property OnClosePopup: TNotifyEvent read FOnClosePopup write FOnClosePopup;end;{ TStyledMenuBar }TStyledMenuBar = class(TCustomControl)privateFMainMenu: TMainMenu;FHotIndex: Integer;FPressedIndex: Integer;FPopupForm: TStyledMenuPopup;FOwnerForm: TCustomForm;FOldFormChangeBounds: TNotifyEvent;FBarColor: TColor;FItemColor: TColor;FItemHoverColor: TColor;FTextColor: TColor;FTextHoverColor: TColor;FPopupColor: TColor;FPopupBorderColor: TColor;FDisabledTextColor: TColor;procedure SetMainMenu(AValue: TMainMenu);function GetItemRect(Index: Integer): TRect;function GetItemWidth(Index: Integer): Integer;procedure ShowPopup(Index: Integer);procedure HidePopup;procedure DoPopupClose(Sender: TObject);procedure HookOwnerForm;procedure UnhookOwnerForm;procedure DoFormChangeBounds(Sender: TObject);protectedprocedure Paint; override;procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); override;procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;procedure MouseLeave; override;procedure Notification(AComponent: TComponent; Operation: TOperation); override;publicconstructor Create(AOwner: TComponent); override;destructor Destroy; override;publishedproperty Align default alTop;property Font;property AutoSize;property BarColor: TColor read FBarColor write FBarColor default clBtnFace;property ItemHoverColor: TColor read FItemHoverColor write FItemHoverColor default clHighlight;property TextColor: TColor read FTextColor write FTextColor default clBtnText;property TextHoverColor: TColor read FTextHoverColor write FTextHoverColor default clHighlightText;property PopupColor: TColor read FPopupColor write FPopupColor default clWhite;property PopupBorderColor: TColor read FPopupBorderColor write FPopupBorderColor default clGray;property DisabledTextColor: TColor read FDisabledTextColor write FDisabledTextColor default clGray;property MainMenu: TMainMenu read FMainMenu write SetMainMenu;end;procedure Register;implementationusesMath;procedure Register; beginRegisterComponents('Additional', [TStyledMenuBar]); end;{ TStyledMenuPopup }constructor TStyledMenuPopup.CreateNew(AOwner: TComponent; Num: Integer); begininherited CreateNew(AOwner, Num);BorderStyle := bsNone;FormStyle := fsSystemStayOnTop;ShowInTaskBar := stNever;FHoverIndex := -1;Color := clWhite;DoubleBuffered := True; end;procedure TStyledMenuPopup.CalculateLayout; vari: Integer;Item: TMenuItem;ShortCutText: String;MaxImgWidth: Integer;MaxImgHeight: Integer; beginFMaxTextWidth := 0;FMaxShortcutWidth := 0;FItemHeight := 0;FTextIndent := 0;if FMenuItems = nil then Exit;if Owner is TStyledMenuBar thenCanvas.Font.Assign(TStyledMenuBar(Owner).Font)elseCanvas.Font := Screen.MenuFont;MaxImgWidth := 0;MaxImgHeight := 0;if (FImages <> nil) and (FImages.Count > 0) thenbeginMaxImgWidth := FImages.Width;MaxImgHeight := FImages.Height;end;for i := 0 to FMenuItems.Count - 1 dobeginItem := FMenuItems[i];if (Item.Bitmap <> nil) and (not Item.Bitmap.Empty) thenbeginMaxImgWidth := Max(MaxImgWidth, Item.Bitmap.Width);MaxImgHeight := Max(MaxImgHeight, Item.Bitmap.Height);end;end;if MaxImgWidth > 0 thenFTextIndent := 4 + MaxImgWidth + 6elseFTextIndent := 10;for i := 0 to FMenuItems.Count - 1 dobeginItem := FMenuItems[i];if Item.Caption <> '-' thenbeginFMaxTextWidth := Max(FMaxTextWidth, Canvas.TextWidth(StringReplace(Item.Caption, '&', '', [rfReplaceAll])));ShortCutText := ShortCutToText(Item.ShortCut);if ShortCutText='Unknown' Then ShortCutText:='';if ShortCutText <> '' thenFMaxShortcutWidth := Max(FMaxShortcutWidth, Canvas.TextWidth(ShortCutText));end;end;FItemHeight := Max(MaxImgHeight, Canvas.TextHeight('Wg')) + 6; end;procedure TStyledMenuPopup.SetMenuItems(AValue: TMenuItem); vari: Integer;TotalHeight: Integer;TotalWidth: Integer; beginFMenuItems := AValue;FHoverIndex := -1;if FMenuItems = nil then Exit;CalculateLayout;TotalWidth := FTextIndent + FMaxTextWidth + 20 + FMaxShortcutWidth + 10;if TotalWidth < 150 then TotalWidth := 150;TotalHeight := 4;for i := 0 to FMenuItems.Count - 1 dobeginif FMenuItems[i].Caption = '-' thenTotalHeight += 6elseTotalHeight += FItemHeight;end;TotalHeight += 2;ClientWidth := TotalWidth;ClientHeight := TotalHeight; end;procedure TStyledMenuPopup.PaintItem(Index: Integer; ARect: TRect; IsHover: Boolean); varItem: TMenuItem;IconX, IconY: Integer;TextX: Integer;ShortCutText: String;IconIdx: Integer;ShortCutX: Integer;IconWidth, IconHeight: Integer; beginItem := FMenuItems[Index];if Item.Enabled thenbeginif IsHover thenbeginCanvas.Brush.Color := TStyledMenuBar(Owner).ItemHoverColor;Canvas.Font.Color := TStyledMenuBar(Owner).TextHoverColor;endelsebeginCanvas.Brush.Color := TStyledMenuBar(Owner).PopupColor;Canvas.Font.Color := TStyledMenuBar(Owner).TextColor;end;endelsebeginCanvas.Brush.Color := TStyledMenuBar(Owner).PopupColor;Canvas.Font.Color := TStyledMenuBar(Owner).DisabledTextColor;end;Canvas.FillRect(ARect);if Item.Caption = '-' thenbeginCanvas.Pen.Color := clGray;Canvas.Line(ARect.Left + 2, ARect.Top + 2, ARect.Right - 2, ARect.Top + 2);Exit;end;IconWidth := 0;IconHeight := 0;IconIdx := Item.ImageIndex;if (FImages <> nil) and (IconIdx >= 0) and (IconIdx < FImages.Count) thenbeginIconWidth := FImages.Width;IconHeight := FImages.Height;IconX := ARect.Left + 4;IconY := ARect.Top + (ARect.Height - IconHeight) div 2;if Item.Enabled thenFImages.Draw(Canvas, IconX, IconY, IconIdx)elseFImages.Draw(Canvas, IconX, IconY, IconIdx, gdeDisabled);endelse if (Item.Bitmap <> nil) and (not Item.Bitmap.Empty) thenbeginIconWidth := Item.Bitmap.Width;IconHeight := Item.Bitmap.Height;IconX := ARect.Left + 4;IconY := ARect.Top + (ARect.Height - IconHeight) div 2;Item.Bitmap.Transparent := True;if Item.Enabled thenCanvas.Draw(IconX, IconY, Item.Bitmap)elseCanvas.Draw(IconX, IconY, Item.Bitmap);end;TextX := ARect.Left + FTextIndent;Canvas.Brush.Style := bsClear;Canvas.TextRect(ARect, TextX, ARect.Top + (ARect.Height - Canvas.TextHeight('Wg')) div 2,StringReplace(Item.Caption, '&', '', [rfReplaceAll]));ShortCutText := ShortCutToText(Item.ShortCut);if ShortCutText='Unknown' Then ShortCutText:='';if ShortCutText <> '' thenbeginShortCutX := ARect.Right - Canvas.TextWidth(ShortCutText) - 5;Canvas.TextRect(ARect, ShortCutX, ARect.Top + (ARect.Height - Canvas.TextHeight('Wg')) div 2, ShortCutText);end; end;procedure TStyledMenuPopup.Paint; vari: Integer;R: TRect;CurY: Integer; begininherited Paint;Canvas.Pen.Color := TStyledMenuBar(Owner).PopupBorderColor;Canvas.Brush.Color := TStyledMenuBar(Owner).PopupColor;Canvas.Rectangle(0, 0, ClientWidth, ClientHeight);if FMenuItems = nil then Exit;if Owner is TStyledMenuBar thenCanvas.Font.Assign(TStyledMenuBar(Owner).Font)elseCanvas.Font := Screen.MenuFont;CurY := 2;for i := 0 to FMenuItems.Count - 1 dobeginif FMenuItems[i].Caption = '-' thenR := Rect(1, CurY, ClientWidth - 1, CurY + 6)elseR := Rect(1, CurY, ClientWidth - 1, CurY + FItemHeight);PaintItem(i, R, (i = FHoverIndex));CurY := R.Bottom;end; end;procedure TStyledMenuPopup.CMMouseLeave(var Msg: TLMessage); begininherited; end;procedure TStyledMenuPopup.MouseMove(Shift: TShiftState; X, Y: Integer); vari: Integer;R: TRect;CurY: Integer;NewIndex: Integer;ScreenP: TPoint;BarP: TPoint;Bar: TStyledMenuBar;// 新增:记录上一次的有效位置 OldScreenP: TPoint; begininherited MouseMove(Shift, X, Y);// 保存当前鼠标位置ScreenP := ClientToScreen(Point(X, Y));// 如果是第一次移动或位置变化很大,使用当前位置if (X = 0) and (Y = 0) thenOldScreenP := ScreenPelseOldScreenP := ScreenP;Bar := TStyledMenuBar(Owner);BarP := Bar.ScreenToClient(ScreenP);// 检查是否移入了主菜单栏区域if (BarP.Y >= 0) and (BarP.Y < Bar.ClientHeight) thenbeginfor i := 0 to Bar.MainMenu.Items.Count - 1 dobeginif PtInRect(Bar.GetItemRect(i), BarP) thenbegin// 如果移动到了不同的菜单项if i <> Bar.FPressedIndex thenbeginBar.HidePopup;Bar.FPressedIndex := i;Bar.FHotIndex := i;Bar.ShowPopup(i);end;Exit;end;end;end;// 处理弹出菜单内部的高亮NewIndex := -1;CurY := 2;for i := 0 to FMenuItems.Count - 1 dobeginif FMenuItems[i].Caption = '-' thenR := Rect(1, CurY, ClientWidth - 1, CurY + 6)elseR := Rect(1, CurY, ClientWidth - 1, CurY + FItemHeight);if PtInRect(R, Point(X, Y)) thenbeginNewIndex := i;Break;end;CurY := R.Bottom;end;if NewIndex <> FHoverIndex thenbeginFHoverIndex := NewIndex;Invalidate;end; end;procedure TStyledMenuPopup.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); vari: Integer;R: TRect;CurY: Integer;Item: TMenuItem;ScreenP: TPoint;BarP: TPoint;Bar: TStyledMenuBar; begininherited MouseDown(Button, Shift, X, Y);Bar := TStyledMenuBar(Owner);ScreenP := ClientToScreen(Point(X, Y));BarP := Bar.ScreenToClient(ScreenP);if (BarP.Y >= 0) and (BarP.Y < Bar.ClientHeight) thenbeginfor i := 0 to Bar.MainMenu.Items.Count - 1 dobeginif PtInRect(Bar.GetItemRect(i), BarP) thenbeginif i = Bar.FPressedIndex thenBar.HidePopupelsebeginBar.HidePopup;Bar.FPressedIndex := i;Bar.FHotIndex := i;Bar.ShowPopup(i);end;Exit;end;end;end;CurY := 2;for i := 0 to FMenuItems.Count - 1 dobeginif FMenuItems[i].Caption = '-' thenR := Rect(1, CurY, ClientWidth - 1, CurY + 6)elseR := Rect(1, CurY, ClientWidth - 1, CurY + FItemHeight);if PtInRect(R, Point(X, Y)) thenbeginItem := FMenuItems[i];if (Item.Caption <> '-') and Item.Enabled thenbeginItem.Click;Hide;if Assigned(FOnClosePopup) then FOnClosePopup(Self);end;Break;end;CurY := R.Bottom;end; end;{ TStyledMenuBar }constructor TStyledMenuBar.Create(AOwner: TComponent); begininherited Create(AOwner);ControlStyle := ControlStyle + [csOpaque];Align := alTop;AutoSize := True;DoubleBuffered := True;FHotIndex := -1;FPressedIndex := -1;FBarColor := clBtnFace;FItemHoverColor := clHighlight;FTextColor := clBtnText;FTextHoverColor := clHighlightText;FPopupColor := clWhite;FPopupBorderColor := clGray;FDisabledTextColor := clGray; end;destructor TStyledMenuBar.Destroy; beginUnhookOwnerForm;inherited Destroy; end;procedure TStyledMenuBar.CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); begininherited CalculatePreferredSize(PreferredWidth, PreferredHeight, WithThemeSpace);Canvas.Font.Assign(Self.Font);PreferredHeight := Canvas.TextHeight('Wg') + 6;PreferredWidth := 0; end;procedure TStyledMenuBar.Notification(AComponent: TComponent; Operation: TOperation); begininherited Notification(AComponent, Operation);if (Operation = opRemove) thenbeginif AComponent = FMainMenu then FMainMenu := nil;if AComponent = FOwnerForm then FOwnerForm := nil;end; end;procedure TStyledMenuBar.HookOwnerForm; beginif FOwnerForm = nil thenbeginif (MainMenu <> nil) and (MainMenu.Owner is TCustomForm) thenFOwnerForm := TCustomForm(MainMenu.Owner)elseFOwnerForm := GetParentForm(Self);end;if (FOwnerForm <> nil) and not (csDesigning in ComponentState) thenbeginFOldFormChangeBounds := FOwnerForm.OnChangeBounds;FOwnerForm.OnChangeBounds := @DoFormChangeBounds;FOwnerForm.FreeNotification(Self);end; end;procedure TStyledMenuBar.UnhookOwnerForm; beginif (FOwnerForm <> nil) and not (csDesigning in ComponentState) thenbegin//if TMethod(FOwnerForm.OnChangeBounds).Code = @TStyledMenuBar.DoFormChangeBounds thenFOwnerForm.OnChangeBounds := FOldFormChangeBounds;end; end;procedure TStyledMenuBar.DoFormChangeBounds(Sender: TObject); beginif Assigned(FOldFormChangeBounds) thenFOldFormChangeBounds(Sender);HidePopup; end;procedure TStyledMenuBar.SetMainMenu(AValue: TMainMenu); beginif FMainMenu = AValue then Exit;UnhookOwnerForm;if FMainMenu <> nil then FMainMenu.RemoveFreeNotification(Self);FMainMenu := AValue;if FMainMenu <> nil thenbeginFMainMenu.FreeNotification(Self);if (FMainMenu.Owner is TCustomForm) thenTCustomForm(FMainMenu.Owner).Menu := nil;end;HookOwnerForm;Invalidate; end;function TStyledMenuBar.GetItemWidth(Index: Integer): Integer; beginif (FMainMenu = nil) or (Index < 0) or (Index >= FMainMenu.Items.Count) thenExit(0);Canvas.Font.Assign(Self.Font);Result := Canvas.TextWidth(FMainMenu.Items[Index].Caption) + 20; end;function TStyledMenuBar.GetItemRect(Index: Integer): TRect; vari, curX: Integer; beginResult := Rect(0, 0, 0, 0);if (FMainMenu = nil) or (Index < 0) or (Index >= FMainMenu.Items.Count) then Exit;curX := 0;for i := 0 to Index - 1 docurX += GetItemWidth(i);Result.Left := curX;Result.Top := 0;Result.Right := curX + GetItemWidth(Index);Result.Bottom := ClientHeight; end;procedure TStyledMenuBar.Paint; vari: Integer;R: TRect;Item: TMenuItem; begininherited Paint;Canvas.Brush.Color := FBarColor;Canvas.FillRect(ClientRect);if FMainMenu = nil then Exit;Canvas.Font.Assign(Self.Font);for i := 0 to FMainMenu.Items.Count - 1 dobeginItem := FMainMenu.Items[i];R := GetItemRect(i);if i = FPressedIndex thenbeginCanvas.Brush.Color := FPopupBorderColor;Canvas.Font.Color := FTextHoverColor;endelse if i = FHotIndex thenbeginCanvas.Brush.Color := FItemHoverColor;Canvas.Font.Color := FTextHoverColor;endelsebeginCanvas.Brush.Style := bsClear;Canvas.Font.Color := FTextColor;end;if (i = FPressedIndex) or (i = FHotIndex) thenCanvas.FillRect(R)elseCanvas.Brush.Style := bsClear;Canvas.TextRect(R, R.Left + 5, R.Top + (R.Height - Canvas.TextHeight(Item.Caption)) div 2, Item.Caption);end; end;procedure TStyledMenuBar.MouseMove(Shift: TShiftState; X, Y: Integer); vari: Integer;R: TRect;NewHot: Integer; begininherited MouseMove(Shift, X, Y);if (FPopupForm = nil) or (not FPopupForm.Visible) thenbeginNewHot := -1;if FMainMenu <> nil thenbeginfor i := 0 to FMainMenu.Items.Count - 1 dobeginR := GetItemRect(i);if PtInRect(R, Point(X, Y)) thenbeginNewHot := i;Break;end;end;end;if NewHot <> FHotIndex thenbeginFHotIndex := NewHot;Invalidate;end;end; end;procedure TStyledMenuBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); vari: Integer;R: TRect; begininherited MouseDown(Button, Shift, X, Y);if FMainMenu = nil then Exit;for i := 0 to FMainMenu.Items.Count - 1 dobeginR := GetItemRect(i);if PtInRect(R, Point(X, Y)) thenbeginif (FPopupForm <> nil) and (FPopupForm.Visible) thenHidePopupelsebeginFPressedIndex := i;ShowPopup(i);end;Invalidate;Break;end;end; end;procedure TStyledMenuBar.MouseLeave; begininherited MouseLeave;if (FPopupForm = nil) or (not FPopupForm.Visible) thenbeginFHotIndex := -1;Invalidate;end; end;procedure TStyledMenuBar.ShowPopup(Index: Integer); varP: TPoint;screenRect:TRect; beginif FMainMenu = nil then Exit;if FMainMenu.Items[Index].Count = 0 thenbeginFMainMenu.Items[Index].Click;FPressedIndex := -1;Invalidate;Exit;end;if FPopupForm = nil thenbeginFPopupForm := TStyledMenuPopup.CreateNew(Self);FPopupForm.OnClosePopup := @DoPopupClose;end;FPopupForm.Images := FMainMenu.Images;FPopupForm.MenuItems := FMainMenu.Items[Index];P := ClientToScreen(Point(GetItemRect(Index).Left, ClientHeight));screenRect := Screen.MonitorFromPoint(P).WorkareaRect;if P.X + FPopupForm.Width > screenRect.Right thenP.X := screenRect.Right - FPopupForm.Width;if P.Y + FPopupForm.Height > screenRect.Bottom thenP.Y := ClientToScreen(Point(0, 0)).Y - FPopupForm.Height;FPopupForm.SetBounds(P.X, P.Y, FPopupForm.Width, FPopupForm.Height);FPopupForm.Show;SetCapture(FPopupForm.Handle); end;procedure TStyledMenuBar.HidePopup; beginif FPopupForm <> nil then FPopupForm.Hide;FPressedIndex := -1;FHotIndex := -1;Invalidate; end;procedure TStyledMenuBar.DoPopupClose(Sender: TObject); beginReleaseCapture;FPressedIndex := -1;FHotIndex := -1;Invalidate; end;end.
