Begin VB.Image imgDesktopTop 
      Height          =   945
      Left            =   0
      Picture         =   "背景.frx":52642
      Top             =   0
      Width           =   15345
   End
   Begin VB.Image Img_Background 
      Height          =   5985
      Left            =   1380
      Picture         =   "背景.frx":62686
      Top             =   840
      Width           =   8760
   End
End
Attribute VB_Name = "frmBackground"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'軟件著作權: 北京用友軟件集團有限公司
'系統名稱: 資金管理8.0
'功能說明: 桌面
'作者: 魏小黎
Option Explicit
Private lSecondFunctionPerHeight     As Long    '二級功能單位間距
Private iPreCtlRightIndex           As Integer
Private iPreFirstFunctionIndex      As Integer
Private iPreMoveFirstFunctionIndex  As Integer
Private iSecondFunctionsCount       As Integer  '二級功能數量
Private sSecondFunctions            As String   '二級功能字符串
Private lLinLength                  As Long     '直線寬度

Private iCurrentFirstFunctionIndex  As Integer  '當前被選定的一級索引

Private Sub Form_Activate()
    Me.ZOrder 1
End Sub

'cuidong 2001.04.09
'取得一個路徑的上級路徑
Private Function GetParentPath(ByVal sPath As String) As String
    Dim i As Long
    Dim bFlag As Boolean
    
    sPath = Trim(sPath)
    
    If Right$(sPath, 1) = "\" Then
       sPath = Left$(sPath, Len(sPath) - 1)
    End If
    
    bFlag = False
    For i = Len(sPath) To 1 Step -1
        If mID$(sPath, i, 1) = "\" Then
           bFlag = True
           Exit For
        End If
    Next i
    
    If bFlag And i > 1 Then
       GetParentPath = Left$(sPath, i - 1)
    Else
       GetParentPath = sPath
    End If
End Function

'cuidong 2001.04.09
'從文件中載入一個圖片，返回是否成功
Private Function LoadPictureFile(ByVal sPathFile As String) As Boolean
    On Error GoTo Err_LoadPictureFile
    LoadPictureFile = False
    Set Pic_Load.Picture = LoadPicture()
    Set Pic_Load.Picture = LoadPicture(sPathFile)
    LoadPictureFile = True
    
Err_LoadPictureFile:
End Function

Private Sub Form_Load()

    'cuidong 2001.04.09
    '--------------------------------------------------
    Dim sResPath As String
    
    sResPath = GetParentPath(App.Path) & "\Res\"
    
    '桌面頂部條
    If LoadPictureFile(sResPath & "DeskTop.bmp") Then
       Set imgDesktopTop.Picture = Pic_Load.Picture
    End If
    
    '桌面快捷功能條
    If LoadPictureFile(sResPath & "DeskStart.bmp") Then
       Set imgCtlMain.Picture = Pic_Load.Picture
    End If
    
    '桌面中心
    If LoadPictureFile(sResPath & "DeskCenter.bmp") Then
       Set Img_Background.Picture = Pic_Load.Picture
    End If
    
    '----zcl add 2001.6.22
    '----裝載二級菜單圖片
    If LoadPictureFile(sResPath & "DeskMenu.bmp") Then
       Set imgCtlRight(0).Picture = Pic_Load.Picture
    End If
    '--------------------------------------------------
     
lLinLength = Me.linRight(0).x2 - Me.linRight(0).x1
iPreCtlRightIndex = -1
iPreFirstFunctionIndex = -1
iPreMoveFirstFunctionIndex = -1
''----------------  一級功能最多為13項

    With Me.imgCtlRight(0):
        .Left = 0
        .Top = 0
        picCtlRight(0).Height = .Height
        picCtlRight(0).Width = .Width
    End With
    Me.Top = 0
    Me.Left = 0
    Me.Height = frmMain.ScaleHeight
    Me.Width = frmMain.ScaleWidth
    Me.imgButton(0).Picture = LoadResPicture(101, vbResIcon)
    Me.imgButton(1).Picture = LoadResPicture(102, vbResIcon)
    Me.imgButton(2).Picture = LoadResPicture(103, vbResIcon)
    Me.imgButton(3).Picture = LoadResPicture(104, vbResIcon)
    Me.imgButton(4).Picture = LoadResPicture(105, vbResIcon)
    Me.imgButton(5).Picture = LoadResPicture(106, vbResIcon)
    Me.imgButton(6).Picture = LoadResPicture(107, vbResIcon)
    Me.imgButton(7).Picture = LoadResPicture(108, vbResIcon)
    
    TunePosition
'    If Me.Height >= 6330 Then imgCtlMain.Top = 1102 + Me.Height - 6330
'    If Me.Height < 6330 Then imgCtlMain.Top = 1102 - (6330 - Me.Height)
    If imgCtlMain.Top < 0 Then imgCtlMain.Top = 0
    
    '使用菜單控件
'    Dim objDOM As New DOMDocument
'    Me.CMenu.SetSubSys "FD"
'    Set objDOM = Me.CMenu.GetMenu
'    Me.CMenu.SetMenu objDOM
    
    Me.ZOrder 1
End Sub

Private Sub TunePosition()
   Dim sngOffset  As Single
   Dim intLoop    As Long
   
   sngOffset = Screen.TwipsPerPixelX / 15
   
   'imgCtlMain.Height = 5800 * sngOffset  'cuidong 2001.04.09
   If imgCtlMain.Height > Me.ScaleHeight - imgDesktopTop.Height Then  'cuidong 2001.04.09
      imgCtlMain.Height = Me.ScaleHeight - imgDesktopTop.Height       'cuidong 2001.04.09
   End If                                                             'cuidong 2001.04.09
   
   imgCtlMain.Top = Me.ScaleHeight - imgCtlMain.Height
   
   For intLoop = 0 To 7
      imgButton(intLoop).Left = imgButton(intLoop).Left * sngOffset
      imgButton(intLoop).Top = imgButton(intLoop).Top * sngOffset
      lblFirstFunction(intLoop).Left = lblFirstFunction(intLoop).Left * sngOffset
      lblFirstFunction(intLoop).Top = lblFirstFunction(intLoop).Top * sngOffset
      If intLoop <> 3 And intLoop <> 4 And intLoop <> 5 Then
         imgArrow(intLoop).Left = imgArrow(intLoop).Left * sngOffset
         imgArrow(intLoop).Top = imgArrow(intLoop).Top * sngOffset
      End If
   Next intLoop
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    NoUnderline
End Sub
'去掉下劃線
Private Sub NoUnderline()
Dim i As Byte
On Error Resume Next
If Not iPreMoveFirstFunctionIndex = -1 Then
    With Me.lblFirstFunction(iPreMoveFirstFunctionIndex):
        If .FontUnderline Then
            .FontUnderline = False
            .ForeColor = RGB(0, 0, 0)
            iPreMoveFirstFunctionIndex = -1
        End If
    End With
End If
If Me.picCtlRight(0).Visible Then
    For i = 0 To Me.lblSecondFunction2.Count - 1
        With Me.lblSecondFunction2(i):
            If .Visible Then
                If .ForeColor = RGB(0, 0, 255) Then
                    .ForeColor = RGB(0, 0, 0)
                End If
            End If
        End With
    Next
End If
On Error GoTo 0

End Sub
'排列二級功能列表
Private Sub SortSecondFunction(s As String)

Dim i As Long
For i = 0 To Me.lblSecondFunction2.Count - 1
    Me.lblSecondFunction2(i).Visible = False
    Me.linRight(i).Visible = False
    With Me.lblSecondFunction2(i)
        .MouseIcon = Me.lblFirstFunction(0).MouseIcon
        .MousePointer = Me.lblFirstFunction(0).MousePointer
        .ForeColor = RGB(0, 0, 0)
    End With
Next
i = 0
If s <> "" Then
    Dim iInstr As Long
    Dim sTmp As String
    iInstr = InStr(1, s, Chr(9))
    If iInstr > 0 Then
        Do While iInstr > 0
            Me.lblSecondFunction2(i).Caption = "· " & Left(s, iInstr - 1)
            Me.lblSecondFunction2(i).Visible = True
            Me.linRight(i).Visible = True
            s = mID(s, iInstr + 1)
            i = i + 1
            iInstr = InStr(1, s, Chr(9))
        Loop
        If s <> "" Then
            Me.lblSecondFunction2(i).Caption = "· " & s
            Me.lblSecondFunction2(i).Visible = True
            Me.linRight(i).Visible = True
        End If
    Else
        With Me.lblSecondFunction2(0):
            .Caption = "· " & s
            .Visible = True
        End With
    End If
    '排序
    iSecondFunctionsCount = i + 1
    lSecondFunctionPerHeight = Me.picCtlRight(0).Height / (iSecondFunctionsCount + 1)
    Me.linRight(0).Y1 = lSecondFunctionPerHeight
    Me.linRight(0).Y2 = Me.linRight(0).Y1
    
    For i = 0 To iSecondFunctionsCount - 1
        If i > 0 Then
            Me.linRight(i).Y1 = Me.linRight(i - 1).Y1 + lSecondFunctionPerHeight
            Me.linRight(i).Y2 = Me.linRight(i).Y1
        End If
        Me.lblSecondFunction2(i).Top = Me.linRight(i).Y1 - Me.lblSecondFunction2(i).Height
        Me.linRight(i).Visible = True
        Me.lblSecondFunction2(i).Visible = True
    Next
End If

End Sub

Private Sub Form_Resize()                                 'Cuidong 2000/06/20
    On Error Resume Next                                  'Cuidong 2000/06/20
    'Img_Background.Move 0, 0, ScaleWidth, ScaleHeight    '滿屏
    With Img_Background                                   'Cuidong 2000/06/20
        .Move ScaleWidth - .Width, ScaleHeight - .Height  '居右下角
    End With                                              'Cuidong 2000/06/20
End Sub

Private Sub Img_Background_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    NoUnderline
End Sub

Private Sub imgCtlMain_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    NoUnderline
End Sub

Private Sub imgCtlRight_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    NoUnderline
End Sub

Private Sub lblFirstFunction_Click(Index As Integer)

    Dim lPerWidth As Long
    Dim bColor As Boolean
    bColor = True
    Dim i As Long
    ''--------------根據Index更換二級功能字符串(已chr(9)分隔)
    Select Case Index
        Case Is = 0
            sSecondFunctions = "利率設置" _
                        & Chr(9) & "結息日定義" _
                        & Chr(9) & "單位定義" _
                        & Chr(9) & "賬戶定義" _
                        & Chr(9) & "賬戶科目" _
                        & Chr(9) & "常用單據" _
                        & Chr(9) & "選項"
        Case Is = 1
            sSecondFunctions = "銀行存款單" _
                        & Chr(9) & "銀行取款單" _
                        & Chr(9) & "內部存款單" _
                        & Chr(9) & "內部取款單" _
                        & Chr(9) & "銀行貸款單" _
                        & Chr(9) & "內部貸款單" _
                        & Chr(9) & "內部拆借單" _
                        & Chr(9) & "銀行貸款本金還款單" _
                        & Chr(9) & "內部貸款本金還款單" _
                        & Chr(9) & "內部拆借本金還款單" _
                        & Chr(9) & "銀行貸款利息還款單" _
                        & Chr(9) & "內部貸款利息還款單" _
                        & Chr(9) & "內部拆借利息還款單" _
                        & Chr(9) & "對外結算單" _
                        & Chr(9) & "內部結算單" _
                        & Chr(9) & "利息單" _
                        & Chr(9) & "催款單"
        Case Is = 2
            sSecondFunctions = "銀行存款單" _
                        & Chr(9) & "銀行取款單" _
                        & Chr(9) & "內部存款單" _
                        & Chr(9) & "內部取款單" _
                        & Chr(9) & "銀行貸款單" _
                        & Chr(9) & "內部貸款單" _
                        & Chr(9) & "內部拆借單" _
                        & Chr(9) & "銀行貸款本金還款單" _
                        & Chr(9) & "內部貸款本金還款單" _
                        & Chr(9) & "內部拆借本金還款單" _
                        & Chr(9) & "銀行貸款利息還款單" _
                        & Chr(9) & "內部貸款利息還款單" _
                        & Chr(9) & "內部拆借利息還款單" _
                        & Chr(9) & "對外結算單" _
                        & Chr(9) & "內部結算單" _
                        & Chr(9) & "利息單" _
                        & Chr(9) & "利息通知單" _
                        & Chr(9) & "催款單"
        Case Is = 3
            sSecondFunctions = ""
            If mnu_right(3, 0) Then