styler~1.ctl

近期下载过的用户: yueshan1020 孙江波 王洪贵 成长 林健 张见 chenhaocheng 胡云龙 yms sdfsd zhong 陈晨 lee 戴友情 [查看上载者韩悦的更多信息]

VERSION 5.00
Begin VB.UserControl StylerButton 
   ClientHeight    =   1470
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   2295
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   KeyPreview      =   -1  'True
   ScaleHeight     =   98
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   153
   ToolboxBitmap   =   "STYLER~1.ctx":0000
   Begin VB.PictureBox imgDis 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H00000000&
      BorderStyle     =   0  'None
      CausesValidation=   0   'False
      ClipControls    =   0   'False
      Enabled         =   0   'False
      ForeColor       =   &H80000008&
      Height          =   15
      Left            =   960
      ScaleHeight     =   1
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   1
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   0
      Visible         =   0   'False
      Width           =   15
   End
   Begin VB.PictureBox imgIcon 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      CausesValidation=   0   'False
      ClipControls    =   0   'False
      Enabled         =   0   'False
      ForeColor       =   &H80000008&
      Height          =   15
      Left            =   120
      ScaleHeight     =   1
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   1
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   120
      Visible         =   0   'False
      Width           =   15
   End
   Begin VB.Timer tmrCheck 
      Enabled         =   0   'False
      Interval        =   50
      Left            =   855
      Top             =   480
   End
End
Attribute VB_Name = "StylerButton"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "PropPageWizardRun" ,"Yes"
'****************************************************************************
'人人为我，我为人人
'枕善居汉化收藏整理
'发布日期：2007/09/19
'描    述：多风格时尚按钮控件2007(最新版）
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************

Option Explicit


'EVENTS.
Public Event Click()
Public Event DoubleClick()
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Public Event KeyPress(KeyAscii As Integer)
Public Event KeyUp(KeyCode As Integer, Shift As Integer)
Public Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event MouseEnters(ByVal X As Long, ByVal Y As Long)
Public Event MouseLeaves(ByVal X As Long, ByVal Y As Long)

'===========================================
'===========================================
'===========================================

'CAPTION.
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 'Enabled?

'===========================================
'===========================================
'===========================================

'FOCUS 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 Long
End Type

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Private Type TRIVERTEX
   X As Long
   Y As Long
   Red As Integer
   Green As Integer
   Blue As Integer
   Alpha As Integer
End Type

Private Type GRADIENT_RECT
    UpperLeft As Long
    LowerRight As Long
End Type

Private 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 Long
End Type

Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type

Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBQUAD
End Type

Private Type cRGB
    Blue As Byte
    Green As Byte
    Red As Byte
End Type

'===========================================
'===========================================
'===========================================

'PUBLIC/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] = 9
End Enum

Public Enum CaptionTextEffects
    [Normal] = 1
    [Embossed] = 2
    [Engraved] = 3
    [OutLine] = 4
    [Shadow] = 5
End Enum

Public Enum COLOR_STYLE
    [Media Player 11] = 1
    [Office 2007 1] = 2
    [Vista 1] = 3
End Enum

Public Enum PICTURE_ALIGN
    [Left Justify] = 1
    [Right Justify] = 2
End Enum

Private Enum GRADIENT_DIRECT
    [Left to Right] = &H0
    [Top to Bottom] = &H1
End Enum

'===========================================
'===========================================
'===========================================

'FUNCTION DECLARE.
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function RoundRect Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function TransparentBlt Lib "msimg32" (ByVal hDCDest As Long, ByVal nXOriginDest As Long, ByVal nYOriginDest As Long, ByVal nWidthDest As Long, ByVal nHeightDest As Long, ByVal hDCSrc As Long, ByVal nXOriginSrc As Long, ByVal nYOriginSrc As Long, ByVal nWidthSrc As Long, ByVal nHeightSrc As Long, ByVal crTransparent As Long) As Long
Private Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function GradientFillRect Lib "msimg32" Alias "GradientFill" (ByVal hDC As Long, pVertex As TRIVERTEX, ByVal dwNumVertex As Long, pMesh As GRADIENT_RECT, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

'===========================================
'===========================================
'===========================================

'PRIVATE CONSTANT.
Private udtRect As RECT
Private Const SRCAND = &H8800C6  ' (DWORD) dest = source AND dest
Private Const SRCPAINT = &HEE0086        ' (DWORD) dest = source OR dest
Private Const BI_RGB = 0&
Private Const DIB_RGB_COLORS = 0



'Draw the icon on to the button.
Private Sub DrawIcon()
On Error Resume Next

Dim lonHeight As Long, lonLeft As Long

If bolEnabled = True Then
    If imgIcon.Picture.Handle <> 0 Then
    
        lonHeight = (UserControl.ScaleHeight / 2) - (imgIcon.ScaleHeight / 2)
        
        If udtIconAlign = [Left Justify] Then

            TransparentBlt UserControl.hDC, 5, lonHeight, imgIcon.ScaleWidth, imgIcon.ScaleHeight, imgIcon.hDC, 0, 0, imgIcon.ScaleWidth, imgIcon.ScaleHeight, IcoTransparent
            
        ElseIf udtIconAlign = [Right Justify] Then
            lonLeft = (UserControl.ScaleWidth - imgIcon.ScaleWidth) - 5
            TransparentBlt UserControl.hDC, lonLeft, lonHeight, imgIcon.ScaleWidth, imgIcon.ScaleHeight, imgIcon.hDC, 0, 0, imgIcon.ScaleWidth, imgIcon.ScaleHeight, IcoTransparent
        
        End If
    
    End If

Else
    
    If imgIcon.Picture.Handle <> 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.ScaleWidth, imgDis.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.ScaleWidth, imgDis.ScaleHeight, imgDis.hDC, 0, 0, imgDis.ScaleWidth, imgDis.ScaleHeight, IcoTransparent
        
        End If
    
    End If

End If
End Sub

'Print aligned text to the button (caption).
Private Sub PrintText(ByVal TextString As String, ByVal Alignment As CaptionAlignmentS)
Dim lonStartWidth As Long, lonStartHeight As Long

If Alignment = 1 Then
    lonStartWidth = 1 + CByte(COX)
    lonStartHeight = 0 + CByte(COY)
ElseIf Alignment = 2 Then
    lonStartWidth = 1 + CByte(COX)
    lonStartHeight = (UserControl.ScaleHeight / 2) - (UserControl.TextHeight(TextString) / 2) - 1 + CByte(COY)
ElseIf Alignment = 3 Then
    lonStartWidth = 1 + CByte(COX)
    lonStartHeight = (UserControl.ScaleHeight - UserControl.TextHeight(TextString)) - 1 + CByte(COY)


ElseIf Alignment = 4 Then
    lonStartWidth = (UserControl.ScaleWidth / 2) - (UserControl.TextWidth(TextString) / 2) - 1 + CByte(COX)
    lonStartHeight = 0 + CByte(COY)
ElseIf Alignment = 5 Then
    lonStartWidth = (UserControl.ScaleWidth / 2) - (UserControl.TextWidth(TextString) / 2) - 1 + CByte(COX)
    lonStartHeight = (UserControl.ScaleHeight / 2) - (UserControl.TextHeight(TextString) / 2) - 1 + CByte(COY)
ElseIf Alignment = 6 Then
    lonStartWidth = (UserControl.ScaleWidth / 2) - (UserControl.TextWidth(TextString) / 2) - 1 + CByte(COX)
    lonStartHeight = (UserControl.ScaleHeight - UserControl.TextHeight(TextString)) - 1 + CByte(COY)


ElseIf Alignment = 7 Then
    lonStartWidth = (UserControl.ScaleWidth - UserControl.TextWidth(TextString)) - 3 + CByte(COX)
    lonStartHeight = 0 + CByte(COY)
ElseIf Alignment = 8 Then
    lonStartWidth = (UserControl.ScaleWidth - UserControl.TextWidth(TextString)) - 3 + CByte(COX)
    lonStartHeight = (UserControl.ScaleHeight / 2) - (UserControl.TextHeight(TextString) / 2) - 1 + CByte(COY)
ElseIf Alignment = 9 Then
    lonStartWidth = (UserControl.ScaleWidth - UserControl.TextWidth(TextString)) - 3 + CByte(COX)
    lonStartHeight = (UserControl.ScaleHeight - UserControl.TextHeight(TextString)) - 1 + CByte(COY)
End If


If bolEnabled = False Then
    UserControl.CurrentX = lonStartWidth