上传用户:zhpu1995
上传日期:2013-09-06
资源大小:61151k
文件大小:13k
源码类别:

企业管理

开发平台:

Visual Basic

  1. VERSION 5.00
  2. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  3. Begin VB.Form ZF_Gr_Frmslzztj 
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "个人_三栏式总帐查询"
  6.    ClientHeight    =   1845
  7.    ClientLeft      =   45
  8.    ClientTop       =   330
  9.    ClientWidth     =   4680
  10.    Icon            =   "辅助_个人_三栏总帐查询条件.frx":0000
  11.    KeyPreview      =   -1  'True
  12.    LinkTopic       =   "Form2"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   1845
  16.    ScaleWidth      =   4680
  17.    StartUpPosition =   2  '屏幕中心
  18.    Begin VB.CommandButton QdCommand 
  19.       Caption         =   "确定(&O)"
  20.       Height          =   300
  21.       Left            =   2280
  22.       TabIndex        =   3
  23.       Top             =   1470
  24.       Width           =   1120
  25.    End
  26.    Begin VB.CommandButton QxCommand 
  27.       Caption         =   "取消(&C)"
  28.       Height          =   300
  29.       Left            =   3480
  30.       TabIndex        =   4
  31.       Top             =   1470
  32.       Width           =   1120
  33.    End
  34.    Begin VB.CheckBox UnloadCheck 
  35.       Caption         =   "卸载窗体"
  36.       Height          =   615
  37.       Left            =   5370
  38.       TabIndex        =   6
  39.       Top             =   720
  40.       Visible         =   0   'False
  41.       Width           =   825
  42.    End
  43.    Begin VB.Frame Fra_Query 
  44.       ForeColor       =   &H00FF0000&
  45.       Height          =   1335
  46.       Left            =   60
  47.       TabIndex        =   5
  48.       Top             =   30
  49.       Width           =   4545
  50.       Begin VB.CommandButton Ydcommand1 
  51.          Height          =   300
  52.          Index           =   0
  53.          Left            =   4140
  54.          Picture         =   "辅助_个人_三栏总帐查询条件.frx":1042
  55.          Style           =   1  'Graphical
  56.          TabIndex        =   9
  57.          Top             =   590
  58.          Visible         =   0   'False
  59.          Width           =   300
  60.       End
  61.       Begin VB.CheckBox Chk_NotBook 
  62.          Caption         =   "是否包含未记帐凭证"
  63.          Height          =   285
  64.          Left            =   90
  65.          TabIndex        =   2
  66.          Top             =   960
  67.          Width           =   2145
  68.       End
  69.       Begin VB.TextBox LrText 
  70.          Height          =   300
  71.          Index           =   0
  72.          Left            =   900
  73.          TabIndex        =   1
  74.          Text            =   "0"
  75.          Top             =   585
  76.          Width           =   3225
  77.       End
  78.       Begin MSComctlLib.ImageCombo Imgebo_FzCcode 
  79.          Height          =   315
  80.          Left            =   900
  81.          TabIndex        =   0
  82.          Top             =   210
  83.          Width           =   3555
  84.          _ExtentX        =   6271
  85.          _ExtentY        =   556
  86.          _Version        =   393216
  87.          ForeColor       =   -2147483640
  88.          BackColor       =   -2147483643
  89.          Locked          =   -1  'True
  90.       End
  91.       Begin VB.Label Label1 
  92.          Caption         =   "会计科目:"
  93.          Height          =   255
  94.          Index           =   0
  95.          Left            =   60
  96.          TabIndex        =   8
  97.          Top             =   300
  98.          Width           =   825
  99.       End
  100.       Begin VB.Label Label1 
  101.          Caption         =   "往来个人:"
  102.          Height          =   255
  103.          Index           =   11
  104.          Left            =   60
  105.          TabIndex        =   7
  106.          Top             =   630
  107.          Width           =   825
  108.       End
  109.    End
  110. End
  111. Attribute VB_Name = "ZF_Gr_Frmslzztj"
  112. Attribute VB_GlobalNameSpace = False
  113. Attribute VB_Creatable = False
  114. Attribute VB_PredeclaredId = True
  115. Attribute VB_Exposed = False
  116. '****************************************************************
  117. '*    模 块 名 称 :个人_三栏式总帐查询条件
  118. '*    功 能 描 述 :
  119. '*    程序员姓名  :张建忠
  120. '*    最后修改人  :奚俊峰
  121. '*    最后修改时间:2001/12/28
  122. '*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
  123. '****************************************************************
  124. Dim Tsxx As String                       '系统信息提示
  125. '以下为固定使用变量(文本框)
  126. Dim Textvar() As Variant                 '存储变体型文本框信息
  127. Dim Textboolean() As Boolean             '存储布尔型文本框信息
  128. Dim Textint() As Integer                 '存储整型文本框信息
  129. Dim Textstr() As String                  '存储字符型文本框信息
  130. Dim Max_Text_Index As Integer            '最大录入文本框索引值
  131. Dim TextGroupCode As String              '文本框录入分组编码
  132. Dim TextValiLock As Boolean              '文本框失去焦点是否进行有效性控制判断
  133. Dim TextValiJudgeLock() As Boolean       '文本框录入有效性判断控制锁
  134. Dim CurTextIndex As Integer              '当前文本框索引值
  135. Dim TextChangeLock As Boolean            '文本框内容变换控制锁
  136. Dim Bln_Cancel As Boolean                '取消按钮信息传递
  137. Private Sub Form_KeyPress(KeyAscii As Integer)   '控 制 焦 点 转 移
  138.     Dim jdzygs As Integer                         '控件焦点转移个数
  139.     jdzygs = 30
  140.     Select Case KeyAscii
  141.     Case vbKeyReturn
  142.         If Kjjdzy(jdzygs) Then
  143.             KeyAscii = 0
  144.         End If
  145.     Case 39           '屏蔽"'"
  146.         KeyAscii = 0
  147.     End Select
  148. End Sub
  149. Private Sub Form_Load()
  150.     '辅助查询科目
  151.     Call FillImageCombo(Imgebo_FzCcode, "Cwzz_grwlkm", 0)
  152.     
  153.     '以下为文本框处理程序
  154.     
  155.     TextGroupCode = "Cwzz_gr_slzzcxtj"
  156.     Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())  '读入文本框录入信息
  157.     Call Wbkcsh
  158.     
  159. End Sub
  160. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  161.     If UnloadCheck.Value <> 1 Then
  162.         Cancel = 1
  163.         Me.Hide
  164.     End If
  165. End Sub
  166. Private Sub QdCommand_Click()                                   '确 定
  167.     '录入条件有效性判断
  168.     If Not Lrtjyxxpd Then
  169.         Exit Sub
  170.     End If
  171.     Me.Hide
  172.     
  173.     '激活查询过程
  174.     ZF_Gr_Frmslzzjg.Timer1.Enabled = True
  175.     ZF_Gr_Frmslzzjg.SetFocus
  176.     
  177. End Sub
  178. Private Sub QxCommand_Click()                                    '取消
  179.     Me.Hide
  180. End Sub
  181. Private Function Lrtjyxxpd() As Boolean                          '用户录入条件有效性判断
  182.     Dim Jsqte As Integer
  183.     Lrtjyxxpd = False
  184.     
  185.     '查询个人不能为空
  186.     If Trim(LrText(0).Text) = "" Then
  187.         Tsxx = "往来个人不能为空!"
  188.         Call Xtxxts(Tsxx, 0, 4)
  189.         LrText(0).SetFocus
  190.         Exit Function
  191.     End If
  192.     
  193.     '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
  194.     For Jsqte = 0 To Max_Text_Index
  195.         If Textint(Jsqte, 9) = 0 Or Textint(Jsqte, 9) = 2 Then
  196.             If Not TextYxxpd(Jsqte) Then
  197.                 Exit Function
  198.             End If
  199.         End If
  200.     Next Jsqte
  201.     
  202.     '[>>以下为依据实际情况自定义部分
  203.     
  204.     '<<]以上为依据实际情况自定义部分
  205.     
  206.     Lrtjyxxpd = True
  207. End Function
  208. '************以下为文本框录入处理程序(固定不变部分)*************'
  209. Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
  210.     
  211.     '以下为依据实际情况自定义部分[
  212.     
  213.     '在此填写文本框录入事后处理程序
  214.     
  215.     ']以上为依据实际情况自定义部分
  216. End Sub
  217. Private Sub LrText_Change(Index As Integer)
  218.     
  219.     '屏蔽程序改变控制
  220.     If TextChangeLock Then
  221.         Exit Sub
  222.     End If
  223.     
  224.     TextValiJudgeLock(Index) = False    '打开有效性判断锁
  225.     
  226.     '限制字段录入长度
  227.     
  228.     TextChangeLock = True  '加锁(防止执行Lrtext_Change)
  229.     Select Case Textint(Index, 1)
  230.     Case 8           '金额型
  231.         Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
  232.     Case 9           '数量型
  233.         Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
  234.     Case 10          '单价型
  235.         Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  236.     Case Else        '其他小数类型控制
  237.         If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
  238.             Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
  239.         End If
  240.     End Select
  241.     TextChangeLock = False '解锁
  242. End Sub
  243. Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
  244.     Call TextShow(Index)
  245.     CurTextIndex = Index
  246.     LrText(Index).SelStart = Len(LrText(Index))
  247. End Sub
  248. Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
  249.     Select Case KeyCode
  250.     Case vbKeyF2
  251.         Call Text_Help(Index)
  252.     End Select
  253. End Sub
  254. Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
  255.     Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
  256. End Sub
  257. Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点进行有效性判断及相应处理
  258.     If Textint(Index, 9) = 0 Or Textint(Index, 9) = 1 Then '事中判断
  259.         Call TextYxxpd(Index)
  260.     End If
  261. End Sub
  262. Private Sub Ydcommand1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)     '按钮提供帮助
  263.     Call Text_Help(Index)
  264. End Sub
  265. Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
  266.     If Not Textboolean(Index, 1) Then
  267.         Exit Sub
  268.     End If
  269.     TextValiJudgeLock(Index) = True
  270.     
  271.     '先进行有效性判断
  272.     If Not TextYxxpd(CurTextIndex) Then
  273.         Exit Sub
  274.     End If
  275.     
  276.     Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
  277.     
  278.     If Len(Xtfhcs) <> 0 Then
  279.         If Textint(Index, 3) = 1 Then
  280.             LrText(Index).Text = Xtfhcsfz
  281.             LrText(Index).Tag = Xtfhcs
  282.         Else
  283.             LrText(Index).Text = Xtfhcs
  284.             LrText(Index).Tag = Xtfhcsfz
  285.         End If
  286.         
  287.     End If
  288.     TextValiJudgeLock(Index) = False
  289.     LrText(Index).SetFocus
  290. End Sub
  291. Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息
  292.     
  293.     '填写文本框得到焦点,进行相应信息处理程序
  294.     
  295. End Sub
  296. Private Sub Wbkcsh()                          '录入文本框初始化
  297.     Dim Jsqte As Integer
  298.     
  299.     '最大录入文本框索引值
  300.     Max_Text_Index = Textvar(1)
  301.     
  302.     ReDim TextValiJudgeLock(Max_Text_Index)
  303.     For Jsqte = 0 To Max_Text_Index
  304.         
  305.         If Len(Trim(Textstr(Jsqte, 1))) <> 0 Then
  306.             If Textboolean(Jsqte, 1) Then
  307.                 If Jsqte <> 0 And Not Textboolean(Jsqte, 3) Then
  308.                     Load Ydcommand1(Jsqte)
  309.                 End If
  310.                 Ydcommand1(Jsqte).Visible = True
  311.                 Ydcommand1(Jsqte).Move LrText(Jsqte).Left + LrText(Jsqte).Width, LrText(Jsqte).Top
  312.             End If
  313.             TextChangeLock = True
  314.             LrText(Jsqte).Text = ""
  315.             LrText(Jsqte).Tag = ""
  316.             If Textint(Jsqte, 5) <> 0 Then
  317.                 LrText(Jsqte).MaxLength = Textint(Jsqte, 5)
  318.             End If
  319.             
  320.             TextChangeLock = False
  321.         End If
  322.         TextValiJudgeLock(Jsqte) = True
  323.     Next Jsqte
  324. End Sub
  325. Private Function TextYxxpd(Index As Integer) As Boolean           '文本框有效性判断
  326.     Dim Sqlstr As String
  327.     Dim Findrec As ADODB.Recordset
  328.     If TextValiJudgeLock(Index) Then    '文本框内容未曾改变不进行有效性判断
  329.         TextYxxpd = True
  330.         Exit Function
  331.     End If
  332.     If Trim(LrText(Index)) = "" Then
  333.         LrText(Index).Tag = ""
  334.         Call Wbklrwbcl(Index)
  335.         TextValiJudgeLock(Index) = True
  336.         TextYxxpd = True
  337.         Exit Function
  338.     End If
  339.     Select Case Textint(Index, 4)
  340.     Case 1      '编码型
  341.         Sqlstr = Trim(Textstr(Index, 5))
  342.         Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
  343.         Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  344.         If Findrec.EOF Then
  345.             Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
  346.             LrText(Index).SetFocus
  347.             Exit Function
  348.         Else
  349.             Select Case Textint(Index, 3)
  350.             Case 0
  351.                 If Len(Trim(Textstr(Index, 2))) <> 0 Then
  352.                     LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  353.                 End If
  354.                 If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  355.                     LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  356.                 End If
  357.             Case 1
  358.                 If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  359.                     LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  360.                 End If
  361.                 If Len(Trim(Textstr(Index, 2))) <> 0 Then
  362.                     LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  363.                 End If
  364.             End Select
  365.         End If
  366.     Case 2      '日期型
  367.         If IsDate(LrText(Index).Text) Then
  368.             LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
  369.         Else
  370.             Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
  371.             Call Xtxxts(Tsxx, 0, 1)
  372.             LrText(Index).SetFocus
  373.             Exit Function
  374.         End If
  375.     Case 3      '其他类型
  376.         
  377.     End Select
  378.     TextValiJudgeLock(Index) = True
  379.     TextYxxpd = True
  380. End Function