【VB开源代码栏目提醒】:本文主要为网学会员提供“VB_按钮控件源代码 - 其它资料”,希望对需要VB_按钮控件源代码 - 其它资料网友有所帮助,学习一下!
VB 按钮控件源
代码Option ExplicitEVENTS.事件Public Event ClickPublic Event DoubleClickPublic Event KeyDownKeyCode As Integer Shift As IntegerPublic Event KeyPressKeyAscii As IntegerPublic Event KeyUpKeyCode As Integer Shift As IntegerPublic Event MouseDownButton As Integer Shift As Integer X As Single Y As SinglePublic Event MouseMoveButton As Integer Shift As Integer X As Single Y As SinglePublic Event MouseUpButton As Integer Shift As Integer X As Single Y As SinglePublic Event MouseEntersByVal X As Long ByVal Y As LongPublic Event MouseLeavesByVal X As Long ByVal Y As LongCAPTION.标题Private strCaption As String Caption text.字幕文本Private CapDis As OLE_COLOR Caption Disabled colour.标题缺陷颜色Private oleForeColor As OLE_COLOR Caption text color.字幕文本颜色Private udtCaptionAlign As CaptionAlignmentS Caption Alignment.标题排列Private fntFont As Font Caption font.标题字体Private CEC As OLE_COLOR Caption Effect Colour.标题效果颜色Private CTE As CaptionTextEffects Caption Effect.标题效果Private COX As Integer Caption Offset X.Private COY As Integer Caption Offset Y.Private SOX As Integer Caption Shadow Offset X.Private SOY As Integer Caption Shadow Offset Y.ICON.图标Private IcoDis As OLE_COLOR Icon Disabled colour.图标缺陷颜色Private udtIconAlign As PICTURE_ALIGN Icon Alignment.图标对齐Private IcoTransparent As OLE_COLOR Icon Transparent Colour.”图标透明的颜色。
Private picIcon As Picture Small icon picture.小图标图片THEMES.主题Private udtColorStyle As COLOR_STYLE Color style of button.颜色风格的按钮。
MOUSE DIRECTION.鼠标方位Private udtPoint As POINTAPI Current mouse position for checking if mouse is over button.当前的鼠标位置进行检查如果鼠标在按钮。
CHECK PROPERTY.检查所有权Private bolMouseDown As Boolean Mouse currently down 鼠标按下了吗Private bolMouseOver As Boolean Mouse currently over button鼠标在按钮上马Private bolHasFocus As Boolean Currently has focus获得焦点吗Private bolEnabled As Boolean EnabledFOCUS DOT RECT.焦点点矩形Private bolFocusDottedRect As Boolean Draw focus dotted rect虚线画焦点矩形吗ROUNDED CORNER.圆形的角落Private lonRoundValue As Long Rounded corners value.圆角值PRIVATE/PUBLIC TYPES.私人和公共类型Private Type POINTAPI X As Long Y As LongEnd TypePrivate Type RECT Left As Long Top As Long Right As Long Bottom As LongEnd TypePrivate Type TRIVERTEX X As Long Y As Long Red As Integer Green As Integer Blue As Integer Alpha As IntegerEnd TypePrivate Type GRADIENT_RECT UpperLeft As Long LowerRight As LongEnd TypePrivate Type BITMAPINFOHEADER biSize As Long biWidth As Long biHeight As Long biPlanes As Integer biBitCount As Integer biCompression As Long biSizeImage As Long biXPelsPerMeter As Long biYPelsPerMeter As Long biClrUsed As Long biClrImportant As LongEnd TypePrivate Type RGBQUAD rgbBlue As Byte rgbGreen As Byte rgbRed As Byte rgbReserved As ByteEnd TypePrivate Type BITMAPINFO bmiHeader As BITMAPINFOHEADER bmiColors As RGBQUADEnd TypePrivate Type cRGB Blue As Byte Green As Byte Red As ByteEnd TypePUBLIC/PRIVATE ENUM.公/私枚举Public Enum CaptionAlignmentS Left Top 1 Left Middle 2 Left Bottom 3 Center Top 4 Center Middle 5 Center Bottom 6 Right Top 7 Right Middle 8 Right Bottom 9End EnumPublic Enum CaptionTextEffects Normal 1 Embossed 2 Engraved 3 OutLine 4 Shadow 5End EnumPublic Enum COLOR_STYLE Media Player 11 1 Office 2007 1 2 Vista 1 3End EnumPublic Enum PICTURE_ALIGN Left Justify 1 Right Justify 2End EnumPrivate Enum GRADIENT_DIRECT Left to Right ampH0 Top to Bottom ampH1End EnumFUNCTION DECLARE.函数声明Private Declare Function CreateRoundRectRgn Lib quotgdi32quot ByVal X1 As Long ByVal Y1 AsLong ByVal X2 As Long ByVal Y2 As Long ByVal X3 As Long ByVal Y3 As Long As LongPrivate Declare Function SetWindowRgn Lib quotuser32quot ByVal hWnd As Long ByVal hRgn AsLong ByVal bRedraw As Boolean As LongPrivate Declare Function GetCursorPos Lib quotuser32quot lpPoint As POINTAPI As LongPrivate Declare Function WindowFromPoint Lib quotuser32quot ByVal xPoint As Long ByVal yPointAs Long As LongPrivate Declare Function RoundRect Lib quotgdi32quot ByVal hDC As Long ByVal X1 As LongByVal Y1 As Long ByVal X2 As Long ByVal Y2 As Long ByVal X3 As Long ByVal Y3 AsLong As LongPrivate Declare Function BitBlt Lib quotgdi32quot ByVal hDestDC As Long ByVal X As Long ByValY As Long ByVal nWidth As Long ByVal nHeight As Long ByVal hSrcDC As Long ByValxSrc As Long ByVal ySrc As Long ByVal dwRop As Long As LongPrivate Declare Function TransparentBlt Lib quotmsimg32quot ByVal hDCDest As Long ByValnXOriginDest As Long ByVal nYOriginDest As Long ByVal nWidthDest As Long ByValnHeightDest As Long ByVal hDCSrc As Long ByVal nXOriginSrc As Long ByVal nYOriginSrcAs Long ByVal nWidthSrc As Long ByVal nHeightSrc As Long ByVal crTransparent As LongAs LongPrivate Declare Function SetDIBitsToDevice Lib quotgdi32quot ByVal hDC As Long ByVal X AsLong ByVal Y As Long ByVal dx As Long ByVal dy As Long ByVal SrcX As Long ByValSrcY As Long ByVal Scan As Long ByVal NumScans As Long Bits As Any BitsInfo AsBITMAPINFO ByVal wUsage As Long As LongPrivate Declare Sub CopyMemory Lib quotkernel32quot Alias quotRtlMoveMemoryquot pDst As Any pSrcAs Any ByVal ByteLen As LongPrivate Declare Function GradientFillRect Lib quotmsimg32quot Alias quotGradientFillquot ByVal hDC AsLong pVertex As TRIVERTEX ByVal dwNumVertex As Long pMesh As GRADIENT_RECTByVal dwNumMesh As Long ByVal dwMode As Long As LongPrivate Declare Function SetRect Lib quotuser32quot lpRect As RECT ByVal X1 As Long ByVal Y1As Long ByVal X2 As Long ByVal Y2 As Long As LongPRIVATE CONSTANT.私人不变。
Private udtRect As RECTPrivate Const SRCAND ampH8800C6 DWORD dest source AND destPrivate Const SRCPAINT ampHEE0086 DWORD dest source OR destPrivate Const BI_RGB 0ampPrivate Const DIB_RGB_COLORS 0Draw the icon on to the button.绘制图标按钮。
Private Sub DrawIconOn Error Resume NextDim lonHeight As Long lonLeft As LongIf bolEnabled True Then If imgIcon.Picture.Handle ltgt 0 Then lonHeight UserControl.ScaleHeight / 2 - imgIcon.ScaleHeight / 2 If udtIconAlign Left Justify Then TransparentBlt UserControl.hDC 5 lonHeight imgIcon.ScaleWidthimgIcon.ScaleHeight imgIcon.hDC 0 0 imgIcon.ScaleWidth imgIcon.ScaleHeightIcoTransparent ElseIf udtIconAlign Right Justify Then lonLeft UserControl.ScaleWidth - imgIcon.ScaleWidth - 5 TransparentBlt UserControl.hDC lonLeft lonHeight imgIcon.ScaleWidthimgIcon.ScaleHeight imgIcon.hDC 0 0 imgIcon.ScaleWidth imgIcon.ScaleHeightIcoTransparent End If End IfElse If imgIcon.Picture.Handle ltgt 0 Then lonHeight UserControl.ScaleHeight 0.5 - imgIcon.ScaleHeight 0.5 Set imgDis.Picture imgIcon.Picture CreatePictureMask imgDis IcoTransparent IcoDis If udtIconAlign Left Justify Then TransparentBlt UserControl.hDC 5 lonHeight imgDis.ScaleWidthimgDis.ScaleHeight imgDis.hDC 0 0 imgDis.ScaleWidth imgDis.ScaleHeight IcoTransparent ElseIf udtIconAlign Right Justify Then lonLeft UserControl.ScaleWidth - imgIcon.ScaleWidth - 5 TransparentBlt UserControl.hDC lonLeft lonHeight imgDis.ScaleWidthimgDis.ScaleHeight imgDis.hDC 0 0 imgDis.ScaleWidth imgDis.ScaleHeight IcoTransparent End If End IfEnd IfEnd SubPrint aligned text to the button caption.打印对齐文本内容的按钮标题Private Sub PrintTextByVal TextString As String ByVal Alignment As CaptionAlignmentSDim lonStartWidth As Long lonStartHeight As LongIf Alignment 1 Then lonStartWidth 1 CByteCOX lonStartHeight 0 CByteCOYElseIf Alignment 2 Then lonStartWidth 1 CByteCOX lonStartHeight UserControl.ScaleHeight / 2 - UserControl.TextHeightTextString / 2 -1 CByteCOYElseIf Alignment 3 Then lonStartWidth 1 CByteCOX lonStartHeight UserControl.ScaleHeight - UserControl.TextHeightTextString - 1 CByteCOYElseIf Alignment 4 Then lonStartWidth UserControl.ScaleWidth / 2 - UserControl.TextWidthTextString / 2 - 1 CByteCOX lonStartHeight 0 CByteCOYElseIf Alignment 5 Then lonStartWidth UserControl.ScaleWidth / 2 - UserControl.TextWidthTextString / 2 - 1 CByteCOX lonStartHeight UserControl.ScaleHeight / 2 - UserControl.TextHeightTextString / 2 -1 CByteCOYElseIf Alignment 6 Then lonStartWidth UserControl.ScaleWidth / 2 - UserControl.TextWidthTextString / 2 - 1 CByteCOX lonStartHeight UserControl.ScaleHeight - UserControl.TextHeightTextString - 1 CByteCOYElseIf Alignment 7 Then lonStartWidth UserControl.ScaleWidth - UserControl.TextWidthTextString - 3 CByteCOX lonStartHeight 0 CByteCOYElseIf Alignment 8 Then lonStartWidth UserControl.ScaleWidth - UserControl.TextWidthTextString - 3 CByteCOX lonStartHeight UserControl.ScaleHeight / 2 - UserControl.TextHeightTextString / 2 -1 CByteCOYElseIf Alignment 9 Then lonStartWidth UserControl.ScaleWidth - UserControl.TextWidthTextString - 3 CByteCOX lonStartHeight UserControl.ScaleHeight - UserControl.TextHeightTextString - 1 CByteCOYEnd IfIf bolEnabled False Then UserControl.CurrentX lonStartWidth UserControl.CurrentY lonStartHeight UserControl.Print TextStringElse If CTE Normal Then UserControl.CurrentX lonStartWidth UserControl.CurrentY lonStartHeight UserControl.Print TextString ElseIf CTE Engraved Then UserControl.ForeColor CEC UserControl.CurrentX lonStartWidth 1 UserControl.CurrentY lonStartHeight 1 UserControl.Print TextString UserControl.ForeColor RGB128 128 128 UserControl.CurrentX lonStartWidth - 1 UserControl.CurrentY lonStartHeight UserControl.Print TextString UserControl.ForeColor oleForeColor UserControl.CurrentX lonStartWidth UserControl.CurrentY lonStartHeight UserControl.Print TextStringElseIf CTE Embossed Then UserControl.ForeColor CEC UserControl.CurrentX lonStartWidth - 1 UserControl.CurrentY lonStartHeight - 1 UserControl.Print TextString UserControl.ForeColor RGB128 128 128 UserControl.CurrentX lonStartWidth 1 UserControl.CurrentY lonStartHeight 1 UserControl.Print TextString UserControl.ForeColor oleForeColor UserControl.CurrentX lonStartWidth UserControl.CurrentY lonStartHeight UserControl.Print TextStringElseIf CTE OutLine Then UserControl.ForeColor CEC UserControl.CurrentX lonStartWidth 1 UserControl.CurrentY lonStartHeight UserControl.Print TextString UserControl.CurrentX lonStartWidth - 1 UserControl.CurrentY lonStartHeight UserControl.Print TextString UserControl.CurrentY lonStartHeight - 1 UserControl.CurrentX lonStartWidth UserControl.Print TextString UserControl.CurrentY lonStartHeight 1 UserControl.CurrentX lonStartWidth UserControl.Print TextString UserControl.ForeColor oleForeColor UserControl.CurrentX lonStartWidth UserControl.CurrentY lonStartHeight UserControl.Print TextStringElseIf CTE Shadow Then UserControl.ForeColor CEC UserControl.CurrentX lonStartWidth CByteSOX UserControl.CurrentY lonStartHeight CByteSOY UserControl.Print TextString UserControl.ForeColor oleForeColor UserControl.CurrentX lonStartWidth UserControl.CurrentY lonStartHeight UserControl.Print TextString End IfEnd If UserControl.CurrentX lonStartWidth UserControl.CurrentY lonStartHeight UserControl.Print TextStringEnd SubDraw the dotted focus rect on the button.“把焦点矩形在按键上的点缀。
Private Sub DrawDottedFocusRectDim lonLoop As Long Draw the top focus dotted line.画上的焦点虚线对折。
For lonLoop 3 To UserControl.ScaleWidth - 5 Step 2 UserControl.PSet lonLoop 2 0Next lonLoop Draw the left focus dotted line.画出左侧虚线对折。
For lonLoop 4 To UserControl.ScaleHeight - 4 Step 2 UserControl.PSet 2 lonLoop 0Next lonLoop Draw the bottom focus dotted line.虚线画底部焦点。
For lonLoop 3 To UserControl.ScaleWidth - 5 Step 2 UserControl.PSet lonLoop ScaleHeight - 4 0Next lonLoop Draw the right focus dotted line.右边的焦点的画虚线。
For lonLoop 4 To UserControl.ScaleHeight - 4 Step 2 UserControl.PSet ScaleWidth - 4 lonLoop 0Next lonLoopEnd SubDraw the control.绘制控制Private Sub PaintControlOn Error Resume NextDim lonRect As LongDim strName As StringShape control.If lonRoundValue lt 0 Then lonRoundValue 1End IflonRect CreateRoundRectRgn0 0 ScaleWidth ScaleHeight lonRoundValue - 1lonRoundValue - 1SetWindowRgn UserControl.hWnd lonRect TruestrName fntFont.NameIf Err 0 Then Set UserControl.Font fntFontEnd IfCheck what style we should be using.检查什么风格我们应该使用。
If udtColorStyle Office 2007 1 Then If bolEnabled False Then UserControl.BackColor vbWhite DefineRect 3 3 ScaleWidth - 4 ScaleHeight / 2 - 1 DrawGradientTwoColour UserControl.hDC Top to Bottom RGB246 249 251RGB168 208 229 DefineRect 3 ScaleHeight / 2 - 1 ScaleWidth - 4 ScaleHeight - 4 DrawGradientTwoColour UserControl.hDC Top to Bottom RGB163 203 223RGB213 236 247 UserControl.ForeColor RGB161 189 207 RoundRect UserControl.hDC 0 0 ScaleWidth - 1 ScaleHeight - 1 lonRoundValuelonRoundValue UserControl.ForeColor RGB255 255 255 RoundRect UserControl.hDC 1 1 ScaleWidth - 2 ScaleHeight - 2 lonRoundValuelonRoundValue RoundRect UserControl.hDC 2 2 ScaleWidth - 3 ScaleHeight - 3 lonRoundValuelonRoundValue UserControl.PSet 3 ScaleHeight - 5 RGB255 255 255 UserCont.