xpb.ctl

VB实现的注册码发生器

End Property
Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
    BackColor = m_BackColor
End Property
Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    m_BackColor = New_BackColor
    PropertyChanged "BackColor"
    UserControl.BackColor = m_BackColor
    Refresh
End Property
Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in an object."
    ForeColor = m_ForeColor
End Property
Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
    m_ForeColor = New_ForeColor
    PropertyChanged "ForeColor"
    UserControl.ForeColor = m_ForeColor
    Refresh
End Property
Public Property Get SoundOver() As Variant
    SoundOver = m_SoundOver
End Property
Public Property Let SoundOver(ByVal New_SoundOver As Variant)
    m_SoundOver = New_SoundOver
    PropertyChanged "SoundOver"
End Property
Public Property Get SoundClick() As String
    SoundClick = m_SoundClick
End Property
Public Property Let SoundClick(ByVal New_SoundClick As String)
    m_SoundClick = New_SoundClick
    PropertyChanged "SoundClick"
End Property
Public Property Get version() As String
Attribute version.VB_Description = "FileVersion"
    version = UserControl.Tag
End Property
Public Property Let version(ByVal New_version As String)
End Property
Private Function PlayASound(SoundFile As String) As Byte
 
    PlayASound = PlaySound(SoundFile, 1, &H20000 _
    + &H0 + &H1 + &H2)
End Function
Public Property Get DefCurHand() As Boolean
    DefCurHand = m_DefCurHand
End Property

Public Property Let DefCurHand(ByVal New_DefCurHand As Boolean)
    m_DefCurHand = New_DefCurHand
    PropertyChanged "DefCurHand"
    
    If m_DefCurHand = True Then
        
        
    Else
        
    End If

End Property

Public Property Get XPShowBorderAlways() As Boolean
    XPShowBorderAlways = m_XPShowBorderAlways
End Property

Public Property Let XPShowBorderAlways(ByVal New_XPShowBorderAlways As Boolean)
    m_XPShowBorderAlways = New_XPShowBorderAlways
    PropertyChanged "XPShowBorderAlways"
End Property
Public Property Get MaskColor() As OLE_COLOR
Attribute MaskColor.VB_Description = "Returns/sets the color that specifies transparent areas in the MaskPicture."
    MaskColor = m_MaskColor
End Property

Public Property Let MaskColor(ByVal New_MaskColor As OLE_COLOR)
    m_MaskColor = New_MaskColor
    PropertyChanged "MaskColor"
    Refresh
End Property
Public Property Get TransparentBG() As Boolean
    TransparentBG = m_TransparentBG
End Property

Public Property Let TransparentBG(ByVal New_TransparentBG As Boolean)
    m_TransparentBG = New_TransparentBG
    PropertyChanged "TransparentBG"
    Refresh
End Property

Public Property Get BEVEL() As Integer
    BEVEL = m_BEVEL
End Property

Public Property Let BEVEL(ByVal New_BEVEL As Integer)
    m_BEVEL = New_BEVEL
    PropertyChanged "BEVEL"
    Refresh
End Property
Public Property Get BEVELDEPTH() As Integer
    BEVELDEPTH = m_BEVELDEPTH
End Property

Public Property Let BEVELDEPTH(ByVal New_BEVELDEPTH As Integer)
    m_BEVELDEPTH = New_BEVELDEPTH
    PropertyChanged "BEVELDEPTH"
    Refresh
End Property

Private Function COLOR_LongToRGB(UniColorValue As Long) As RGB
    Dim BlueS As Double, GreenS As Double, RGBs As String
    COLOR_LongToRGB.blue = Fix((UniColorValue / 256) / 256)
    BlueS = (COLOR_LongToRGB.blue * 256) * 256
    COLOR_LongToRGB.Green = Fix((UniColorValue - BlueS) / 256)
    GreenS = COLOR_LongToRGB.Green * 256
    COLOR_LongToRGB.Red = Fix(UniColorValue - BlueS - GreenS)

End Function
Private Function COLOR_UniColor(ColorVal As Long) As Long

    COLOR_UniColor = ColorVal
    If ColorVal > &HFFFFFF Or ColorVal < 0 Then COLOR_UniColor = GetSysColor(ColorVal And &HFFFFFF)
End Function
Private Function COLOR_DarkenLightenColor(ByVal Color As Long, ByVal Value As Long) As Long
    Dim R As Long, G As Long, B As Long
    B = ((Color \ &H10000) Mod &H100): B = B + ((B * Value) \ &HC0)
    G = ((Color \ &H100) Mod &H100) + Value
    R = (Color And &HFF) + Value
        If R < 0 Then R = 0
        If R > 255 Then R = 255
        If G < 0 Then G = 0
        If G > 255 Then G = 255
        If B < 0 Then B = 0
        If B > 255 Then B = 255
    COLOR_DarkenLightenColor = RGB(R, G, B)
End Function


Private Sub DrawLine(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal Color As Long)
    Dim pt As POINTAPI
    Call DeleteObject(SelectObject(hdc, CreatePen(0, 1, Color)))
    MoveToEx hdc, X1, Y1, pt
    LineTo hdc, X2, Y2
End Sub

Private Sub DRAWRECT(DestHDC As Long, ByVal RectLEFT As Long, _
            ByVal RectTOP As Long, _
            ByVal RectRIGHT As Long, ByVal RectBOTTOM As Long, _
            ByVal MyColor As Long, _
            Optional FillRectWithColor As Byte = 0)
    Dim MyRect As RECT, Firca As Long
    Firca = CreateSolidBrush(COLOR_UniColor(MyColor))
    With MyRect
        .Left = RectLEFT
        .Top = RectTOP
        .Right = RectRIGHT
        .Bottom = RectBOTTOM
    End With
    If FillRectWithColor = 1 Then FillRect DestHDC, MyRect, Firca Else FrameRect DestHDC, MyRect, Firca
    DeleteObject Firca
End Sub

Private Sub DrawWinXPButton(ByVal None_Press_Disabled As Byte, Optional HOVERING As Byte)
Dim x As Long, Intg As Single, curBackColor As Long, OuterBorderColor As Long
Dim KolorHover As Long, KolorPressed As Long
DRAWRECT hdc, 0, 0, Gen, Yuk, m_BackColor, 1
OuterBorderColor = &H80000015
If Enabled Then
    If m_XPDefaultColors = True Then
        KolorPressed = RGB(140, 170, 230)
        KolorHover = RGB(225, 153, 71)
    Else
        KolorPressed = m_XPColor_Pressed
        KolorHover = m_XPColor_Hover
    End If


    If None_Press_Disabled = 0 Then
             Intg = 25 / Yuk: curBackColor = COLOR_DarkenLightenColor(COLOR_UniColor(m_BackColor), 48)
             For x = 1 To Yuk
                 DrawLine 0, x, Gen, x, COLOR_DarkenLightenColor(curBackColor, -Intg * x)
             Next
           
             DRAWRECT hdc, 0, 0, Gen, Yuk, OuterBorderColor
             SetPixel hdc, 1, 1, OuterBorderColor
             SetPixel hdc, 1, Yuk - 2, OuterBorderColor
             SetPixel hdc, Gen - 2, 1, OuterBorderColor
             SetPixel hdc, Gen - 2, Yuk - 2, OuterBorderColor

             If g_HasFocus = 1 Then
                 DRAWRECT hdc, 1, 2, Gen - 1, Yuk - 2, KolorPressed
                 DrawLine 2, Yuk - 2, Gen - 2, Yuk - 2, COLOR_DarkenLightenColor(COLOR_UniColor(KolorPressed), -33)
                 DrawLine 2, 1, Gen - 2, 1, COLOR_DarkenLightenColor(COLOR_UniColor(KolorPressed), 65)
                 DrawLine 1, 2, Gen - 1, 2, COLOR_DarkenLightenColor(COLOR_UniColor(KolorPressed), 50)
                 DrawLine 2, 3, 2, Yuk - 3, COLOR_DarkenLightenColor(COLOR_UniColor(KolorPressed), 31)
                 DrawLine Gen - 3, 3, Gen - 3, Yuk - 3, COLOR_DarkenLightenColor(COLOR_UniColor(KolorPressed), 31)
             Else
                 DrawLine 2, Yuk - 2, Gen - 2, Yuk - 2, COLOR_DarkenLightenColor(curBackColor, -48)
                 DrawLine 1, Yuk - 3, Gen - 2, Yuk - 3, COLOR_DarkenLightenColor(curBackColor, -32)
                 DrawLine Gen - 2, 2, Gen - 2, Yuk - 2, COLOR_DarkenLightenColor(curBackColor, -36)
                 DrawLine Gen - 3, 3, Gen - 3, Yuk - 3, COLOR_DarkenLightenColor(curBackColor, -24)
                 DrawLine 2, 1, Gen - 2, 1, COLOR_DarkenLightenColor(curBackColor, 16)
                 DrawLine 1, 2, Gen - 2, 2, COLOR_DarkenLightenColor(curBackColor, 10)
                 DrawLine 1, 2, 1, Yuk - 2, COLOR_DarkenLightenColor(curBackColor, -5)
                 DrawLine 2, 3, 2, Yuk - 3, COLOR_DarkenLightenColor(curBackColor, -10)
             End If
             If HOVERING = 1 Then
                 DRAWRECT hdc, 1, 2, Gen - 1, Yuk - 2, KolorHover
                 DrawLine 2, Yuk - 2, Gen - 2, Yuk - 2, COLOR_DarkenLightenColor(KolorHover, -40)
                 DrawLine 2, 1, Gen - 2, 1, COLOR_DarkenLightenColor(KolorHover, 90)
                 DrawLine 1, 2, Gen - 1, 2, COLOR_DarkenLightenColor(KolorHover, 35)
                 DrawLine 2, 3, 2, Yuk - 3, COLOR_DarkenLightenColor(KolorHover, 20)
                 DrawLine Gen - 3, 3, Gen - 3, Yuk - 3, COLOR_DarkenLightenColor(KolorHover, 20)
             End If
    ElseIf None_Press_Disabled = 2 Then
            Intg = 15 / Yuk
            curBackColor = COLOR_DarkenLightenColor(COLOR_UniColor(m_BackColor), 48)
            curBackColor = COLOR_DarkenLightenColor(curBackColor, -32)
            For x = 1 To Yuk
                DrawLine 0, Yuk - x, Gen, Yuk - x, COLOR_DarkenLightenColor(curBackColor, -Intg * x)
            Next
            DRAWRECT hdc, 0, 0, Gen, Yuk, OuterBorderColor
            SetPixel hdc, 1, 1, OuterBorderColor
            SetPixel hdc, 1, Yuk - 2, OuterBorderColor
            SetPixel hdc, Gen - 2, 1, OuterBorderColor
            SetPixel hdc, Gen - 2, Yuk - 2, OuterBorderColor
            
            DrawLine 2, Yuk - 2, Gen - 2, Yuk - 2, COLOR_DarkenLightenColor(curBackColor, 16)
            DrawLine 1, Yuk - 3, Gen - 2, Yuk - 3, COLOR_DarkenLightenColor(curBackColor, 10)
            DrawLine Gen - 2, 2, Gen - 2, Yuk - 2, COLOR_DarkenLightenColor(curBackColor, 5)
            DrawLine Gen - 3, 3, Gen - 3, Yuk - 3, curBackColor
            DrawLine 2, 1, Gen - 2, 1, COLOR_DarkenLightenColor(curBackColor, -32)
            DrawLine 1, 2, Gen - 2, 2, COLOR_DarkenLightenColor(curBackColor, -24)
            DrawLine 1, 2, 1, Yuk - 2, COLOR_DarkenLightenColor(curBackColor, -32)
            DrawLine 2, 2, 2, Yuk - 2, COLOR_DarkenLightenColor(curBackColor, -22)
    End If
Else
        curBackColor = COLOR_DarkenLightenColor(COLOR_UniColor(m_BackColor), 48)
        DRAWRECT hdc, 0, 0, Gen, Yuk, COLOR_DarkenLightenColor(curBackColor, -24), 1
        DRAWRECT hdc, 0, 0, Gen, Yuk, COLOR_DarkenLightenColor(curBackColor, -84)
        SetPixel hdc, 1, 1, COLOR_DarkenLightenColor(curBackColor, -72)
        SetPixel hdc, 1, Yuk - 2, COLOR_DarkenLightenColor(curBackColor, -72)
        SetPixel hdc, Gen - 2, 1, COLOR_DarkenLightenColor(curBackColor, -72)
        SetPixel hdc, Gen - 2, Yuk - 2, COLOR_DarkenLightenColor(curBackColor, -72)
End If
End Sub

Private Sub RoundCorners()
Dim Alan1 As Long, Alan2 As Long
    DeleteObject AreaOriginal
    AreaOriginal = CreateRectRgn(0, 0, Gen, Yuk)
    Alan2 = CreateRectRgn(0, 0, 0, 0)
        Alan1 = CreateRectRgn(0, 0, 2, 1)
        CombineRgn Alan2, AreaOriginal, Alan1, 4
        DeleteObject Alan1
        Alan1 = CreateRectRgn(0, Yuk, 2, Yuk - 1)
        CombineRgn AreaOriginal, Alan2, Alan1, 4
        DeleteObject Alan1
        Alan1 = CreateRectRgn(Gen, 0, Gen - 2, 1)
        CombineRgn Alan2, AreaOriginal, Alan1, 4
        DeleteObject Alan1
        Alan1 = CreateRectRgn(Gen, Yuk, Gen - 2, Yuk - 1)
        CombineRgn AreaOriginal, Alan2, Alan1, 4
        DeleteObject Alan1
        Alan1 = CreateRectRgn(0, 1, 1, 2)
        CombineRgn Alan2, AreaOriginal, Alan1, 4
        DeleteObject Alan1
        Alan1 = CreateRectRgn(0, Yuk - 1, 1, Yuk - 2)
        CombineRgn AreaOriginal, Alan2, Alan1, 4
        DeleteObject Alan1
        Alan1 = CreateRectRgn(Gen, 1, Gen - 1, 2)
        CombineRgn Alan2, AreaOriginal, Alan1, 4
        DeleteObject Alan1
        Alan1 = CreateRectRgn(Gen, Yuk - 1, Gen - 1, Yuk - 2)
        CombineRgn AreaOriginal, Alan2, Alan1, 4
        DeleteObject Alan1
DeleteObject Alan2
SetWindowRgn hwnd, AreaOriginal, True
End Sub
Private Sub TransParentPic(DestDC As Long, _
                           DestDCTrans As Long, _
                           SrcDC As Long, _
                           SrcRectLeft As Long, SrcRectTop As Long, _
                           SrcRectRight As Long, SrcRectBottom As Long, _
                           DstX As Long, _
                           DstY As Long, _
                           MaskColor As Long)
   
  Dim nRet As Long, w As Integer, h As Integer
  Dim MonoMaskDC As Long, hMonoMask As Long
  Dim MonoInvDC As Long, hMonoInv As Long
  Dim ResultDstDC As Long, hResultDst As Long
  Dim ResultSrcDC As Long, hResultSrc As Long
  Dim hPrevMask As Long, hPrevInv As Long
  Dim hPrevSrc As Long, hPrevDst As Long
  Dim SrcRect As RECT
  
  With SrcRect
    .Left = SrcRectLeft
    .Top = SrcRectTop
    .Right = SrcRectRight
    .Bottom = SrcRectBottom
  End With

  w = SrcRectRight - SrcRectLeft
  h = SrcRectBottom - SrcRectTop
   
   
 
  MonoMaskDC = CreateCompatibleDC(DestDCTrans)
  MonoInvDC = CreateCompatibleDC(DestDCTrans)
  hMonoMask = CreateBitmap(w, h, 1, 1, ByVal 0&)
  hMonoInv = CreateBitmap(w, h, 1, 1, ByVal 0&)
  hPrevMask = SelectObject(MonoMaskDC, hMonoMask)
  hPrevInv = SelectObject(MonoInvDC, hMonoInv)
   
 
  ResultDstDC = CreateCompatibleDC(DestDCTrans)
  ResultSrcDC = CreateCompatibleDC(DestDCTrans)
  hResultDst = CreateCompatibleBitmap(DestDCTrans, w, h)
  hResultSrc = CreateCompatibleBitmap(DestDCTrans, w, h)
  hPrevDst = SelectObject(ResultDstDC, hResultDst)
  hPrevSrc = SelectObject(ResultSrcDC, hResultSrc)
   

  Dim OldBC As Long
  OldBC = SetBkColor(SrcDC, MaskColor)
  nRet = BitBlt(MonoMaskDC, 0, 0, w, h, SrcDC, _
                SrcRect.Left, SrcRect.Top, &HCC0020)
  MaskColor = SetBkColor(SrcDC, OldBC)
   
 
  nRet = BitBlt(MonoInvDC, 0, 0, w, h, _
                MonoMaskDC, 0, 0, &H330008)
   
 
  nRet = BitBlt(ResultDstDC, 0, 0, w, h, _
                DestDCTrans, DstX, DstY, &HCC0020)
   
 
  nRet = BitBlt(ResultDstDC, 0, 0, w, h, _
                MonoMaskDC, 0, 0, &H8800C6)
   
 
  nRet = BitBlt(ResultSrcDC, 0, 0, w, h, SrcDC, _
                SrcRect.Left, SrcRect.Top, &HCC0020)
   
 
  nRet = BitBlt(ResultSrcDC, 0, 0, w, h, _
                MonoInvDC, 0, 0, &H8800C6)
   

  nRet = BitBlt(ResultDstDC, 0, 0, w, h, _
                ResultSrcDC, 0, 0, &H660046)
   
 
  nRet = BitBlt(DestDC, DstX, DstY, w, h, _
                ResultDstDC, 0, 0, &HCC0020)
                
 
  hMonoMask = SelectObject(MonoMaskDC, hPrevMask)
  DeleteObject hMonoMask

  hMonoInv = SelectObject(MonoInvDC, hPrevInv)
  DeleteObject hMonoInv

  hResultDst = SelectObject(ResultDstDC, hPrevDst)
  DeleteObject hResultDst

  hResultSrc = SelectObject(ResultSrcDC, hPrevSrc)
  DeleteObject hResultSrc

  DeleteDC MonoMaskDC
  DeleteDC MonoInvDC
  DeleteDC ResultDstDC
  DeleteDC ResultSrcDC
End Sub

Private Sub SetAccessKeys()
Dim ampersandPos As Long
If Len(m_Caption) > 1 Then
    ampersandPos = InStr(1, m_Caption, "&", vbTextCompare)
    If (ampersandPos < Len(m_Caption)) And (ampersandPos > 0) Then
        If Mid(m_Caption, ampersandPos + 1, 1) <> "&" Then
            UserControl.AccessKeys = LCase(Mid(m_Caption, ampersandPos + 1, 1))
        Else
            ampersandPos = InStr(ampersandPos + 2, m_Caption, "&", vbTextCompare)
            If Mid(m_Caption, ampersandPos + 1, 1) <> "&" Then
                UserControl.AccessKeys = LCase(Mid(m_Caption, ampersandPos + 1, 1))
            Else
                UserControl.AccessKeys = ""
            End If
        End If
    Else
        UserControl.AccessKeys = ""
    End If
Else
    UserControl.AccessKeys = ""
End If
End Sub