osen xp form.ctl

用vb编写的工程控制程序

Private Sub Bottom_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

    On Error Resume Next
        If MyForm Is Nothing Then Exit Sub ':(燛xpand Structure or consider reversing Condition
        If (MyForm.BorderStyle = 2) Then
            If MyForm.WindowState = 0 Then
                GetCursorPos Newcp
                ResizeForm MyForm, Oldcp, Newcp, 3
                SetStyle MyForm
                If MyForm.BorderStyle <> 0 Then MyForm.Height = MyForm.Height + 375 ':(燛xpand Structure
                UserControl.Height = MyForm.Height
                UserControl.Width = MyForm.Width
                ReTransObj MyForm
            End If
        End If

End Sub ':(燨n Error Resume still active

Private Sub BottomLeft_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

    If MyForm Is Nothing Then Exit Sub ':(燛xpand Structure or consider reversing Condition
    If (MyForm.BorderStyle = 2) Then
        GetCursorPos Oldcp
    End If

End Sub

Private Sub BottomLeft_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    On Error GoTo Z
    If MyForm Is Nothing Then Exit Sub ':(燛xpand Structure or consider reversing Condition
    If (MyForm.BorderStyle = 2) And (MyForm.WindowState = 0) Then
        BottomLeft.MousePointer = 6
      Else 'NOT (MYFORM.BORDERSTYLE...
        BottomLeft.MousePointer = 0
    End If
Z:

End Sub

Private Sub BottomLeft_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

    On Error Resume Next
        If MyForm Is Nothing Then Exit Sub ':(燛xpand Structure or consider reversing Condition

        If (MyForm.BorderStyle = 2) Then

            If MyForm.WindowState = 0 Then

                GetCursorPos Newcp
                ResizeForm MyForm, Oldcp, Newcp, 5
                SetStyle MyForm

                If MyForm.BorderStyle <> 0 Then MyForm.Height = MyForm.Height + 375 ':(燛xpand Structure

                UserControl.Height = MyForm.Height
                UserControl.Width = MyForm.Width
                ReTransObj MyForm

            End If

        End If

End Sub ':(燨n Error Resume still active

Private Sub BottomRight_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

    If MyForm Is Nothing Then Exit Sub ':(燛xpand Structure or consider reversing Condition
    If (MyForm.BorderStyle = 2) Then
        GetCursorPos Oldcp
    End If

End Sub

Private Sub BottomRight_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    On Error GoTo Z
    If MyForm Is Nothing Then Exit Sub ':(燛xpand Structure or consider reversing Condition
    If (MyForm.BorderStyle = 2) And (MyForm.BorderStyle = 2) And (MyForm.WindowState = 0) Then
        BottomRight.MousePointer = 8
      Else 'NOT (MYFORM.BORDERSTYLE...
        BottomRight.MousePointer = 0
    End If
Z:

End Sub

Private Sub BottomRight_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

    On Error Resume Next
        If MyForm Is Nothing Then Exit Sub ':(燛xpand Structure or consider reversing Condition
        If (MyForm.BorderStyle = 2) Then
            If MyForm.WindowState = 0 Then
                GetCursorPos Newcp
                ResizeForm MyForm, Oldcp, Newcp, 4
                SetStyle MyForm
                If MyForm.BorderStyle <> 0 Then MyForm.Height = MyForm.Height + 375 ':(燛xpand Structure
                UserControl.Height = MyForm.Height
                UserControl.Width = MyForm.Width
                ReTransObj MyForm
            End If
        End If

End Sub ':(燨n Error Resume still active

Public Property Get Caption() As String
Attribute Caption.VB_Description = "Returns/sets the text displayed in an object's title bar or below an object's icon."

    Caption = Caption1.Caption

End Property

Public Property Let Caption(ByVal New_Caption As String)

    Caption1.Caption() = New_Caption
    Caption2.Caption = New_Caption
    UserControl.Parent.Caption = New_Caption
    PropertyChanged "Caption"

End Property

Private Sub Caption1_Change()

    Caption2.Caption = Caption1.Caption

End Sub

Private Sub Caption1_DblClick()

    Title_DblClick

End Sub

Private Sub Caption1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

  'Lets user move parent form

    Call ReleaseCapture
    Call SendMessage(UserControl.ContainerHwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)

End Sub

Private Sub Caption2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

  'Lets user move parent form

    Call ReleaseCapture
    Call SendMessage(UserControl.ContainerHwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)

End Sub

Public Property Get CloseActive() As Boolean

    CloseActive = m_CloseActive

End Property

Public Property Let CloseActive(ByVal New_CloseActive As Boolean)

    m_CloseActive = New_CloseActive
    PropertyChanged "CloseActive"

End Property

Private Sub CbMin_Click(Index As Integer)

End Sub

Private Sub CloseButton_Click()

    On Error GoTo EF
    If CloseActive Then
        RaiseEvent CloseForm
      Else 'CLOSEACTIVE = FALSE/0
        If Not MyForm Is Nothing Then Unload MyForm ':(燛xpand Structure
    End If
EF:

End Sub

Public Sub ContainerCheck()

    On Error GoTo hjk
  Dim Control As Object ':(燤ove line to top of current Sub
    For Each Control In UserControl.Parent
        If Control.Container.hwnd = UserControl.ContainerHwnd Then
            Control.Left = Control.Left + 75
            Control.Top = Control.Top + 450
        End If
    Next Control
hjk:

End Sub

Public Function DefaultBackgroundColor() As String

    DefaultBackgroundColor = &HD8E9EC   '&HEAF1F1   'Returns a common off-white Windows XP color

End Function

Public Property Let Enabled(ByVal New_Enabled As Boolean)
Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."

    PicMain.Enabled() = New_Enabled
    PropertyChanged "Enabled"

End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=PicMain,PicMain,-1,Enabled
Public Property Get Enabled() As Boolean

    Enabled = PicMain.Enabled

End Property

Public Property Get EnableMaximize() As Boolean

    EnableMaximize = m_EnableMaximize

End Property

Public Property Let EnableMaximize(ByVal New_EnableMaximize As Boolean)

    m_EnableMaximize = New_EnableMaximize
    MaximizeButton.Enabled = m_EnableMaximize
    PropertyChanged "EnableMaximize"
    
End Property

Public Property Get Font() As Font
Attribute Font.VB_Description = "Returns a Font object."
Attribute Font.VB_UserMemId = -512

    Set Font = Caption1.Font

End Property

Public Property Set Font(ByVal New_Font As Font)

    Set Caption1.Font = New_Font
    Set Caption2.Font = New_Font
    PropertyChanged "Font"

End Property

Public Sub FormOnTop(hWindow As Long, bTopMost As Boolean)

    On Error Resume Next
      Dim wFlags As Long, placement As Long ':(燤ove line to top of current Sub
        wFlags = &H2 Or &H1 Or &H40 Or &H10
        Select Case bTopMost
          Case True
            placement = -1
          Case False
            placement = -2
        End Select
        SetWindowPos hWindow, placement, 0, 0, 0, 0, wFlags

End Sub ':(燨n Error Resume still active

Public Function GetCompName() As String

  Dim Commstr As String, nErr As Long

    Commstr = Space$(255)
    nErr = GetComputerName(Commstr, 255)
    GetCompName = Commstr

End Function

Public Property Let HaveChild(ByVal NewHaveChild As Boolean)

    m_HaveChild = NewHaveChild
    PropertyChanged "HaveChild"

End Property

Public Property Get HaveChild() As Boolean

    HaveChild = m_HaveChild

End Property

Public Property Get hwnd() As Long
Attribute hwnd.VB_Description = "Returns a handle (from Microsoft Windows) to an object's window."

    hwnd = PicMain.hwnd

End Property

Public Property Get Icon() As Picture
Attribute Icon.VB_Description = "Returns/sets a graphic to be displayed in a control."

    Set Icon = TitleIcon.Picture

End Property

Public Property Set Icon(ByVal New_Icon As Picture)

    On Error GoTo Z
    Set TitleIcon.Picture = New_Icon
    Set UserControl.Parent.Icon = TitleIcon.Picture
    If Not New_Icon Is Nothing Then
        ShowIcon = True
    Else
        ShowIcon = False
    End If
    PropertyChanged "Icon"
Z:

End Property

Public Property Let IconTop(ByVal New_IconTop As Integer)

    m_IconTop = New_IconTop
    TitleIcon.Top = New_IconTop
    PropertyChanged "IconTop"

End Property

Public Property Get IconTop() As Integer

    IconTop = m_IconTop
    TitleIcon.Top = IconTop

End Property

Public Property Get IpModal() As Integer

    IpModal = m_IpModal

End Property

Public Property Let IpModal(ByVal New_IpModal As Integer)

    m_IpModal = New_IpModal
    PropertyChanged "IpModal"

End Property

Private Sub LbMenu_Click(Index As Integer)
  Dim Xok As Long, Yok As Long, J As Integer ':(燤ove line to top of current Sub
  On Error GoTo Z
    
        Xok = LbMenu(Index).Left + pICmenu.Left + 60
        Yok = LbMenu(Index).Top + pICmenu.Top + 450 + LbMenu(Index).Height - 80
        MyForm.PopupMenu MyMainMenu(Index), , Xok, Yok
Z:

End Sub

Private Sub LbMenu_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim Xok As Long, Yok As Long, J As Integer ':(燤ove line to top of current Sub
  On Error GoTo Z
    
    If Button = 1 Then
        Xok = LbMenu(Index).Left + pICmenu.Left + 60
        Yok = LbMenu(Index).Top + pICmenu.Top + 480 + LbMenu(Index).Height - 80
        MyForm.PopupMenu MyMainMenu(Index), , Xok, Yok
    End If
Z:

End Sub

Private Sub Left_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

    If MyForm Is Nothing Then Exit Sub ':(燛xpand Structure or consider reversing Condition
    If (MyForm.BorderStyle = 2) Then
        GetCursorPos Oldcp
    End If

End Sub

Private Sub Left_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    On Error GoTo Z
    If MyForm Is Nothing Then Exit Sub ':(燛xpand Structure or consider reversing Condition
    If (MyForm.BorderStyle = 2) And (MyForm.BorderStyle = 2) And (MyForm.WindowState = 0) Then
        Left.MousePointer = 9
      Else 'NOT (MYFORM.BORDERSTYLE...
        Left.MousePointer = 0
    End If
Z:

End Sub

Private Sub Left_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

    On Error Resume Next

        If MyForm Is Nothing Then Exit Sub ':(燛xpand Structure or consider reversing Condition
        If (MyForm.BorderStyle = 2) Then
            If MyForm.WindowState = 0 Then
                GetCursorPos Newcp
                ResizeForm MyForm, Oldcp, Newcp, 0
                SetStyle MyForm
                If MyForm.BorderStyle <> 0 Then MyForm.Height = MyForm.Height + 375 ':(燛xpand Structure
                UserControl.Height = MyForm.Height
                UserControl.Width = MyForm.Width
                ReTransObj MyForm
            End If
        End If

End Sub ':(燨n Error Resume still active

Public Sub LoadXP(Optional ByVal OptModal As Integer = 0, Optional ByVal OwnForm As Object)

    On Error GoTo Z

  Dim IpForm As Object ':(燤ove line to top of current Sub
  Dim XP_Name As Object ':(燤ove line to top of current Sub
  Dim oCtl As Control ':(燤ove line to top of current Sub
  Dim i As Integer ':(燤ove line to top of current Sub

    Set IpForm = UserControl.Parent
    Set MyForm = IpForm
    IsLoad = True

    i = 0
    SetCursorPos 9000, 9000
    '/******* Hidden Object in procccess **********************
    For Each oCtl In MyForm
        If TypeOf oCtl Is OsenXPForm Then
            oCtl.Top = 0
            oCtl.Left = 0