??
字號:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form ZF_Gr_Frmslzztj
BorderStyle = 1 'Fixed Single
Caption = "個人_三欄式總帳查詢"
ClientHeight = 1845
ClientLeft = 45
ClientTop = 330
ClientWidth = 4680
Icon = "輔助_個人_三欄總帳查詢條件.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1845
ScaleWidth = 4680
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton QdCommand
Caption = "確定(&O)"
Height = 300
Left = 2280
TabIndex = 3
Top = 1470
Width = 1120
End
Begin VB.CommandButton QxCommand
Caption = "取消(&C)"
Height = 300
Left = 3480
TabIndex = 4
Top = 1470
Width = 1120
End
Begin VB.CheckBox UnloadCheck
Caption = "卸載窗體"
Height = 615
Left = 5370
TabIndex = 6
Top = 720
Visible = 0 'False
Width = 825
End
Begin VB.Frame Fra_Query
ForeColor = &H00FF0000&
Height = 1335
Left = 60
TabIndex = 5
Top = 30
Width = 4545
Begin VB.CommandButton Ydcommand1
Height = 300
Index = 0
Left = 4140
Picture = "輔助_個人_三欄總帳查詢條件.frx":1042
Style = 1 'Graphical
TabIndex = 9
Top = 590
Visible = 0 'False
Width = 300
End
Begin VB.CheckBox Chk_NotBook
Caption = "是否包含未記帳憑證"
Height = 285
Left = 90
TabIndex = 2
Top = 960
Width = 2145
End
Begin VB.TextBox LrText
Height = 300
Index = 0
Left = 900
TabIndex = 1
Text = "0"
Top = 585
Width = 3225
End
Begin MSComctlLib.ImageCombo Imgebo_FzCcode
Height = 315
Left = 900
TabIndex = 0
Top = 210
Width = 3555
_ExtentX = 6271
_ExtentY = 556
_Version = 393216
ForeColor = -2147483640
BackColor = -2147483643
Locked = -1 'True
End
Begin VB.Label Label1
Caption = "會計科目:"
Height = 255
Index = 0
Left = 60
TabIndex = 8
Top = 300
Width = 825
End
Begin VB.Label Label1
Caption = "往來個人:"
Height = 255
Index = 11
Left = 60
TabIndex = 7
Top = 630
Width = 825
End
End
End
Attribute VB_Name = "ZF_Gr_Frmslzztj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************
'* 模 塊 名 稱 :個人_三欄式總帳查詢條件
'* 功 能 描 述 :
'* 程序員姓名 :張建忠
'* 最后修改人 :奚俊峰
'* 最后修改時間:2001/12/28
'* 備 注:程序中所有依實際情況自定義部分均用[>> <<]括起
'****************************************************************
Dim Tsxx As String '系統(tǒng)信息提示
'以下為固定使用變量(文本框)
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) '控 制 焦 點 轉 移
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()
'輔助查詢科目
Call FillImageCombo(Imgebo_FzCcode, "Cwzz_grwlkm", 0)
'以下為文本框處理程序
TextGroupCode = "Cwzz_gr_slzzcxtj"
Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr()) '讀入文本框錄入信息
Call Wbkcsh
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() '確 定
'錄入條件有效性判斷
If Not Lrtjyxxpd Then
Exit Sub
End If
Me.Hide
'激活查詢過程
ZF_Gr_Frmslzzjg.Timer1.Enabled = True
ZF_Gr_Frmslzzjg.SetFocus
End Sub
Private Sub QxCommand_Click() '取消
Me.Hide
End Sub
Private Function Lrtjyxxpd() As Boolean '用戶錄入條件有效性判斷
Dim Jsqte As Integer
Lrtjyxxpd = False
'查詢個人不能為空
If Trim(LrText(0).Text) = "" Then
Tsxx = "往來個人不能為空!"
Call Xtxxts(Tsxx, 0, 4)
LrText(0).SetFocus
Exit Function
End If
'對需要進行事后判斷的文本框錄入內容進行有效性判斷 (固定不變)
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
'[>>以下為依據實際情況自定義部分
'<<]以上為依據實際情況自定義部分
Lrtjyxxpd = True
End Function
'************以下為文本框錄入處理程序(固定不變部分)*************'
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 '加鎖(防止執(zhí)行Lrtext_Change)
Select Case Textint(Index, 1)
Case 8 '金額型
Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
Case 9 '數量型
Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
Case 10 '單價型
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) '文本框失去焦點進行有效性判斷及相應處理
If Textint(Index, 9) = 0 Or Textint(Index, 9) = 1 Then '事中判斷
Call TextYxxpd(Index)
End If
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
TextValiJudgeLock(Index) = True
'先進行有效性判斷
If Not TextYxxpd(CurTextIndex) 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
TextValiJudgeLock(Index) = False
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
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")
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
TextYxxpd = True
End Function
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -