📄 frminputa.frm
字号:
NewID = 0
With adoZtcRst
.Open "Select * From Ztc Order By ZtcID"
.MoveFirst
Do Until .EOF
If Trim(.Fields("ZtcID")) = NewID Then NewID = NewID + 1
If Trim(.Fields("Ztc")) = Trim(dcZTC(Index).Text) Then
NewZtc = False
ZZID(Index + 2) = Val(dcZTC(Index).BoundText)
Exit Do
End If
.MoveNext
Loop
.MoveFirst
If NewZtc Then
.AddNew
.Fields("ZtcID") = NewID
.Fields("Ztc") = dcZTC(Index).Text
.Update
ZZID(Index + 2) = NewID
End If
.Close
End With
End Sub
Private Sub E_Clear_Click()
cmdClear_Click
End Sub
Private Sub E_Copy_Click()
cmdCopy_Click
End Sub
Private Sub F_Add_Click()
cmdAdd_Click
End Sub
Private Sub F_Exit_Click()
CmdReturn_Click
End Sub
Private Sub F_Save_Click()
cmdOK_Click
End Sub
Private Sub Form_Load()
Set adoCon = New ADODB.Connection
adoCon.Open "PmData", "Admin"
Set adoRst = New ADODB.Recordset
Set adoRst.ActiveConnection = adoCon
adoRst.CursorType = adOpenKeyset
adoRst.LockType = adLockOptimistic
Set adoZrRst = New ADODB.Recordset
Set adoZrRst.ActiveConnection = adoCon
adoZrRst.CursorType = adOpenKeyset
adoZrRst.LockType = adLockOptimistic
Set adoZtcRst = New ADODB.Recordset
Set adoZtcRst.ActiveConnection = adoCon
adoZtcRst.CursorType = adOpenKeyset
adoZtcRst.LockType = adLockOptimistic
adoRst.Open "Select * From DataA Where FileType Like '" & frmMain.FileType & "'"
Call SetEnable(False)
frmInputA.Caption = frmInputA.Caption + " (" + frmMain.FileType + "档案)"
End Sub
Sub Text0_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Private Sub Text10_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Private Sub Text11_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Private Sub Text12_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Private Sub Text12_LostFocus()
Dim i, j, k As Integer
Dim ZT(10, 3), ZT1 As String
Dim Swap
i = 0
With adoZtcRst
.Open "Select * From Ztc Order By ZtcID"
.MoveFirst
Do While Not .EOF And i < 10
ZT1 = LTrim(Trim(.Fields!Ztc))
ZT(i, 2) = InStr(Text12.Text, ZT1)
If ZT(i, 2) Then
ZT(i, 0) = ZT1
ZT(i, 1) = .Fields!ZtcID
i = i + 1
End If
.MoveNext
Loop
i = i - 1
For j = 0 To i - 1
For k = j + 1 To i
If ZT(j, 2) > ZT(k, 2) Then
Swap = ZT(j, 0)
ZT(j, 0) = ZT(k, 0)
ZT(k, 0) = Swap
Swap = ZT(j, 1)
ZT(j, 1) = ZT(k, 1)
ZT(k, 1) = Swap
Swap = ZT(j, 2)
ZT(j, 2) = ZT(k, 2)
ZT(k, 2) = Swap
End If
Next k
Next j
For i = 0 To 4
dcZTC(i).Text = ZT(i, 0)
dcZTC(i).BoundText = ZT(i, 1)
Next
.Close
End With
End Sub
Private Sub Text13_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cmdOK.SetFocus
KeyAscii = 0
End If
End Sub
Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Sub Text5_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Sub Text6_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Sub Text7_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Private Sub Text7_LostFocus()
Dim i, dotNum, dotLoc(10), lenDate As Integer
Dim iDate As String
If Text7.Text = "" Then Exit Sub
dotNum = 0
iDate = LTrim(Trim(Text7.Text))
lenDate = Len(iDate)
For i = 1 To lenDate
If Mid(iDate, i, 1) = "." Then
dotNum = dotNum + 1
dotLoc(dotNum) = i
End If
Next
Select Case dotNum
Case Is = 0
If lenDate = 2 Then
iDate = "19" & iDate
Else
If lenDate <> 4 Then
Text7.SetFocus
Exit Sub
End If
End If
Case Is = 1
If dotLoc(1) = 3 And lenDate > 3 Then
iDate = "19" & iDate
lenDate = lenDate + 2
If lenDate = 6 Then
iDate = Left(iDate, 5) & "0" & Right(iDate, 1)
lenDate = lenDate + 1
End If
If lenDate <> 7 Then
Text7.SetFocus
Exit Sub
End If
Else
If dotLoc(1) = 5 Then
If lenDate = 6 Then
iDate = Left(iDate, 5) & "0" & Right(iDate, 1)
lenDate = lenDate + 1
End If
If lenDate <> 7 Then
Text7.SetFocus
Exit Sub
End If
Else
Text7.SetFocus
Exit Sub
End If
End If
Case Is = 2
Select Case dotLoc(1)
Case 3
Select Case dotLoc(2)
Case 5
Select Case lenDate
Case 6
iDate = "19" & Left(iDate, 3) & _
"0" & Mid(iDate, 4, 2) & _
"0" & Right(iDate, 1)
Case 7
iDate = "19" & Left(iDate, 3) & _
"0" & Right(iDate, 4)
End Select
Case 6
Select Case lenDate
Case 7
iDate = "19" & Left(iDate, 6) & _
"0" & Right(iDate, 1)
Case 8
iDate = "19" & iDate
End Select
End Select
Case 5
Select Case dotLoc(2)
Case 7
Select Case lenDate
Case 8
iDate = Left(iDate, 5) & "0" & _
Mid(iDate, 6, 2) & "0" & _
Right(iDate, 1)
Case 9
iDate = Left(iDate, 5) & "0" & _
Right(iDate, 4)
End Select
Case 8 And lenDate = 9
iDate = Left(iDate, 8) & "0" & Right(iDate, 1)
End Select
End Select
lenDate = Len(iDate)
If lenDate <> 10 Or Mid(iDate, 5, 1) <> "." Or Mid(iDate, 8, 1) <> "." Then
Text7.SetFocus
Exit Sub
End If
Case Else
Text7.SetFocus
Exit Sub
End Select
If Right(iDate, 1) = "." Then
Text7.Text = Left(iDate, lenDate - 1)
Else
Text7.Text = iDate
End If
End Sub
Sub Text8_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Private Sub Text8_LostFocus()
Dim i, dotNum, dotLoc(10), lenDate As Integer
Dim iDate As String
If Text8.Text = "" Then Exit Sub
dotNum = 0
iDate = LTrim(Trim(Text8.Text))
lenDate = Len(iDate)
For i = 1 To lenDate
If Mid(iDate, i, 1) = "." Then
dotNum = dotNum + 1
dotLoc(dotNum) = i
End If
Next
Select Case dotNum
Case Is = 0
If lenDate = 2 Then
iDate = "19" & iDate
Else
If lenDate <> 4 Then
Text8.SetFocus
Exit Sub
End If
End If
Case Is = 1
If dotLoc(1) = 3 And lenDate > 3 Then
iDate = "19" & iDate
lenDate = lenDate + 2
If lenDate = 6 Then
iDate = Left(iDate, 5) & "0" & Right(iDate, 1)
lenDate = lenDate + 1
End If
If lenDate <> 7 Then
Text8.SetFocus
Exit Sub
End If
Else
If dotLoc(1) = 5 Then
If lenDate = 6 Then
iDate = Left(iDate, 5) & "0" & Right(iDate, 1)
lenDate = lenDate + 1
End If
If lenDate <> 7 Then
Text8.SetFocus
Exit Sub
End If
Else
Text8.SetFocus
Exit Sub
End If
End If
Case Is = 2
Select Case dotLoc(1)
Case 3
Select Case dotLoc(2)
Case 5
Select Case lenDate
Case 6
iDate = "19" & Left(iDate, 3) & _
"0" & Mid(iDate, 4, 2) & _
"0" & Right(iDate, 1)
Case 7
iDate = "19" & Left(iDate, 3) & _
"0" & Right(iDate, 4)
End Select
Case 6
Select Case lenDate
Case 7
iDate = "19" & Left(iDate, 6) & _
"0" & Right(iDate, 1)
Case 8
iDate = "19" & iDate
End Select
End Select
Case 5
Select Case dotLoc(2)
Case 7
Select Case lenDate
Case 8
iDate = Left(iDate, 5) & "0" & _
Mid(iDate, 6, 2) & "0" & _
Right(iDate, 1)
Case 9
iDate = Left(iDate, 5) & "0" & _
Right(iDate, 4)
End Select
Case 8 And lenDate = 9
iDate = Left(iDate, 8) & "0" & Right(iDate, 1)
End Select
End Select
lenDate = Len(iDate)
If lenDate <> 10 Or Mid(iDate, 5, 1) <> "." Or Mid(iDate, 8, 1) <> "." Then
Text8.SetFocus
Exit Sub
End If
Case Else
Text8.SetFocus
Exit Sub
End Select
If Right(iDate, 1) = "." Then
Text8.Text = Left(iDate, lenDate - 1)
Else
Text8.Text = iDate
End If
If Text7.Text > Text8.Text Then
Text7.SetFocus
Exit Sub
End If
End Sub
Sub Text9_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -