www.pudn.com > 档案管理系统源码VB.zip > AddGuestType.frm
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form frmCatalog
AutoRedraw = -1 'True
BorderStyle = 3 'Fixed Dialog
Caption = "档案类型管理[添加、删除]"
ClientHeight = 3285
ClientLeft = 45
ClientTop = 330
ClientWidth = 5460
Icon = "AddGuestType.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3285
ScaleWidth = 5460
ShowInTaskbar = 0 'False
Begin VB.CommandButton ExitB
Cancel = -1 'True
Caption = "关 闭(&C)"
Height = 330
Left = 3615
TabIndex = 6
Top = 1230
Width = 1575
End
Begin VB.CommandButton DeleteB
Caption = "删 除(&D)"
Height = 330
Left = 3615
TabIndex = 5
Top = 900
Width = 1575
End
Begin VB.CommandButton cmdModify
Caption = "修 改(&M)"
Height = 330
Left = 3615
TabIndex = 4
Top = 570
Width = 1575
End
Begin ComctlLib.ListView ListView1
Height = 2895
Left = 165
TabIndex = 7
Top = 180
Width = 3225
_ExtentX = 5689
_ExtentY = 5106
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 327682
Icons = "ImageList1"
SmallIcons = "ImageList1"
ForeColor = 16777215
BackColor = 32768
BorderStyle = 1
Appearance = 1
NumItems = 0
End
Begin VB.PictureBox picDraw
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1125
Left = 3750
Picture = "AddGuestType.frx":030A
ScaleHeight = 1125
ScaleWidth = 1260
TabIndex = 11
Top = 1785
Width = 1260
End
Begin VB.PictureBox Picture1
AutoSize = -1 'True
Height = 540
Left = 3210
Picture = "AddGuestType.frx":D27A
ScaleHeight = 480
ScaleWidth = 480
TabIndex = 10
Top = 120
Visible = 0 'False
Width = 540
End
Begin VB.PictureBox AddPicture
AutoRedraw = -1 'True
BorderStyle = 0 'None
Height = 1440
Left = 3405
ScaleHeight = 1440
ScaleWidth = 1860
TabIndex = 8
Top = 1635
Visible = 0 'False
Width = 1860
Begin VB.CommandButton CancelRecord
Caption = "取消"
Height = 390
Left = 1020
TabIndex = 2
Top = 825
Width = 795
End
Begin VB.CommandButton SaveRecord
Caption = "保存"
Default = -1 'True
Enabled = 0 'False
Height = 390
Left = 210
TabIndex = 1
Top = 825
Width = 795
End
Begin VB.TextBox NewTypeName
Height = 300
Left = 195
TabIndex = 0
Top = 480
Width = 1590
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "请输入新的档案类型"
ForeColor = &H000040C0&
Height = 180
Left = 165
TabIndex = 9
Top = 195
Width = 1620
End
End
Begin VB.CommandButton AddB
Caption = "添 加(&A)"
Height = 330
Left = 3615
TabIndex = 3
Top = 240
Width = 1575
End
Begin VB.Line Line3
BorderColor = &H00E0E0E0&
Index = 1
X1 = 5415
X2 = 5415
Y1 = 15
Y2 = 3240
End
Begin VB.Line Line2
BorderColor = &H00808080&
Index = 1
X1 = 5400
X2 = 5400
Y1 = 15
Y2 = 3210
End
Begin VB.Line Line3
BorderColor = &H00E0E0E0&
Index = 0
X1 = 45
X2 = 45
Y1 = 30
Y2 = 3225
End
Begin VB.Line Line2
BorderColor = &H00808080&
Index = 0
X1 = 30
X2 = 30
Y1 = 30
Y2 = 3225
End
Begin ComctlLib.ImageList ImageList1
Left = 1965
Top = 2355
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
MaskColor = 12632256
_Version = 327682
End
Begin VB.Line Line1
BorderColor = &H00808080&
Index = 3
X1 = 30
X2 = 5415
Y1 = 3225
Y2 = 3225
End
Begin VB.Line Line1
BorderColor = &H00E0E0E0&
Index = 2
X1 = 15
X2 = 5415
Y1 = 3240
Y2 = 3240
End
Begin VB.Line Line1
BorderColor = &H00E0E0E0&
Index = 1
X1 = 30
X2 = 5400
Y1 = 30
Y2 = 30
End
Begin VB.Line Line1
BorderColor = &H00808080&
Index = 0
X1 = 30
X2 = 5400
Y1 = 15
Y2 = 15
End
End
Attribute VB_Name = "frmCatalog"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim GTN As String
Dim NoChange As Boolean
Private Sub AddB_Click()
DeleteB.Enabled = False
ExitB.Enabled = False
AddB.Enabled = False
cmdModify.Enabled = False
AddPicture.Visible = True
picDraw.Visible = False
NewTypeName.SetFocus
Label1.Caption = "请输入新的档案类型"
End Sub
Private Sub AddB_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
GetStatus "添加新的档案类型"
End Sub
Private Sub CancelRecord_Click()
NewTypeName.Text = ""
AddPicture.Visible = False
picDraw.Visible = True
DeleteB.Enabled = True
ExitB.Enabled = True
AddB.Enabled = True
cmdModify.Enabled = True
AddB.SetFocus
subPurView '安装权限
End Sub
Private Sub CancelRecord_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
GetStatus "放弃保存档案新类型"
End Sub
Private Sub cmdModify_Click()
If GTN = "" Then
MsgBox "请先选择一个档案类型，然后按修改按钮。 ", vbInformation, "档案管理系统"
Exit Sub
End If
'进行修改目录动作
DeleteB.Enabled = False
ExitB.Enabled = False
AddB.Enabled = False
AddPicture.Visible = True
picDraw.Visible = False
cmdModify.Enabled = False
NewTypeName.Text = GTN
NewTypeName.SetFocus
Label1.Caption = "输入修改的档案类型"
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