qqform.ctl

在Visual Basic 6.0的环境下

VERSION 5.00
Begin VB.UserControl QQForm 
   AutoRedraw      =   -1  'True
   ClientHeight    =   11910
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   13065
   ControlContainer=   -1  'True
   ScaleHeight     =   11910
   ScaleWidth      =   13065
   Begin VB.Image ICON 
      Height          =   240
      Left            =   12000
      Picture         =   "QQForm.ctx":0000
      Top             =   6120
      Width           =   240
   End
   Begin VB.Image ImgMin 
      Height          =   240
      Index           =   0
      Left            =   8400
      MousePointer    =   99  'Custom
      ToolTipText     =   "最小化"
      Top             =   510
      Width           =   240
   End
   Begin VB.Image ImgClose 
      Height          =   240
      Index           =   0
      Left            =   8400
      MouseIcon       =   "QQForm.ctx":038A
      MousePointer    =   99  'Custom
      ToolTipText     =   "关闭"
      Top             =   240
      Width           =   240
   End
   Begin VB.Image ImgClose 
      Height          =   240
      Index           =   1
      Left            =   8730
      Picture         =   "QQForm.ctx":04E8
      Top             =   240
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.Image ImgClose 
      Height          =   240
      Index           =   2
      Left            =   9030
      Picture         =   "QQForm.ctx":06EC
      Top             =   240
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.Image ImgClose 
      Height          =   240
      Index           =   3
      Left            =   9330
      Picture         =   "QQForm.ctx":09B4
      Top             =   240
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.Image ImgMin 
      Height          =   240
      Index           =   1
      Left            =   8730
      Picture         =   "QQForm.ctx":0C7C
      Top             =   510
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.Image ImgMin 
      Height          =   240
      Index           =   2
      Left            =   9030
      Picture         =   "QQForm.ctx":0E68
      Top             =   510
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.Image ImgMin 
      Height          =   240
      Index           =   3
      Left            =   9330
      Picture         =   "QQForm.ctx":10DC
      Top             =   510
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.Image ImgMax 
      Height          =   240
      Index           =   0
      Left            =   8400
      MousePointer    =   99  'Custom
      Top             =   780
      Width           =   240
   End
   Begin VB.Image ImgMax 
      Height          =   240
      Index           =   1
      Left            =   8730
      Picture         =   "QQForm.ctx":1350
      Top             =   780
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.Image ImgMax 
      Height          =   240
      Index           =   2
      Left            =   9030
      Picture         =   "QQForm.ctx":152C
      Top             =   780
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.Image ImgMax 
      Height          =   240
      Index           =   3
      Left            =   9330
      Picture         =   "QQForm.ctx":17B8
      Top             =   780
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.Image ImgMax 
      Height          =   240
      Index           =   4
      Left            =   9660
      Picture         =   "QQForm.ctx":1A44
      Top             =   780
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.Image ImgMax 
      Height          =   240
      Index           =   5
      Left            =   9990
      Picture         =   "QQForm.ctx":1C50
      Top             =   780
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.Image ImgMax 
      Height          =   240
      Index           =   6
      Left            =   10320
      Picture         =   "QQForm.ctx":1F1C
      Top             =   780
      Visible         =   0   'False
      Width           =   255
   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          =   5445
      Left            =   0
      Picture         =   "QQForm.ctx":21E8
      Top             =   0
      Visible         =   0   'False
      Width           =   7920
   End
End
Attribute VB_Name = "QQForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

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, 50, 350, .Width - 100, .Height - 425, 200, 310, Skin.Width - 250, Skin.Height - 380
    .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
    
      

    
    If .Parent.ICON <> 0 Then
        .PaintPicture ICON.Picture, 100, 55, 240, 240, 0, 0, 240, 240   '打印标题图标
    End If
    SetRgn UserControl, 7
    SetRgn .Parent, 7
    .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 + 70
    
    ImgClose(0).Left = .ScaleWidth - ImgClose(0).Width - 70
    ImgClose(0).Top = 70
    
    ImgMin(0).Top = 70
    ImgMax(0).Top = 70
    
    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
    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