📄 frmaddress.frm
字号:
TabIndex = 4
Top = 180
Width = 975
_ExtentX = 1720
_ExtentY = 609
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "删除(&D)"
ForeColor = -2147483630
ForeHover = 0
End
Begin Manage.xpcmdButton cmdEdit
Height = 345
Index = 0
Left = 4560
TabIndex = 5
Top = 180
Width = 975
_ExtentX = 1720
_ExtentY = 609
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "添加(&A)"
ForeColor = -2147483630
ForeHover = 0
End
Begin Manage.xpcmdButton cmdEdit
Height = 345
Index = 3
Left = 7800
TabIndex = 6
Top = 180
Width = 975
_ExtentX = 1720
_ExtentY = 609
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "关闭(&C)"
ForeColor = -2147483630
ForeHover = 0
End
Begin VB.Label lblCount
AutoSize = -1 'True
BackStyle = 0 'Transparent
Height = 180
Left = 120
TabIndex = 9
Top = 240
Width = 90
End
End
End
Attribute VB_Name = "frmAddress"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'12－19建立初步方案
Option Explicit
Dim strhead(1) As String
Private Sub cmdEdit_Click(Index As Integer)
On Error GoTo errNext
' Select Case Index
' Case 0: '新增
' bAddNew = True
' Call subClear
' Call stbEdit_Click(0)
' cmdEdit(1).Enabled = True
' If gblnAdd = False Then
' cmdEdit(1).SetFocus
' Else
' gblnAdd = False
' End If
' cmdEdit(0).Enabled = False
' cmdEdit(3).Enabled = False
' Case 1: '保存
' Dim strNumber(2) As String '员工编号 与姓名,部门
' Dim blnSave As Boolean
' blnSave = False
' strNumber(0) = Trim(txtID.Text)
' strNumber(2) = Trim(cboManage.Text)
' If Len(strNumber(2)) = 0 Then MsgBox "隶属部门不能为空,请重新输入!", vbCritical, App.Title: cboManage.SetFocus: Exit Sub
' If Len(strNumber(0)) = 0 Then MsgBox "员工编号不能为空,请重新输入!", vbCritical, App.Title: TxtPersonal(21).SetFocus: Exit Sub
' strNumber(1) = Trim(txtName.Text)
' If Len(strNumber(1)) = 0 Then MsgBox "员工姓名不能为空,请重新输入!", vbCritical, App.Title: TxtPersonal(18).SetFocus: Exit Sub
' With adoMainLink
' If .State = adStateOpen Then .Close
' .Open "select * from 员工详细资料 where 员工编号='" & strNumber(0) & "'", adoConn, adOpenDynamic, adLockPessimistic, adCmdText
' If bAddNew = True Then
' If .EOF = False Then MsgBox "此员工编号已在存在,请输入新的编号!", vbCritical, App.Title: txtID.Text = strString(0): txtID.SetFocus: Exit Sub '如果发现此编号已在别处存在，则发出错误!
' .AddNew
' Else
' If .EOF = False And strString(0) <> strNumber(0) Then MsgBox "此员工编号已在存在,请输入新的编号!", vbCritical, App.Title: txtID.Text = strString(0): txtID.SetFocus: Exit Sub '如果发现此编号已在别处存在，则发出错误!
' .Close
' .Open "select * from 员工详细资料 where 员工编号='" & strString(0) & "'", adoConn, adOpenDynamic, adLockPessimistic, adCmdText
' End If
' .Fields("隶属部门") = intID(cboManage.ListIndex)
' .Fields("员工编号") = Mid(strNumber(0), 1, .Fields("员工编号").DefinedSize)
' .Fields("姓名") = Mid(strNumber(1), 1, .Fields("姓名").DefinedSize)
' For intCount = 0 To 5
' .Fields(lblDate(intCount).Caption) = IIf(Len(Trim(txtDate(intCount).Text)) <> 0, txtDate(intCount).Text, Null)
' Next
' For intCount = 0 To 11
' .Fields(lblCboPersonal(intCount).Caption) = IIf(Len(Trim(cboPersonal(intCount).Text)) <> 0, Mid(Trim(cboPersonal(intCount).Text), 1, .Fields(lblCboPersonal(intCount).Caption).DefinedSize), Null)
' Next
' '.Fields("住宿房间") = IIf((cboPersonal(12).ListIndex) <> -1, intRoom(cboPersonal(12).ListIndex), Null)
' If (cboPersonal(12).ListIndex) = -1 Then
' .Fields("住宿房间") = Null
' Else
' .Fields("住宿房间") = intRoom(cboPersonal(12).ListIndex)
' End If
' For intCount = 0 To 11
' .Fields(lblTxtPersonal(intCount).Caption) = IIf(Len(Trim(TxtPersonal(intCount).Text)) <> 0, Mid(Trim(TxtPersonal(intCount).Text), 1, .Fields(lblTxtPersonal(intCount).Caption).DefinedSize), Null)
' Next
' .Update
' newID = .Fields("id")
' .Close
' .Open "select * from 其它资料 where 员工ID='" & newID & "'", adoConn, adOpenDynamic, adLockPessimistic, adCmdText
' If Len(strName) > 0 Then blnSave = True: GoTo SaveOther
' For intCount = 12 To 18
' If Len(Trim(TxtPersonal(intCount).Text)) > 0 Then blnSave = True: GoTo SaveOther
' Next
' GoTo NotSaveOther
'SaveOther:
' If .EOF = True Then .AddNew
' .Fields("员工ID") = newID
' .Fields("照片路径") = strName
' .Fields("银行名称") = IIf(Len(Trim(cboPersonal(13).Text)) <> 0, Mid(Trim(cboPersonal(13).Text), 1, .Fields("银行名称").DefinedSize), Null)
' For intCount = 12 To 18
' .Fields(lblTxtPersonal(intCount).Caption) = IIf(Len(Trim(TxtPersonal(intCount).Text)) <> 0, Mid(Trim(TxtPersonal(intCount).Text), 1, .Fields(lblTxtPersonal(intCount).Caption).DefinedSize), Null)
' Next
' .Update
' GoTo NextTest
'NotSaveOther:
' If .EOF = False Then .Delete
'NextTest:
' .Close
' .Open "select 员工编号,隶属部门 from v员工详细资料 where 隶属部门='" & strNumber(2) & "'", adoConn, adOpenDynamic, adLockPessimistic, adCmdText
' intCount = 0
' If .EOF = False Then
' .MoveLast
' intCount = .RecordCount
' End If
' Call frmInfo.AddTreeView
' If bAddNew = True Then
' gintManCount = gintManCount + 1
' frmInfo.staInfo.Panels(3).Text = "公司员工数:" & gintManCount & "个"
' ricBox.Text = ricBox.Text & "时间: " & Now & " 内容: 添加新员工,隶属部门[" & strNumber(2) & "],编号[" & strNumber(0) & "],姓名[" & strNumber(1) & "]." & vbCrLf
' bAddNew = False
' Else
' ricBox.Text = ricBox.Text & "时间: " & Now & " 内容: 修改隶属部门[" & strString(2) & "],编号[" & strString(0) & "],姓名[" & strString(1) & "]的员工,修改为隶属部门[" & strNumber(2) & "],编号[" & strNumber(0) & "],姓名[" & strNumber(1) & "]." & vbCrLf
' End If
' strString(0) = strNumber(0)
' strString(1) = strNumber(1)
' strString(2) = strNumber(2)
' strString(3) = newID
' End With
' fraClose.Visible = False
' cmdEdit(0).Enabled = True
' cmdEdit(3).Enabled = True
' Call frmInfo.ManageLoad(0)
' MsgBox "保存成功!", vbInformation, App.Title
' Case 2: '取消
' Call subClear
' Call subLoad
' If bAddNew = True Then
' bAddNew = False
' cmdEdit(0).Enabled = True
' cmdEdit(0).SetFocus
' End If
' Case 3: '删除
' If MsgBox("确认要删除隶属部门[" & strString(2) & "],编号[" & strString(0) & "],姓名[" & strString(1) & "]的员工吗?", vbInformation + vbYesNo, App.Title) = vbYes Then
' With adoMainLink
' If .State = adStateOpen Then .Close
' .Open "select 员工编号,隶属部门 from 员工详细资料 where 员工编号='" & strString(0) & "'", adoConn, adOpenDynamic, adLockPessimistic, adCmdText
' If .EOF = False Then
' For intCount = 0 To cboManage.ListCount
' If cboManage.List(intCount) = .Fields("隶属部门") & "" Then
' cboManage.ListIndex = intCount
' End If
' Next
' .Delete
' .Close
' .Open "select 员工ID from 其它资料 where 员工ID='" & strString(3) & "'", adoConn, adOpenDynamic, adLockPessimistic, adCmdText
' If .EOF = False Then .Delete
' cmdEdit(0).Enabled = True
' cmdEdit(1).Enabled = False
' cmdEdit(3).Enabled = False
' .Close
' .Open "select * from v员工详细资料 where 隶属部门='" & cboManage.Text & "'", adoConn, adOpenDynamic, adLockPessimistic, adCmdText
' intCount = 0
' If .EOF = False Then
' .MoveLast
' intCount = .RecordCount
' End If
' Call subClear
' If frmInfo.tvwManage.Nodes(cboManage.ListIndex + 2).Text Like "*(*)" Then
' frmInfo.tvwManage.Nodes(cboManage.ListIndex + 2).Text = cboManage.Text & "(" & intCount & ")"
' End If
' gintManCount = gintManCount - 1
' frmInfo.staInfo.Panels(3).Text = "公司员工数:" & gintManCount & "个"
' ricBox.Text = ricBox.Text & "时间: " & Now & " 内容: 删除员工,隶属部门[" & strString(2) & "],编号[" & strString(0) & "],姓名[" & strString(1) & "]." & vbCrLf
' Call frmInfo.ManageLoad(0)
' strString(0) = ""
' strString(1) = ""
' strString(2) = ""
' strString(3) = ""
' MsgBox "删除成功!", vbInformation, App.Title
' Else
' MsgBox "发生错误,在数据库中未找该编号的员工!", vbInformation + vbYesNo, App.Title
' End If
' End With
' End If
' Case 4: '关闭
' Unload Me
' End Select
Exit Sub
errNext:
Call ErrMsg(Err.Number, Err.Description)
End Sub
Private Sub dgdAddress_DblClick()
On Error Resume Next
If adoMainLink.EOF = True Then Exit Sub
'Me.Enabled = False
'frmHisInfo.Show
End Sub
Private Sub dgdAddress_HeadClick(ByVal ColIndex As Integer)
strhead(0) = dgdAddress.Columns(ColIndex).Caption
cmdFind_Click (0)
End Sub
Private Sub dgdAddress_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Call dgdAddress_DblClick
End Sub
Private Sub Form_Load()
Me.Icon = MDIMain.Icon
strhead(0) = "国别,地区,城市"
Me.Move GetSetting(App.Title, "Address", "MainLeft", 1000), _
GetSetting(App.Title, "Address", "MainTop", 1000), _
GetSetting(App.Title, "Address", "MainWidth", 6500), _
GetSetting(App.Title, "Address", "MainHeight", 6500)
cboCount.ListIndex = 0
cboFind.ListIndex = 0
End Sub
Private Sub Form_Resize()
On Error Resume Next
If Me.Width < 8400 Then Me.Width = 8400
If Me.Height < 6400 Then Me.Height = 6400
fraFind.Width = Me.ScaleWidth - 120
txtFind.Width = fraFind.Width - 6160
cmdFind(1).Left = fraFind.Width - 1100
cmdFind(0).Left = cmdFind(1).Left - 1100
fraBasic.Move 60, 600, fraFind.Width, Me.ScaleHeight - 1260
picMove.Move tvwManage.Width - 60, 100, 60, fraBasic.Height - 120
tvwManage.Move 20, 100, picMove.Left - 20, fraBasic.Height - 120
dgdAddress.Move picMove.Left + 60, 100, fraBasic.Width - picMove.Left - 80, tvwManage.Height
fraAddress.Move 60, fraBasic.Height + 580, fraFind.Width, 600
cmdEdit(4).Left = fraAddress.Width - 1100
cmdEdit(3).Left = cmdEdit(4).Left - 1100
cmdEdit(2).Left = cmdEdit(3).Left - 1100
cmdEdit(1).Left = cmdEdit(2).Left - 1100
cmdEdit(0).Left = cmdEdit(1).Left - 1100
End Sub
Private Sub Form_Unload(Cancel As Integer)
If Me.WindowState <> vbMinimized Then
SaveSetting App.Title, "Address", "MainLeft", Me.Left
SaveSetting App.Title, "Address", "MainTop", Me.Top
SaveSetting App.Title, "Address", "MainWidth", Me.Width
SaveSetting App.Title, "Address", "MainHeight", Me.Height
End If
End Sub
Private Sub picMove_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then picMove.BackColor = &H404040
End Sub
Private Sub picMove_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 And picMove.BackColor = &H404040 Then picMove.Left = picMove.Left + X
End Sub
Private Sub picMove_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If picMove.Left < 2000 Then picMove.Left = 2000
If picMove.Left > (Me.ScaleWidth - 6400) Then picMove.Left = Me.ScaleWidth - 6400
picMove.BackColor = Me.BackColor
tvwManage.Width = picMove.Left
Call Form_Resize
Button = 2
End Sub
Private Sub txtFind_KeyPress(KeyAscii As Integer)
Call cmdFind_Click(0)
End Sub
Private Sub txtFind_Change()
Call cmdFind_Click(0)
End Sub
Private Sub cmdFind_Click(Index As Integer)
On Error GoTo errNext
If Index = 0 And Len(Trim(txtFind.Text)) <> 0 Then
If cboFind.ListIndex = 0 Then
strhead(1) = "where " & cboCount.Text & " like '%" & Trim(txtFind.Text) & "%'"
Else
strhead(1) = "where " & cboCount.Text & cboFind.Text & "'" & Trim(txtFind.Text) & "'"
End If
Else
strhead(1) = ""
End If
With adoMainLink
If .State = adStateOpen Then .Close
.Open "select * from 城市信息 " & strhead(1) & " order by " & strhead(0), adoConn, adOpenDynamic, adLockPessimistic, adCmdText
If .EOF = False Then
cmdEdit(1).Enabled = gblnPopedom
.MoveLast
lblCount.Caption = "查找符合条件的信息数量为:" & .RecordCount & "条."
.MoveFirst
Else
lblCount.Caption = "没有找到符合条件的信息."
End If
Set dgdAddress.DataSource = adoMainLink
End With
Exit Sub
errNext:
Call ErrMsg(Err.Number, Err.Description)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -