xpb.ctl

VB实现的注册码发生器

VERSION 5.00
Begin VB.UserControl XpBs 
   ClientHeight    =   1665
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4290
   DefaultCancel   =   -1  'True
   EditAtDesignTime=   -1  'True
   MousePointer    =   99  'Custom
   ScaleHeight     =   111
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   286
   Tag             =   "030102-15"
   Begin VB.Timer OverTimer 
      Enabled         =   0   'False
      Interval        =   10
      Left            =   1080
      Top             =   0
   End
   Begin VB.Image imgHAND 
      Height          =   480
      Left            =   1800
      Top             =   0
      Visible         =   0   'False
      Width           =   480
   End
End
Attribute VB_Name = "XpBs"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "PropPageWizardRun" ,"Yes"
Option Explicit
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type POINTAPI
        x As Long
        y As Long
End Type

Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function SetPixel Lib "gdi32" Alias "SetPixelV" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Private AreaOriginal As Long
Dim Gen As Long
Dim Yuk As Long


Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor 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 SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) 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 Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Private Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetTextColor Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectPalette Lib "gdi32" (ByVal hdc As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long
Private Declare Function RealizePalette Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DrawState Lib "user32" Alias "DrawStateA" (ByVal hdc As Long, ByVal hBrush As Long, ByVal lpDrawStateProc As Long, ByVal lParam As Long, ByVal wParam As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal n3 As Long, ByVal n4 As Long, ByVal un As Long) As Long
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long



Private Type RGB
    Red As Double
    Green As Double
    blue As Double
End Type


Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function DrawTextEx Lib "user32" Alias "DrawTextExA" (ByVal hdc As Long, ByVal lpsz As String, ByVal n As Long, lpRect As RECT, ByVal un As Long, lpDrawTextParams As textparametreleri) As Long
Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
Private Declare Function ShellExecute _
   Lib "shell32.dll" Alias "ShellExecuteA" _
   (ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long


Private Type textparametreleri
    cbSize As Long
    iTabLength As Long
    iLeftMargin As Long
    iRightMargin As Long
    uiLengthDrawn As Long
End Type

Public Enum XBPicturePosition
    gbTOP = 0
    gbLEFT = 1
    gbRIGHT = 2
    gbBOTTOM = 3
End Enum

Public Enum XBButtonStyle
    gbStandard = 0
    gbFlat = 1
    gbOfficeXP = 2
    gbWinXP = 3
    gbNoBorder = 4
End Enum

Public Enum XBPictureSize
    size16x16 = 0
    size32x32 = 1
    sizeDefault = 2
    sizeCustom = 3
End Enum

Private mvarClientRect As RECT
Private mvarPictureRect As RECT
Private mvarCaptionRect As RECT
Dim mvarOrgRect As RECT
Dim g_FocusRect As RECT
Dim alan As RECT

Dim m_OriginalPicSizeW  As Long
Dim m_OriginalPicSizeH  As Long


Dim m_PictureOriginal As Picture
Dim m_PictureHover As Picture
Dim m_Caption As String
Dim m_PicturePosition As XBPicturePosition
Dim m_ButtonStyle As XBButtonStyle
Dim m_Picture As Picture
Dim m_PictureWidth As Long
Dim m_PictureHeight As Long
Dim m_PictureSize As XBPictureSize
Dim mvarDrawTextParams As textparametreleri
Dim g_HasFocus As Byte
Dim g_MouseDown As Byte, g_MouseIn As Byte
Dim g_Button As Integer, g_Shift As Integer, g_X As Single, g_Y As Single
Dim g_KeyPressed As Byte
Dim m_URL As String
Dim m_ShowFocusRect As Boolean


Dim WithEvents g_Font As StdFont
Attribute g_Font.VB_VarHelpID = -1

Const mvarPadding As Byte = 4

Event Click()
Event KeyDown(KeyCode As Integer, Shift As Integer)
Event KeyPress(KeyAscii As Integer)
Event KeyUp(KeyCode As Integer, Shift As Integer)
Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Event MouseIn(Shift As Integer)
Event MouseOut(Shift As Integer)

Dim m_BEVEL As Integer
Dim m_BEVELDEPTH As Integer
Dim m_TransparentBG As Boolean
Dim m_MaskColor As OLE_COLOR
Dim m_XPShowBorderAlways As Boolean
Dim m_DefCurHand As Boolean
Dim m_SoundOver As String
Dim m_SoundClick As String
Dim m_ForeColor As OLE_COLOR
Dim m_BackColor As OLE_COLOR
Dim m_XPDefaultColors As Boolean
Dim m_XPColor_Pressed As OLE_COLOR
Dim m_XPColor_Hover As OLE_COLOR

Private Sub UserControl_InitProperties()
    m_BackColor = &H8000000F
    m_ForeColor = &H80000012
    m_ShowFocusRect = 1
    Set UserControl.Font = Ambient.Font
    Set g_Font = Ambient.Font
    m_Caption = Ambient.DisplayName
    m_PicturePosition = 1
    m_ButtonStyle = 2
    m_PictureWidth = 32
    m_PictureHeight = 32
    m_PictureSize = 1
    Set m_PictureHover = LoadPicture("")
    Set m_PictureOriginal = LoadPicture("")
    m_URL = ""
    m_XPColor_Pressed = &H80000014
    m_XPColor_Hover = &H80000016
    m_XPDefaultColors = 1
    
    m_SoundOver = ".\resources\over.wav"
    m_SoundClick = ".\resources\click.wav"
    m_DefCurHand = 0
    m_XPShowBorderAlways = 0
    m_MaskColor = 0
    m_TransparentBG = 0
    m_BEVEL = 1
    m_BEVELDEPTH = 8
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    m_BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
    UserControl.BackColor = m_BackColor
    m_ForeColor = PropBag.ReadProperty("ForeColor", &H80000012)
    UserControl.ForeColor = m_ForeColor
    
    m_ShowFocusRect = PropBag.ReadProperty("ShowFocusRect", 1)
    m_Caption = PropBag.ReadProperty("Caption", Ambient.DisplayName)
    m_PicturePosition = PropBag.ReadProperty("PicturePosition", 1)
    m_ButtonStyle = PropBag.ReadProperty("ButtonStyle", 2)
    Set m_Picture = PropBag.ReadProperty("Picture", Nothing)
    m_PictureWidth = PropBag.ReadProperty("PictureWidth", 32)
    m_PictureHeight = PropBag.ReadProperty("PictureHeight", 32)
    m_PictureSize = PropBag.ReadProperty("PictureSize", 1)
    m_OriginalPicSizeW = PropBag.ReadProperty("OriginalPicSizeW", 32)
    m_OriginalPicSizeH = PropBag.ReadProperty("OriginalPicSizeH", 32)
    Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font)
    Set g_Font = PropBag.ReadProperty("Font", Ambient.Font)
    Set m_PictureHover = PropBag.ReadProperty("PictureHover", Nothing)
    Set m_PictureOriginal = PropBag.ReadProperty("Picture", Nothing)
    Set MouseIcon = PropBag.ReadProperty("MouseIcon", Nothing)
    UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
    UserControl.MousePointer = PropBag.ReadProperty("MousePointer", 0)

    m_URL = PropBag.ReadProperty("URL", "")
    m_XPColor_Pressed = PropBag.ReadProperty("XPColor_Pressed", &H80000014)
    m_XPColor_Hover = PropBag.ReadProperty("XPColor_Hover", &H80000016)
    m_XPDefaultColors = PropBag.ReadProperty("XPDefaultColors", 1)
    
    m_SoundOver = PropBag.ReadProperty("SoundOver", ".\resources\over.wav")
    m_SoundClick = PropBag.ReadProperty("SoundClick", ".\resources\click.wav")
    m_DefCurHand = PropBag.ReadProperty("DefCurHand", 0)
    m_XPShowBorderAlways = PropBag.ReadProperty("XPShowBorderAlways", 0)
    m_MaskColor = PropBag.ReadProperty("MaskColor", 0)
    m_TransparentBG = PropBag.ReadProperty("TransparentBG", 0)
    m_BEVEL = PropBag.ReadProperty("BEVEL", 1)
    m_BEVELDEPTH = PropBag.ReadProperty("BEVELDEPTH", 8)
    SetAccessKeys
    
UserControl_Resize
End Sub

Private Sub UserControl_Terminate()
    DeleteObject AreaOriginal
    Set g_Font = Nothing
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Caption", m_Caption, Ambient.DisplayName)
    Call PropBag.WriteProperty("PicturePosition", m_PicturePosition, 1)
    Call PropBag.WriteProperty("ButtonStyle", m_ButtonStyle, 2)
    Call PropBag.WriteProperty("Picture", m_Picture, Nothing)
    Call PropBag.WriteProperty("PictureWidth", m_PictureWidth, 32)
    Call PropBag.WriteProperty("PictureHeight", m_PictureHeight, 32)
    Call PropBag.WriteProperty("PictureSize", m_PictureSize, 1)
    Call PropBag.WriteProperty("OriginalPicSizeW", m_OriginalPicSizeW, 32)
    Call PropBag.WriteProperty("OriginalPicSizeH", m_OriginalPicSizeH, 32)
    
    Call PropBag.WriteProperty("PictureHover", m_PictureHover, Nothing)
    
    Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
    Call PropBag.WriteProperty("Font", UserControl.Font, Ambient.Font)
    Call PropBag.WriteProperty("MouseIcon", MouseIcon, Nothing)
    Call PropBag.WriteProperty("MousePointer", UserControl.MousePointer, 0)
    Call PropBag.WriteProperty("ShowFocusRect", m_ShowFocusRect, 1)
 
    Call PropBag.WriteProperty("URL", m_URL, "")
    Call PropBag.WriteProperty("XPColor_Pressed", m_XPColor_Pressed, &H80000014)
    Call PropBag.WriteProperty("XPColor_Hover", m_XPColor_Hover, &H80000016)
    Call PropBag.WriteProperty("XPDefaultColors", m_XPDefaultColors, 1)
    Call PropBag.WriteProperty("BackColor", m_BackColor, &H8000000F)
    Call PropBag.WriteProperty("ForeColor", m_ForeColor, &H80000012)
    
    Call PropBag.WriteProperty("SoundOver", m_SoundOver, ".\resources\over.wav")
    Call PropBag.WriteProperty("SoundClick", m_SoundClick, ".\resources\click.wav")
    Call PropBag.WriteProperty("DefCurHand", m_DefCurHand, 0)
    Call PropBag.WriteProperty("XPShowBorderAlways", m_XPShowBorderAlways, 0)
    Call PropBag.WriteProperty("MaskColor", m_MaskColor, 0)
    Call PropBag.WriteProperty("TransparentBG", m_TransparentBG, 0)
    Call PropBag.WriteProperty("BEVEL", m_BEVEL, 1)
    Call PropBag.WriteProperty("BEVELDEPTH", m_BEVELDEPTH, 8)
 End Sub
Private Sub CalcRECTs()
    Dim picWidth, picHeight, capWidth, capHeight As Long
    With alan
        .Left = 0
        .Top = 0
        .Right = ScaleWidth - 1
        .Bottom = ScaleHeight - 1
    End With
    
    With mvarClientRect
     .Left = alan.Left + mvarPadding
     .Top = alan.Top + mvarPadding
     .Right = alan.Right - mvarPadding + 1
     .Bottom = alan.Bottom - mvarPadding + 1
    End With
    
    If m_Picture Is Nothing Then
        With mvarCaptionRect
           .Left = mvarClientRect.Left
           .Top = mvarClientRect.Top
           .Right = mvarClientRect.Right
           .Bottom = mvarClientRect.Bottom
        End With
        CalculateCaptionRect
    Else
        If m_Caption = "" Then
         With mvarPictureRect
            .Left = (((mvarClientRect.Right - mvarClientRect.Left) - m_PictureWidth) \ 2) + mvarClientRect.Left
            .Top = (((mvarClientRect.Bottom - mvarClientRect.Top) - m_PictureHeight) \ 2) + mvarClientRect.Top
            .Right = mvarPictureRect.Left + m_PictureWidth
            .Bottom = mvarPictureRect.Top + m_PictureHeight
         End With
            Exit Sub
        End If
        
        With mvarCaptionRect
        .Left = mvarClientRect.Left
        .Top = mvarClientRect.Top
        .Right = mvarClientRect.Right
        .Bottom = mvarClientRect.Bottom
        End With
        CalculateCaptionRect
        
        picWidth = m_PictureWidth
        picHeight = m_PictureHeight
        capWidth = mvarCaptionRect.Right - mvarCaptionRect.Left
        capHeight = mvarCaptionRect.Bottom - mvarCaptionRect.Top
        
        
        If m_PicturePosition = gbLEFT Then
            With mvarPictureRect
                .Top = (((mvarClientRect.Bottom - mvarClientRect.Top) - picHeight) \ 2) + mvarClientRect.Top
                .Left = (((mvarClientRect.Right - mvarClientRect.Left) - (picWidth + mvarPadding + capWidth)) \ 2) + mvarClientRect.Left
                .Bottom = mvarPictureRect.Top + picHeight
                .Right = mvarPictureRect.Left + picWidth
            End With
            With mvarCaptionRect
                .Top = (((mvarClientRect.Bottom - mvarClientRect.Top) - capHeight) \ 2) + mvarClientRect.Top
                .Left = mvarPictureRect.Right + mvarPadding
                .Bottom = mvarCaptionRect.Top + capHeight
                .Right = mvarCaptionRect.Left + capWidth
            End With
        
        ElseIf m_PicturePosition = gbRIGHT Then
            With mvarCaptionRect
                .Top = (((mvarClientRect.Bottom - mvarClientRect.Top) - capHeight) \ 2) + mvarClientRect.Top
                .Left = (((mvarClientRect.Right - mvarClientRect.Left) - (picWidth + mvarPadding + capWidth)) \ 2) + mvarClientRect.Left
                .Bottom = mvarCaptionRect.Top + capHeight
                .Right = mvarCaptionRect.Left + capWidth
            End With
            With mvarPictureRect
                .Top = (((mvarClientRect.Bottom - mvarClientRect.Top) - picHeight) \ 2) + mvarClientRect.Top
                .Left = mvarCaptionRect.Right + mvarPadding
                .Bottom = mvarPictureRect.Top + picHeight
                .Right = mvarPictureRect.Left + picWidth
            End With
        ElseIf m_PicturePosition = gbTOP Then
            With mvarPictureRect
                .Top = (((mvarClientRect.Bottom - mvarClientRect.Top) - (picHeight + mvarPadding + capHeight)) \ 2) + mvarClientRect.Top
                .Left = (((mvarClientRect.Right - mvarClientRect.Left) - picWidth) \ 2) + mvarClientRect.Left
                .Bottom = mvarPictureRect.Top + picHeight
                .Right = mvarPictureRect.Left + picWidth
            End With
            With mvarCaptionRect
                .Top = mvarPictureRect.Bottom + mvarPadding
                .Left = (((mvarClientRect.Right - mvarClientRect.Left) - capWidth) \ 2) + mvarClientRect.Left
                .Bottom = mvarCaptionRect.Top + capHeight
                .Right = mvarCaptionRect.Left + capWidth
            End With
        ElseIf m_PicturePosition = gbBOTTOM Then
            With mvarCaptionRect
                .Top = (((mvarClientRect.Bottom - mvarClientRect.Top) - (picHeight + mvarPadding + capHeight)) \ 2) + mvarClientRect.Top
                .Left = (((mvarClientRect.Right - mvarClientRect.Left) - capWidth) \ 2) + mvarClientRect.Left
                .Bottom = mvarCaptionRect.Top + capHeight
                .Right = mvarCaptionRect.Left + capWidth
            End With
            With mvarPictureRect
                .Top = mvarCaptionRect.Bottom + mvarPadding
                .Left = (((mvarClientRect.Right - mvarClientRect.Left) - picWidth) \ 2) + mvarClientRect.Left
                .Bottom = mvarPictureRect.Top + picHeight
                .Right = mvarPictureRect.Left + picWidth