有谁做过开始菜单的那种界面功能吗?
怎样让Form显示那种样式,无标题栏但有窗体?
还有到底怎么做才好,该用什么控件效果好点

解决方案 »

  1.   

    有个activebar控件,你试试能达到你的那种效果吗,你到搜一下 ,装下就可以了
      

  2.   

    Fanks(铁面人) 回答正确 ControlBox = False隐藏标题栏
    至于里面的菜单项可以用图片框或者其他基本空间做,变通一下就可以啦
      

  3.   

    '1)添加一个form 窗体,加入以下代码:
    Dim cL As New cLogo
    Private Sub Form_Load()
        cL.DrawingObject = picLogo
        cL.Caption = "Steve McMahon"
    End SubPrivate Sub Form_Resize()
        On Error Resume Next
        picLogo.Height = Me.ScaleHeight
        On Error GoTo 0
        cL.Draw
    End Sub
    '2)添加一个类,命名为cLogo . 然后添加以下代码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    '  Logical pixels/inch in X
    Private Const LOGPIXELSY = 90    '  Logical pixels/inch in Y
    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 = -1Private 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_COLORPublic Property Let Caption(ByVal sCaption As String)
        m_sCaption = sCaption
    End Property
    Public Property Get Caption() As String
        Caption = m_sCaption
    End PropertyPublic 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
        ' Set a graduation of 255 pixels:
        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
            ' Draw bar:
            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
            ' Adjust colour:
            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
            'Debug.Print bRGB(1), (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    ' Convert an OLE StdFont to a LOGFONT structure:
        With tLF
            sFont = fntThis.Name
            ' There is a quicker way involving StrConv and CopyMemory, but
            ' this is simpler!:
            For iChar = 1 To Len(sFont)
                .lfFaceName(iChar - 1) = CByte(Asc(Mid$(sFont, iChar, 1)))
            Next iChar
            ' Based on the Win32SDK documentation:
            .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 SubPrivate Sub Class_Initialize()
        StartColor = &H0
        EndColor = vbButtonFace
    End Sub
      

  4.   

    啊,差点忘了
    界面上再添加一个PictureBox 控件命名为 picLogo
    picLogo 的长度和开始菜单中的竖条一般宽就可以.
    运行看看.