Disclaimer　This example program is provided "as is" with no warranty of any kind. It is intended for demonstration purposes only. In particular, it does no error handling. You can use the example in any form, but please mention www.vb-helper.com.-----　How to create a menu with a pixturebox, some labels, and a few lines to make it look good. I lot more flexibilty with this menu but unforutnately a lot more work and typing. You can make some very cool effects with bold, italics, underlining, colors, etc. etc. If you like the menu and use it for anything put a small link to my web site if you want, or just put my e-mail address since the URL is very long. Hopefully this address will change soon.http://www.geocities.com/SiliconValley/Ridge/6656/index.htmlE-Mail: S.S.Software@iName.comSami SamhuriPresident & C.E.O.S.S. Software-----以下是窗体中的代码：'------------------------------------------------------''　Create a menu with a picturebox and some labels,　　''The lines give it a nice effect tht you only get with ''　 Win98, or the fancy MS products for Win95/WinNT　　''　　　　　　　　　　　　　-----　　　　　　　　　　　 ''Sami Samhuri - S.S. Software　　　　　　　　　　　　　''www.geocities.com/SiliconValley/Ridge/6656/index.html ''E-Mail: S.S.Software@iName.com　　　　　　　　　　　　''------------------------------------------------------'Option ExplicitDim Shown As BooleanDim ctr As IntegerDim Autohide, Border As Boolean' Constants used for line colorsPrivate Const LC1 = &HC0C0C0Private Const LC2 = &H636363Sub ShowBorder(Ctrl As Control, Optional Reverse As Boolean = False)　　Dim Corner1, Corner2, Corner3, Corner4 As Long　　' If mnu is "pressed down" then reverse colors　　If Reverse Then　　　　Lines(0).BorderColor = LC2　　　　Lines(1).BorderColor = LC1　　　　Lines(2).BorderColor = LC2　　　　Lines(3).BorderColor = LC1　　Else　　' Otherwise change them back to normal　　　　Lines(0).BorderColor = LC1　　　　Lines(1).BorderColor = LC2　　　　Lines(2).BorderColor = LC1　　　　Lines(3).BorderColor = LC2　　End If　　' Set variables for positioning the lines around control　　Corner1 = Ctrl.Left - 10　　Corner2 = Ctrl.Left + Ctrl.Width + 10　　Corner3 = Ctrl.Top - 10　　Corner4 = Ctrl.Top + Ctrl.Height + 10　　' Adding 15 to the width/height makes the lines meet _　　　　the second one needs 20 for some reason though　　' Position Top line　　Lines(0).X1 = Corner1　　Lines(0).X2 = Corner2 + 15　　Lines(0).Y1 = Corner3　　Lines(0).Y2 = Corner3　　' Position Bottom line　　Lines(1).X1 = Corner1　　Lines(1).X2 = Corner2 + 20　　Lines(1).Y1 = Corner4　　Lines(1).Y2 = Corner4　　' Position Left line　　Lines(2).X1 = Corner1　　Lines(2).X2 = Corner1　　Lines(2).Y1 = Corner3　　Lines(2).Y2 = Corner4 + 15　　' Position Right line　　Lines(3).X1 = Corner2　　Lines(3).X2 = Corner2　　Lines(3).Y1 = Corner3　　Lines(3).Y2 = Corner4 + 15　　' Show the border(lines)　　For ctr = 0 To 3　　　　Lines(ctr).Visible = True　　Next ctrEnd SubSub HideBorder()　　' Hide the border(lines)　　For ctr = 0 To 3　　　　Lines(ctr).Visible = False　　Next ctr　　　　' Make sure the line colors are back to normal　　Lines(0).BorderColor = LC1　　Lines(1).BorderColor = LC2　　Lines(2).BorderColor = LC1　　Lines(3).BorderColor = LC2End SubSub HideBar()　　' Disabled the menus　　For ctr = 0 To mnu.UBound　　　　mnu(ctr).Enabled = False　　Next ctr　　　　' Make sure the border is hidden　　HideBorder　　　　' Set menubar flag　　Shown = False　　　　' Make the menu "fold up" but leave a bit visible _　　　　so we can access the menu, looks ugly with _　　　　a border around the menu　　For ctr = picMenu.Top To ((-1 * picMenu.Height) + 60) Step -5　　　　picMenu.Top = ctr　　　　　　　　' This ensures that it shows the menu "folding"　　　　DoEvents　　Next ctrEnd SubSub ShowBar()　　' Make sure the border is hidden　　HideBorder　　　　' Set menubar flag　　Shown = True　　　　' Make the menu "fold down"　　For ctr = picMenu.Top To 0 Step 5　　　　picMenu.Top = ctr　　　　　　　　' This ensures that it shows the menu "folding"　　　　DoEvents　　Next ctr　　　　' Re-enabled the menus　　For ctr = 0 To mnu.UBound　　　　mnu(ctr).Enabled = True　　Next ctrEnd SubPrivate Sub Form_Load()　　' Hide the menu bar　　HideBar　　　　' Set the autohide flag　　Autohide = True　　　　' Set the menu to show autohide is on　　mnuBarAutoHide.Checked = Autohide　　　　' Set the border flag, not nessecary　　Border = False　　　　' Set the menu to show there's no border _　　　　also not nessecary　　mnuBarBorder.Checked = BorderEnd SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)　　' If the border is on the hide it　　If Lines(0).Visible Then _　　　　HideBorder　　　　' If the menu is visible and autohide is on _　　　　then hide the menu　　If Shown And Autohide Then _　　　　HideBarEnd SubPrivate Sub Form_Resize()　　' Size the menu to fit the screen　　picMenu.Width = ScaleWidth　　　　' Make sure it stays at the left edge　　picMenu.Left = 0End SubPrivate Sub Form_Unload(Cancel As Integer)　　' Program wouldn't close right away while the menu _　　　　was folding　　' You also could set a variable so when it's _　　　　unloading if it's folding it just stops but _　　　　whatever works...I thought this was easier _　　　　although not always recommended..."End" does _　　　　some strange things sometimes　　EndEnd SubPrivate Sub mnu_Click(Index As Integer)　　' If it's hidden then don't do anything　　If Not Shown And Autohide Then Exit Sub　　　　' Make the menu appear to be "pressed down"　　ShowBorder mnu(Index), True　　　　' Show the proper menu. It was easier to have menus _　　　　with corresponding indexes than to do a _　　　　"Select Case Index" etc. etc...　　' Make sure the submenu appears under the menu　　PopupMenu mnumnu(Index), , mnu(Index).Left, _　　　　mnu(Index).Top + mnu(Index).Height + 10End SubPrivate Sub mnu_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)　　' If it's hidden then don't do anything　　If Not Shown And Autohide Then Exit Sub　　　　' If the border is already on the right control _　　　　don't let it flash　　If Lines(0).X1 + 10 = mnu(Index).Left _　　　　And Lines(0).Visible Then Exit Sub　　　　' Otherwise show the border　　ShowBorder mnu(Index)End SubPrivate Sub mnuBarAutoHide_Click()　　' Toggle autohide flag　　Autohide = Not Autohide　　　　' Update menu check to match　　mnuBarAutoHide.Checked = AutohideEnd SubPrivate Sub mnuBarBorder_Click()　　' Toggle border flag　　Border = Not Border　　　　' Set menu to show checked or not　　mnuBarBorder.Checked = Border　　　　' Show/Hide the border, I prefer it with no border　　If Border Then　　　　picMenu.BorderStyle = 1　　Else　　　　picMenu.BorderStyle = 0　　End IfEnd SubPrivate Sub picMenu_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)　　' If it's not the right button don't do anything　　If Button <> 2 Then Exit Sub　　　　' If it's the right button then show the menu　　PopupMenu mnuBarEnd SubPrivate Sub picMenu_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)　　' If the border is on the hide it　　If Lines(0).Visible Then _　　　　HideBorder　　　　' If the menu's hidden then show it　　If Not Shown Then _　　　　ShowBarEnd Sub

评论