?? +?
字號:
Cancel = 1
Me.Hide
End If
End Sub
Private Sub QdCommand_Click() '確 定
'錄入條件有效性判斷(Fixed)
If Not Lrtjyxxpd Then
Exit Sub
End If
Me.Hide
'[>>激活查詢過程結果窗體
Dev_MalfunctionListForm.Timer1.Enabled = True
Dev_MalfunctionListForm.SetFocus
'<<]
End Sub
Private Sub QxCommand_Click() '取消(Fixed)
Me.Hide
End Sub
Private Function Lrtjyxxpd() As Boolean '用戶錄入條件有效性判斷
Dim jsqte As Integer
Lrtjyxxpd = False
'對需要進行事后判斷的文本框錄入內容進行有效性判斷 (Fixed)
For jsqte = 0 To Max_Text_Index
If Textint(jsqte, 9) = 0 Or Textint(jsqte, 9) = 2 Then
If Not TextYxxpd(jsqte) Then
Exit Function
End If
End If
Next jsqte
'[>>以下為依據實際情況自定義部分
'查詢日期范圍應由小到大
If LrText(0).Text > LrText(1).Text And Trim(LrText(1).Text) <> "" Then
Tsxx = "查詢訂單日期范圍應由小到大!"
Call Xtxxts(Tsxx, 0, 4)
LrText(0).SetFocus
Exit Function
End If
'<<]以上為依據實際情況自定義部分
Lrtjyxxpd = True
End Function
Private Sub Cmd_Clear_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) '將用戶輸入條件全部清除(可選)
'清除文本框(Fixed)
For jsqte = 0 To Max_Text_Index
LrText(jsqte).Tag = ""
LrText(jsqte).Text = ""
Next jsqte
'[>>
'此處可以寫入其他清除條件程序
'<<]
End Sub
'*************以下為文本框錄入處理程序(固定不變部分)*************'
Private Sub Wbklrwbcl(Index As Integer) '文本框錄入事后處理程序
'以下為依據實際情況自定義部分[
'在此填寫文本框錄入事后處理程序
']以上為依據實際情況自定義部分
End Sub
Private Sub LrText_Change(Index As Integer)
'屏蔽程序改變控制
If TextChangeLock Then
Exit Sub
End If
TextValiJudgeLock(Index) = False '打開有效性判斷鎖
'限制字段錄入長度
TextChangeLock = True '加鎖(防止執行Lrtext_Change)
Call TextChangeLimit(LrText(Index), Textint(Index, 1)) '去掉無效字符
Select Case Textint(Index, 1)
Case 8, 11 '金額型
Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
Case 9, 12 '數量型
Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
Case 10 '單價型
Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
Case Else '其他小數類型控制
If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
End If
End Select
TextChangeLock = False '解鎖
End Sub
Private Sub LrText_GotFocus(Index As Integer) '文本框得到焦點,顯示相應信息
Call TextShow(Index)
CurTextIndex = Index
LrText(Index).SelStart = Len(LrText(Index))
End Sub
Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer) '字段按F2鍵提供幫助
Select Case KeyCode
Case vbKeyF2
Call Text_Help(Index)
End Select
End Sub
Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer) '文本框錄入事中控制
Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
End Sub
Private Sub LrText_LostFocus(Index As Integer) '文本框失去焦點
'顯示相應信息但不能進行有效性判斷
End Sub
Private Sub Ydcommand1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) '按鈕提供幫助
Call Text_Help(Index)
End Sub
Private Sub Text_Help(Index As Integer) '錄入字段幫助
If Not Textboolean(Index, 1) Then
Exit Sub
End If
'調用幫助
Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
'根據設置選擇顯示編碼和名稱,并進行存儲
If Len(Xtfhcs) <> 0 Then
If Textint(Index, 3) = 1 Then
LrText(Index).Text = Xtfhcsfz
LrText(Index).Tag = Xtfhcs
Else
LrText(Index).Text = Xtfhcs
LrText(Index).Tag = Xtfhcsfz
End If
End If
LrText(Index).SetFocus
End Sub
Private Sub TextShow(Index As Integer) '文本框得到焦點,顯示相應信息
'填寫文本框得到焦點,進行相應信息處理程序
End Sub
Private Sub Wbkcsh() '錄入文本框初始化
Dim jsqte As Integer
'最大錄入文本框索引值
Max_Text_Index = Textvar(1)
ReDim TextValiJudgeLock(Max_Text_Index)
For jsqte = 0 To Max_Text_Index
If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
If Textboolean(jsqte, 1) Then
If jsqte <> 0 And Not Textboolean(jsqte, 3) Then
Load Ydcommand1(jsqte)
End If
Ydcommand1(jsqte).Visible = True
Ydcommand1(jsqte).Move LrText(jsqte).Left + LrText(jsqte).Width, LrText(jsqte).Top
End If
TextChangeLock = True
LrText(jsqte).Text = ""
LrText(jsqte).Tag = ""
If Textint(jsqte, 5) <> 0 Then
LrText(jsqte).MaxLength = Textint(jsqte, 5)
End If
TextChangeLock = False
End If
TextValiJudgeLock(jsqte) = True
Next jsqte
End Sub
Private Function TextYxxpd(Index As Integer) As Boolean '文本框有效性判斷
Dim Sqlstr As String
Dim Findrec As ADODB.Recordset
'文本框內容未曾改變不進行有效性判斷
If TextValiJudgeLock(Index) Then
TextYxxpd = True
Exit Function
End If
'文本框內容為空認為有效,并清空其Tag值
If Trim(LrText(Index)) = "" Then
LrText(Index).Tag = ""
Call Wbklrwbcl(Index)
TextValiJudgeLock(Index) = True
TextYxxpd = True
Exit Function
End If
'可在此加入不做有效性判斷的理由
Select Case Textint(Index, 4)
Case 1 '編碼型
Sqlstr = Trim(Textstr(Index, 5))
Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
If Findrec.EOF Then
Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
LrText(Index).SetFocus
Exit Function
Else
Select Case Textint(Index, 3)
Case 0
If Len(Trim(Textstr(Index, 2))) <> 0 Then
LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
End If
If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
End If
Case 1
If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
End If
If Len(Trim(Textstr(Index, 2))) <> 0 Then
LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
End If
End Select
End If
Case 2 '日期型
If IsDate(LrText(Index).Text) Then
LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
If Val(Mid(LrText(Index), 1, 4)) < 1900 Then
LrText(Index).Text = "1900" + Mid(LrText(Index), 5, 6)
End If
Else
Tsxx = "非法公歷日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
Call Xtxxts(Tsxx, 0, 1)
LrText(Index).SetFocus
Exit Function
End If
Case 3 '其他類型
End Select
'如果有效則加鎖,用戶不改變內容則不再進行有效性判斷
TextValiJudgeLock(Index) = True
'調用文本框事后處理程序
Call Wbklrwbcl(Index)
'有效性判斷通過則返回True
TextYxxpd = True
End Function
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -