reldsktp.bas

财务信息管理系统,适合做毕业论文的人使用

Attribute VB_Name = "RelativeDesktop"
Option Explicit

Public Type POINTAPI
        x As Long
        y As Long
End Type
Public Type OSVERSIONINFO
        dwOSVersionInfoSize As Long
        dwMajorVersion As Long
        dwMinorVersion As Long
        dwBuildNumber As Long
        dwPlatformId As Long
        szCSDVersion As String * 128      '  Maintenance string for PSS usage
End Type

Public Const VER_PLATFORM_WIN32_WINDOWS = 1
Public Const VER_PLATFORM_WIN32_NT = 2

Public Declare Sub SetHook Lib "MouseHuk.dll" (ByVal fnCallback As Long)
Public Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Public Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Public Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Public gd_frmFloat As Form
Public gd_frmFlow As Form
Public g_x As Single, g_y As Single
Public gd_frmMain As MDIForm
Public gd_domMenu As MSXML2.DOMDocument
Public gd_oMenu As Object
Public gd_picForm As PictureBox
Public gd_cSubSys As String

Public Sub MouseProc(ByVal x As Long, ByVal y As Long)
    g_x = x
    g_y = y
End Sub

Public Function GetMenu(ByVal bChinese As Boolean, ByVal cSubSys As String, ByVal cAccId As String, ByVal cYear As String, ByVal cUserId As String, ByVal enumModify As Long, ByVal oMenu As Object, ByVal picForm As PictureBox, ByVal vConn As Variant) As MSXML2.DOMDocument
    oMenu.SetStatus 1
    oMenu.SetSubSys cSubSys
    Dim oMenuSrv As New MnuSrv.clsMenuSrv
    Set gd_domMenu = oMenuSrv.LoadMenu1(bChinese, cSubSys, cAccId, cYear, cUserId, vConn)
    If Not gd_domMenu Is Nothing Then
        oMenu.SetMenu gd_domMenu
    End If
    
    Set gd_oMenu = oMenu
    gd_cSubSys = cSubSys
    Set gd_picForm = picForm
    Set GetMenu = gd_domMenu
End Function

'Public Sub SaveMenu(ByVal vConn As Variant)
'    If GetParent(gd_picForm.hwnd) <> gd_frmMain.hwnd Then
'        SetParent gd_picForm.hwnd, gd_frmMain.hwnd
'        gd_frmFloat.Visible = False
'    End If
'    If Not gd_oMenu Is Nothing Then
'        Dim o As Object
'        Set o = gd_oMenu.GetMenu
'        Dim oMenuSrv As New MnuSrv.clsMenuSrv
'        oMenuSrv.SaveMenu gd_cSubSys, vConn, o
'    End If
'End Sub

Public Sub SetFlowForm(ByVal fMain As MDIForm, ByVal fFlow As Form)
    Set gd_frmFlow = fFlow
    Load gd_frmFlow
    gd_frmFlow.left = 0
    gd_frmFlow.top = 0
    gd_frmFlow.Height = fMain.ScaleHeight
    gd_frmFlow.width = fMain.ScaleWidth
    gd_frmFlow.Show vbModeless
    Set gd_frmMain = fMain
    Set gd_frmFlow = fFlow
End Sub

Public Sub DestroyFlowForm()
    Unload gd_frmFlow
    Set gd_frmFlow = Nothing
End Sub

Public Sub SetFloatForm(ByVal fMain As MDIForm, ByVal fFloat As Form, ByVal picForm As PictureBox, ByVal nTop As Single)
    Set gd_frmFloat = fFloat
    Load gd_frmFloat
    Dim pnt As POINTAPI
    pnt.x = 0: pnt.y = 0
    ClientToScreen fMain.hWnd, pnt
    gd_frmFloat.left = 0
    gd_frmFloat.top = pnt.y * Screen.TwipsPerPixelY + nTop + 30
    
    gd_frmFloat.Height = fMain.ScaleHeight
    gd_frmFloat.width = 1 * Screen.TwipsPerPixelX
    gd_frmFloat.m_nMaxWidth = picForm.width
    gd_frmFloat.Show vbModeless, fMain
    gd_frmFloat.Visible = False
    Set gd_frmMain = fMain
    Set gd_frmFloat = fFloat
    Set gd_picForm = picForm
End Sub

Public Sub DestroyFloatForm()
    Unload gd_frmFloat
    Set gd_frmFloat = Nothing
End Sub

Public Sub ResizeMenu()
    If gd_oMenu Is Nothing Or gd_picForm Is Nothing Then Exit Sub
    gd_oMenu.left = 0
    gd_oMenu.top = 0
    gd_oMenu.width = gd_picForm.ScaleWidth
    gd_oMenu.Height = gd_picForm.ScaleHeight - gd_oMenu.top
End Sub

Public Sub ResizeFlowForm()
    If IsNull(gd_frmFlow) Then Exit Sub
    If Not gd_frmFlow Is Nothing Then
        gd_frmFlow.left = 0
        gd_frmFlow.top = 0
        gd_frmFlow.width = gd_frmMain.ScaleWidth
        gd_frmFlow.Height = gd_frmMain.ScaleHeight
    End If
End Sub

Public Sub ResizeFloatForm(ByVal nTop As Long, Optional CmdWindow As Integer)
    If gd_frmMain Is Nothing Then Exit Sub
    Dim osv As OSVERSIONINFO
    osv.dwOSVersionInfoSize = Len(osv)
    GetVersionEx osv
    If osv.dwPlatformId = VER_PLATFORM_WIN32_NT Then
        If CmdWindow = 2 Then
            If Not gd_frmFloat Is Nothing Then
                If GetParent(gd_picForm.hWnd) <> gd_frmMain.hWnd Then
                    SetParent gd_picForm.hWnd, gd_frmMain.hWnd
                    gd_frmFloat.Visible = False
                End If
            End If
            Exit Sub
        End If
        If gd_frmMain.WindowState = 2 Or CmdWindow = 1 Then
            Dim pnt As POINTAPI
            pnt.x = 0: pnt.y = 0
            ClientToScreen gd_frmMain.hWnd, pnt
            gd_frmFloat.left = 0
            gd_frmFloat.top = pnt.y * Screen.TwipsPerPixelY + nTop + 30
            gd_frmFloat.Height = gd_frmMain.ScaleHeight
            gd_frmFloat.width = 1 * Screen.TwipsPerPixelX
            
            SetParent gd_picForm.hWnd, gd_frmFloat.hWnd
            gd_frmFloat.Visible = True
            gd_frmFloat.width = 1 * Screen.TwipsPerPixelX
        Else
            If Not gd_frmFloat Is Nothing Then
                If GetParent(gd_picForm.hWnd) <> gd_frmMain.hWnd Then
                    SetParent gd_picForm.hWnd, gd_frmMain.hWnd
                    gd_frmFloat.Visible = False
                End If
            End If
        End If
    End If
End Sub

Public Sub RestoreMenuParent()

    If gd_frmMain.WindowState = 2 Then
        If GetParent(gd_picForm.hWnd) <> gd_frmMain.hWnd Then
            SetParent gd_picForm.hWnd, gd_frmMain.hWnd
            gd_frmFloat.Visible = False
        End If
    End If

End Sub