jscaption.ctl

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

    '    m_BackColor = m_def_BackColor
    '    m_ForeColor = m_def_ForeColor
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

    If JS_DOACTION = True Then
        If JS_CONTROLBOX = True Then

            If JS_DOWHAT = jsclose Then
                JS_CLOSE.LoadResource pb.ReadProperty("CLOSE2")
                BitBlt UserControl.hdc, UserControl.ScaleWidth - JS_CLOSE.Width - JS_FROMRIGHT, JS_FROMTOP, JS_CLOSE.Width, JS_CLOSE.Height, JS_CLOSE.hdc, 0, 0, SRCCOPY

            ElseIf JS_DOWHAT = jsmax Then
                If hyfda = 1 Then
                    JS_MAX.LoadResource pb.ReadProperty("RES3")
                    BitBlt UserControl.hdc, UserControl.ScaleWidth - JS_MAX.Width - JS_ICONSPACE - JS_CLOSE.Width - JS_FROMRIGHT, JS_FROMTOP, JS_MAX.Width, JS_MAX.Height, JS_MAX.hdc, 0, 0, SRCCOPY
                Else
                    JS_MAX.LoadResource pb.ReadProperty("MAX2")
                    BitBlt UserControl.hdc, UserControl.ScaleWidth - JS_MAX.Width - JS_ICONSPACE - JS_CLOSE.Width - JS_FROMRIGHT, JS_FROMTOP, JS_MAX.Width, JS_MAX.Height, JS_MAX.hdc, 0, 0, SRCCOPY

                End If

            ElseIf JS_DOWHAT = jsmin Then
                JS_MIN.LoadResource pb.ReadProperty("MIN2")
                BitBlt UserControl.hdc, UserControl.ScaleWidth - JS_MIN.Width - JS_ICONSPACE - JS_MAX.Width - JS_ICONSPACE - JS_CLOSE.Width - JS_FROMRIGHT, JS_FROMTOP, JS_MIN.Width, JS_MIN.Height, JS_MIN.hdc, 0, 0, SRCCOPY
            End If
        End If
    Else
        FormDrag
    End If

End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If JS_CONTROLBOX = True Then
        'If JS_BORDERSTYLE <> FIXEDx Then

        If y > JS_FROMTOP And y < (JS_CLOSE.Height + JS_FROMTOP) Then
            If x > UserControl.ScaleWidth - JS_CLOSE.Width - JS_FROMRIGHT And x < UserControl.ScaleWidth - JS_FROMRIGHT Then
                If JS_BORDERSTYLE <> FIXEDx Then
                    JS_CLOSE.LoadResource pb.ReadProperty("CLOSE3") ' JS_Path & "CLOSE3.BMP"
                    BitBlt UserControl.hdc, UserControl.ScaleWidth - JS_CLOSE.Width - JS_FROMRIGHT, JS_FROMTOP, JS_CLOSE.Width, JS_CLOSE.Height, JS_CLOSE.hdc, 0, 0, SRCCOPY
                    JS_DOWHAT = jsclose
                    JS_DOACTION = True
                End If

            ElseIf x > UserControl.ScaleWidth - JS_CLOSE.Width - JS_ICONSPACE - JS_MAX.Width - JS_FROMRIGHT And x < UserControl.ScaleWidth - JS_CLOSE.Width - JS_ICONSPACE - JS_FROMRIGHT Then
                If JS_BORDERSTYLE <> FIXED2 And JS_BORDERSTYLE <> FIXED Then
                    If hyfda = 1 Then
                        JS_MAX.LoadResource pb.ReadProperty("RES2")
                        BitBlt UserControl.hdc, UserControl.ScaleWidth - JS_MAX.Width - JS_ICONSPACE - JS_CLOSE.Width - JS_FROMRIGHT, JS_FROMTOP, JS_MAX.Width, JS_MAX.Height, JS_MAX.hdc, 0, 0, SRCCOPY
                        JS_DOWHAT = jsmax
                        JS_DOACTION = True
                    Else
                        JS_MAX.LoadResource pb.ReadProperty("MAX3")
                        BitBlt UserControl.hdc, UserControl.ScaleWidth - JS_MAX.Width - JS_ICONSPACE - JS_CLOSE.Width - JS_FROMRIGHT, JS_FROMTOP, JS_MAX.Width, JS_MAX.Height, JS_MAX.hdc, 0, 0, SRCCOPY
                        JS_DOWHAT = jsmax
                        JS_DOACTION = True

                    End If
                End If
            ElseIf x > UserControl.ScaleWidth - JS_MIN.Width - JS_ICONSPACE - JS_CLOSE.Width - JS_ICONSPACE - JS_MAX.Width - JS_FROMRIGHT And x < UserControl.ScaleWidth - JS_CLOSE.Width - JS_MIN.Width - JS_ICONSPACE - JS_ICONSPACE - JS_FROMRIGHT Then
                If JS_BORDERSTYLE <> FIXED Then
                    JS_MIN.LoadResource pb.ReadProperty("MIN3")
                    BitBlt UserControl.hdc, UserControl.ScaleWidth - JS_MIN.Width - JS_ICONSPACE - JS_MAX.Width - JS_ICONSPACE - JS_CLOSE.Width - JS_FROMRIGHT, JS_FROMTOP, JS_MIN.Width, JS_MIN.Height, JS_MIN.hdc, 0, 0, SRCCOPY
                    JS_DOWHAT = jsmin
                    JS_DOACTION = True
                End If
                'frmtopmost
            ElseIf x > UserControl.ScaleWidth - JS_BONTOP.Width - JS_ICONSPACE - JS_MIN.Width - JS_ICONSPACE - JS_CLOSE.Width - JS_ICONSPACE - JS_MAX.Width - JS_FROMRIGHT And x < UserControl.ScaleWidth - JS_ICONSPACE - JS_MIN.Width - JS_ICONSPACE - JS_CLOSE.Width - JS_ICONSPACE - JS_MAX.Width - JS_FROMRIGHT Then
                If JS_SHOWONTOP = True Then
                    JS_DOWHAT = jsontop
                    JS_DOACTION = True
                End If

            Else
                JS_CLOSE.LoadResource pb.ReadProperty("CLOSE")
                BitBlt UserControl.hdc, UserControl.ScaleWidth - JS_CLOSE.Width - JS_FROMRIGHT, JS_FROMTOP, JS_CLOSE.Width, JS_CLOSE.Height, JS_CLOSE.hdc, 0, 0, SRCCOPY
                If JS_BORDERSTYLE <> FIXED Then
                    If hyfda = 1 Then

                        JS_MAX.LoadResource pb.ReadProperty("RES1")
                    Else
                        JS_MAX.LoadResource pb.ReadProperty("MAX")

                    End If
                    BitBlt UserControl.hdc, UserControl.ScaleWidth - JS_MAX.Width - JS_ICONSPACE - JS_CLOSE.Width - JS_FROMRIGHT, JS_FROMTOP, JS_MAX.Width, JS_MAX.Height, JS_MAX.hdc, 0, 0, SRCCOPY

                    JS_MIN.LoadResource pb.ReadProperty("MIN")
                    BitBlt UserControl.hdc, UserControl.ScaleWidth - JS_MIN.Width - JS_ICONSPACE - JS_MAX.Width - JS_ICONSPACE - JS_CLOSE.Width - JS_FROMRIGHT, JS_FROMTOP, JS_MIN.Width, JS_MIN.Height, JS_MIN.hdc, 0, 0, SRCCOPY
                End If
                JS_DOACTION = False
            End If
        End If

    End If

End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If JS_CONTROLBOX = True Then

        If JS_DOACTION = True Then
            If JS_DOWHAT = jsclose Then
                JS_CLOSE.LoadResource pb.ReadProperty("CLOSE")
                BitBlt UserControl.hdc, UserControl.ScaleWidth - JS_CLOSE.Width - JS_FROMRIGHT, JS_FROMTOP, JS_CLOSE.Width, JS_CLOSE.Height, JS_CLOSE.hdc, 0, 0, SRCCOPY

            ElseIf JS_DOWHAT = jsmax Then
                JS_MAX.LoadResource pb.ReadProperty("MAX")
                BitBlt UserControl.hdc, UserControl.ScaleWidth - JS_MAX.Width - JS_ICONSPACE - JS_CLOSE.Width - JS_FROMRIGHT, JS_FROMTOP, JS_MAX.Width, JS_MAX.Height, JS_MAX.hdc, 0, 0, SRCCOPY
            ElseIf JS_DOWHAT = jsmin Then
                JS_MIN.LoadResource pb.ReadProperty("MIN")
                BitBlt UserControl.hdc, UserControl.ScaleWidth - JS_MIN.Width - JS_ICONSPACE - JS_MAX.Width - JS_ICONSPACE - JS_CLOSE.Width - JS_FROMRIGHT, JS_FROMTOP, JS_MIN.Width, JS_MIN.Height, JS_MIN.hdc, 0, 0, SRCCOPY
            End If

        End If
    End If
End Sub

Private Sub UserControl_Paint()
    DOSKIN
    Label1.Move JS_XOFFSET + 17, JS_YOFFSET
    Label2.Move JS_XOFFSET + 16, JS_YOFFSET - 1

    Label1.Caption = UserControl.Parent.Caption
    Label2.Caption = UserControl.Parent.Caption

    Label1.ForeColor = UserControl.ForeColor
    Label2.ForeColor = UserControl.BackColor

End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    JS_path = PropBag.ReadProperty("Path", "")
    JS_DRAGOK = PropBag.ReadProperty("Movable", True)
    JS_BORDERSTYLE = PropBag.ReadProperty("Style", 1)
    JS_SHOWICON = PropBag.ReadProperty("ShowIcon", True)
    JS_CONTROLBOX = PropBag.ReadProperty("ControlBox", True)
    JS_ONTOP = PropBag.ReadProperty("ONTOP", False)
    JS_SHOWONTOP = PropBag.ReadProperty("SHOWONTOP", False)

    Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font)
    If JS_BORDERSTYLE = FIXED Or nosize Then
        JS_RESIZE = False
    Else
        JS_RESIZE = True
    End If

    '''llll

    If JS_DRAGOK = True Then
        UserControl.MousePointer = 99
    Else
        UserControl.MousePointer = 0
    End If

    If JS_ONTOP = True Then
        FRMontop.MakeTopMost UserControl.Parent.hwnd
    ElseIf JS_ONTOP = False Then
        FRMontop.MakeNormal UserControl.Parent.hwnd

    End If

    '    m_BackColor = PropBag.ReadProperty("BackColor", m_def_BackColor)
    '    m_ForeColor = PropBag.ReadProperty("ForeColor", m_def_ForeColor)
    Label2.ForeColor = PropBag.ReadProperty("BackColor", &H80000012)
    Label1.ForeColor = PropBag.ReadProperty("ForeColor", &HFFFFFF)
End Sub

Private Sub UserControl_Resize()

    If hyfda = 1 Then  '最大化不可变尺寸
        JS_RESIZE = False
    Else
        If Style = SIZABLE Then JS_RESIZE = True '回原后要有条件才可改变尺寸
    End If '最大化不可变尺寸

    DOSKIN

    If Ambient.UserMode = False Then

        UserControl.Height = 400

    End If

    'Image1.Move 8, 5
    'JS_XOFFSET, JS_YOFFSET
    Image1.Move JS_XOFFSET2, JS_YOFFSET + 2

    If JS_SHOWICON = True Then

        Image1.Refresh

    End If

End Sub

Private Sub UserControl_Terminate()
    Set JS_TOPLEFT = Nothing
    Set JS_TOPMID = Nothing
    Set JS_TOPRIGHT = Nothing
    Set JS_CLOSE = Nothing
    Set JS_MAX = Nothing
    Set JS_MIN = Nothing
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    PropBag.WriteProperty "Path", JS_path, ""
    PropBag.WriteProperty "Movable", JS_DRAGOK, True
    PropBag.WriteProperty "ShowIcon", JS_SHOWICON, True
    PropBag.WriteProperty "ControlBox", JS_CONTROLBOX, True
    PropBag.WriteProperty "ONTOP", JS_ONTOP, False
    PropBag.WriteProperty "SHOWONTOP", JS_SHOWONTOP, False

    PropBag.WriteProperty "Style", JS_BORDERSTYLE, 1
    Call PropBag.WriteProperty("Font", UserControl.Font, Ambient.Font)
    '    Call PropBag.WriteProperty("BackColor", m_BackColor, m_def_BackColor)
    '    Call PropBag.WriteProperty("ForeColor", m_ForeColor, m_def_ForeColor)
    Call PropBag.WriteProperty("BackColor", Label2.ForeColor, &H80000012)
    Call PropBag.WriteProperty("ForeColor", Label1.ForeColor, &HFFFFFF)
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Font
Public Property Get Font() As Font
Attribute Font.VB_Description = "Returns a Font object."
Attribute Font.VB_UserMemId = -512
    Set Font = UserControl.Font
End Property

Public Property Set Font(ByVal New_Font As Font)
    Set UserControl.Font = New_Font
    PropertyChanged "Font"
    DOSKIN
End Property
'
''注意！不要删除或修改下列被注释的行！
''MemberInfo=8,0,0,0
'Public Property Get BackColor() As Long
'    BackColor = m_BackColor
'End Property
'
'Public Property Let BackColor(ByVal New_BackColor As Long)
'    m_BackColor = New_BackColor
'    PropertyChanged "BackColor"
'End Property
'
''注意！不要删除或修改下列被注释的行！
''MemberInfo=8,0,0,0
'Public Property Get ForeColor() As Long
'    ForeColor = m_ForeColor
'End Property
'
'Public Property Let ForeColor(ByVal New_ForeColor As Long)
'    m_ForeColor = New_ForeColor
'    PropertyChanged "ForeColor"
'End Property
'
'注意！不要删除或修改下列被注释的行！
'MappingInfo=Label2,Label2,-1,ForeColor
Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "返回/设置对象中文本和图形的前景色。"
    BackColor = Label2.ForeColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    Label2.ForeColor() = New_BackColor
    PropertyChanged "BackColor"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=Label1,Label1,-1,ForeColor
Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_Description = "返回/设置对象中文本和图形的前景色。"
    ForeColor = Label1.ForeColor
End Property

Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
    Label1.ForeColor() = New_ForeColor
    PropertyChanged "ForeColor"
End Property