?? frmmanager.frm

?? 檔案管理
?? FRM
?? 第 1 頁 / 共 2 頁
字號:
上一頁 12
  
  '定位上次分隔條
  If Val(GetSetting(App.EXEName, "Config", "Split")) < 1500 Then
    imgSplit.Left = 1500
   Else
    imgSplit.Left = Val(GetSetting(App.EXEName, "Config", "Split"))
  End If
  '安裝列表
  cmdLoad_Click
  '使搜索有效
  frmMain.Toolbar1.Buttons(9).Enabled = True
  frmMain.Toolbar1.Buttons(11).Enabled = False
  
  subPurView '安裝權限
  
End Sub

Private Sub Form_Resize()

  On Error Resume Next
  If Me.Height < 3000 Then Me.Height = 3000
  If Me.Width < 3000 Then Me.Width = 3000
  SizeControls imgSplit.Left
  
End Sub

Private Sub Form_Unload(Cancel As Integer)

  '使按鈕無效
  frmMain.Toolbar1.Buttons(9).Enabled = False
  frmMain.Toolbar1.Buttons(5).Enabled = False
  frmMain.Toolbar1.Buttons(6).Enabled = False
  frmMain.Toolbar1.Buttons(7).Enabled = False
  frmMain.Toolbar1.Buttons(11).Enabled = True
  
  IT = False
  
End Sub

Private Sub imgSplit_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    With imgSplit
        SliptBar.Move .Left, .Top, .Width \ 2, .Height - 20
    End With
    SliptBar.Visible = True
    MDown = True
    
End Sub

Private Sub imgSplit_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    Dim lPos As Single

    If MDown Then
        lPos = X + imgSplit.Left
        If lPos < sglSplitLimit Then
            SliptBar.Left = sglSplitLimit
        ElseIf lPos > Me.ScaleWidth - sglSplitLimit Then
            SliptBar.Left = Me.ScaleWidth - sglSplitLimit
        Else
            SliptBar.Left = lPos
        End If
    End If

End Sub

Private Sub imgSplit_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    SizeControls SliptBar.Left
    SliptBar.Visible = False
    MDown = False
    SaveSetting App.EXEName, "Config", "Split", imgSplit.Left
    
End Sub

Sub SizeControls(X As Single)
    
    On Error Resume Next
    
    '設置 Width 屬性
    If X < 1500 Then X = 1500
    If X > (Me.Width - 1500) Then X = Me.Width - 1500
    TreeView.Width = X
    imgSplit.Left = X
    ListView.Left = X + 40
    ListView.Width = Me.Width - (TreeView.Width - 30)
    
    TreeView.Height = Me.ScaleHeight
    
    ListView.Top = TreeView.Top
    
    ListView.Height = TreeView.Height
    imgSplit.Top = TreeView.Top
    imgSplit.Height = TreeView.Height
    
End Sub

Public Sub cmdLoad_Click()
    
    Me.MousePointer = 11
    '清除右邊的項目內容
    lblFileCaption.Caption = "檔案倉庫"
    txtFields(1).Text = ""
    txtFields(2).Text = ""
    txtFields(3).Text = ""
    txtFields(0).Text = ""
    frmMain.Toolbar1.Buttons(5).Enabled = False
    frmMain.Toolbar1.Buttons(6).Enabled = False
    frmMain.Toolbar1.Buttons(7).Enabled = False
    MnuAddFile.Enabled = False
    MnuModifyFile.Enabled = False
    MnuDeleteFile.Enabled = False
    MnuOpenFile.Enabled = False
    
    Dim rsPublishers As Recordset, rsTitles As Recordset
    Dim IntIndex
    TreeView.Nodes.Clear   '清除原有的數據
    '配置TreeView
    TreeView.Sorted = True
    Set mNode = TreeView.Nodes.Add
    With mNode
     .Text = "檔案倉庫"
     .Tag = "FileManager"
     .Image = "Closed"
    End With
    TreeView.LabelEdit = 1
     
    Set mdbFile = OpenDatabase(ConData, False, False, ConStr)
    Set rsPublishers = mdbFile.OpenRecordset("Catalog", dbOpenDynaset)
        
    Do Until rsPublishers.EOF
       
       Set mNode = TreeView.Nodes.Add(1, tvwChild, rsPublishers!Name, CStr(rsPublishers!Name), "SClosed")
        mNode.Tag = "File"
        IntIndex = mNode.Index
        If strSearchString <> "" Then '查詢時
         Set rsTitles = mdbFile.OpenRecordset("Select * from Detail Where Name ='" & rsPublishers!Name & "'" & strSearchString)
          Else
         Set rsTitles = mdbFile.OpenRecordset("Select * from Detail Where Name ='" & rsPublishers!Name & "'")
        End If
        Do Until rsTitles.EOF
            Set mNode = TreeView.Nodes.Add(IntIndex, tvwChild)
            mNode.Text = rsTitles!檔案號
            mNode.Key = rsTitles!檔案號
            mNode.Tag = "SFile"
            mNode.Image = "File"
            rsTitles.MoveNext
        Loop
        rsPublishers.MoveNext   ' Move to next Publishers record.
    Loop
    
    TreeView.Nodes(1).Sorted = True
    TreeView.Nodes(1).Expanded = True
    
    '釋放數據庫
    rsTitles.Close
    rsPublishers.Close
    mdbFile.Close
    Set mdbFile = Nothing
    
    '取消所有檔案操作
     MnuAddFile.Enabled = False
     MnuModifyFile.Enabled = False
     MnuDeleteFile.Enabled = False
     Me.MousePointer = 0
    
End Sub

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

 If lShow = False Then Exit Sub '已經隱藏時退出
 lLeft.Visible = False
 lRight.Visible = False
 lTop.Visible = False
 lBottom.Visible = False
 lShow = False
 
End Sub

Private Sub ListView_Resize()

  lblFileCaption.Left = (ListView.Width - lblFileCaption.Width) / 2
  lblLine.Width = ListView.ScaleWidth
  lblLine.Left = -20
  Label2.Left = -20
  Label2.Width = ListView.ScaleWidth
  
End Sub

Public Sub MnuAddFile_Click()

   Me.MousePointer = 11
      frmNewForm.Show 1
   Me.MousePointer = 0
   
End Sub

Public Sub MnuDeleteFile_Click()

 If MsgBox("真的要刪除檔案嗎？     " & vbCrLf & vbclrf & vbCrLf & strFileID & " [是/否]？     ", vbYesNo + vbCritical + vbDefaultButton2, "檔案刪除后將不能恢復!") = vbNo Then Exit Sub
    
    Dim strTemp As String
    
    DBEngine.BeginTrans
    
    Set mdbFile = OpenDatabase(ConData, False, False, ConStr)
    strTemp = "Delete * From Detail Where Name='" & strFileType & "' And 檔案號='" & strFileID & "'"
    mdbFile.Execute strTemp
    mdbFile.Close
    Set mdbFile = Nothing
    DBEngine.CommitTrans
    
    '刷新數據
    Call cmdLoad_Click
   frmMain.Toolbar1.Buttons(5).Enabled = False
   frmMain.Toolbar1.Buttons(6).Enabled = False
   frmMain.Toolbar1.Buttons(7).Enabled = False
   MnuAddFile.Enabled = False
   MnuModifyFile.Enabled = False
   MnuDeleteFile.Enabled = False
     
End Sub

Private Sub MnuExit_Click()
  
  Unload frmMain
  
End Sub

Private Sub MnuFolder_Click()

  Me.MousePointer = 11
     frmCatalog.Show 1
  Me.MousePointer = 0
  
End Sub

Public Sub MnuModifyFile_Click()

  Me.MousePointer = 11
  frmModifyForm.Show 1
  Me.MousePointer = 0
  
End Sub

Private Sub MnuOpenFile_Click()

  Call picEditFile_Click
  
End Sub

Private Sub MnuRefresh_Click()

  strSearchString = ""  '查詢條件為空
  Call cmdLoad_Click
   
End Sub

Private Sub MnuReturn_Click()

   Unload Me
   
End Sub

Public Sub MnuSearchFile_Click()

  Me.MousePointer = 11
     frmSearchForm.Show 1
  Me.MousePointer = 0
  
End Sub

Private Sub picEditFile_Click()

  On Error Resume Next
  '編輯檔案
  Dim retVal As Long
  
  retVal = ShellExecute(Me.hwnd, "Open", txtFields(1).Text, "", App.Path + "\File", 1)
  
  If retVal = 2 Then  '文件不存在
     MsgBox "下面文件沒有找到：    " & vbCrLf & vbCrLf & txtFields(1).Text & "    ", vbInformation, "檔案管理系統"
     Exit Sub
  End If
  
  If retVal = 31 Then '文件不能打開時
     If MsgBox("系統不能自動打開下面文件：    " & vbCrLf & vbCrLf & txtFields(1).Text & _
      vbCrLf & vbCrLf & "是否使用其它Open方法試試,(是/否)?      ", vbYesNo + vbQuestion, "檔案管理系統") = vbNo Then
      Exit Sub
     Else
      '使用Explorer打開文件
      retVal = Shell("Explorer.Exe " & txtFields(1).Text, vbNormalFocus)
     End If
  End If
  
End Sub

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

 lTop.BorderColor = &H808080
 lBottom.BorderColor = &HFFFFFF
 
End Sub

Private Sub picEditFile_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  
 If lShow = True Then Exit Sub  '已經顯示時退出
 
 lLeft.Visible = True
 lRight.Visible = True
 lTop.Visible = True
 lBottom.Visible = True
 lShow = True
 
End Sub

Private Sub picEditFile_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
 lTop.BorderColor = &HFFFFFF
 lBottom.BorderColor = &H808080
 
End Sub

Private Sub TreeView_Collapse(ByVal Node As ComctlLib.Node)
  
  If Node.Tag = "FileManager" Then Node.Image = "Closed"
  If Node.Tag = "File" Then Node.Image = "SClosed"

End Sub

Private Sub TreeView_Expand(ByVal Node As ComctlLib.Node)
  
  If Node.Tag = "FileManager" Then Node.Image = "Open"
  If Node.Tag = "File" Then Node.Image = "SOpen"
  
End Sub

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

  If Button = 2 Then
     PopupMenu MnuControl
  End If
  
End Sub

Private Sub TreeView_NodeClick(ByVal Node As ComctlLib.Node)

   lblFileCaption.Caption = Node.Text
   lblFileCaption.Left = (ListView.Width - lblFileCaption.Width) / 2
   
  If Node.Tag = "SFile" Then
     MnuAddFile.Enabled = True
     MnuModifyFile.Enabled = True
     MnuDeleteFile.Enabled = True
     frmMain.Toolbar1.Buttons(5).Enabled = True
     frmMain.Toolbar1.Buttons(6).Enabled = True
     frmMain.Toolbar1.Buttons(7).Enabled = True
     subPurView '安裝權限
   Else
     MnuAddFile.Enabled = False
     MnuModifyFile.Enabled = False
     MnuDeleteFile.Enabled = False
     frmMain.Toolbar1.Buttons(5).Enabled = False
     frmMain.Toolbar1.Buttons(6).Enabled = False
     frmMain.Toolbar1.Buttons(7).Enabled = False
  End If
  
   If Node.Tag = "SFile" And strHistory <> Node.Text Then
      If Trim(Node.Text) <> "" Then
         LoadData (Node.Text) '安裝數據庫
         strHistory = Node.Text
         If Trim(txtFields(1).Text) <> "" And PurView <> "只能添加" Then
            MnuOpenFile.Enabled = True
         Else
            MnuOpenFile.Enabled = False
         End If
      End If
   End If
   
   If Node.Tag <> "SFile" Then
      txtFields(0).Text = ""
      txtFields(1).Text = ""
      txtFields(2).Text = ""
      txtFields(3).Text = ""
      strHistory = ""
      MnuOpenFile.Enabled = False
   End If
   
   '安裝ID與類型,但為根目錄時跳過
   If Node.Text = "檔案倉庫" Then
     ElseIf Node.Tag = "File" Then
       MnuAddFile.Enabled = True
       frmMain.Toolbar1.Buttons(5).Enabled = True
       strFileType = Node.Text
       strFileID = ""
     Else
       strFileType = Node.Parent.Text
       strFileID = Node.Text
   End If
      
End Sub

Private Sub LoadData(strTemp As String)
  
   If PurView = "只能添加" Then Exit Sub
   
   Set mdbFile = OpenDatabase(ConData, False, False, ConStr)
   Dim rsTitles As Recordset
    Set rsTitles = mdbFile.OpenRecordset("Select * From Detail Where 檔案號='" & strTemp & "'", dbOpenDynaset)
    
        txtFields(0).Text = rsTitles!Name
        txtFields(1).Text = rsTitles!文件名
        txtFields(2).Text = rsTitles!文件說明
        txtFields(3).Text = rsTitles!參考說明
     rsTitles.Close
     mdbFile.Close
    Set mdbFile = Nothing
   
End Sub

Private Sub txtFields_Change(Index As Integer)

  If Trim(txtFields(1).Text) = "" Then
     picEditFile.Visible = False
   Else
     picEditFile.Visible = True
  End If
  
End Sub

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

If lShow = False Then Exit Sub '已經隱藏時退出

 lLeft.Visible = False
 lRight.Visible = False
 lTop.Visible = False
 lBottom.Visible = False
 lShow = False
 
End Sub

Private Sub subPurView()

 '權限控制
Select Case PurView
   Case "只能添加"
     MnuAddFile.Enabled = True
     MnuModifyFile.Enabled = False
     MnuDeleteFile.Enabled = False
     frmMain.Toolbar1.Buttons(5).Enabled = True
     frmMain.Toolbar1.Buttons(6).Enabled = False
     frmMain.Toolbar1.Buttons(7).Enabled = False
     MnuSearchFile.Enabled = False
     frmMain.Toolbar1.Buttons(9).Enabled = False
   Case "不能修改"
     MnuAddFile.Enabled = True
     MnuModifyFile.Enabled = False
     MnuDeleteFile.Enabled = False
     frmMain.Toolbar1.Buttons(5).Enabled = True
     frmMain.Toolbar1.Buttons(6).Enabled = False
     frmMain.Toolbar1.Buttons(7).Enabled = False
   Case "可以修改"
     '沒有
   Case "超級權限"
     '沒有權限限制
End Select

End Sub

Private Function LocalPath(strFileName As String) As String

  strFileName = Trim(strFileName)
  
  Dim X As Integer
      X = 1
  For X = 1 To Len(strFileName)
      If InStr(1, Right(strFileName, X), "\", vbTextCompare) Then
         Exit For
      End If
  Next
    
  If X > Len(strFileName) Then
     LocalPath = CurDir()
  Else
     LocalPath = Left(strFileName, Len(strFileName) - X)
  End If
   
End Function
上一頁 12
?? 文件大小 472 K
?? 上傳用戶 bonylee_java
?? 所屬分類 *行業應用
?? 快捷鍵說明

復制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號 Ctrl + =
減小字號 Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? frmmanager.frm

?? 快捷鍵說明
