xpb.ctl

VB实现的注册码发生器

    m_URL = New_URL
    PropertyChanged "URL"
End Property

Public Property Get Caption() As String
    Caption = m_Caption
End Property
Public Property Let Caption(ByVal New_Caption As String)
    m_Caption = New_Caption
    PropertyChanged "Caption"
    SetAccessKeys
    Refresh
End Property
Public Property Get ButtonStyle() As XBButtonStyle
    ButtonStyle = m_ButtonStyle
End Property
Public Property Let ButtonStyle(ByVal New_ButtonStyle As XBButtonStyle)
    m_ButtonStyle = New_ButtonStyle
    PropertyChanged "ButtonStyle"
    If m_ButtonStyle = gbWinXP Then TransparentBG = False
    UserControl_Resize
End Property

Public Property Get PicturePosition() As XBPicturePosition
    PicturePosition = m_PicturePosition
End Property
Public Property Let PicturePosition(ByVal New_PicturePosition As XBPicturePosition)
    m_PicturePosition = New_PicturePosition
    PropertyChanged "PicturePosition"
    Refresh
End Property
Public Property Get Picture() As Picture
    Set Picture = m_Picture
End Property
Public Property Set Picture(ByVal New_Picture As Picture)
    Set m_Picture = New_Picture
    Set m_PictureOriginal = New_Picture
    If m_Picture Is Nothing Then
        m_OriginalPicSizeW = 32
        m_OriginalPicSizeH = 32
    Else
        m_OriginalPicSizeW = UserControl.ScaleX(m_Picture.Width, 8, UserControl.ScaleMode)
        m_OriginalPicSizeH = UserControl.ScaleY(m_Picture.Height, 8, UserControl.ScaleMode)
    End If
    PropertyChanged "Picture"
    If m_PictureSize = sizeDefault Then
        m_PictureWidth = UserControl.ScaleX(m_Picture.Width, 8, UserControl.ScaleMode)
        m_PictureHeight = UserControl.ScaleY(m_Picture.Height, 8, UserControl.ScaleMode)
    End If
    Refresh
End Property

Public Property Get PictureWidth() As Long
    PictureWidth = m_PictureWidth
End Property
Public Property Let PictureWidth(ByVal New_PictureWidth As Long)
    m_PictureWidth = New_PictureWidth
    PropertyChanged "PictureWidth"
    Refresh
End Property
Public Property Get PictureHeight() As Long
    PictureHeight = m_PictureHeight
End Property
Public Property Let PictureHeight(ByVal New_PictureHeight As Long)
    m_PictureHeight = New_PictureHeight
    PropertyChanged "PictureHeight"
    Refresh
End Property
Public Property Get PictureSize() As XBPictureSize
    PictureSize = m_PictureSize
End Property
Public Property Let PictureSize(ByVal New_PictureSize As XBPictureSize)
    m_PictureSize = New_PictureSize
    PropertyChanged "PictureSize"
    
    If New_PictureSize = size16x16 Then
        m_PictureWidth = 16
        m_PictureHeight = 16
    ElseIf New_PictureSize = size32x32 Then
        m_PictureWidth = 32
        m_PictureHeight = 32
    ElseIf New_PictureSize = sizeDefault Then
        If Not (m_Picture Is Nothing) Then
            m_PictureWidth = m_OriginalPicSizeW
            m_PictureHeight = m_OriginalPicSizeH
        Else
            m_PictureWidth = 32
            m_PictureHeight = 32
        End If
    End If
   
    Refresh
End Property

Private Sub CalculateCaptionRect()
    Dim mvarWidth, mvarHeight As Long
    Dim mvarFormat As Long
    With mvarDrawTextParams
        .iLeftMargin = 1
        .iRightMargin = 1
        .iTabLength = 1
        .cbSize = Len(mvarDrawTextParams)
    End With
    mvarFormat = &H400 Or &H10 Or &H4 Or &H1
    DrawTextEx hdc, m_Caption, Len(m_Caption), mvarCaptionRect, mvarFormat, mvarDrawTextParams
    mvarWidth = mvarCaptionRect.Right - mvarCaptionRect.Left
    mvarHeight = mvarCaptionRect.Bottom - mvarCaptionRect.Top
    With mvarCaptionRect
        .Left = mvarClientRect.Left + (((mvarClientRect.Right - mvarClientRect.Left) - (mvarCaptionRect.Right - mvarCaptionRect.Left)) \ 2)
        .Top = mvarClientRect.Top + (((mvarClientRect.Bottom - mvarClientRect.Top) - (mvarCaptionRect.Bottom - mvarCaptionRect.Top)) \ 2)
        .Right = mvarCaptionRect.Left + mvarWidth
        .Bottom = mvarCaptionRect.Top + mvarHeight
    End With
End Sub

Private Sub DrawCaption()
    If m_Caption = "" Then Exit Sub
    
    SetTextColor hdc, COLOR_UniColor(m_ForeColor)
    
    Dim mvarForeColor As OLE_COLOR
    mvarOrgRect = mvarCaptionRect
    If g_MouseDown = 1 And m_ButtonStyle <> gbOfficeXP Then
       With mvarCaptionRect
        .Left = mvarCaptionRect.Left + 1
        .Top = mvarCaptionRect.Top + 1
        .Right = mvarCaptionRect.Right + 1
        .Bottom = mvarCaptionRect.Bottom + 1
       End With
    End If
    
    If Not Enabled Then
        Dim g_tmpFontColor As OLE_COLOR
        g_tmpFontColor = UserControl.ForeColor
        
        
        SetTextColor hdc, COLOR_UniColor(&H80000014)
        Dim mvarCaptionRect_Iki As RECT
        With mvarCaptionRect_Iki
            .Bottom = mvarCaptionRect.Bottom
            .Left = mvarCaptionRect.Left + 1
            .Right = mvarCaptionRect.Right + 1
            .Top = mvarCaptionRect.Top + 1
        End With
        DrawTextEx hdc, m_Caption, Len(m_Caption), mvarCaptionRect_Iki, &H10 Or &H4 Or &H1, mvarDrawTextParams
        
        
        SetTextColor hdc, COLOR_UniColor(&H80000010)
        DrawTextEx hdc, m_Caption, Len(m_Caption), mvarCaptionRect, &H10 Or &H4 Or &H1, mvarDrawTextParams
        
        
        SetTextColor hdc, COLOR_UniColor(g_tmpFontColor)
        Exit Sub
    End If
    DrawTextEx hdc, m_Caption, Len(m_Caption), mvarCaptionRect, &H10 Or &H4 Or &H1, mvarDrawTextParams
    mvarCaptionRect = mvarOrgRect
End Sub
Private Sub DrawBitmap(EnabledPic As Byte, CurPictRECT As RECT, _
                            Optional AsShadow As Byte = 0)
Dim DC1 As Long
Dim BM1 As Long
Dim DC2 As Long
Dim BM2 As Long
Dim UZUN1 As Long
Dim UZUN2 As Long
Dim hBrush As Long

DC1 = CreateCompatibleDC(hdc)
DC2 = CreateCompatibleDC(hdc)
BM1 = CreateCompatibleBitmap(hdc, m_OriginalPicSizeW, m_OriginalPicSizeH)
BM2 = CreateCompatibleBitmap(hdc, m_PictureWidth, m_PictureHeight)
UZUN1 = SelectObject(DC1, BM1)
UZUN2 = SelectObject(DC2, BM2)

If EnabledPic = 0 Then
                Dim DC3 As Long
                Dim BM3 As Long
                
                DC3 = CreateCompatibleDC(hdc)
                BM3 = SelectObject(DC3, m_Picture.Handle)
                
                SetBkColor DC1, &HFFFFFF
                 
                DRAWRECT DC1, 0, 0, _
                    m_OriginalPicSizeW, m_OriginalPicSizeH, &HFFFFFF, 1

                TransParentPic DC1, DC1, DC3, 0, 0, _
                    m_OriginalPicSizeW, m_OriginalPicSizeH, 0, 0, m_MaskColor
                
                StretchBlt DC2, 0, 0, _
                    m_PictureWidth, _
                        m_PictureHeight, _
                            DC1, 0, 0, m_OriginalPicSizeW, m_OriginalPicSizeH, &HCC0020
                
                SelectObject DC2, UZUN2
                
                

                
                If AsShadow = 1 Then
                    hBrush = CreateSolidBrush(RGB(146, 146, 146))
                    Call DrawState(hdc, hBrush, 0, BM2, 0, CurPictRECT.Left, _
                                 CurPictRECT.Top, 0, 0, &H80& Or &H4&)
                    DeleteObject hBrush
                Else
                    Call DrawState(hdc, 0, 0, BM2, 0, CurPictRECT.Left, _
                                 CurPictRECT.Top, 0, 0, &H20& Or &H4&)
                End If


                

    DeleteObject BM3
    DeleteDC DC3
                
Else
                
                Call DrawState(DC1, 0, 0, m_Picture, 0, 0, 0, 0, 0, _
                    &H0 Or &H4&)
            
                StretchBlt DC2, 0, 0, _
                    m_PictureWidth, _
                        m_PictureHeight, _
                            DC1, 0, 0, m_OriginalPicSizeW, m_OriginalPicSizeH, &HCC0020
                            
                TransParentPic hdc, hdc, DC2, 0, 0, _
                    m_PictureWidth, m_PictureHeight, _
                     CurPictRECT.Left, CurPictRECT.Top, m_MaskColor
                
End If

    SelectObject DC1, UZUN1
    SelectObject DC2, UZUN2
    DeleteObject BM1
    DeleteObject BM2
    DeleteDC DC1
    DeleteDC DC2
End Sub
Private Sub DrawPIcon(EnabledPic As Byte, CurPictRECT As RECT, Optional AsShadow As Byte = 0)
If EnabledPic = 0 Then
                 Dim DC1 As Long
                Dim BM1 As Long
                Dim DC2 As Long
                Dim BM2 As Long
                Dim UZUN1 As Long
                Dim UZUN2 As Long
                Dim hBrush As Long
                    
                    

                
                DC1 = CreateCompatibleDC(hdc)
                BM1 = CreateCompatibleBitmap(hdc, m_OriginalPicSizeW, m_OriginalPicSizeH)
            
                DC2 = CreateCompatibleDC(hdc)
                BM2 = CreateCompatibleBitmap(hdc, m_PictureWidth, m_PictureHeight)
            
                UZUN1 = SelectObject(DC1, BM1)
                UZUN2 = SelectObject(DC2, BM2)
                
                
                If AsShadow = 1 Then
                    hBrush = CreateSolidBrush(RGB(146, 146, 146))
                    Call DrawState(DC1, hBrush, 0, m_Picture, 0, 0, 0, 0, 0, _
                        &H80& Or &H3&)
                    DeleteObject hBrush
                Else
                    Call DrawState(DC1, 0, 0, m_Picture, 0, 0, 0, 0, 0, _
                       &H20& Or &H3&)
                End If
                
                
                StretchBlt DC2, 0, 0, _
                    CurPictRECT.Right - CurPictRECT.Left, _
                        CurPictRECT.Bottom - CurPictRECT.Top, _
                            DC1, 0, 0, m_OriginalPicSizeW, m_OriginalPicSizeH, &HCC0020
                            
                TransParentPic hdc, hdc, DC2, 0, 0, _
                    m_PictureWidth, m_PictureHeight, _
                      CurPictRECT.Left, CurPictRECT.Top, &H0
                
                SelectObject DC1, UZUN1
                SelectObject DC2, UZUN2
                DeleteObject BM1
                DeleteObject BM2
                DeleteDC DC1
                DeleteDC DC2

Else


            UserControl.PaintPicture m_Picture, CurPictRECT.Left, _
                CurPictRECT.Top, CurPictRECT.Right - CurPictRECT.Left, _
                  CurPictRECT.Bottom - CurPictRECT.Top, 0, 0, _
                    m_OriginalPicSizeW, m_OriginalPicSizeH
End If
End Sub

Private Sub DrawPicture()
    Dim Margin As Integer
    
    If m_Picture Is Nothing Then Exit Sub
    mvarOrgRect = mvarPictureRect
    
    
    If g_MouseDown = 0 And g_MouseIn = 1 And m_ButtonStyle = gbOfficeXP Then
      
        Margin = -3
    ElseIf g_MouseDown = 1 And Not m_ButtonStyle = gbOfficeXP Then
      
        Margin = 1
    End If
    
    With mvarPictureRect
        .Left = .Left + Margin
        .Top = .Top + Margin
        .Right = .Right + Margin
        .Bottom = .Bottom + Margin
    End With


        If m_Picture.Type = 1 Then
            If Not Enabled Then
                DrawBitmap 0, mvarPictureRect
            Else
                If g_MouseDown = 0 And g_MouseIn = 1 And _
                            m_ButtonStyle = gbOfficeXP Then _
                    DrawBitmap 0, mvarOrgRect, 1
                
                DrawBitmap 1, mvarPictureRect
            End If
        ElseIf m_Picture.Type = 3 Then
            If Not Enabled Then
                DrawPIcon 0, mvarPictureRect
            Else
                If g_MouseDown = 0 And g_MouseIn = 1 And _
                        m_ButtonStyle = gbOfficeXP Then _
                    DrawPIcon 0, mvarOrgRect, 1
                    
                DrawPIcon 1, mvarPictureRect
            End If
        End If
mvarPictureRect = mvarOrgRect
End Sub
Private Sub Transparentia()
  On Error Resume Next
Dim RESIM As StdPicture
Dim mem_dc As Long
Dim mem_bm As Long
Dim orig_bm As Long
Dim wid As Long
Dim hgt As Long
Dim IX As Long
Dim YE As Long

IX = ScaleX(Extender.Left, Parent.ScaleMode, ScaleMode)
YE = ScaleY(Extender.Top, Parent.ScaleMode, ScaleMode)

Set RESIM = Parent.Picture
    mem_dc = CreateCompatibleDC(hdc)
    mem_bm = CreateCompatibleBitmap(mem_dc, ScaleWidth, ScaleHeight)
    
    SelectObject mem_dc, RESIM.Handle
    
    BitBlt hdc, 0, 0, ScaleWidth, ScaleHeight, _
        mem_dc, IX, YE, &HCC0020
    

    SelectObject mem_dc, orig_bm
    DeleteObject mem_bm
    DeleteDC mem_dc
    Set RESIM = Nothing
End Sub

Public Property Get PictureHover() As Picture
    Set PictureHover = m_PictureHover
End Property

Public Property Set PictureHover(ByVal New_PictureHover As Picture)
    Set m_PictureHover = New_PictureHover
    PropertyChanged "PictureHover"
End Property
Public Property Get XPColor_Pressed() As OLE_COLOR
    XPColor_Pressed = m_XPColor_Pressed
End Property

Public Property Let XPColor_Pressed(ByVal New_XPColor_Pressed As OLE_COLOR)
    m_XPColor_Pressed = New_XPColor_Pressed
    PropertyChanged "XPColor_Pressed"
End Property
Public Property Get XPColor_Hover() As OLE_COLOR
    XPColor_Hover = m_XPColor_Hover
End Property

Public Property Let XPColor_Hover(ByVal New_XPColor_Hover As OLE_COLOR)
    m_XPColor_Hover = New_XPColor_Hover
    PropertyChanged "XPColor_Hover"
End Property
Public Property Get XPDefaultColors() As Boolean
    XPDefaultColors = m_XPDefaultColors
End Property
Public Property Let XPDefaultColors(ByVal New_XPDefaultColors As Boolean)
    m_XPDefaultColors = New_XPDefaultColors
    PropertyChanged "XPDefaultColors"