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

企业管理

开发平台:

Visual Basic

  1. VERSION 5.00
  2. Begin VB.Form Report_FrmAccAgeQuery 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "账龄分析查询条件"
  5.    ClientHeight    =   2595
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   5265
  9.    Icon            =   "统计分析_账龄分析查询条件.frx":0000
  10.    KeyPreview      =   -1  'True
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   2595
  15.    ScaleWidth      =   5265
  16.    ShowInTaskbar   =   0   'False
  17.    StartUpPosition =   1  '所有者中心
  18.    Begin VB.Frame Frame1 
  19.       Height          =   2085
  20.       Left            =   60
  21.       TabIndex        =   10
  22.       Top             =   30
  23.       Width           =   5145
  24.       Begin VB.CommandButton Ydcommand1 
  25.          Height          =   300
  26.          Index           =   0
  27.          Left            =   4710
  28.          Picture         =   "统计分析_账龄分析查询条件.frx":1042
  29.          Style           =   1  'Graphical
  30.          TabIndex        =   21
  31.          Top             =   210
  32.          Visible         =   0   'False
  33.          Width           =   300
  34.       End
  35.       Begin VB.TextBox LrText 
  36.          Height          =   300
  37.          Index           =   0
  38.          Left            =   960
  39.          TabIndex        =   0
  40.          Text            =   "0"
  41.          Top             =   210
  42.          Width           =   3765
  43.       End
  44.       Begin VB.CommandButton Ydcommand1 
  45.          Height          =   300
  46.          Index           =   3
  47.          Left            =   4710
  48.          Picture         =   "统计分析_账龄分析查询条件.frx":13CC
  49.          Style           =   1  'Graphical
  50.          TabIndex        =   15
  51.          Top             =   930
  52.          Visible         =   0   'False
  53.          Width           =   300
  54.       End
  55.       Begin VB.CommandButton Ydcommand1 
  56.          Height          =   300
  57.          Index           =   2
  58.          Left            =   4710
  59.          Picture         =   "统计分析_账龄分析查询条件.frx":1756
  60.          Style           =   1  'Graphical
  61.          TabIndex        =   14
  62.          Top             =   570
  63.          Visible         =   0   'False
  64.          Width           =   300
  65.       End
  66.       Begin VB.CommandButton Ydcommand1 
  67.          Height          =   300
  68.          Index           =   1
  69.          Left            =   2550
  70.          Picture         =   "统计分析_账龄分析查询条件.frx":1AE0
  71.          Style           =   1  'Graphical
  72.          TabIndex        =   13
  73.          Top             =   570
  74.          Visible         =   0   'False
  75.          Width           =   300
  76.       End
  77.       Begin VB.TextBox LrText 
  78.          Height          =   300
  79.          Index           =   1
  80.          Left            =   960
  81.          TabIndex        =   1
  82.          Text            =   "1"
  83.          Top             =   570
  84.          Width           =   1605
  85.       End
  86.       Begin VB.TextBox LrText 
  87.          Height          =   300
  88.          Index           =   2
  89.          Left            =   3120
  90.          TabIndex        =   2
  91.          Text            =   "2"
  92.          Top             =   570
  93.          Width           =   1605
  94.       End
  95.       Begin VB.TextBox LrText 
  96.          Height          =   300
  97.          Index           =   3
  98.          Left            =   960
  99.          TabIndex        =   3
  100.          Text            =   "3"
  101.          Top             =   930
  102.          Width           =   3765
  103.       End
  104.       Begin VB.TextBox LrText 
  105.          Height          =   300
  106.          Index           =   4
  107.          Left            =   960
  108.          TabIndex        =   4
  109.          Text            =   "4"
  110.          Top             =   1290
  111.          Width           =   3765
  112.       End
  113.       Begin VB.CommandButton Ydcommand1 
  114.          Height          =   300
  115.          Index           =   4
  116.          Left            =   4710
  117.          Picture         =   "统计分析_账龄分析查询条件.frx":1E6A
  118.          Style           =   1  'Graphical
  119.          TabIndex        =   12
  120.          Top             =   1290
  121.          Visible         =   0   'False
  122.          Width           =   300
  123.       End
  124.       Begin VB.TextBox LrText 
  125.          Height          =   300
  126.          Index           =   5
  127.          Left            =   960
  128.          TabIndex        =   5
  129.          Text            =   "5"
  130.          Top             =   1650
  131.          Width           =   3765
  132.       End
  133.       Begin VB.CommandButton Ydcommand1 
  134.          Height          =   300
  135.          Index           =   5
  136.          Left            =   4710
  137.          Picture         =   "统计分析_账龄分析查询条件.frx":21F4
  138.          Style           =   1  'Graphical
  139.          TabIndex        =   11
  140.          Top             =   1650
  141.          Visible         =   0   'False
  142.          Width           =   300
  143.       End
  144.       Begin VB.Label Label1 
  145.          AutoSize        =   -1  'True
  146.          Caption         =   "截止日期:"
  147.          Height          =   180
  148.          Index           =   2
  149.          Left            =   150
  150.          TabIndex        =   20
  151.          Top             =   270
  152.          Width           =   810
  153.       End
  154.       Begin VB.Label Label1 
  155.          AutoSize        =   -1  'True
  156.          Caption         =   "币别:"
  157.          Height          =   180
  158.          Index           =   11
  159.          Left            =   150
  160.          TabIndex        =   19
  161.          Top             =   990
  162.          Width           =   450
  163.       End
  164.       Begin VB.Label Label1 
  165.          AutoSize        =   -1  'True
  166.          Caption         =   "部门:"
  167.          Height          =   180
  168.          Index           =   0
  169.          Left            =   150
  170.          TabIndex        =   18
  171.          Top             =   1350
  172.          Width           =   450
  173.       End
  174.       Begin VB.Label Label1 
  175.          AutoSize        =   -1  'True
  176.          Caption         =   "供应商:"
  177.          Height          =   180
  178.          Index           =   1
  179.          Left            =   150
  180.          TabIndex        =   17
  181.          Top             =   630
  182.          Width           =   630
  183.       End
  184.       Begin VB.Label Label1 
  185.          AutoSize        =   -1  'True
  186.          Caption         =   "经办人:"
  187.          Height          =   180
  188.          Index           =   4
  189.          Left            =   150
  190.          TabIndex        =   16
  191.          Top             =   1710
  192.          Width           =   630
  193.       End
  194.       Begin VB.Line Line1 
  195.          X1              =   2880
  196.          X2              =   3060
  197.          Y1              =   690
  198.          Y2              =   690
  199.       End
  200.    End
  201.    Begin VB.CommandButton Cmd_Clear 
  202.       Caption         =   "全清"
  203.       Height          =   300
  204.       Left            =   60
  205.       TabIndex        =   8
  206.       Top             =   2220
  207.       Width           =   1120
  208.    End
  209.    Begin VB.CommandButton QxCommand 
  210.       Caption         =   "取消(&C)"
  211.       Height          =   300
  212.       Left            =   4085
  213.       TabIndex        =   7
  214.       Top             =   2220
  215.       Width           =   1120
  216.    End
  217.    Begin VB.CommandButton QdCommand 
  218.       Caption         =   "确定(&O)"
  219.       Height          =   300
  220.       Left            =   2850
  221.       TabIndex        =   6
  222.       Top             =   2220
  223.       Width           =   1120
  224.    End
  225.    Begin VB.CheckBox UnloadCheck 
  226.       Caption         =   "卸载窗体"
  227.       Height          =   615
  228.       Left            =   6450
  229.       TabIndex        =   9
  230.       Top             =   1170
  231.       Width           =   825
  232.    End
  233. End
  234. Attribute VB_Name = "Report_FrmAccAgeQuery"
  235. Attribute VB_GlobalNameSpace = False
  236. Attribute VB_Creatable = False
  237. Attribute VB_PredeclaredId = True
  238. Attribute VB_Exposed = False
  239. '******************************************************************
  240. '*    模 块 名 称 :账龄分析查询条件
  241. '*    功 能 描 述 :
  242. '*    程序员姓名  :陈恩宇
  243. '*    最后修改人  :陈恩宇
  244. '*    最后修改时间:2002/01/04
  245. '*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
  246. '******************************************************************
  247. Dim Tsxx As String                       '系统信息提示
  248. '以下为固定使用变量(文本框)
  249. Dim Textvar() As Variant                 '存储变体型文本框信息
  250. Dim Textboolean() As Boolean             '存储布尔型文本框信息
  251. Dim Textint() As Integer                 '存储整型文本框信息
  252. Dim Textstr() As String                  '存储字符型文本框信息
  253. Dim Max_Text_Index As Integer            '最大录入文本框索引值
  254. Dim TextGroupCode As String              '文本框录入分组编码
  255. Dim TextValiLock As Boolean              '文本框失去焦点是否进行有效性控制判断
  256. Dim TextValiJudgeLock() As Boolean       '文本框录入有效性判断控制锁
  257. Dim CurTextIndex As Integer              '当前文本框索引值
  258. Dim TextChangeLock As Boolean            '文本框内容变换控制锁
  259. Dim Bln_Cancel As Boolean                '取消按钮信息传递
  260. Private Sub Form_KeyPress(KeyAscii As Integer)   '控 制 焦 点 转 移(Fixed)
  261.     
  262.     Dim jdzygs As Integer                         '控件焦点转移个数
  263.     jdzygs = 6
  264.     Select Case KeyAscii
  265.         Case vbKeyReturn
  266.             If Kjjdzy(jdzygs) Then
  267.                 KeyAscii = 0
  268.             End If
  269.         Case 39           '屏蔽"'"
  270.             KeyAscii = 0
  271.     End Select
  272. End Sub
  273. Private Sub Form_Load()
  274.    
  275.     '以下为文本框处理程序(Fixed)
  276.     TextGroupCode = "Ap_AccAgeQuery"
  277.     Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())  '读入文本框录入信息
  278.     Call Wbkcsh
  279.     
  280.     LrText(0).Text = Xtrq
  281.    
  282. End Sub
  283. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)          '查询条件窗体卸载
  284.     '查询条件窗体卸载时判断是否因为结果窗体卸载,如是则卸载,否则隐藏
  285.     If UnloadCheck.Value <> 1 Then
  286.         Cancel = 1
  287.         Me.Hide
  288.     End If
  289. End Sub
  290. Private Sub QdCommand_Click()                                   '确 定
  291.     '录入条件有效性判断(Fixed)
  292.     If Not Lrtjyxxpd Then
  293.         Exit Sub
  294.     End If
  295.     Me.Hide
  296.         
  297.     '[>>激活查询过程结果窗体
  298.     Report_FrmAccAgeList.Timer1.Enabled = True
  299.     Report_FrmAccAgeList.SetFocus
  300.     '<<]
  301. End Sub
  302. Private Sub QxCommand_Click()                                    '取消(Fixed)
  303.     Me.Hide
  304. End Sub
  305. Private Function Lrtjyxxpd() As Boolean                          '用户录入条件有效性判断
  306.  
  307.     Dim jsqte As Integer
  308.     Lrtjyxxpd = False
  309.  
  310.     '对需要进行事后判断的文本框录入内容进行有效性判断 (Fixed)
  311.     For jsqte = 0 To Max_Text_Index
  312.         If Textint(jsqte, 9) = 0 Or Textint(jsqte, 9) = 2 Then
  313.             If Not TextYxxpd(jsqte) Then
  314.                 Exit Function
  315.             End If
  316.         End If
  317.     Next jsqte
  318.    
  319.     '[>>以下为依据实际情况自定义部分
  320.     
  321.     '截止日期不能为空
  322.     If Trim(LrText(0).Text) = "" Then
  323.         Tsxx = "截止日期不能为空!"
  324.         Call Xtxxts(Tsxx, 0, 4)
  325.         LrText(0).SetFocus
  326.         Exit Function
  327.     End If
  328.  
  329.     '客户范围应由小到大
  330.     If Trim(LrText(1).Text) <> "" And Trim(LrText(2).Text) <> "" Then
  331.         If Trim(LrText(1).Tag) > Trim(LrText(2).Tag) Then
  332.             Tsxx = "查询供应商范围应由小到大!"
  333.             Call Xtxxts(Tsxx, 0, 4)
  334.             LrText(1).SetFocus
  335.             Exit Function
  336.         End If
  337.     End If
  338.   
  339.     '<<]以上为依据实际情况自定义部分
  340.  
  341.     Lrtjyxxpd = True
  342. End Function
  343. Private Sub Cmd_Clear_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)    '将用户输入条件全部清除(可选)
  344.     '清除文本框(Fixed)
  345.     For jsqte = 0 To Max_Text_Index
  346.         LrText(jsqte).Tag = ""
  347.         LrText(jsqte).Text = ""
  348.     Next jsqte
  349.   
  350.     '[>>
  351.       
  352.     '此处可以写入其他清除条件程序
  353.   
  354.     '<<]
  355.   
  356. End Sub
  357. '*************以下为文本框录入处理程序(固定不变部分)*************'
  358. Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
  359.   
  360.     '以下为依据实际情况自定义部分[
  361.   
  362.     '在此填写文本框录入事后处理程序
  363.    
  364.     ']以上为依据实际情况自定义部分
  365.   
  366. End Sub
  367. Private Sub LrText_Change(Index As Integer)
  368.     
  369.     '屏蔽程序改变控制
  370.     If TextChangeLock Then
  371.         Exit Sub
  372.     End If
  373.     
  374.     TextValiJudgeLock(Index) = False    '打开有效性判断锁
  375.     
  376.     '限制字段录入长度
  377.           
  378.     TextChangeLock = True  '加锁(防止执行Lrtext_Change)
  379.      
  380.     Select Case Textint(Index, 1)
  381.         Case 8, 11      '金额型
  382.             Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
  383.         Case 9, 12      '数量型
  384.             Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
  385.         Case 10          '单价型
  386.             Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  387.         Case Else        '其他小数类型控制
  388.             If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
  389.                 Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
  390.             End If
  391.     End Select
  392.         
  393.     TextChangeLock = False '解锁
  394. End Sub
  395. Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
  396.     
  397.     Call TextShow(Index)
  398.     CurTextIndex = Index
  399.     LrText(Index).SelStart = Len(LrText(Index))
  400. End Sub
  401. Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
  402.     
  403.     Select Case KeyCode
  404.         Case vbKeyF2
  405.             Call Text_Help(Index)
  406.     End Select
  407. End Sub
  408. Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
  409.     Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
  410. End Sub
  411. Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点
  412.   '显示相应信息但不能进行有效性判断
  413.   
  414. End Sub
  415. Private Sub Ydcommand1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)     '按钮提供帮助
  416.     Call Text_Help(Index)
  417. End Sub
  418. Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
  419.     If Not Textboolean(Index, 1) Then
  420.         Exit Sub
  421.     End If
  422.      
  423.     '调用帮助
  424.     Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
  425.   
  426.     '根据设置选择显示编码和名称,并进行存储
  427.     If Len(Xtfhcs) <> 0 Then
  428.         If Textint(Index, 3) = 1 Then
  429.             LrText(Index).Text = Xtfhcsfz
  430.             LrText(Index).Tag = Xtfhcs
  431.         Else
  432.             LrText(Index).Text = Xtfhcs
  433.             LrText(Index).Tag = Xtfhcsfz
  434.         End If
  435.     End If
  436.    
  437.     LrText(Index).SetFocus
  438. End Sub
  439. Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息
  440.   '填写文本框得到焦点,进行相应信息处理程序
  441.    
  442. End Sub
  443. Private Sub Wbkcsh()                          '录入文本框初始化
  444.   
  445.     Dim jsqte As Integer
  446.   
  447.     '最大录入文本框索引值
  448.     Max_Text_Index = Textvar(1)
  449.   
  450.     ReDim TextValiJudgeLock(Max_Text_Index)
  451.     For jsqte = 0 To Max_Text_Index
  452.          
  453.         If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
  454.             If Textboolean(jsqte, 1) Then
  455.                 If jsqte <> 0 And Not Textboolean(jsqte, 3) Then
  456.                     Load Ydcommand1(jsqte)
  457.                 End If
  458.                 Ydcommand1(jsqte).Visible = True
  459.                 Ydcommand1(jsqte).Move LrText(jsqte).Left + LrText(jsqte).Width, LrText(jsqte).Top
  460.             End If
  461.             TextChangeLock = True
  462.             LrText(jsqte).Text = ""
  463.             LrText(jsqte).Tag = ""
  464.             If Textint(jsqte, 5) <> 0 Then
  465.                 LrText(jsqte).MaxLength = Textint(jsqte, 5)
  466.             End If
  467.             TextChangeLock = False
  468.         End If
  469.      
  470.         TextValiJudgeLock(jsqte) = True
  471.     Next jsqte
  472. End Sub
  473. Private Function TextYxxpd(Index As Integer) As Boolean           '文本框有效性判断
  474.     Dim Sqlstr As String
  475.     Dim Findrec As ADODB.Recordset
  476.   
  477.     '文本框内容未曾改变不进行有效性判断
  478.     If TextValiJudgeLock(Index) Then
  479.         TextYxxpd = True
  480.         Exit Function
  481.     End If
  482.   
  483.     '文本框内容为空认为有效,并清空其Tag值
  484.     If Trim(LrText(Index)) = "" Then
  485.         LrText(Index).Tag = ""
  486.         Call Wbklrwbcl(Index)
  487.         TextValiJudgeLock(Index) = True
  488.         TextYxxpd = True
  489.         Exit Function
  490.     End If
  491.   
  492.     '可在此加入不做有效性判断的理由
  493.   
  494.     Select Case Textint(Index, 4)
  495.         Case 1      '编码型
  496.             Sqlstr = Trim(Textstr(Index, 5))
  497.             Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
  498.             Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  499.             If Findrec.EOF Then
  500.                 Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
  501.                 LrText(Index).SetFocus
  502.                 Exit Function
  503.             Else
  504.                 Select Case Textint(Index, 3)
  505.                     Case 0
  506.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  507.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  508.                         End If
  509.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  510.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  511.                         End If
  512.                     Case 1
  513.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  514.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  515.                         End If
  516.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  517.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  518.                         End If
  519.                 End Select
  520.             End If
  521.         Case 2      '日期型
  522.             If IsDate(LrText(Index).Text) Then
  523.                 LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
  524.                 If Val(Mid(LrText(Index), 1, 4)) < 1900 Then
  525.                     LrText(Index).Text = "1900" + Mid(LrText(Index), 5, 6)
  526.                 End If
  527.             Else
  528.                 Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
  529.                 Call Xtxxts(Tsxx, 0, 1)
  530.                 LrText(Index).SetFocus
  531.                 Exit Function
  532.             End If
  533.         Case 3      '其他类型
  534.     End Select
  535.     
  536.     '如果有效则加锁,用户不改变内容则不再进行有效性判断
  537.     TextValiJudgeLock(Index) = True
  538.     '调用文本框事后处理程序
  539.     Call Wbklrwbcl(Index)
  540.   
  541.     '有效性判断通过则返回True
  542.     TextYxxpd = True
  543.    
  544. End Function