用VB6建立带光栅的超级开始菜单
unction 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
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