qqform.ctl

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

VERSION 5.00
Begin VB.UserControl QQForm 
   AutoRedraw      =   -1  'True
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ControlContainer=   -1  'True
   ScaleHeight     =   3600
   ScaleWidth      =   4800
   Begin VB.Image ImgMax 
      Height          =   240
      Index           =   6
      Left            =   2610
      Picture         =   "QQForm.ctx":0000
      Top             =   3000
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.Image ImgMax 
      Height          =   240
      Index           =   5
      Left            =   2280
      Picture         =   "QQForm.ctx":0344
      Top             =   3000
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.Image ImgMax 
      Height          =   240
      Index           =   4
      Left            =   1950
      Picture         =   "QQForm.ctx":0688
      Top             =   3000
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.Image ImgMax 
      Height          =   240
      Index           =   3
      Left            =   1620
      Picture         =   "QQForm.ctx":09CC
      Top             =   3000
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.Image ImgMax 
      Height          =   240
      Index           =   2
      Left            =   1320
      Picture         =   "QQForm.ctx":0D10
      Top             =   3000
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.Image ImgMax 
      Height          =   240
      Index           =   1
      Left            =   1020
      Picture         =   "QQForm.ctx":1054
      Top             =   3000
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.Image ImgMax 
      Height          =   240
      Index           =   0
      Left            =   690
      MousePointer    =   99  'Custom
      Top             =   3000
      Width           =   240
   End
   Begin VB.Image ImgMin 
      Height          =   240
      Index           =   3
      Left            =   1620
      Picture         =   "QQForm.ctx":1398
      Top             =   2730
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.Image ImgMin 
      Height          =   240
      Index           =   2
      Left            =   1320
      Picture         =   "QQForm.ctx":16DC
      Top             =   2730
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.Image ImgMin 
      Height          =   240
      Index           =   1
      Left            =   1020
      Picture         =   "QQForm.ctx":1A20
      Top             =   2730
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.Image ImgClose 
      Height          =   240
      Index           =   3
      Left            =   1620
      Picture         =   "QQForm.ctx":1D64
      Top             =   2460
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.Image ImgClose 
      Height          =   240
      Index           =   2
      Left            =   1320
      Picture         =   "QQForm.ctx":20A8
      Top             =   2460
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.Image ImgClose 
      Height          =   240
      Index           =   1
      Left            =   1020
      Picture         =   "QQForm.ctx":23EC
      Top             =   2460
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.Image ImgClose 
      Height          =   240
      Index           =   0
      Left            =   690
      MouseIcon       =   "QQForm.ctx":2730
      MousePointer    =   99  'Custom
      ToolTipText     =   "关闭"
      Top             =   2460
      Width           =   240
   End
   Begin VB.Image ImgMin 
      Height          =   240
      Index           =   0
      Left            =   690
      MousePointer    =   99  'Custom
      ToolTipText     =   "最小化"
      Top             =   2730
      Width           =   240
   End
   Begin VB.Label LbMove 
      BackStyle       =   0  'Transparent
      ForeColor       =   &H00000000&
      Height          =   345
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   3135
   End
   Begin VB.Image Skin 
      Height          =   2385
      Left            =   0
      Picture         =   "QQForm.ctx":288E
      Top             =   0
      Visible         =   0   'False
      Width           =   3840
   End
End
Attribute VB_Name = "QQForm"
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
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Integer, ByVal Y1 As Integer, ByVal X2 As Integer, ByVal Y2 As Integer, ByVal x3 As Integer, ByVal y3 As Integer) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject 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 ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private IsP As Boolean

Public Event MinClick()
Public Event MaxClick()
Public Event CloseClick()


Private Sub UserControl_Initialize()
ImgClose(0).Picture = ImgClose(1).Picture
ImgMin(0).Picture = ImgMin(1).Picture


ImgMin(0).MouseIcon = ImgClose(0).MouseIcon
ImgMax(0).MouseIcon = ImgClose(0).MouseIcon
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If IsP = False Then
    ImgClose(0).Picture = ImgClose(1).Picture
    ImgMin(0).Picture = ImgMin(1).Picture
    If UserControl.Parent.WindowState = 0 Then
        ImgMax(0).Picture = ImgMax(1).Picture
    ElseIf UserControl.Parent.WindowState = 2 Then
        ImgMax(0).Picture = ImgMax(4).Picture
    End If
    IsP = True
End If
End Sub

Private Sub UserControl_Resize()
    Refresh
End Sub

Private Sub UserControl_Show()
    Refresh
End Sub

Public Sub Refresh()

With UserControl
    .PaintPicture Skin.Picture, 420, 0, .Width, 600, 420, 0, 120, 600
    .PaintPicture Skin.Picture, 420, .Height - 600, .Width, 600, 420, Skin.Height - 600, 120, 600
    
    .PaintPicture Skin.Picture, 0, 0, 200, .Height, 0, 880, 200, 40
    .PaintPicture Skin.Picture, .Width - 210, 0, 210, .Height, Skin.Width - 210, 880, 210, 40

    .PaintPicture Skin.Picture, 0, 0, 450, 600, 0, 0, 450, 600
    .PaintPicture Skin.Picture, 0, .Height - 600, 450, 600, 0, Skin.Height - 600, 450, 600

    .PaintPicture Skin.Picture, .Width - 1665, 0, 1665, 435, Skin.Width - 1665, 0, 1660, 435
    .PaintPicture Skin.Picture, .Width - 1665, .Height - 525, 1665, 525, Skin.Width - 1665, Skin.Height - 525, 1665, 525
    '画中心部分
    .PaintPicture Skin.Picture, 50, 350, .Width - 100, .Height - 425, 200, 310, Skin.Width - 250, Skin.Height - 380
    
    If .Parent.Icon <> 0 Then
        .PaintPicture .Parent.Icon, 50, 50, 240, 240, 0, 0, 240, 240   '打印标题图标
    End If
    
    SetRgn UserControl, 5
    SetRgn .Parent, 5
    .Width = .Parent.Width
    .Height = .Parent.Height
    .Parent.BorderStyle = 0
    .Parent.AutoRedraw = True
    If .Parent.WindowState = 0 Then
        ImgMax(0).Picture = ImgMax(1).Picture
        ImgMax(0).ToolTipText = "最大化"
    ElseIf .Parent.WindowState = 2 Then
        ImgMax(0).Picture = ImgMax(4).Picture
        ImgMax(0).ToolTipText = "向下还原"
    End If
    LbMove.Width = .ScaleWidth - 15
    LbMove.Height = ImgClose(0).Height + 50
    
    ImgClose(0).Left = .ScaleWidth - ImgClose(0).Width - 70
    ImgClose(0).Top = 50
    
    ImgMin(0).Top = 50
    ImgMax(0).Top = 50
    
    ImgMin(0).Visible = .Parent.MinButton
    ImgMax(0).Visible = .Parent.MaxButton
    If ImgMax(0).Visible = False Then
        ImgMin(0).Left = ImgClose(0).Left - ImgMin(0).Width - 30
    Else
        ImgMax(0).Left = ImgClose(0).Left - ImgMax(0).Width - 30
        ImgMin(0).Left = ImgMax(0).Left - ImgMin(0).Width - 30
    End If
    
    .FontBold = True
    .ForeColor = &HFFFFFF
    If .Parent.Icon <> 0 Then .CurrentX = 360 Else .CurrentX = 100
    .CurrentY = 90
    UserControl.Print .Parent.Caption
    Debug.Print .Parent.Caption
    UserControl.Refresh
End With
End Sub

Private Sub SetRgn(ByVal Obj, ByVal Rgn As Long)
    Dim Hround As Long
    Hround = CreateRoundRectRgn(0, 0, ScaleX(Obj.Width + 10, vbTwips, vbPixels), ScaleY(Obj.Height + 10, vbTwips, vbPixels), Rgn, Rgn)
    SetWindowRgn Obj.hwnd, Hround, True
    DeleteObject Hround
End Sub

Private Sub ImgClose_Click(Index As Integer)
If Index = 0 Then
    Unload UserControl.Parent
    RaiseEvent CloseClick
End If
End Sub

Private Sub ImgClose_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Index = 0 Then
    ImgClose(0).Picture = ImgClose(3).Picture
End If
End Sub

Private Sub ImgClose_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Index = 0 Then
    If IsP = True Then
        ImgClose(0).Picture = ImgClose(2).Picture
        IsP = False
    End If
End If
End Sub

Private Sub ImgClose_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Index = 0 Then
    ImgClose(0).Picture = ImgClose(1).Picture
End If
End Sub

Private Sub ImgMin_Click(Index As Integer)
If Index = 0 Then
    UserControl.Parent.WindowState = 1
    RaiseEvent MinClick
End If
End Sub

Private Sub ImgMin_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Index = 0 Then
    ImgMin(0).Picture = ImgMin(3).Picture
End If
End Sub

Private Sub ImgMin_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Index = 0 Then
    If IsP = True Then
        ImgMin(0).Picture = ImgMin(2).Picture
        IsP = False
    End If
End If
End Sub

Private Sub ImgMin_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Index = 0 Then
    ImgMin(0).Picture = ImgMin(1).Picture
End If
End Sub
Private Sub ImgMax_Click(Index As Integer)
If Index = 0 Then
    With UserControl
        If .Parent.WindowState = 0 Then
            .Parent.WindowState = 2
        ElseIf .Parent.WindowState = 2 Then
            .Parent.WindowState = 0
        End If
        .Width = .Parent.Width
        .Height = .Parent.Height
    End With
    RaiseEvent MaxClick
End If
End Sub

Private Sub ImgMax_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Index = 0 Then
    With UserControl
        If .Parent.WindowState = 0 Then
            ImgMax(0).Picture = ImgMax(3).Picture
        ElseIf .Parent.WindowState = 2 Then
            ImgMax(0).Picture = ImgMax(6).Picture
        End If
    End With
End If
End Sub

Private Sub ImgMax_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Index = 0 Then
    If IsP = True Then
        With UserControl
            If .Parent.WindowState = 0 Then
                ImgMax(0).Picture = ImgMax(2).Picture
            ElseIf .Parent.WindowState = 2 Then
                ImgMax(0).Picture = ImgMax(5).Picture
            End If
        End With
        IsP = False
    End If
End If
End Sub

Private Sub ImgMax_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Index = 0 Then
    With UserControl
        If .Parent.WindowState = 0 Then
            ImgMax(0).Picture = ImgMax(1).Picture
        ElseIf .Parent.WindowState = 2 Then
            ImgMax(0).Picture = ImgMax(4).Picture
        End If
    End With
End If
End Sub

Private Sub LbMove_DblClick()
If ImgMax(0).Visible = True Then
    ImgMax_Click (0)
End If
End Sub

Private Sub lbmove_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If (Button = 1) And (UserControl.Parent.WindowState = 0) Then
    UserControl.MousePointer = 15
    ReleaseCapture
    SendMessage UserControl.ContainerHwnd, &H112, &HF010& + 2, 0
    UserControl.MousePointer = 0
End If
End Sub

Private Sub LbMove_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    UserControl_MouseMove 0, Shift, X, Y
End Sub