（一）編程原理；



　　由于windows自身并未提供這項接口函數，因此我們必須從分析菜單的實質入手，我認為任何菜單實質上是一個沒有標題欄的窗體，菜單項目是某些控件（如標簽控件），通過監測鼠標是否移動到控件上而相應的改變控件的背景色和填充色，從而達到相應的目的，當然另外一項關鍵是如何制造出那一個倒立著的寫著“windows98”字樣的標題，這需要我們調用復雜的系統函數來實現。



　　（二）編程實踐；



　　（1）運行vb6，建立一個標準exe工程，添加命名為form1的窗體，放上一個command控件“command1”，caption=“開始”，調整到適當的位置,雙擊窗體，寫入以下代碼：



　　Private Sub Command1_Click()



　　frmTest.Show ‘當開始按鈕被點擊時激活超級菜單



　　End Sub



　　Private Sub Form_Load()



　　Me.left = (Screen.Width － Me.Width) / 2



　　Me.tOp = (Screen.Height － Me.Height) / 2 ‘窗體位置居中



　　End Sub



　　Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)



　　If frmTest.Visible = True Then



　　Unload frmTest



　　End If ‘當鼠標離開菜單時卸載菜單



　　End Sub



　　Private Sub Form_Unload(Cancel As Integer)



　　End ‘結束程序



　　End Sub



　　（2） 添加命名為frmtest的窗體，添加一個picturebox控件，命名為piclogo，采用默認值就行了，添加控件數組label1（1－－6）（讀者可以根據自己的需要添加）,caption=“菜單項目”，添加一個image控件，將它的圖片設計為自己喜歡的圖片，移動窗體和圖片到適當位置，雙擊窗體，寫入以下代碼：



　　Option Explicit



　　Dim cL As New cLogo ‘引用類模塊



　　Private Sub Form_Load()



　　Me.left = Form1.left



　　Me.tOp = Form1.tOp － Form1.Height ‘指定窗體位置



　　Me.Caption = App.Title ‘窗體標題



　　cL.DrawingObject = picLogo ‘指定piclogo為載體



　　cL.Caption = ″ 歡迎使用國產軟件! －－zouhero 2000 ″‘文本



　　cL.StartColor = vbBlue ‘前段顏色－藍色



　　cL.EndColor = vbRed ‘后段顏色－紅色



　　End Sub



　　Private Sub Form_Resize()



　　On Error Resume Next



　　picLogo.Height = Me.ScaleHeight



　　cL.Draw



　　End Sub



　　Private Sub Label1_Click(Index As Integer)



　　MsgBox ″你選擇了菜單″ ＆ Index, vbExclamation



　　’在這里添加你的相應代碼



　　End Sub



　　Private Sub Label1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)



　　Dim i As Integer ‘當鼠標移動標簽控件時，前景色變成白色，背景色變成藍色



　　 Label1(Index).BackColor = vbBlue



　　 Label1(Index).ForeColor = ＆HFFFFFF



　　 For i = 0 To Label1.Count － 1 ‘其他標簽顏色恢復原狀



　　If i = Index Then GoTo aa



　　Label1(i).BackColor = vbButtonFace



　　Label1(i).ForeColor = ＆H0



　　aa:



　　Next ‘恢復除選定標簽外的所有標簽的前景色和背景色



　　End Sub ‘代碼結束



　　（3）選擇“工程”菜單－“添加類模塊”，命名為clogo，寫入以下代碼：



　　Option Explicit ’以下是令人眼花繚亂的win api引用



　　Private Type RECT



　　left As Long



　　tOp As Long



　　Right As Long



　　Bottom As Long



　　End Type



　　Private Declare Function FillRect Lib ″user32″ (ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Long



　　Private Declare Function CreateSolidBrush Lib ″gdi32″ (ByVal crColor As Long) As Long



　　Private Declare Function TextOut Lib ″gdi32″ Alias ″TextOutA″ (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long



　　Private Declare Function GetDeviceCaps Lib ″gdi32″ (ByVal hDC As Long, ByVal nIndex As Long) As Long



　　Private Const LOGPIXELSX = 88



　　Private Const LOGPIXELSY = 90



　　Private Declare Function MulDiv Lib ″kernel32″ (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long



　　Private Const LF_FACESIZE = 32



　　Private Type LOGFONT



　　lfHeight As Long



　　lfWidth As Long



　　lfEscapement As Long



　　lfOrientation As Long



　　lfWeight As Long



　　lfItalic As Byte



　　lfUnderline As Byte



　　lfStrikeOut As Byte



　　lfCharSet As Byte



　　lfOutPrecision As Byte



　　lfClipPrecision As Byte



　　lfQuality As Byte



　　lfPitchAndFamily As Byte



　　lfFaceName(LF_FACESIZE) As Byte



　　End Type



　　Private Declare Function CreateFontIndirect Lib ″gdi32″ Alias ″CreateFontIndirectA″ (lpLogFont As LOGFONT) As Long



　　Private Declare Function SelectObject Lib ″gdi32″ (ByVal hDC As Long, ByVal hObject As Long) As Long



　　Private Declare Function DeleteObject Lib ″gdi32″ （ByVal hObject As Long) As Long



　　Private Const FW_NORMAL = 400



　　Private Const FW_BOLD = 700



　　Private Const FF_DONTCARE = 0



　　Private Const DEFAULT_QUALITY = 0



　　Private Const DEFAULT_PITCH = 0



　　Private Const DEFAULT_CHARSET = 1



　　Private Declare Function OleTranslateColor Lib ″OLEPRO32.DLL″ (ByVal OLE_COLOR As Long, ByVal HPALETTE As Long, pccolorref As Long) As Long



　　Private Const CLR_INVALID = －1



　　Private m_picThis As PictureBox



　　Private m_sCaption As String



　　Private m_bRGBStart(1 To 3) As Integer



　　Private m_oStartColor As OLE_COLOR



　　Private m_bRGBEnd(1 To 3) As Integer



　　Private m_oEndColor As OLE_COLOR ’api聲明結束



　　’以下代碼建立建立類模塊的出入口函數



　　Public Property Let Caption(ByVal sCaption As String) ’



　　m_sCaption = sCaption



　　End Property



　　Public Property Get Caption() As String ’標題欄文字



　　Caption = m_sCaption



　　End Property



　　Public Property Let DrawingObject(ByRef picThis As PictureBox)‘指定目標圖片



　　Set m_picThis = picThis



　　End Property



　　Public Property Get StartColor() As OLE_COLOR ‘StartColor = m_oStartColor



　　End Property



　　Public Property Let StartColor(ByVal oColor As OLE_COLOR) ‘指定前段顏色



　　Dim lColor As Long



　　If (m_oStartColor <> oColor) Then



　　m_oStartColor = oColor



　　OleTranslateColor oColor, 0, lColor



　　m_bRGBStart(1) = lColor And ＆HFF＆



　　m_bRGBStart(2) = ((lColor And ＆HFF00＆) \ ＆H100)



　　m_bRGBStart(3) = ((lColor And ＆HFF0000) \ ＆H10000)



　　If Not (m_picThis Is Nothing) Then



　　Draw



　　End If



　　End If



　　End Property



　　Public Property Get EndColor() As OLE_COLOR



　　EndColor = m_oEndColor



　　End Property



　　Public Property Let EndColor(ByVal oColor As OLE_COLOR) ‘指定后段顏色



　　Dim lColor As Long



　　If (m_oEndColor <> oColor) Then



　　m_oEndColor = oColor



　　OleTranslateColor oColor, 0, lColor



　　m_bRGBEnd(1) = lColor And ＆HFF＆



　　m_bRGBEnd(2) = ((lColor And ＆HFF00＆) \ ＆H100)



　　m_bRGBEnd(3) = ((lColor And ＆HFF0000) \ ＆H10000)



　　If Not (m_picThis Is Nothing) Then



　　Draw



　　End If



　　End If



　　End Property



　　Public Sub Draw() ‘畫背景顏色



　　Dim lHeight As Long, lWidth As Long



　　Dim lYStep As Long



　　Dim lY As Long



　　Dim bRGB(1 To 3) As Integer



　　Dim tLF As LOGFONT



　　Dim hFnt As Long



　　Dim hFntOld As Long



　　Dim lR As Long



　　Dim rct As RECT



　　Dim hBr As Long



　　Dim hDC As Long



　　Dim dR(1 To 3) As Double



　　On Error GoTo DrawError



　　hDC = m_picThis.hDC



　　lHeight = m_picThis.Height \ Screen.TwipsPerPixelY



　　rct.Right = m_picThis.Width \ Screen.TwipsPerPixelY



　　lYStep = lHeight \ 255



　　If (lYStep = 0) Then



　　lYStep = 1



　　End If



　　rct.Bottom = lHeight



　　bRGB(1) = m_bRGBStart(1)



　　bRGB(2) = m_bRGBStart(2)



　　bRGB(3) = m_bRGBStart(3)



　　dR(1) = m_bRGBEnd(1) － m_bRGBStart(1)



　　dR(2) = m_bRGBEnd(2) － m_bRGBStart(2)



　　dR(3) = m_bRGBEnd(3) － m_bRGBStart(3)



　　For lY = lHeight To 0 Step －lYStep



　　rct.tOp = rct.Bottom － lYStep



　　hBr = CreateSolidBrush((bRGB(3) ＊ ＆H10000 ＋ bRGB(2) ＊ ＆H100＆ ＋ bRGB(1)))



　　FillRect hDC, rct, hBr



　　DeleteObject hBr



　　rct.Bottom = rct.tOp



　　bRGB(1) = m_bRGBStart(1) ＋ dR(1) ＊ (lHeight － lY) / lHeight



　　bRGB(2) = m_bRGBStart(2) ＋ dR(2) ＊ (lHeight － lY) / lHeight



　　bRGB(3) = m_bRGBStart(3) ＋ dR(3) ＊ (lHeight － lY) / lHeight



　　Next lY



　　pOLEFontToLogFont m_picThis.Font, hDC, tLF



　　tLF.lfEscapement = 900



　　hFnt = CreateFontIndirect(tLF)



　　If (hFnt <> 0) Then



　　hFntOld = SelectObject(hDC, hFnt)



　　lR = TextOut(hDC, 0, lHeight － 16, m_sCaption, Len(m_sCaption))



　　SelectObject hDC, hFntOld



　　DeleteObject hFnt



　　End If



　　m_picThis.Refresh



　　Exit Sub



　　DrawError:



　　Debug.Print ″Problem: ″ ＆ Err.Description



　　End Sub



　　Private Sub pOLEFontToLogFont(fntThis As StdFont, hDC As Long, tLF As LOGFONT) ‘文字字體



　　Dim sFont As String



　　Dim iChar As Integer



　　With tLF



　　sFont = fntThis.Name



　　For iChar = 1 To Len(sFont)



　　.lfFaceName(iChar － 1) =CByte(Asc(Mid＄(sFont, iChar, 1)))



　　Next iChar



　　.lfHeight = －MulDiv((fntThis.Size), (GetDeviceCaps(hDC, LOGPIXELSY)), 72)



　　.lfItalic = fntThis.Italic



　　If (fntThis.Bold) Then



　　.lfWeight = FW_BOLD



　　Else



　　.lfWeight = FW_NORMAL



　　End If



　　.lfUnderline = fntThis.Underline



　　.lfStrikeOut = fntThis.Strikethrough



　　End With



　　End Sub



　　Private Sub Class_Initialize()



　　StartColor = ＆H0



　　EndColor = vbButtonFace



　　End Sub ‘模塊定義結束



　　調試、運行。