osen xp form.ctl

用vb编写的工程控制程序

Private Sub Right_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 Right_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    On Error GoTo Z
    If Not MyForm Is Nothing Then
        If (MyForm.BorderStyle = 2) And (MyForm.BorderStyle = 2) And (MyForm.WindowState = 0) Then
            Right.MousePointer = 9
          Else 'NOT (MYFORM.BORDERSTYLE...
            Right.MousePointer = 0
        End If
    End If
Z:

End Sub

Private Sub Right_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, 1
                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

Public Sub SetMDIPosition(ByVal iLeft As Long, ByVal iWidth As Long, ByVal IHeight As Long)

    With PicMain
        .Left = iLeft
        .Height = IHeight
        .Width = iWidth
    End With 'PICMAIN

End Sub
Public Sub SetStyle(ByVal IpForm As Object)

    On Error Resume Next
      Dim lCurrentSettings As Long ':(燤ove line to top of current Sub
      Const WS_MINIMIZEBOX = &H20000 ':(燤ove line to top of current Sub
      Const WS_MAXIMIZEBOX = &H10000 ':(燤ove line to top of current Sub
      Const WS_THICKFRAME = &H40000 ':(燤ove line to top of current Sub
      Const WS_DLGFRAME = &H400000 ':(燤ove line to top of current Sub
      Const WS_CAPTION = &HC00000 ':(燤ove line to top of current Sub
        lCurrentSettings = GetWindowLong(IpForm.hwnd, GWL_STYLE)
        lCurrentSettings = lCurrentSettings And Not WS_THICKFRAME
        lCurrentSettings = lCurrentSettings And Not WS_DLGFRAME
        lCurrentSettings = lCurrentSettings And Not WS_CAPTION
        lCurrentSettings = lCurrentSettings And Not WS_MINIMIZEBOX
        lCurrentSettings = lCurrentSettings And Not WS_MAXIMIZEBOX
        lCurrentSettings = lCurrentSettings Or WS_SYSMENU
        SetWindowLong IpForm.hwnd, GWL_STYLE, lCurrentSettings
        SetWindowPos IpForm.hwnd, 0, IpForm.Left / 15, IpForm.Top / 15, (IpForm.Width / 15), (IpForm.Height / 15), &H40
        If IpForm.BorderStyle <> 0 Then
            IpForm.Height = IpForm.Height - 365
        End If

End Sub ':(燨n Error Resume still active

Public Sub ShowChild(ByVal IpForm As Object)
    
    IpForm.Show 0, MyForm
    SetParent IpForm.hwnd, PicMain.hwnd
    m_activeform = m_activeform + 1
    
End Sub
Public Function NChildForm() As Integer
    NChildForm = m_activeform
End Function
Public Sub CloseChildForm()
    If m_activeform > 0 Then
        m_activeform = m_activeform - 1
    End If
End Sub
Public Property Let ShowClose(ByVal New_ShowClose As Boolean)

    m_ShowClose = New_ShowClose
    CloseButton.Visible = m_ShowClose
    PropertyChanged "ShowClose"

End Property

Public Property Get ShowClose() As Boolean

    ShowClose = m_ShowClose

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

    ShowIcon = TitleIcon.Visible

End Property

Public Property Let ShowIcon(ByVal New_ShowIcon As Boolean)

    TitleIcon.Visible = New_ShowIcon
    Repos
    PropertyChanged "ShowIcon"

End Property

Public Property Get ShowMaximize() As Boolean

    ShowMaximize = m_ShowMaximize

End Property

Public Property Let ShowMaximize(ByVal New_ShowMaximize As Boolean)

    m_ShowMaximize = New_ShowMaximize
    MaximizeButton.Visible = m_ShowMaximize
    PropertyChanged "ShowMaximize"

End Property

Public Property Let ShowMinimize(ByVal New_ShowMinimize As Boolean)

    m_ShowMinimize = New_ShowMinimize
    Minimizebutton.Visible = m_ShowMinimize
    PropertyChanged "ShowMinimize"

End Property

Public Property Get ShowMinimize() As Boolean

    ShowMinimize = m_ShowMinimize

End Property

Public Sub TaskBarShow()

  Dim rtn As Long

    rtn = FindWindow("Shell_traywnd", "")
    Call SetWindowPos(rtn, 0, 0, 0, 0, 0, &H40)

End Sub

Private Sub Title_DblClick()

    On Error Resume Next
        If Not MyForm Is Nothing Then
            If MyForm.BorderStyle = 2 Then

                If (EnableMaximize And MyForm.MaxButton) Then

                    If MyForm.WindowState = 0 Then
                        MyForm.WindowState = 2
                      Else 'NOT MYFORM.WINDOWSTATE...
                        MyForm.WindowState = 0
                    End If

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

                    ReTransObj MyForm
                    Repos
                    Minimizebutton.RefreshControl
                    MaximizeButton.RefreshControl
                    CloseButton.RefreshControl

                End If

            End If
        End If

End Sub ':(燨n Error Resume still active

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

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

End Sub


Private Sub TitleIcon_DblClick()

    On Error Resume Next
        If Not MyForm Is Nothing Then
            If MyForm.BorderStyle = 2 Then
                If MyForm.WindowState = 0 Then
                    MyForm.WindowState = 2
                  Else 'NOT MYFORM.WINDOWSTATE...
                    MyForm.WindowState = 0
                End If
                UserControl.Width = MyForm.Width
                UserControl.Height = MyForm.Height
                ReTransObj MyForm
            End If
        End If

End Sub ':(燨n Error Resume still active

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

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

End Sub

Private Sub TitleLeft_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 TitleRight_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 TitleTop() As Integer

    TitleTop = m_TitleTop

End Property

Public Property Let TitleTop(ByVal New_TitleTop As Integer)

    m_TitleTop = New_TitleTop
    PropertyChanged "TitleTop"
    Repos

End Property

Public Sub TransparentEdges()

    bTransparent = True
    Repos

End Sub

Private Sub UserControl_Initialize()

    On Error Resume Next
        bTransparent = False  'So we do not set the corners transparent while still in design mode
        IsLoad = False
        Repos   'Reposition

End Sub ':(燨n Error Resume still active

Private Sub UserControl_InitProperties()

    On Error GoTo Z
    UserControl.Parent.BackColor = DefaultBackgroundColor
    m_ShowMinimize = m_def_ShowMinimize
    m_ShowMaximize = m_def_ShowMaximize
    m_ShowClose = m_def_ShowClose
    m_ShowHelp = m_def_ShowHelp
    m_EnableMaximize = m_def_EnableMaximize
    m_AutoLoad = True
    Caption1.Caption = "Hello " & GetCompName
    UserControl.Parent.Caption = "Osen Kusnadi<[e-mail]>"
    m_IpModal = m_def_IpModal
    m_CloseActive = m_def_CloseActive
    m_IconIndex = m_def_IconIndex
    m_IconTop = m_def_IconTop
    m_TitleTop = m_def_TitleTop
    ShowIcon = False
    Minimizebutton.ButtonStyle = MinButton
    MaximizeButton.ButtonStyle = MaxButton
    CloseButton.ButtonStyle = CloseButton
    
Z:

    m_Theme = m_def_Theme
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    Caption1.Caption = PropBag.ReadProperty("Caption", "SEN MASTER")
    Caption2.Caption = Caption1.Caption
    Set Caption1.Font = PropBag.ReadProperty("Font", Ambient.Font)
    Set Caption2.Font = PropBag.ReadProperty("Font", Ambient.Font)
    m_ShowMinimize = PropBag.ReadProperty("ShowMinimize", m_def_ShowMinimize)
    m_ShowMaximize = PropBag.ReadProperty("ShowMaximize", m_def_ShowMaximize)
    m_ShowClose = PropBag.ReadProperty("ShowClose", m_def_ShowClose)
    m_ShowHelp = PropBag.ReadProperty("ShowHelp", m_def_ShowHelp)
    m_EnableMaximize = PropBag.ReadProperty("EnableMaximize", m_def_EnableMaximize)
    Set TitleIcon.Picture = PropBag.ReadProperty("Icon", Nothing)
    m_AutoLoad = PropBag.ReadProperty("AutoLoad", m_def_AutoLoad)
    TitleIcon.Visible = PropBag.ReadProperty("ShowIcon", True)
    m_IpModal = PropBag.ReadProperty("IpModal", m_def_IpModal)
    pICmenu.BackColor = PropBag.ReadProperty("MenuBackColor", &H80000004)
    m_CloseActive = PropBag.ReadProperty("CloseActive", m_def_CloseActive)
    m_IconTop = PropBag.ReadProperty("IconTop", m_def_IconTop)
    TitleIcon.Top = m_IconTop
    m_TitleTop = PropBag.ReadProperty("TitleTop", m_def_TitleTop)
    m_HaveChild = PropBag.ReadProperty("HaveChild", False)
    PicMain.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
    Set Picture = PropBag.ReadProperty("Picture", Nothing)
    PicMain.Enabled = PropBag.ReadProperty("Enabled", True)
    m_Theme = PropBag.ReadProperty("Theme", m_def_Theme)
    MaximizeButton.Enabled = m_EnableMaximize
    Repos
End Sub

Private Sub UserControl_Resize()

    Repos   'Reposition

End Sub

Private Sub UserControl_Show()

    On Error GoTo Z
    Repos
    If AutoLoad Then LoadXP ':(燛xpand Structure
Z:

End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    With PropBag
        Call .WriteProperty("Caption", Caption1.Caption, "SEN MASTER")
        Call .WriteProperty("Font", Caption1.Font, Ambient.Font)
        Call .WriteProperty("ShowMinimize", m_ShowMinimize, m_def_ShowMinimize)
        Call .WriteProperty("ShowMaximize", m_ShowMaximize, m_def_ShowMaximize)
        Call .WriteProperty("ShowClose", m_ShowClose, m_def_ShowClose)
        Call .WriteProperty("ShowHelp", m_ShowHelp, m_def_ShowHelp)
        Call .WriteProperty("EnableMaximize", m_EnableMaximize, m_def_EnableMaximize)
        Call .WriteProperty("AutoLoad", m_AutoLoad, m_def_AutoLoad)
        Call .WriteProperty("ShowIcon", TitleIcon.Visible, True)
        Call .WriteProperty("Icon", TitleIcon.Picture, Nothing)
        Call .WriteProperty("IpModal", m_IpModal, m_def_IpModal)
        Call .WriteProperty("MenuBackColor", pICmenu.BackColor, &H80000004)
        Call .WriteProperty("CloseActive", m_CloseActive, m_def_CloseActive)
        Call .WriteProperty("IconTop", m_IconTop, m_def_IconTop)
        Call .WriteProperty("TitleTop", m_TitleTop, m_def_TitleTop)
        Call .WriteProperty("HaveChild", m_HaveChild, False)
        TitleIcon.Top = m_IconTop
    End With 'PROPBAG
    Call PropBag.WriteProperty("BackColor", PicMain.BackColor, &H8000000F)
    Call PropBag.WriteProperty("Picture", Picture, Nothing)
    Call PropBag.WriteProperty("Enabled", PicMain.Enabled, True)

    Call PropBag.WriteProperty("Theme", m_Theme, m_def_Theme)
End Sub
Public Property Get ColorScheme() As XPTheme
    ColorScheme = m_Theme
End Property

Public Property Let ColorScheme(ByVal New_Theme As XPTheme)
    m_Theme = New_Theme
    PropertyChanged "Theme"
    DoEvents
    Repos
    Repos
End Property

Public Sub SetFormActiveStyle(ByVal ActiveForm As Boolean)
    Dim Index As Integer
    
    Index = m_Theme
    ChangeTitleFontcolor ActiveForm
    
    ThemeX1.ChangeTheme Left, TitleLeft, _
    Title, TitleRight, Right, Bottom, BottomLeft, BottomRight, Index, ActiveForm
    
    Minimizebutton.IsActivate = ActiveForm
    MaximizeButton.IsActivate = ActiveForm
    CloseButton.IsActivate = ActiveForm
    Minimizebutton.Theme = m_Theme
    MaximizeButton.Theme = m_Theme
    CloseButton.Theme = m_Theme
    Minimizebutton.RefreshControl ActiveForm
    CloseButton.RefreshControl ActiveForm
    
    If MaximizeButton.Enabled Then
        MaximizeButton.RefreshControl ActiveForm
    End If
    
End Sub

Private Sub ChangeTitleFontcolor(Optional IsActive As Boolean)
Caption2.Visible = IsActive
    If m_Theme <> 2 Then
        If IsActive Then
            Caption1.ForeColor = vbWhite
            Caption2.ForeColor = IIf(m_Theme, &H4000&, &H400000)       '&H8000&
        Else
            Caption1.ForeColor = vbWhite
            Caption2.ForeColor = vbWhite
        End If
    Else
        If IsActive Then
            Caption1.ForeColor = &H0&
            Caption2.ForeColor = &HE0E0E0
        Else
            Caption1.ForeColor = &HC0C0C0
            Caption2.ForeColor = &HE0E0E0
        End If
    End If
End Sub