?? 包裝物管理系統_帳簿統計_包裝物入庫匯總統計查詢條件.frm
字號:
End
Begin VB.CheckBox UnloadCheck
Caption = "卸載窗體"
Height = 615
Left = 6000
TabIndex = 12
Top = 4530
Width = 825
End
Begin VB.CommandButton QdCommand
Caption = "確定(&O)"
Height = 300
Left = 2430
TabIndex = 9
Top = 4650
Width = 1120
End
Begin VB.CommandButton QxCommand
Caption = "取消(&C)"
Height = 300
Left = 3600
TabIndex = 10
Top = 4620
Width = 1120
End
Begin VB.CommandButton Cmd_Clear
Caption = "全清"
Height = 300
Left = 90
TabIndex = 11
Top = 4620
Width = 1120
End
End
Attribute VB_Name = "Cask_HarvestStatQuery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'******************************************************************
'* 模 塊 名 稱 :包裝物入庫匯總統計查詢條件
'* 功 能 描 述 :
'* 程序員姓名 :鄒力
'* 最后修改人 :
'* 最后修改時間:2001/12/13
'* 備 注:程序中所有依實際情況自定義部分均用[>> <<]括起
'******************************************************************
Dim Tsxx As String '系統信息提示
'以下為固定使用變量(文本框)
Dim Textvar() As Variant '存儲變體型文本框信息
Dim Textboolean() As Boolean '存儲布爾型文本框信息
Dim Textint() As Integer '存儲整型文本框信息
Dim Textstr() As String '存儲字符型文本框信息
Dim Max_Text_Index As Integer '最大錄入文本框索引值
Dim TextGroupCode As String '文本框錄入分組編碼
Dim TextValiLock As Boolean '文本框失去焦點是否進行有效性控制判斷
Dim TextValiJudgeLock() As Boolean '文本框錄入有效性判斷控制鎖
Dim CurTextIndex As Integer '當前文本框索引值
Dim TextChangeLock As Boolean '文本框內容變換控制鎖
Dim Bln_Cancel As Boolean '取消按鈕信息傳遞
Private Sub Form_KeyPress(KeyAscii As Integer) '控 制 焦 點 轉 移(Fixed)
Dim jdzygs As Integer '控件焦點轉移個數
jdzygs = 30
Select Case KeyAscii
Case vbKeyReturn
If Kjjdzy(jdzygs) Then
KeyAscii = 0
End If
Case 39 '屏蔽"'"
KeyAscii = 0
End Select
End Sub
Private Sub Form_Load()
'以下為文本框處理程序(Fixed)
TextGroupCode = "Cask_HarvestStatQuer"
Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr()) '讀入文本框錄入信息
Call Wbkcsh
'[>>初始化查詢條件默認值
LrText(0).Text = Format(Xtrq, "yyyy-mm-dd")
LrText(1).Text = Format(Xtrq, "yyyy-mm-dd")
'<<]
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) '查詢條件窗體卸載
'查詢條件窗體卸載時判斷是否因為結果窗體卸載,如是則卸載,否則隱藏
If UnloadCheck.Value <> 1 Then
Cancel = 1
Me.Hide
End If
End Sub
Private Sub QdCommand_Click() '確 定
'錄入條件有效性判斷(Fixed)
If Not Lrtjyxxpd Then
Exit Sub
End If
Me.Hide
'[>>激活查詢過程結果窗體
Cask_HarvestStat.Timer1.Enabled = True
Cask_HarvestStat.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
Opt_Check(0).Value = True
'[>>
'此處可以寫入其他清除條件程序
'<<]
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 + -