qqbutton.ctl

VB写的一个下载者 服务端和生成器都有

VERSION 5.00
Begin VB.UserControl QQButton 
   AutoRedraw      =   -1  'True
   BackColor       =   &H00D7D7D7&
   ClientHeight    =   375
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1365
   ScaleHeight     =   375
   ScaleWidth      =   1365
   Begin VB.PictureBox Pback 
      AutoRedraw      =   -1  'True
      BackColor       =   &H00D7D7D7&
      BorderStyle     =   0  'None
      Height          =   375
      Left            =   0
      ScaleHeight     =   375
      ScaleWidth      =   1455
      TabIndex        =   0
      Top             =   0
      Width           =   1455
   End
   Begin VB.Image Im 
      Height          =   300
      Index           =   0
      Left            =   2160
      Picture         =   "QQButton.ctx":0000
      Top             =   930
      Width           =   675
   End
   Begin VB.Image IM1 
      Height          =   375
      Left            =   3360
      Top             =   1590
      Visible         =   0   'False
      Width           =   375
   End
   Begin VB.Image Im 
      Height          =   300
      Index           =   1
      Left            =   2160
      Picture         =   "QQButton.ctx":0AE2
      Top             =   1320
      Visible         =   0   'False
      Width           =   675
   End
   Begin VB.Image Im 
      Height          =   300
      Index           =   3
      Left            =   2160
      Picture         =   "QQButton.ctx":15C4
      Top             =   2070
      Visible         =   0   'False
      Width           =   675
   End
   Begin VB.Image Im 
      Height          =   300
      Index           =   2
      Left            =   2160
      Picture         =   "QQButton.ctx":20A6
      Top             =   1680
      Visible         =   0   'False
      Width           =   675
   End
End
Attribute VB_Name = "QQButton"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

' **********************************************************************
'  描  述：QQ2005界面控件
'  中国VB网收集整理  http://www.ChinaVB.net
'  QQ交流群：13047826
'  发表源码或文章请发邮件到:[e-mail]
' **********************************************************************

Option Explicit
Public Enum Kstyle
Left
Top
End Enum

Private m_Style As Kstyle

Private mForeColor As OLE_COLOR

Private m_Caption As String
Private ifon As Boolean
Private If2 As Boolean

Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
'事件声明:
Event Click()
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=Pback,Pback,-1,MouseDown
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=Pback,Pback,-1,MouseDown
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=Pback,Pback,-1,MouseDown

Public Property Get Picture() As Picture
Attribute Picture.VB_Description = "返回/设置控件中显示的图形。"
    Set Picture = IM1.Picture
End Property

Public Property Set Picture(ByVal New_Picture As Picture)
    Set IM1.Picture = New_Picture
    PrintB 1
    PropertyChanged "Picture"
End Property

Public Property Get Style() As Kstyle
    Style = m_Style
End Property

Public Property Let Style(ByVal New_Style As Kstyle)
    m_Style = New_Style
    PrintB 1
    PropertyChanged "Style"
End Property

Public Property Get Font() As Font
Attribute Font.VB_Description = "返回一个 Font 对象。"
    Set Font = Pback.Font
End Property

Public Property Set Font(ByVal New_Font As Font)
    Set Pback.Font = New_Font
    PropertyChanged "Font"
    PrintB 1
End Property

Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_Description = "返回/设置对象中文本和图形的前景色。"
    ForeColor = Pback.ForeColor
End Property

Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
    Pback.ForeColor() = New_ForeColor
    PropertyChanged "ForeColor"
    PrintB 1
End Property

Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "返回/设置一个值，决定一个对象是否响应用户生成事件。"
    Enabled = Pback.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
    Pback.Enabled() = New_Enabled
    PropertyChanged "Enabled"
    PrintB 1
End Property

Public Property Get Caption() As String
Attribute Caption.VB_Description = "返回/设置对象的标题栏中或图标下面的文本。"
    Caption = Pback.Tag
End Property

Public Property Let Caption(ByVal New_Caption As String)
    Pback.Tag = New_Caption
    PrintB 1
    PropertyChanged "Caption"
End Property

Public Property Get Keys() As String
    Keys = UserControl.AccessKeys
End Property

Public Property Let Keys(ByVal New_Key As String)
    UserControl.AccessKeys = UCase(Mid(New_Key, 1, 1))
End Property



Private Sub Pback_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then Pback_Click
End Sub

Private Sub UserControl_AccessKeyPress(KeyAscii As Integer)
    Pback_Click
End Sub

'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    m_Style = PropBag.ReadProperty("Style", 0)
    Pback.Enabled = PropBag.ReadProperty("Enabled", True)
    Pback.Tag = PropBag.ReadProperty("Caption", "")
    Set Pback.Font = PropBag.ReadProperty("Font", Ambient.Font)
    Set Picture = PropBag.ReadProperty("Picture", Nothing)
    Pback.ForeColor = PropBag.ReadProperty("ForeColor", &H80000012)
    UserControl.AccessKeys = PropBag.ReadProperty("Keys", "")
End Sub

Private Sub UserControl_Show()
PrintB 1
End Sub

'将属性值写到存储器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Style", m_Style, 0)
    Call PropBag.WriteProperty("Picture", Picture, Nothing)
    Call PropBag.WriteProperty("Caption", Pback.Tag, "")
    Call PropBag.WriteProperty("Font", Pback.Font, Ambient.Font)
    Call PropBag.WriteProperty("ForeColor", Pback.ForeColor, &H80000012)
    Call PropBag.WriteProperty("Enabled", Pback.Enabled, True)
    Call PropBag.WriteProperty("Keys", UserControl.AccessKeys, "")
End Sub

Public Sub UserControl_Resize()
Pback.Width = UserControl.Width
Pback.Height = UserControl.Height
PrintB 1
End Sub

Private Sub UserControl_Initialize()
PrintB 1
End Sub

Private Sub Pback_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
       RaiseEvent MouseMove(Button, Shift, X, Y)

    Dim MouseOver As Boolean
    '判断当前鼠标位置是否在控件上
    MouseOver = (0 <= X) And (X <= Pback.Width) And (0 <= Y) And (Y <= Pback.Height)
    If MouseOver Then
        If ifon = False Then
            PrintB 2
            ifon = True
        End If
        SetCapture Pback.hwnd
    Else
        PrintB 1
        ifon = False
        ReleaseCapture
    End If
End Sub

Private Sub Pback_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseDown(Button, Shift, X, Y)

If Button = 1 Then
    PrintB 3
    If2 = True
Else
    If2 = False
End If

End Sub

Private Sub Pback_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseUp(Button, Shift, X, Y)
    ifon = False
    PrintB 1
End Sub

Private Sub Pback_Click()
If If2 = False Then Exit Sub
    RaiseEvent Click
End Sub

Public Sub PrintB(VV)
Dim Z As Integer
Dim Brx As Single
Dim Bry As Single
Dim Bw As Single
Dim Bh As Single

Pback.Cls
If VV = 1 Then
    If Pback.Enabled = False Then
        Z = 0
    Else
        Z = 1
    End If
Else
    Z = VV
End If
    
    Brx = Pback.Width - 45
    Bry = Pback.Height - 45
    Bw = Pback.Width - 90
    Bh = Pback.Height - 90
    
    Pback.PaintPicture Im(Z).Picture, 0, 0, 45, 45, 0, 0, 45, 45 '左上角
    Pback.PaintPicture Im(Z).Picture, Brx, 0, 45, 45, Im(Z).Width - 45, 0, 45, 45 '右上角
    Pback.PaintPicture Im(Z).Picture, Brx, Bry, 45, 45, Im(Z).Width - 45, 250, 45, 45
    Pback.PaintPicture Im(Z).Picture, 0, Bry, 45, 45, 0, 250, 45, 45 '左下角
    Pback.PaintPicture Im(Z).Picture, 45, 0, Bw, 45, 45, 0, 225, 45 '上
    Pback.PaintPicture Im(Z).Picture, Brx, 45, 45, Bh, Im(Z).Width - 45, 45, 45, 225 '右
    Pback.PaintPicture Im(Z).Picture, 0, 45, 45, Bh, 0, 45, 45, 225 '左
    Pback.PaintPicture Im(Z).Picture, 45, Bry, Bw, 45, 45, Im(Z).Height - 45, 225, 45 '下
    Pback.PaintPicture Im(Z).Picture, 45, 45, Bw, Bh, 45, 45, 180, 180 '中

SetText Pback.Tag
End Sub

Private Sub SetText(ByVal Caption As String)
Dim X As Single
Dim Y As Single
Dim nn As OLE_COLOR

On Error Resume Next
X = IM1.Width: Y = IM1.Height
nn = UserControl.ForeColor

If Caption = "" And IM1.Picture = LoadPicture() Then Exit Sub
If Caption = "" Then Pback.PaintPicture IM1.Picture, (Pback.Width - X) / 2, (Pback.Height - Y) / 2, IM1.Width, IM1.Height: Exit Sub
If IM1.Picture = LoadPicture("") Then
    If Pback.Enabled = False Then
        With Pback
            .CurrentX = 18 + (.Width - TextWidth(Caption)) / 2
            .CurrentY = 18 + (.Height - TextHeight(Caption)) / 2
        End With
        Pback.ForeColor = 16777215
        Pback.Print Caption
        Pback.ForeColor = nn
        With Pback
            .CurrentX = (.Width - TextWidth(Caption)) / 2
            .CurrentY = (.Height - TextHeight(Caption)) / 2
        End With
        Pback.ForeColor = 8421504
        Pback.Print Caption
        Pback.ForeColor = nn
    Else
        With Pback
            .CurrentX = (.Width - TextWidth(Caption)) / 2
            .CurrentY = (.Height - TextHeight(Caption)) / 2
        End With
        Pback.ForeColor = &H80000012
        Pback.Print Caption
    End If
    Exit Sub
End If

If m_Style = 0 Then
    Pback.PaintPicture IM1.Picture, (Pback.Width - X - TextWidth(Caption)) / 3, (Pback.Height - Y) / 2, IM1.Width, IM1.Height
    If Pback.Enabled = False Then
        With Pback
            .CurrentX = 18 + X + 2 * (.Width - X - TextWidth(Caption)) / 3
            .CurrentY = 18 + (.Height - TextHeight(Caption)) / 2
        End With
        Pback.ForeColor = 16777215
        Pback.Print Caption
        Pback.ForeColor = nn
        With Pback
            .CurrentX = X + 2 * (.Width - X - TextWidth(Caption)) / 3
            .CurrentY = (.Height - TextHeight(Caption)) / 2
        End With
        Pback.ForeColor = 8421504
        Pback.Print Caption
        Pback.ForeColor = nn
    Else
        With Pback
            .CurrentX = X + 2 * (.Width - X - TextWidth(Caption)) / 3
            .CurrentY = (.Height - TextHeight(Caption)) / 2
        End With
        Pback.ForeColor = &H80000012
        Pback.Print Caption
    End If
    Exit Sub
End If

If m_Style = 1 Then
    Pback.PaintPicture IM1.Picture, (Pback.Width - X) / 2, (Pback.Height - Y - TextHeight(Caption)) / 3, IM1.Width, IM1.Height
    If Pback.Enabled = False Then
        With Pback
            .CurrentX = 18 + (.Width - TextWidth(Caption)) / 2
            .CurrentY = 18 + Y + 2 * (.Height - TextHeight(Caption) - Y) / 3
        End With
        Pback.ForeColor = 16777215
        Pback.Print Caption
        Pback.ForeColor = nn
        With Pback
            .CurrentX = (.Width - TextWidth(Caption)) / 2
            .CurrentY = Y + 2 * (.Height - TextHeight(Caption) - Y) / 3
        End With
        Pback.ForeColor = 8421504
        Pback.Print Caption
        Pback.ForeColor = nn
    Else
        With Pback
            .CurrentX = (.Width - TextWidth(Caption)) / 2
            .CurrentY = Y + 2 * (.Height - TextHeight(Caption) - Y) / 3
        End With
        Pback.ForeColor = &H80000012
        Pback.Print Caption
    End If
    Exit Sub
End If

End Sub