addguesttype.frm

档案管理系统源码VB档案管理系统源码VB

End Sub

Private Sub cmdModify_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
 GetStatus "修改左边选定的档案类型"

End Sub

Private Sub DeleteB_Click()

If GTN = "" Then
   MsgBox "请先选择一个档案类型，然后按删除按钮。     ", vbExclamation, "档案管理系统"
   Exit Sub
End If
   '进行删除目录动作
   Dim OK As Integer
   OK = MsgBox("真的要删除[" & GTN & "]类型,及其所有文件吗？（Y/N）    ", vbYesNo + 16 + vbDefaultButton2, "确认")
   If OK = 7 Then
      Exit Sub
      Else
  '删除代码
  ListView1.Visible = False
  ListView1.ListItems.Clear
  Dim DB As Database, tempStr As String
    DBEngine.BeginTrans
    Set DB = OpenDatabase(ConData, False, False, ConStr)
        tempStr = "Delete * From Catalog Where Name='" & GTN & "'"
        DB.Execute tempStr
        tempStr = "Delete * From Detail Where Name='" & GTN & "'"
        DB.Execute tempStr
        DB.Close
    DBEngine.CommitTrans
  Dim EF As Recordset
  Set DB = OpenDatabase(ConData, False, False, ConStr)
    Set EF = DB.OpenRecordset("Catalog", dbOpenDynaset)
        Do Until EF.EOF
           Set ListIT = ListView1.ListItems.Add()
               ListIT.Text = EF!Name
               ListIT.Icon = "Top"
               ListIT.Key = EF!Name
           EF.MoveNext
        Loop
    DB.Close
    ListView1.Visible = True
    GTN = ""
   End If
   NoChange = True
    
End Sub

Private Sub DeleteB_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
 GetStatus "删除左边选定的档案类型"
 
End Sub

Private Sub ExitB_Click()
  
  If IT = True And NoChange = True Then
     Call frmManager.cmdLoad_Click
  End If
  
  Unload Me
  
End Sub

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

  GetStatus "关闭"
  
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

 Select Case KeyCode
 
  Case 46
    If DeleteB.Enabled = True Then
       Call DeleteB_Click
    End If
  Case 27
    If picDraw.Visible = False Then
       Call CancelRecord_Click
    End If
 End Select
  
 
End Sub

Private Sub Form_Load()

frmCatalog.Left = Val(GetSetting(App.EXEName, "Type", "Left"))
frmCatalog.Top = Val(GetSetting(App.EXEName, "Type", "Top"))

subPurView  '安装权限

ImageList1.ListImages.Add 1, "Top", Picture1.Picture
ListView1.View = lvwIcon  '图标形式浏览
Dim ListIT As ListItem
Dim DB As Database, EF As Recordset
    Set DB = OpenDatabase(ConData, False, False, ConStr)
    Set EF = DB.OpenRecordset("Catalog", dbOpenDynaset)
        Do Until EF.EOF
           Set ListIT = ListView1.ListItems.Add()
               ListIT.Text = EF!Name
               ListIT.Icon = "Top"
               ListIT.Key = EF!Name
           EF.MoveNext
        Loop
    DB.Close
    GTN = ""
 NoChange = False
 
End Sub

Private Sub Form_Unload(Cancel As Integer)

 SaveSetting App.EXEName, "Type", "Left", Me.Left
 SaveSetting App.EXEName, "Type", "Top", Me.Top
 
End Sub

Private Sub ListView1_ItemClick(ByVal Item As ComctlLib.ListItem)
GTN = Item.Text
End Sub


Private Sub ListView1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
GetStatus "已经定义的档案类型"
End Sub

Private Sub NewTypeName_Change()

If Trim(NewTypeName.Text) = "" Then
   SaveRecord.Enabled = False
   Else
   SaveRecord.Enabled = True
End If

End Sub

Private Sub NewTypeName_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
GetStatus "请输入新的档案类型"
End Sub

Private Sub SaveRecord_Click()
 
 'Save Data
  If InStr(1, NewTypeName.Text, "'", vbTextCompare) Then
   MsgBox "该项目之中有特殊字符" + "<'>,请删除。", vbOKOnly + 48, "提示："
   NewTypeName.SetFocus
   Exit Sub
  End If
  
  Dim DB As Database, tempStr As String, EF As Recordset
  Set DB = OpenDatabase(ConData, False, False, ConStr)
   
   'IF add then
   If Label1.Caption = "请输入新的档案类型" Then
        tempStr = "Select * From Catalog Where Name='" & Trim(NewTypeName.Text) & "'"
    
    DBEngine.BeginTrans
    
    Set EF = DB.OpenRecordset(tempStr, dbOpenDynaset)
    If EF.EOF And EF.BOF Then
        tempStr = "Insert into Catalog (Name) Values('" & Trim(NewTypeName.Text) & "')"
        DB.Execute tempStr
        EF.Close
        DB.Close
        DBEngine.CommitTrans
    Else
        MsgBox "该档案类型已经存在，请重新列入。    ", vbOKOnly + 48, "提示："
        NewTypeName.SetFocus
        EF.Close
        DB.Close
        DBEngine.CommitTrans
        Exit Sub
    End If
  
  'Else Modify
   Else
     If Trim(NewTypeName.Text) = GTN Then
        DB.Close
        NewTypeName.Text = ""
        AddPicture.Visible = False
        picDraw.Visible = True
        cmdModify.Enabled = True
        DeleteB.Enabled = True
        ExitB.Enabled = True
        AddB.Enabled = True
        subPurView  '安装权限
        cmdModify.SetFocus
        Exit Sub
     Else
        tempStr = "Select * From Catalog Where Name='" & Trim(NewTypeName.Text) & "'"
    
    DBEngine.BeginTrans
    
    Set EF = DB.OpenRecordset(tempStr, dbOpenDynaset)
    If EF.EOF And EF.BOF Then
        tempStr = "Update Catalog Set Name='" & Trim(NewTypeName.Text) & "' Where Name='" & GTN & "'"
        DB.Execute tempStr
        tempStr = "Update Detail Set Name='" & Trim(NewTypeName.Text) & "' Where Name='" & GTN & "'"
        DB.Execute tempStr
        EF.Close
        DB.Close
        DBEngine.CommitTrans
        GTN = ""
    Else
        MsgBox "该档案类型已经存在，请重新列入。    ", vbOKOnly + 48, "提示："
        NewTypeName.SetFocus
        EF.Close
        DB.Close
        DBEngine.CommitTrans
        Exit Sub
     End If
    End If
   End If
  'Refresh Data
    ListView1.Visible = False
    ListView1.ListItems.Clear
    DBEngine.BeginTrans
    Set DB = OpenDatabase(ConData, False, False, ConStr)
    Set EF = DB.OpenRecordset("Catalog", dbOpenDynaset)
        Do Until EF.EOF
           Set ListIT = ListView1.ListItems.Add()
               ListIT.Text = EF!Name
               ListIT.Icon = "Top"
               ListIT.Key = EF!Name
           EF.MoveNext
        Loop
    DB.Close
    DBEngine.CommitTrans
    ListView1.Visible = True
    NewTypeName.Text = ""
    NewTypeName.SetFocus
    NoChange = True
    
    If Label1.Caption = "输入修改的档案类型" Then
        'Finish then
     GTN = ""
     NewTypeName.Text = ""
     AddPicture.Visible = False
     picDraw.Visible = True
     cmdModify.Enabled = True
     DeleteB.Enabled = True
     ExitB.Enabled = True
     AddB.Enabled = True
     cmdModify.SetFocus
    End If
    subPurView  '安装权限
    
End Sub

Private Sub SaveRecord_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
 GetStatus "保存新类型并返回"
 
End Sub

Private Sub subPurView()

 '权限控制
Select Case PurView
   Case "只能添加"
     cmdModify.Enabled = False
     DeleteB.Enabled = False
   Case "不能修改"
     cmdModify.Enabled = False
     DeleteB.Enabled = False
   Case "可以修改"
     '没有
   Case "超级权限"
     '没有权限限制
End Select

End Sub