jscaption.ctl

复件 VB界面换肤 复件 VB界面换肤

VERSION 5.00
Begin VB.UserControl JSCAPTION 
   Alignable       =   -1  'True
   Appearance      =   0  'Flat
   BackColor       =   &H00DC7E5A&
   ClientHeight    =   465
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3300
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   8.25
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H00FFFFFF&
   ScaleHeight     =   31
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   220
   ToolboxBitmap   =   "JSCAPTION.ctx":0000
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "酷毙了的 XP 窗体控件 (支持换皮肤)"
      BeginProperty Font 
         Name            =   "Trebuchet MS"
         Size            =   11.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   300
      Left            =   1800
      TabIndex        =   0
      Top             =   75
      Width           =   3990
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "酷毙了的 XP 窗体控件 (支持换皮肤)"
      BeginProperty Font 
         Name            =   "Trebuchet MS"
         Size            =   11.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   1350
      TabIndex        =   1
      Top             =   90
      Width           =   3990
   End
   Begin VB.Image Image1 
      Height          =   240
      Left            =   120
      Stretch         =   -1  'True
      Top             =   105
      Width           =   240
   End
End
Attribute VB_Name = "JSCAPTION"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Dim hyfda As Byte
Dim hyfx As Long
Dim hyfy As Long
Dim hyfl As Long
Dim hyft As Long

'判断桌面大小
Const SPI_GETWORKAREA = 48

Private Type RECT
    aLeft As Long
    aTop As Long
    aRight As Long
    aBottom As Long
End Type

Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
                          (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, _
                          ByVal fuWinIni As Long) As Long
'判断桌面大小

Dim z As POINTAPI
Private pb As PropertyBag
Private JS_path As String
Private FRMontop As New clsOnTop

Private JS_TOPLEFT As clsBitmap
Private JS_TOPMID As clsBitmap
Private JS_TOPRIGHT As clsBitmap
Private JS_CLOSE As clsBitmap
Private JS_MAX As clsBitmap
Private JS_MIN As clsBitmap
Private JS_BONTOP As clsBitmap
Private JS_DRAGOK As Boolean
Private JS_ONTOP As Boolean

Private JS_XOFFSET2 As Integer
Private JS_XOFFSET As Integer
Private JS_YOFFSET As Integer
Private JS_SHOWONTOP As Boolean
Private JS_FROMTOP As Integer
Private JS_FROMRIGHT As Integer
Private JS_ICONSPACE As Integer

Private JS_SHOWICON As Boolean
Private JS_CONTROLBOX As Boolean

Enum ACTION
    jsclose = 0
    jsmin = 1
    jsmax = 2
    jsontop = 3
End Enum

Private JS_DOWHAT As ACTION
Private JS_DOACTION As Boolean

Private JS_BORDERSTYLE2 As JS_BORDER2
Enum JS_BORDER2
    dig0 = 0 '最小化
    dig1 = 1 '最大化
    dig2 = 2 '平常
End Enum

Private JS_BORDERSTYLE As JS_BORDER
Enum JS_BORDER
    FIXED = 0
    SIZABLE = 1
    nosize = 2
    FIXED2 = 3
    FIXEDx = 4
End Enum
'缺省属性值:
'Const m_def_BackColor = 0
'Const m_def_ForeColor = 0
'属性变量:
'Dim m_BackColor As Long
'Dim m_ForeColor As Long
'事件声明:
Event Click()

Public Property Get ControlBox() As Boolean
    ControlBox = JS_CONTROLBOX
End Property

Public Property Let ControlBox(newvalue As Boolean)
    JS_CONTROLBOX = newvalue
    PropertyChanged "ControlBox"
End Property

Public Property Let Movable(newvalue As Boolean)
    JS_DRAGOK = newvalue
    PropertyChanged "Movable"
End Property

Public Property Get Movable() As Boolean
    Movable = JS_DRAGOK

End Property

Private Sub FormDrag()
    If JS_DRAGOK = True Then
        ' ReleaseCapture
        ' Call SendMessage(UserControl.Parent.hwnd, &HA1, 2, 0&)
        '   ReleaseCapture
        '   SendMessage UserControl.Parent.hwnd, &H112, &HF012, 0 'Move the form
        ReleaseCapture
        If hyfda <> 1 Then '只要是最大化，标题就不可移动
            SendMessage UserControl.Parent.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0

        End If
    End If
End Sub

Private Sub DOSKIN()

    If Ambient.UserMode = True Then

        Dim varTemp As Variant
        Dim byteArr() As Byte
        On Error Resume Next
        '
        'INIALIZE THE IMAGES IN DC
        '

        Set JS_TOPLEFT = New clsBitmap
        Set JS_TOPMID = New clsBitmap
        Set JS_TOPRIGHT = New clsBitmap
        Set JS_CLOSE = New clsBitmap
        Set JS_MAX = New clsBitmap
        Set JS_MIN = New clsBitmap
        Set JS_BONTOP = New clsBitmap
        '   On Error GoTo errhandler

        Set pb = New PropertyBag

        'Open the file and store the data in a variable
        Open JS_path For Binary As #1
        Get #1, , varTemp
        Close #1

        ' Convert the variant to byte.
        byteArr = varTemp
        ' Property bag contents as byte.
        pb.Contents = byteArr

        ' Now put the value of the data in textboxes
        With pb
            JS_TOPLEFT.LoadResource .ReadProperty("TOPLEFT")
            JS_TOPMID.LoadResource .ReadProperty("TOPMID")
            JS_TOPRIGHT.LoadResource .ReadProperty("TOPRIGHT")
            JS_CLOSE.LoadResource .ReadProperty("CLOSE")
            If hyfda = 1 Then
                JS_MAX.LoadResource .ReadProperty("RES1")
                JS_BORDERSTYLE2 = dig1
            ElseIf UserControl.Parent.WindowState = 1 Then '窗口初值为何，就看这里了。
                JS_BORDERSTYLE2 = dig0
            ElseIf hyfda = 0 Then
                JS_MAX.LoadResource .ReadProperty("MAX")
                JS_BORDERSTYLE2 = dig2

            End If
            JS_MIN.LoadResource .ReadProperty("MIN")

            If JS_ONTOP = True Then
                JS_BONTOP.LoadResource .ReadProperty("ONTOP3")
            Else
                JS_BONTOP.LoadResource .ReadProperty("ONTOP1")

            End If
            JS_XOFFSET = .ReadProperty("XOFFSET")
            JS_XOFFSET2 = .ReadProperty("XOFFSET2")
            JS_YOFFSET = .ReadProperty("YOFFSET")
            JS_FROMRIGHT = .ReadProperty("FROMRIGHT")
            JS_FROMTOP = .ReadProperty("FROMTOP")
            JS_ICONSPACE = .ReadProperty("ICONSPACE")
            UserControl.ForeColor = .ReadProperty("FORECOLOR")
            UserControl.BackColor = .ReadProperty("BackColor") '这里一改就有底色了
            UserControl.Parent.BackColor = .ReadProperty("PARENTBACKCOLOR")

        End With

        '
        'LOAD THE IMAGES FROM DISK
        '

        '
        'SET CONTROLHEIGHT
        '
        UserControl.Height = (JS_TOPLEFT.Height) * Screen.TwipsPerPixelY
        '
        'PLACE THE IMAGES ON THE USERCONTROL
        '
        'MIDDLE IMAGE
        For i = 0 To UserControl.ScaleWidth
            BitBlt UserControl.hdc, JS_TOPMID.Width * i, 0, JS_TOPMID.Width, JS_TOPMID.Height, JS_TOPMID.hdc, 0, 0, SRCCOPY
        Next i
        'LEFT HAND IMAGE
        BitBlt UserControl.hdc, 0, 0, JS_TOPLEFT.Width, JS_TOPLEFT.Height, JS_TOPLEFT.hdc, 0, 0, SRCCOPY
        'RIGHT HAND IMAGE
        BitBlt UserControl.hdc, UserControl.ScaleWidth - JS_TOPRIGHT.Width, 0, JS_TOPRIGHT.Width, JS_TOPRIGHT.Height, JS_TOPRIGHT.hdc, 0, 0, SRCCOPY

        If JS_SHOWICON = True Then
            Image1.Picture = UserControl.Parent.Icon
        End If

        '
        'PLACE THE CLOSE min max BUTTON
        '
        If JS_CONTROLBOX = True Then
            BitBlt UserControl.hdc, UserControl.ScaleWidth - JS_CLOSE.Width - JS_FROMRIGHT, JS_FROMTOP, JS_CLOSE.Width, JS_CLOSE.Height, JS_CLOSE.hdc, 0, 0, SRCCOPY '这一代码管关闭按纽