📄 menu45.frm
字号:
bg.Text = ""
End If
If Data1.Recordset.RecordCount > 0 Then
Do While Data1.Recordset.EOF() = False
bh = ""
mc = ""
zdmj = ""
yhmj = ""
lhmj = ""
ls = ""
dlwz = ""
lxdh = ""
qyrq = ""
If IsNull(Data1.Recordset.Fields("bh")) = False Then bh = Data1.Recordset.Fields("bh")
If IsNull(Data1.Recordset.Fields("mc")) = False Then mc = Data1.Recordset.Fields("mc")
If IsNull(Data1.Recordset.Fields("qyrq")) = False Then qyrq = Data1.Recordset.Fields("qyrq")
If IsNull(Data1.Recordset.Fields("zdmj")) = False Then zdmj = Format(Val(Data1.Recordset.Fields("zdmj")), "###,#0.00")
If IsNull(Data1.Recordset.Fields("yhmj")) = False Then yhmj = Format(Val(Data1.Recordset.Fields("yhmj")), "###,#0.00")
If IsNull(Data1.Recordset.Fields("lhmj")) = False Then lhmj = Format(Val(Data1.Recordset.Fields("lhmj")), "###,#0.00")
If IsNull(Data1.Recordset.Fields("ls")) = False Then ls = Data1.Recordset.Fields("ls")
If IsNull(Data1.Recordset.Fields("dlwz")) = False Then dlwz = Data1.Recordset.Fields("dlwz")
If IsNull(Data1.Recordset.Fields("lxdh")) = False Then lxdh = Data1.Recordset.Fields("lxdh")
bg.Row = 1
bg.Col = 0
If bg.Text = "" Then
bg.Col = 0
bg.Text = bh
bg.Col = 1
bg.Text = mc
bg.Col = 2
bg.Text = qyrq
bg.Col = 3
bg.Text = zdmj
bg.Col = 4
bg.Text = yhmj
bg.Col = 5
bg.Text = lhmj
bg.Col = 6
bg.Text = ls
bg.Col = 7
bg.Text = dlwz
bg.Col = 8
bg.Text = lxdh
Else
bg.AddItem (bh & vbTab & mc & vbTab & qyrq & vbTab & zdmj & vbTab & yhmj & vbTab & lhmj & vbTab & ls & vbTab & dlwz & vbTab & lxdh)
End If
Data1.Recordset.MoveNext
Loop
i = 1
Do While i < bg.Rows
bg.Row = i
bg.Col = 0
If bg.Text = text1(0).Text Then
bg.Col = 1
Call bg_Click
End If
i = i + 1
Loop
End If
text1(0).SetFocus
End Sub
Private Sub bg_Click()
i = bg.Col
bg.Col = 0
text1(0).Text = bg.Text
bg.Col = 1
text1(1).Text = bg.Text
bg.Col = 2
text1(2).Text = bg.Text
bg.Col = 3
If Val(bg.Text) = 0 Then
ttFields(0).Text = ""
Else
ttFields(0).Text = Format(Val(bg.Text), "##,##0.00")
End If
bg.Col = 4
If Val(bg.Text) = 0 Then
ttFields(1).Text = ""
Else
ttFields(1).Text = Format(Val(bg.Text), "##,##0.00")
End If
bg.Col = 5
If Val(bg.Text) = 0 Then
ttFields(2).Text = ""
Else
ttFields(2).Text = Format(Val(bg.Text), "##,##0.00")
End If
bg.Col = 6
text1(3).Text = bg.Text
bg.Col = 7
text1(4).Text = bg.Text
bg.Col = 8
text1(5).Text = bg.Text
bg.Col = i
End Sub
Private Sub cmdAdd_Click()
bg.Enabled = False
cmdAdd.Enabled = False
cmdedit.Enabled = False
cmdDelete.Enabled = False
Comsave.Enabled = True
cmdClose.Enabled = True
Cmdtc.Enabled = False
Command1.Enabled = False
editbl = text1(0).Text
i = 0
Do While i < 6
text1(i).Locked = False
text1(i).Text = ""
i = i + 1
Loop
i = 0
Do While i < 3
ttFields(i).Locked = False
ttFields(i).Text = ""
i = i + 1
Loop
adedbj = 1
text1(0).SetFocus
End Sub
Private Sub cmdClose_Click()
bg.Enabled = True
bg.Row = 1
bg.Col = 0
i = 1
Do While i < bg.Rows
bg.Row = i
If bg.Text = editbl Then
bg.Col = 1
Call bg_Click
Exit Do
End If
i = i + 1
Loop
adedbj = 0
i = 0
Do While i < 6
text1(i).Locked = True
i = i + 1
Loop
i = 0
Do While i < 3
ttFields(i).Locked = True
i = i + 1
Loop
If Data1.Recordset.RecordCount > 0 Then
cmdedit.Enabled = True
cmdDelete.Enabled = True
Else
cmdedit.Enabled = False
cmdDelete.Enabled = False
End If
cmdAdd.Enabled = True
Comsave.Enabled = False
cmdClose.Enabled = False
Cmdtc.Enabled = True
Command1.Enabled = True
text1(0).SetFocus
End Sub
Private Sub cmdDelete_Click()
k = MsgBox("您确实要删除" + text1(1).Text + "吗?", vbQuestion + vbYesNo, "系统信息")
If k = vbYes And Data1.Recordset.RecordCount > 0 Then
Data1.Recordset.FindFirst "bh=" + "'" + text1(0).Text + "'"
If Data1.Recordset.NoMatch = False Then Data1.Recordset.Delete
Data1.Recordset.MoveNext
If Len(text1(0).Text) < 1 Then
Data1.Recordset.MovePrevious
End If
sxbj = 0
If Data1.Recordset.RecordCount < 1 Then
cmdedit.Enabled = False
cmdDelete.Enabled = False
Else
cmdedit.Enabled = True
cmdDelete.Enabled = True
End If
bg.Col = 0
bg.Row = 1
i = 1
Do While bg.Text <> text1(0).Text
If bg.Rows > 2 Then
i = i + 1
bg.Row = i
End If
Loop
If bg.Text = text1(0).Text And bg.Rows > 2 Then
bg.RemoveItem (i)
Else
bg.Col = 0
i = 0
bg.Row = 1
Do While i < bg.Cols
bg.Col = i
bg.Text = ""
i = i + 1
Loop
End If
bg.Col = 1
Call bg_Click
End If
text1(0).SetFocus
End Sub
Private Sub cmdedit_Click()
bg.Enabled = False
cmdedit.Enabled = False
cmdAdd.Enabled = False
cmdDelete.Enabled = False
Comsave.Enabled = True
cmdClose.Enabled = True
Cmdtc.Enabled = False
Command1.Enabled = False
editbl = text1(0).Text
i = 0
Do While i < 6
text1(i).Locked = False
i = i + 1
Loop
i = 0
Do While i < 3
ttFields(i).Locked = False
i = i + 1
Loop
adedbj = 2
text1(0).SetFocus
End Sub
Private Sub Cmdlw_Click()
If lh <= Val(Text4.Text) Then
Data1.Recordset.AddNew
Data1.Recordset("bh") = Text2.Text
Data1.Recordset("mc") = Text3.Text
Data1.Recordset("lh") = text1(0).Text
Data1.Recordset("dy") = text1(1).Text
Data1.Recordset("lc") = text1(2).Text
Data1.Recordset("mczh") = text1(3).Text
If Check1.Value = 1 Then Data1.Recordset("sfrz") = "Y" Else Data1.Recordset("sfrz") = "N"
Data1.Recordset("hh") = Trim$(Str(Val(text1(2).Text) * Val(text1(3).Text)) * Val(text1(1)))
Data1.Recordset.Update
lh = lh + 1
If Len(Trim$(Str(lh))) < 2 Then text1(0).Text = "0" + Trim$(Str(lh)) Else text1(0).Text = Trim$(Str(lh))
Else
Unload frmlwda
End If
End Sub
Private Sub Cmdtc_Click()
Unload frmwyda
End Sub
Private Sub Command1_Click()
Command1.MousePointer = 11
bgsx
Command1.MousePointer = 0
End Sub
Private Sub Command2_Click()
End Sub
Private Sub Command3_Click()
If bg.Enabled = False And Val(text1(3)) > 0 Then
frmlwda.text1(0).Text = "01"
frmlwda.Text2.Text = text1(0).Text
frmlwda.Text3.Text = text1(1).Text
frmlwda.Text4.Text = text1(3).Text
frmlwda.Text5.Text = adedbj
frmlwda.Top = 4020
frmlwda.Left = 6570
frmlwda.Show vbModal
End If
End Sub
Private Sub Comsave_Click()
bg.Enabled = True
If text1(0).Text = "" And Val(text1(0).Text) = 0 Then
MsgBox "小区编号是必填项,且不能重复。", vbExclamation + vbOKOnly, "系统信息", 0, 3
text1(0).SetFocus
Else
If text1(1).Text = "" And Val(text1(1).Text) = 0 Then
MsgBox "小区名称是必填项。", vbExclamation + vbOKOnly, "系统信息", 0, 3
text1(1).SetFocus
Exit Sub
End If
If Data1.Recordset.RecordCount > 0 Then
Data1.Recordset.FindFirst "bh=" + "'" + text1(0).Text + "'"
If Not Data1.Recordset.NoMatch Then
If adedbj <> 2 Or (adedbj = 2 And text1(0).Text <> editbl) Then
MsgBox "小区编号不能重复。", vbExclamation + vbOKOnly, "系统信息", 0, 3
text1(0).SetFocus
Exit Sub
End If
End If
End If
If adedbj = 1 Then Data1.Recordset.AddNew
If adedbj = 2 Then
Data1.Recordset.FindFirst "bh=" + "'" + editbl + "'"
Data1.Recordset.Edit
End If
Data1.Recordset("bh") = Trim(text1(0).Text)
Data1.Recordset("mc") = Trim(text1(1).Text)
Data1.Recordset("qyrq") = Trim(text1(2).Text)
Data1.Recordset("zdmj") = Trim(ttFields(0).Text)
Data1.Recordset("yhmj") = Trim(ttFields(1).Text)
Data1.Recordset("lhmj") = Trim(ttFields(2).Text)
Data1.Recordset("ls") = Trim(text1(3).Text)
Data1.Recordset("dlwz") = Trim(text1(4).Text)
Data1.Recordset("lxdh") = Trim(text1(5).Text)
sb = adedbj
adedbj = 0
Data1.Recordset.Update
Comsave.Enabled = False
cmdClose.Enabled = False
cmdAdd.Enabled = True
cmdedit.Enabled = True
cmdDelete.Enabled = True
Cmdtc.Enabled = True
Command1.Enabled = True
i = 0
Do While i < 6
text1(i).Locked = True
i = i + 1
Loop
i = 0
Do While i < 3
ttFields(i).Locked = True
i = i + 1
Loop
End If
sxbj = 0
If bg.Rows > 3 And adedbj = 1 Then
bh = ""
mc = ""
zdmj = ""
yhmj = ""
lhmj = ""
ls = ""
dlwz = ""
lxdh = ""
qyrq = ""
If IsNull(Data1.Recordset.Fields("bh")) = False Then bh = Data1.Recordset.Fields("bh")
If IsNull(Data1.Recordset.Fields("mc")) = False Then mc = Data1.Recordset.Fields("mc")
If IsNull(Data1.Recordset.Fields("qyrq")) = False Then qyrq = Data1.Recordset.Fields("qyrq")
If IsNull(Data1.Recordset.Fields("zdmj")) = False Then zdmj = Format(Val(Data1.Recordset.Fields("zdmj")), "###,#0.00")
If IsNull(Data1.Recordset.Fields("yhmj")) = False Then yhmj = Format(Val(Data1.Recordset.Fields("yhmj")), "###,#0.00")
If IsNull(Data1.Recordset.Fields("lhmj")) = False Then lhmj = Format(Val(Data1.Recordset.Fields("lhmj")), "###,#0.00")
If IsNull(Data1.Recordset.Fields("ls")) = False Then ls = Data1.Recordset.Fields("ls")
If IsNull(Data1.Recordset.Fields("dlwz")) = False Then dlwz = Data1.Recordset.Fields("dlwz")
If IsNull(Data1.Recordset.Fields("lxdh")) = False Then lxdh = Data1.Recordset.Fields("lxdh")
bg.Row = 1
bg.Col = 0
bg.AddItem (bh & vbTab & mc & vbTab & qyrq & vbTab & zdmj & vbTab & yhmj & vbTab & lhmj & vbTab & ls & vbTab & dlwz & vbTab & lxdh)
Else
If adedbj = 1 Then bgsx
End If
Data1.Refresh
text1(0).SetFocus
End Sub
Private Sub Form_Activate()
If adedbj = 0 Then bgsx
End Sub
Private Sub Form_Load()
winmenu45.Left = 0
winmenu45.Top = 0
winmenu45.Width = 9540
winmenu45.Height = 6144
End Sub
Private Sub Form_Resize()
bg.Height = Me.Height
Frame1.Height = Me.Height
End Sub
Private Sub Image3_Click()
frmdate.text1.Text = 1
frmdate.Show vbModal
ttFields(0).SetFocus
End Sub
Private Sub text1_GotFocus(Index As Integer)
text1(Index).SelStart = 0
text1(Index).SelLength = Len(Trim(text1(Index).Text))
If Index > 2 And text1(2).Text = "" Then text1(2).Text = Format(Date, "yyyy-mm-dd")
End Sub
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
If Index = 2 Then
ttFields(0).SetFocus
Else
If Index = 5 Then
If Comsave.Enabled = False Then Cmdtc.SetFocus Else Comsave.SetFocus
Else
text1(Index + 1).SetFocus
End If
End If
End If
If Index = 3 Then
If Not (KeyAscii >= 48 And KeyAscii <= 57 Or KeyAscii = 45 Or KeyAscii = 8) Then KeyAscii = 0
End If
End Sub
Private Sub Text1_LostFocus(Index As Integer)
If Index = 0 And text1(0).Text <> "" Then
If Len(Trim(text1(0).Text)) < 2 Then text1(0).Text = "0" + Trim(text1(0).Text)
End If
If Index = 2 And Len(text1(2).Text) < 1 Then
text1(2).Text = Format(Date, "YYYY-MM-DD")
Else
text1(2).Text = Format(text1(2).Text, "YYYY-MM-DD")
End If
If Index = 3 And (cmdAdd.Enabled = False Or cmdedit.Enabled = False) Then Call Command3_Click
End Sub
Private Sub ttFields_GotFocus(Index As Integer)
ttFields(Index).SelStart = 0
ttFields(Index).SelLength = Len(Trim(ttFields(Index).Text))
If text1(2).Text = "" Then text1(2).Text = Format(Date, "yyyy-mm-dd")
End Sub
Private Sub ttFields_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
If Index = 2 Then
text1(3).SetFocus
Else
ttFields(Index + 1).SetFocus
End If
Else
If KeyAscii >= 48 And KeyAscii <= 57 Or KeyAscii = 46 Or KeyAscii = 45 Or KeyAscii = 8 Then
Else
KeyAscii = 0
End If
End If
End Sub
Private Sub ttFields_LostFocus(Index As Integer)
If Val(ttFields(Index).Text) = 0 Then
ttFields(Index).Text = ""
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -