?? 設備運行_設備故障編輯.frm
字號:
Private Function Fun_AllowEdit() As Boolean '判斷當前單據是否允許編輯或刪除
Dim RecTemp As New ADODB.Recordset '臨時使用動態集
Fun_AllowEdit = False
Sqlstr = "Select Checker From Dev_Malfunction Where MalfunctionID=" & Val(Lab_BillId.Caption)
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With RecTemp
If Not .EOF Then
If Trim(.Fields("Checker") & "") <> "" Then
Tsxx = "該單據已審核確認,不能修改或刪除!"
Call Xtxxts(Tsxx, 0, 4)
Exit Function
End If
End If
End With
Fun_AllowEdit = True
End Function
'[>>===================以上為根據實際業務需要自定義過程區域=============================<<]
'*****************************以下為文本框錄入處理程序(固定不變部分)*******************************'
'************以下為文本框錄入處理程序(固定不變部分)*************'
Private Sub Wbklrwbcl(Index As Integer) '文本框錄入事后處理程序
Dim RecTemp As New ADODB.Recordset
'以下為依據實際情況自定義部分[
Select Case Index
'在此填寫文本框錄入事后處理程序
Case 1
Sqlstr = "SELECT Dev_Main.*,Gy_Department.DeptName" & _
" FROM Dev_Main LEFT OUTER JOIN Gy_Department ON Dev_Main.DeptCode = Gy_Department.DeptCode " & _
" Where DEVID='" & Trim(LrText(1).Text) & "'"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
If Not RecTemp.EOF Then
LrText(2).Text = RecTemp.Fields("Dname")
LrText(3).Text = RecTemp.Fields("Model")
LrText(4).Text = RecTemp.Fields("Deptname")
LrText(4).Tag = RecTemp.Fields("Deptcode")
End If
End Select
']以上為依據實際情況自定義部分
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) '文本框失去焦點
'顯示相應信息但不能進行有效性判斷
Select Case Index
Case 1
If Trim(LrText(0).Text) = "" Then
Exit Sub
Else
Call Wbklrwbcl(Index)
End If
End Select
End Sub
Private Sub Ydcommand1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) '按鈕提供幫助
'文本框處于非錄入狀態時不允許調入幫助
If Not LrText(Index).Enabled Then
Exit Sub
End If
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
If Index = 1 And Len(Xtfhcs) <> 0 Then
Call Wbklrwbcl(Index)
End If
End Sub
Private Sub TextShow(Index As Integer) '文本框得到焦點,顯示相應信息
'填寫文本框得到焦點,進行相應信息處理程序
End Sub
Private Sub Wbkcsh() '錄入文本框初始化
Dim Int_TabIndex As Integer 'Tab焦點計數器
'單據錄入中文本框焦點由0開始
LrText(0).TabIndex = 0
'最大錄入文本框索引值
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 jsqte <> 0 Then
Load LrText(jsqte)
Load tsLabel(jsqte)
'判斷錄入文本框是否顯示
If Textboolean(jsqte, 4) Then
LrText(jsqte).Visible = True
tsLabel(jsqte).Visible = True
End If
'判斷文本框是否可編輯
If Textboolean(jsqte, 5) Then
LrText(jsqte).Enabled = True
Else
LrText(jsqte).Enabled = False
End If
'判斷文本框是否提供幫助
If Textboolean(jsqte, 1) Then
If Not Textboolean(jsqte, 3) Then
Load Ydcommand1(jsqte)
End If
End If
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
'設置文本框位置及大小,并設置相應標簽內容及其位置
LrText(jsqte).Move Textint(jsqte, 13), Textint(jsqte, 12), Textint(jsqte, 11), Textint(jsqte, 10)
tsLabel(jsqte).Caption = Textstr(jsqte, 7) & ":"
tsLabel(jsqte).Move Textint(jsqte, 13) - tsLabel(jsqte).Width - 20, Textint(jsqte, 12) + (Textint(jsqte, 10) - tsLabel(jsqte).Height) / 2 - 30
'判斷文本框是否提供幫助
If Textboolean(jsqte, 1) Then
Ydcommand1(jsqte).Visible = True
Ydcommand1(jsqte).Move LrText(jsqte).Left + LrText(jsqte).Width, LrText(jsqte).Top
End If
End If
'將文本框有效性判斷進行加鎖,在文本框內容發生變化時將鎖打開
TextValiJudgeLock(jsqte) = True
Next jsqte
'設置文本框焦點轉移順序(前提文本焦點從0至Max_Text_Index)
For Int_TabIndex = 0 To Max_Text_Index
For jsqte = 0 To Max_Text_Index
If Textint(jsqte, 14) = Int_TabIndex Then
LrText(jsqte).TabIndex = Int_TabIndex
End If
Next jsqte
Next Int_TabIndex
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 + -