📄 createuser.frm
字号:
End Sub
Private Sub Form_Load()
Dim i As Integer
On Error Resume Next
OpenMdb
Check1.Value = Val(GetSetting(App.EXEName, "SysStart", "AutoCode", ""))
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 1 - 900
Me.Caption = Me.Caption & "---->" & XzName & XcName
'置无效
Frame3.Visible = False
Command1(0).Enabled = False
Command1(1).Enabled = False
Frame2.Enabled = False
For i = 0 To 5
Command2(i).Enabled = False
Next
'自动编码
'If GetSetting(App.EXEName, "SysSetup", "AutoCode", "") = "1" Then
' AutoCoding = True
'End If
'加载银行
Set MdbR = NdMd.OpenRecordset("银行配置")
If MdbR.RecordCount <> 0 Then
With MdbR
For i = 0 To .RecordCount - 1
Combo1(2).AddItem .Fields!Bank
.MoveNext
Next
Combo1(2).ListIndex = 0
End With
End If
'加载用户类型
Combo1(1).AddItem "普通照明"
Combo1(1).AddItem "工业动力"
Combo1(1).ListIndex = 0
'加载台区信息
Set MdbR = NdMd.OpenRecordset("select * from 台变信息")
If MdbR.RecordCount <> 0 Then
While Not MdbR.eof
Combo1(0).AddItem MdbR!台变代码 & vbTab & MdbR!台变名称
MdbR.MoveNext
Wend
End If
'加载电价代码
Set MdbR = NdMd.OpenRecordset("SELECT * FROM 电价档案 WHERE 状态 =true order by 价区代码")
If MdbR.RecordCount = 0 Then
MsgBox "请建立电价数据！", vbInformation
Unload Me
ElectPrice.Show vbModal
Exit Sub
Else
MdbR.MoveLast
MdbR.MoveFirst
With MdbR
For i = 0 To .RecordCount - 1
Combo1(2).AddItem .Fields!电价ID & .Fields!价区类别 & Space(10) & "|" & Format(.Fields!电价, "0.000")
.MoveNext
Next
End With
Combo1(2).ListIndex = 0
End If
Set MdbR = NdMd.OpenRecordset("SELECT 用户电费.用户编码,用户电费.用户名称,用户电费.全称,用户电费.台区,用户电费.地址 FROM 用户电费 WHERE 用户电费.镇村代码='" & UserSeek & "' and 用户电费.主表=-1 order by 用户电费.组合编码")
Dim intCounter, intRecCount As Integer
Dim itm As ListItem
ListView1.SortKey = 0
ListView1.SortOrder = lvwAscending
If Not MdbR.eof Then
MdbR.MoveLast
intRecCount = MdbR.RecordCount
MdbR.MoveFirst
For intCounter = 0 To MdbR.RecordCount - 1
Set itm = ListView1.ListItems.Add(, , CStr(MdbR!用户编码))
itm.SubItems(1) = CStr(MdbR!用户名称) & ""
itm.SubItems(2) = MdbR!全称 & ""
itm.SubItems(3) = MdbR!地址 & ""
itm.SubItems(4) = MdbR!台区 & ""
MdbR.MoveNext
DoEvents
Next intCounter
ListView1.Sorted = True
End If
End Sub
'//////////////////////////卸载窗体
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Screen.MousePointer = vbDefault
MdbR.Close
NdMd.Close
End Sub
Private Sub Command1_Click(Index As Integer)
On Error Resume Next
Select Case Index
Case 0 '保存
If pbUserPermission <> "系统管理员" Then
MsgBox "您的权限不够，请于系统管理员联系!", vbInformation
Exit Sub
End If
If Command1(Index).Caption = "保存档案(&S)" Then
'标识主表,在保存时若用户为多表只,增加只在主表字段中标识一次
If Text1(1).Text = "" Then
MsgBox "用户名称必须输入!", vbCritical
Text1(1).SetFocus
Exit Sub
End If
If Len(Text1(2).Text) = 0 Or Len(Text1(3).Text) = 0 Then
If MsgBox("数据输入不完整,是否保存?(Y/N)", vbInformation + vbYesNo) = vbYes Then
Command1(Index).Caption = "新建用户(&X)"
Frame1.Enabled = False
Frame2.Enabled = True
Command1(2).Enabled = True
zMeter = True
'自动编码
If Check1.Value = 1 Then
Set MdbR = NdMd.OpenRecordset("select max(val(用户电费.抄表码)) as sl from 用户电费 where 镇村代码='" & UserSeek & "'")
Text1(4).Text = Format(MdbR.Fields!sl + 1, "000000")
Text1(4).Enabled = False
zis = Val(Text1(4).Text) '+ 1
Combo1(1).SetFocus
Else
Text1(4).Enabled = True
Text1(4).SetFocus
End If
Dim itm As ListItem
Set itm = ListView1.ListItems.Add(, , Trim(Text1(0).Text))
itm.SubItems(1) = Mid(Text1(1).Text, 1, 10)
If Combo1(1).Text = "工业动力" Then
itm.SubItems(2) = IIf(Len(Text1(2).Text) = 0, Mid(Text1(1).Text, 1, 10) & "(" & XSBS & "相)", Text1(2).Text)
Else
itm.SubItems(2) = IIf(Len(Text1(2).Text) = 0, Mid(Text1(1).Text, 1, 10) & "(" & Trim(Str(hjs + jls + 1)) & ")", Text1(2).Text)
End If
itm.SubItems(3) = IIf(Len(Text1(3).Text) = 0, XzName & XcName, Text1(3).Text)
itm.SubItems(4) = IIf(Len(Trim(Combo1(0).Text)) = 0, XzName & XcName, Trim(Combo1(0).Text))
Else
If Len(Text1(2).Text) = 0 Then
Text1(2).SetFocus
Exit Sub
End If
If Len(Text1(3).Text) = 0 Then
Text1(3).SetFocus
Exit Sub
End If
End If
Else
Command1(Index).Caption = "新建用户(&X)"
Frame1.Enabled = False
Frame2.Enabled = True
Command1(2).Enabled = True
zMeter = True
Set itm = ListView1.ListItems.Add(, , Trim(Text1(0).Text))
itm.SubItems(1) = Mid(Text1(1).Text, 1, 10)
If Combo1(1).Text = "工业动力" Then
itm.SubItems(2) = IIf(Len(Text1(2).Text) = 0, Mid(Text1(1).Text, 1, 10) & "(" & XSBS & "相)", Text1(2).Text)
Else
itm.SubItems(2) = IIf(Len(Text1(2).Text) = 0, Mid(Text1(1).Text, 1, 10) & "(" & Trim(Str(hjs + jls + 1)) & ")", Text1(2).Text)
End If
itm.SubItems(3) = IIf(Len(Text1(3).Text) = 0, XzName & XcName, Text1(3).Text)
itm.SubItems(4) = IIf(Len(Trim(Combo1(0).Text)) = 0, XzName & XcName, Trim(Combo1(0).Text))
'自动编码
If Check1.Value = 1 Then
Set MdbR = NdMd.OpenRecordset("select max(val(用户电费.抄表码)) as sl from 用户电费 where 镇村代码='" & UserSeek & "'")
Text1(4).Text = Format(MdbR.Fields!sl + 1, "000000")
Text1(4).Enabled = False
zis = Val(Text1(4).Text) '+ 1
Combo1(1).SetFocus
Else
Text1(4).Enabled = True
Text1(4).SetFocus
End If
End If
Else '新建
Command1(Index).Caption = "保存档案(&S)"
Frame1.Enabled = True
Frame2.Enabled = False
Text1(0).Tag = Text1(0).Text
Text1(0).Text = ""
Text1(1).Tag = Text1(1).Text
Text1(1).Text = ""
Text1(2).Tag = Text1(2).Text
Text1(2).Text = ""
Text1(3).Tag = Text1(3).Text
Text1(3).Text = ""
Combo1(0).Text = ""
hjs = 0
jls = 0
ListView2.ListItems.Clear
If zMeter = True Then
zMeter = False
End If
Text1(0).SetFocus
End If
Case 1 '保存
If Text1(0) = "" Then
MsgBox "请输入用户编码！！", vbCritical, "注意!"
Text1(0).SetFocus
Exit Sub
End If
If Text1(1) = "" Then
MsgBox "用户名称(简称)必须输入！！", vbCritical, "注意!"
Text1(1).SetFocus
Exit Sub
End If
If Text1(5) = "" Or Text1(4) = "" Or Text1(2) = "" Or Text1(3) = "" Or Text1(7) = "" Or Text1(11) = "" Or Text1(10) = "" Then
If MsgBox("所录入数据不完整,是否保存?", vbYesNo + vbCritical + vbDefaultButton1, "注意!") = vbYes Then
Call AppeData(True)
End If
Else
Call AppeData(True)
End If
Case 2 '修改
Frame1.Enabled = True
Text1(0).Tag = Text1(0).Text
Text1(1).Tag = Text1(1).Text
Text1(2).Tag = Text1(2).Text
Text1(3).Tag = Text1(3).Text
Text1(1).SetFocus
Case 3 '退出
Unload Me
Case 4 '帮助
MsgBox "Sorry,Not Found Help! ", vbInformation
End Select
End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Call ViewMeter
End Sub
Private Sub Option1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
End If
End Sub
Private Sub Option2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
End If
End Sub
'/////////////////聚焦、失焦过程//////////////////////////
Private Sub Text1_GotFocus(Index As Integer)
Text1(Index).BackColor = &HFFFF80
End Sub
Private Sub Text1_LostFocus(Index As Integer)
Text1(Index).BackColor = vbWhite
Text1(0) = Format(Text1(0), "0000")
' Combo2.ListIndex = 0
End Sub
'===combo
Private Sub Combo1_LostFocus(Index As Integer)
On Error Resume Next
Combo1(Index).BackColor = vbWhite
If Index = 0 Then
'Combo1(Index).AddItem XcName 'XzName & XcName
'Combo1(Index).ListIndex = 0
Combo1(0).Text = Trim(XzName) & Trim(XcName)
End If
End Sub
Private Sub Combo1_GotFocus(Index As Integer)
Combo1(Index).BackColor = &HFFFF80
End Sub
Private Sub Combo1_Click(Index As Integer)
On Error Resume Next
Select Case Index
Case 1
'If Combo1(Index).Text = "工业动力" Then
' Frame3.Visible = True
' Text2(0).SetFocus
'Else
' Frame3.Visible = False
' Text1(5).SetFocus
'End If
'If Combo1(Index).ListIndex = 0 Then
' Text1(5).Text = 1
'Else
' Text1(5).Text = 3
'End If
Case 2
Label6.Caption = Right(Trim(Combo1(Index).Text), 5) 'PriceStr(Mid(Combo1(Index).Text, 1, Len(Combo1(Index)) - 14), ".")
End Select
End Sub
'////////////////////chang过程////////////////
Private Sub Text1_Change(Index As Integer)
' On Error Resume Next
Dim i As Integer
Dim sTR1 As String, sTR2 As String
On Error Resume Next
Select Case Index
Case 0 '编码
If Len(Text1(Index)) = 4 Then
Call CheckIsNumber(Text1(Index))
Command1(0).Enabled = True
Else
Command1(0).Enabled = False
End If
If Len(Trim(Text1(Index))) > 4 Then
MsgBox "用户编码大于4位！", 48
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -