资源名称:ERPSYS.zip [点击查看]
上传用户:zhpu1995
上传日期:2013-09-06
资源大小:61151k
文件大小:68k
源码类别:
企业管理
开发平台:
Visual Basic
- VERSION 5.00
- Object = "{65A39231-6133-11D1-BAA2-444553540000}#1.0#0"; "vslight6.OCX"
- Object = "{D76D7128-4A96-11D3-BD95-D296DC2DD072}#1.0#0"; "VSOCX7.OCX"
- Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
- Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
- Object = "{C932BA88-4374-101B-A56C-00AA003668DC}#1.1#0"; "MSMASK32.OCX"
- Begin VB.Form Tr_DispatchWash
- BorderStyle = 1 'Fixed Single
- Caption = "调洗单"
- ClientHeight = 7095
- ClientLeft = 45
- ClientTop = 330
- ClientWidth = 9345
- Icon = "铁运管理_调洗单.frx":0000
- KeyPreview = -1 'True
- LinkTopic = "Form2"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 7095
- ScaleWidth = 9345
- StartUpPosition = 1 '所有者中心
- Begin TabDlg.SSTab StTab
- Height = 6435
- Left = 30
- TabIndex = 5
- Top = 660
- Width = 9330
- _ExtentX = 16457
- _ExtentY = 11351
- _Version = 393216
- Style = 1
- Tabs = 2
- Tab = 1
- TabHeight = 520
- TabCaption(0) = "列表视图"
- TabPicture(0) = "铁运管理_调洗单.frx":1042
- Tab(0).ControlEnabled= 0 'False
- Tab(0).Control(0)= "CzxsGrid"
- Tab(0).ControlCount= 1
- TabCaption(1) = "单张视图"
- TabPicture(1) = "铁运管理_调洗单.frx":105E
- Tab(1).ControlEnabled= -1 'True
- Tab(1).Control(0)= "Frame1"
- Tab(1).Control(0).Enabled= 0 'False
- Tab(1).ControlCount= 1
- Begin VB.Frame Frame1
- Height = 6015
- Left = 90
- TabIndex = 6
- Top = 330
- Width = 9135
- Begin MSMask.MaskEdBox JiText
- Height = 300
- Index = 1
- Left = 1755
- TabIndex = 2
- Top = 1215
- Width = 1620
- _ExtentX = 2858
- _ExtentY = 529
- _Version = 393216
- MaxLength = 16
- Mask = "####-##-## ##:##"
- PromptChar = "_"
- End
- Begin MSMask.MaskEdBox JiText
- Height = 300
- Index = 0
- Left = 1740
- TabIndex = 1
- Top = 795
- Width = 1620
- _ExtentX = 2858
- _ExtentY = 529
- _Version = 393216
- MaxLength = 16
- Mask = "####-##-## ##:##"
- PromptChar = "_"
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 0
- Left = 3720
- Picture = "铁运管理_调洗单.frx":107A
- Style = 1 'Graphical
- TabIndex = 8
- Top = 3270
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton BcCommand
- Caption = "保存(&S)"
- Height = 300
- Left = 780
- TabIndex = 4
- Top = 2520
- Width = 1120
- End
- Begin VB.CommandButton QxCommand
- Cancel = -1 'True
- Caption = "取消(&C)"
- Height = 300
- Left = 2010
- TabIndex = 7
- Top = 2520
- Width = 1120
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 1
- Left = 1755
- TabIndex = 3
- Text = "1"
- Top = 1650
- Width = 1620
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 0
- Left = 1755
- TabIndex = 0
- Text = "0"
- Top = 360
- Width = 1618
- End
- Begin VB.Label TsLabel
- AutoSize = -1 'True
- Caption = "调洗完毕时间:"
- Height = 180
- Index = 3
- Left = 420
- TabIndex = 15
- Top = 1275
- Width = 1170
- End
- Begin VB.Label TsLabel
- AutoSize = -1 'True
- Caption = "要求调洗时间:"
- Height = 180
- Index = 2
- Left = 420
- TabIndex = 14
- Top = 855
- Width = 1170
- End
- Begin VB.Label TsLabel
- AutoSize = -1 'True
- Caption = "调洗负责人:"
- Height = 180
- Index = 1
- Left = 420
- TabIndex = 10
- Top = 1710
- Width = 990
- End
- Begin VB.Label TsLabel
- AutoSize = -1 'True
- Caption = "车号:"
- Height = 180
- Index = 0
- Left = 420
- TabIndex = 9
- Top = 420
- Width = 450
- End
- End
- Begin VSFlex8Ctl.VSFlexGrid CzxsGrid
- Height = 5955
- Left = -74910
- TabIndex = 11
- Top = 390
- Width = 9135
- _ExtentX = 16113
- _ExtentY = 10504
- Appearance = 1
- BorderStyle = 1
- Enabled = -1 'True
- BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
- Name = "宋体"
- Size = 9
- Charset = 134
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- MousePointer = 0
- BackColor = -2147483643
- ForeColor = -2147483640
- BackColorFixed = -2147483633
- ForeColorFixed = -2147483630
- BackColorSel = -2147483635
- ForeColorSel = -2147483634
- BackColorBkg = 8421504
- BackColorAlternate= -2147483643
- GridColor = -2147483633
- GridColorFixed = -2147483632
- TreeColor = -2147483632
- FloodColor = 192
- SheetBorder = -2147483642
- FocusRect = 1
- HighLight = 1
- AllowSelection = -1 'True
- AllowBigSelection= -1 'True
- AllowUserResizing= 0
- SelectionMode = 0
- GridLines = 1
- GridLinesFixed = 2
- GridLineWidth = 1
- Rows = 5000
- Cols = 10
- FixedRows = 1
- FixedCols = 0
- RowHeightMin = 0
- RowHeightMax = 0
- ColWidthMin = 0
- ColWidthMax = 0
- ExtendLastCol = 0 'False
- FormatString = ""
- ScrollTrack = 0 'False
- ScrollBars = 3
- ScrollTips = 0 'False
- MergeCells = 0
- MergeCompare = 0
- AutoResize = -1 'True
- AutoSizeMode = 0
- AutoSearch = 0
- MultiTotals = -1 'True
- SubtotalPosition= 1
- OutlineBar = 0
- OutlineCol = 0
- Ellipsis = 0
- ExplorerBar = 0
- PicturesOver = 0 'False
- FillStyle = 0
- RightToLeft = 0 'False
- PictureType = 0
- TabBehavior = 0
- OwnerDraw = 0
- Editable = 0 'False
- ShowComboButton = -1 'True
- WordWrap = 0 'False
- TextStyle = 0
- TextStyleFixed = 0
- OleDragMode = 0
- OleDropMode = 0
- DataMode = 0
- VirtualData = -1 'True
- End
- End
- Begin MSComctlLib.Toolbar SzToolbar
- Align = 1 'Align Top
- Height = 570
- Left = 0
- TabIndex = 12
- Top = 0
- Width = 9345
- _ExtentX = 16484
- _ExtentY = 1005
- ButtonWidth = 820
- ButtonHeight = 953
- AllowCustomize = 0 'False
- Appearance = 1
- Style = 1
- ImageList = "ImageList1"
- _Version = 393216
- BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
- NumButtons = 12
- BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "设置"
- Key = "ymsz"
- ImageKey = "sz"
- EndProperty
- BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "打印"
- Key = "dy"
- Object.ToolTipText = "点击或按Ctrl+P打印表格"
- ImageKey = "dy"
- EndProperty
- BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "预览"
- Key = "yl"
- ImageKey = "yl"
- EndProperty
- BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Style = 3
- EndProperty
- BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "增加"
- Key = "zj"
- Object.ToolTipText = "点击或按Ctrl+A增加记录"
- ImageKey = "xz"
- EndProperty
- BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "修改"
- Key = "xg"
- ImageKey = "xg"
- EndProperty
- BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "删除"
- Key = "sc"
- Object.ToolTipText = "点击或按Ctrl+D删除当前记录"
- ImageKey = "sc"
- EndProperty
- BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Style = 3
- EndProperty
- BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "刷新"
- Key = "sx"
- ImageKey = "sx"
- EndProperty
- BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Style = 3
- EndProperty
- BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "帮助"
- Key = "bz"
- ImageKey = "bz"
- EndProperty
- BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "退出"
- Key = "fh"
- ImageKey = "tc"
- EndProperty
- EndProperty
- BorderStyle = 1
- Begin MSComctlLib.Toolbar GsToolbar
- Height = 540
- Left = 6870
- TabIndex = 13
- Top = 0
- Width = 2475
- _ExtentX = 4366
- _ExtentY = 953
- ButtonWidth = 1455
- ButtonHeight = 953
- AllowCustomize = 0 'False
- Appearance = 1
- Style = 1
- ImageList = "ImageList1"
- _Version = 393216
- BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
- NumButtons = 3
- BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "保存格式"
- Key = "bcgs"
- ImageKey = "bcgs"
- EndProperty
- BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "默认列宽"
- Key = "hfmrgs"
- ImageKey = "mrlk"
- EndProperty
- BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "显示项目"
- Key = "szxsxm"
- ImageKey = "xsxm"
- EndProperty
- EndProperty
- End
- End
- Begin MSComctlLib.ImageList ImageList1
- Left = 0
- Top = 420
- _ExtentX = 1005
- _ExtentY = 1005
- BackColor = -2147483643
- ImageWidth = 16
- ImageHeight = 16
- MaskColor = 12632256
- _Version = 393216
- BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
- NumListImages = 29
- BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":1404
- Key = "sz"
- EndProperty
- BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":179E
- Key = "dy"
- EndProperty
- BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":1B38
- Key = "yl"
- EndProperty
- BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":1ED2
- Key = "xg"
- EndProperty
- BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":226C
- Key = "zh"
- EndProperty
- BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":2606
- Key = "sh"
- EndProperty
- BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":29A0
- Key = "bc"
- EndProperty
- BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":2D3A
- Key = "fq"
- EndProperty
- BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":30D4
- Key = "bz"
- EndProperty
- BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":346E
- Key = "tc"
- EndProperty
- BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":3808
- Key = "bcgs"
- EndProperty
- BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":3BA2
- Key = "mrlk"
- EndProperty
- BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":3F3C
- Key = "xsxm"
- EndProperty
- BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":42D6
- Key = "first"
- EndProperty
- BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":4670
- Key = "prev"
- EndProperty
- BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":4A0A
- Key = "next"
- EndProperty
- BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":4DA4
- Key = "last"
- EndProperty
- BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":513E
- Key = "xx"
- EndProperty
- BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":54D8
- Key = "define"
- EndProperty
- BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":5872
- Key = "exec"
- EndProperty
- BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":5C0C
- Key = "xz"
- EndProperty
- BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":5FA6
- Key = "sc"
- EndProperty
- BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":6340
- Key = "sx"
- EndProperty
- BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":66DA
- Key = "cx"
- EndProperty
- BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":6A74
- Key = "zd"
- EndProperty
- BeginProperty ListImage26 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":6E0E
- Key = "dz"
- EndProperty
- BeginProperty ListImage27 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":71A8
- Key = "ph"
- EndProperty
- BeginProperty ListImage28 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":7542
- Key = "fz"
- EndProperty
- BeginProperty ListImage29 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "铁运管理_调洗单.frx":78DC
- Key = "dw"
- EndProperty
- EndProperty
- End
- End
- Attribute VB_Name = "Tr_DispatchWash"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- '*******************************************************
- '* 模 块 名 称 :调洗单设置
- '* 功 能 描 述 :设置车辆洗涤单据
- '* 程序员姓名 :孙宝龙
- '* 最后修改人 :孙宝龙
- '* 最后修改时间:2001/12/06
- '* 备 注:
- '*******************************************************
- Dim Rec_CodeSet As New ADODB.Recordset '编码设置表
- Dim jdzygs As Integer '控件焦点转移个数
- Dim Lrzt As Integer '录入状态标志(0-非录入状态 1-增加 2-修改)
- Dim ReportTitle As String '报表主标题
- Dim Str_RightEdit As String '编辑(新增、修改、删除)权限索引
- '自定义
- Public dbl_RecordAutoCode As Double
- '以下为固定使用变量(网格)
- Dim Cxnrrec As New ADODB.Recordset '显示查询内容动态集
- Dim Dyymctbl As New DY_Dyymsz '打印页面窗体变量
- Dim GridCode As String '显示网格网格代码
- Dim GridInf() As Variant '整个网格设置信息
- Dim Tsxx As String '系统提示信息
- Dim Qslz As Long '网格隐藏(非操作显示)列数
- Dim Sjhgd As Double '网格数据行高度
- Dim GridBoolean() As Boolean '网格列信息(布尔型)
- Dim GridStr() As String '网格列信息(字符型)
- Dim GridInt() As Integer '网格列信息(整型)
- Dim szzls As Integer '数组总列数(网格列数-1)
- '以下为固定使用变量(文本框)
- 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) '控 制 焦 点 转 移
- jdzygs = 5
- 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()
- '打印报表标题信息
- ReportTitle = "调 洗 单"
- Xtrq = Format(Xtrq, "yyyy-mm-dd hh:mm")
- '调入打印页面设置窗体
- XtReportCode = "Tr_DispatchWash"
- Load Dyymctbl
- '以下为文本框处理程序(读入文本框录入信息)
- TextGroupCode = "Tr_DispatchWash"
- Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())
- Call Wbkcsh
- '调入网格设置信息
- GridCode = "Tr_DispatchWash"
- Call BzWgcsh(CzxsGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
- Qslz = GridInf(1)
- Sjhgd = GridInf(2)
- szzls = CzxsGrid.Cols - 1
- '填 充 网 格
- Call Cxnrtcwg
- '初始化toolbar,tab卡状态
- StTab.Tab = 0
- StTab.TabEnabled(1) = False
- Frame1.Enabled = False
- '设置为非录入状态
- Lrzt = 0
- '编辑(新增、修改、删除)权限索引
- Str_RightEdit = "Tr_DispatchWash_Edit"
- End Sub
- Private Sub Cxnrtcwg() '查询内容填充网格
- Dim Sqlstr As String '查询连接串
- Dim jsqte As Long '查询临时使用变量
- '为加快显示速度,将网格刷新动作冻结
- CzxsGrid.Redraw = False
- '[>>查询连接串
- Sqlstr = "SELECT Tr_DispatchWash.*,Tr_NowAccount.VoucherId as VoucherId FROM Tr_DispatchWash left outer join Tr_NowAccount on Tr_DispatchWash.WashId=Tr_NowAccount.ChildId where Tr_NowAccount.VoucherNum=4 order by Tr_DispatchWash.WashTime"
- '<<]
- Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
- With Cxnrrec
- CzxsGrid.Rows = CzxsGrid.FixedRows
- If .EOF And .BOF Then
- CzxsGrid.Redraw = True
- Exit Sub
- End If
- jsqte = CzxsGrid.FixedRows
- Do While Not .EOF
- CzxsGrid.AddItem ""
- Call Jltcwg(Cxnrrec, jsqte) '调入填充网格子过程
- CzxsGrid.RowHeight(jsqte) = Sjhgd '设置网格高度
- .MoveNext
- jsqte = jsqte + 1
- Loop
- End With
- '将网格刷新动作解冻
- CzxsGrid.Redraw = True
- End Sub
- Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long) '记录内容填充网格
- '[>>以下为自定义部分
- With Jlbrec
- CzxsGrid.TextMatrix(Rowjsq, 0) = .Fields("WashId")
- CzxsGrid.TextMatrix(Rowjsq, 1) = .Fields("VoucherId")
- CzxsGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), szzls)) = Trim(.Fields("VehicleNum") & "") '车号
- If Not IsNull(.Fields("WashTime")) Then
- CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), szzls)) = Format(Trim(.Fields("WashTime")), "yyyy-mm-dd hh:mm") '要求调洗时间
- Else
- CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), szzls)) = ""
- End If
- If Not IsNull(.Fields("WashEndTime")) Then
- CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), szzls)) = Format(Trim(.Fields("WashEndTime")), "yyyy-mm-dd hh:mm") '调洗完毕时间
- Else
- CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), szzls)) = ""
- End If
- If Not IsNull(.Fields("WashMan")) Then
- CzxsGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), szzls)) = Trim(.Fields("WashMan") & "") '调洗负责人
- Else
- CzxsGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), szzls)) = ""
- End If
- If Trim(.Fields("Result")) = True Then '调洗状态
- CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), szzls)) = "已调洗"
- Else
- CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), szzls)) = "未调洗"
- End If
- End With
- '以上为自定义部分<<]
- End Sub
- Private Sub Form_Unload(Cancel As Integer) '窗体卸载
- dbl_RecordAutoCode = 0
- Set Cxnrrec = Nothing
- Set Rec_CodeSet = Nothing
- Unload Dyymctbl
- End Sub
- Private Function Bclrsj() As Boolean '判断录入数据有效性,并保存数据
- Dim jsqte As Integer
- Dim Findrc As New ADODB.Recordset
- '对文本框录入内容进行为零和为空判断(固定不变)
- With Rec_CodeSet
- For jsqte = 0 To Max_Text_Index
- If Textint(jsqte, 8) = 1 Then '字段不能为空
- If Len(Trim(LrText(jsqte).Text)) = 0 Then
- Tsxx = Textstr(jsqte, 7) & "不能为空!"
- Call Xtxxts(Tsxx, 0, 1)
- LrText(jsqte).SetFocus
- Bclrsj = False
- Exit Function
- End If
- Else
- If Textint(jsqte, 8) = 2 Then '字段不能为零
- If Val(Trim(LrText(jsqte).Text)) = 0 Then
- Tsxx = Textstr(jsqte, 7) & "不能为零!"
- Call Xtxxts(Tsxx, 0, 1)
- LrText(jsqte).SetFocus
- Bclrsj = False
- Exit Function
- End If
- End If
- End If
- Next jsqte
- '<<自定义
- '判断要求调洗时间的年度是否与当前会计年度相符
- If Trim(JiText(0).Text <> "____-__-__ __:__") Then
- If IsDate(JiText(0).Text) Then
- JiText(0).Text = Format(JiText(0).Text, "yyyy-mm-dd hh:mm")
- If Val(Trim(JiText(0).Text)) <> Val(Year(Xtrq)) Then
- Tsxx = "年度与当前会计年度不符,请重新输入"
- Call Xtxxts(Tsxx, 0, 4)
- JiText(0).SetFocus
- Exit Function
- End If
- Else
- Tsxx = "非法公历时间!(格式:" + Format(Date, "yyyy-mm-dd hh:mm") + ")"
- Call Xtxxts(Tsxx, 0, 1)
- JiText(0).SetFocus
- Exit Function
- End If
- End If
- '要求调洗时间不能为空
- If Trim(JiText(0).Text) = "____-__-__ __:__" Then
- Tsxx = "要求调洗时间不能为空!"
- Call Xtxxts(Tsxx, 0, 1)
- JiText(0).SetFocus
- Bclrsj = False
- Exit Function
- End If
- '判断调洗完毕时间的年度是否与当前会计年度相符
- If Trim(JiText(1).Text <> "____-__-__ __:__") Then
- If IsDate(JiText(1).Text) Then
- JiText(1).Text = Format(JiText(1).Text, "yyyy-mm-dd hh:mm")
- If Val(Trim(JiText(1).Text)) <> Val(Year(Xtrq)) Then
- Tsxx = "年度与当前会计年度不符,请重新输入"
- Call Xtxxts(Tsxx, 0, 4)
- JiText(1).SetFocus
- Exit Function
- End If
- Else
- Tsxx = "非法公历时间!(格式:" + Format(Date, "yyyy-mm-dd hh:mm") + ")"
- Call Xtxxts(Tsxx, 0, 1)
- JiText(1).SetFocus
- Exit Function
- End If
- End If
- '要求调洗时间不能大于调洗完毕时间
- If Trim(JiText(0).Text) <> "____-__-__ __:__" And Trim(JiText(1).Text) <> "____-__-__ __:__" Then
- If CDate(JiText(0).Text) > CDate(JiText(1).Text) Then
- Tsxx = "要求调洗时间不能大于调洗完毕时间!"
- Call Xtxxts(Tsxx, 0, 1)
- Bclrsj = False
- JiText(1).SetFocus
- Exit Function
- End If
- End If
- If Not JiTextptpd Then
- 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
- If Lrzt = 1 Then '增 加
- If .State = 1 Then .Close
- .Open "SELECT * FROM Tr_DispatchWash where 1=2 ", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
- '判断记录内容无误后,将记录内容写入数据表
- On Error GoTo Swcwcl
- Cw_DataEnvi.DataConnect.BeginTrans
- .AddNew
- .Fields("VehicleNum") = Trim(LrText(0).Text & "") '车号
- If Trim(JiText(0).Text) <> "____-__-__ __:__" Then
- .Fields("WashTime") = Format(JiText(0).Text, "yyyy-mm-dd hh:mm") '要求调洗时间
- Else
- .Fields("WashTime") = Null
- End If
- If Trim(JiText(1).Text) <> "____-__-__ __:__" Then
- .Fields("WashEndTime") = Format(JiText(1).Text, "yyyy-mm-dd hh:mm") '调洗完毕时间
- Else
- .Fields("WashEndTime") = Null
- End If
- If Trim(LrText(1).Text) <> "" Then
- .Fields("WashMan") = Trim(LrText(1).Text & "") '调洗负责人
- Else
- .Fields("WashMan") = ""
- End If
- If Trim(JiText(1).Text) <> "____-__-__ __:__" Then '调洗状态
- .Fields("Result") = 1
- Else
- .Fields("Result") = 0
- End If
- .Update
- dbl_RecordAutoCode = .Fields("WashID")
- '增加记录的同时增加台准帐排它表中的记录(由此判断各状态时间问题)
- If Findrc.State = 1 Then Findrc.Close
- Findrc.Open "SELECT * FROM Tr_NowAccount where 1=2 ", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
- Findrc.AddNew
- Findrc.Fields("VoucherNum") = 4 '各状态拾别号调洗为4
- Findrc.Fields("ChildId") = dbl_RecordAutoCode
- Findrc.Fields("VehicleNum") = Trim(.Fields("VehicleNum") & "") '车号
- If Not IsNull(.Fields("WashTime")) Then
- Findrc.Fields("BeginTime") = Format(Trim(.Fields("WashTime")), "yyyy-mm-dd hh:mm") '各状态要求时间
- Else
- Findrc.Fields("BeginTime") = Format(Trim(.Fields("WashTime")), "yyyy-mm-dd hh:mm")
- End If
- If Not IsNull(.Fields("WashEndTime")) Then
- Findrc.Fields("EndTime") = Format(Trim(.Fields("WashEndTime")), "yyyy-mm-dd hh:mm") '各状态完毕时间
- Else
- Findrc.Fields("EndTime") = Format(Trim(.Fields("WashTime")), "yyyy-mm-dd hh:mm")
- End If
- Findrc.Fields("MNumber") = Null
- If .Fields("Result") = True Then
- Findrc.Fields("NowStatus") = "已调洗" '目前状态
- Findrc.Fields("LimitMark") = 1
- Else
- Findrc.Fields("NowStatus") = "调洗"
- Findrc.Fields("LimitMark") = 0
- End If
- Findrc.Update
- Cw_DataEnvi.DataConnect.CommitTrans
- '将记录加入网格
- Sqlstr = "SELECT Tr_DispatchWash.*,Tr_NowAccount.VoucherId as VoucherId FROM Tr_DispatchWash left outer join Tr_NowAccount on Tr_DispatchWash.WashId=Tr_NowAccount.ChildId where Tr_NowAccount.VoucherNum=4 and tr_DispatchWash.washid='" & dbl_RecordAutoCode & "' order by Tr_DispatchWash.WashTime"
- Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
- With CzxsGrid
- .AddItem ""
- .RowHeight(.Rows - 1) = Sjhgd
- .Select .Rows - 1, Qslz
- Call Jltcwg(Cxnrrec, .Rows - 1)
- End With
- Tsxx = "保存完毕!"
- Call Xtxxts(Tsxx, 0, 4)
- Call Cshlrxx(1)
- LrText(0).SetFocus
- '将网格按编码排序
- With CzxsGrid
- .Col = Sydz("002", GridStr(), szzls)
- CzxsGrid.Sort = flexSortStringAscending
- End With
- '<<]
- Else '否则为修改记录
- On Error GoTo Swcwcl
- Cw_DataEnvi.DataConnect.BeginTrans
- If .State = 1 Then .Close
- .Open "SELECT * FROM Tr_DispatchWash WHERE WashId= '" & dbl_RecordAutoCode & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
- If Not .EOF Then
- If Trim(JiText(0).Text) <> "____-__-__ __:__" Then
- .Fields("WashTime") = Format(JiText(0).Text, "yyyy-mm-dd hh:mm") '要求调洗时间
- Else
- .Fields("WashTime") = Null
- End If
- If Trim(JiText(1).Text) <> "____-__-__ __:__" Then
- .Fields("WashEndTime") = Format(JiText(1).Text, "yyyy-mm-dd hh:mm") '调洗完毕时间
- Else
- .Fields("WashEndTime") = Null
- End If
- If Trim(LrText(1).Text) <> "" Then
- .Fields("WashMan") = Trim(LrText(1).Text & "") '调洗负责人
- Else
- .Fields("WashMan") = ""
- End If
- If Trim(JiText(1).Text) <> "____-__-__ __:__" Then '调洗状态
- .Fields("Result") = 1
- Else
- .Fields("Result") = 0
- End If
- .Update
- End If
- If Findrc.State = 1 Then Findrc.Close
- Findrc.Open "SELECT * FROM Tr_NowAccount where ChildId = '" & dbl_RecordAutoCode & "'and VoucherNum=4", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
- If Not Findrc.EOF Then
- If Not IsNull(.Fields("WashTime")) Then
- Findrc.Fields("BeginTime") = Format(Trim(.Fields("WashTime")), "yyyy-mm-dd hh:mm") '各状态要求时间
- Else
- Findrc.Fields("BeginTime") = Format(Trim(.Fields("WashTime")), "yyyy-mm-dd hh:mm")
- End If
- If Not IsNull(.Fields("WashEndTime")) Then
- Findrc.Fields("EndTime") = Format(Trim(.Fields("WashEndTime")), "yyyy-mm-dd hh:mm") '各状态完毕时间
- Else
- Findrc.Fields("EndTime") = Format(Trim(.Fields("WashTime")), "yyyy-mm-dd hh:mm")
- End If
- Findrc.Fields("MNumber") = Null
- If .Fields("Result") = True Then
- Findrc.Fields("NowStatus") = "已调洗" '目前状态
- Findrc.Fields("LimitMark") = 1
- Else
- Findrc.Fields("NowStatus") = "调洗"
- Findrc.Fields("LimitMark") = 0
- End If
- Findrc.Update
- End If
- Cw_DataEnvi.DataConnect.CommitTrans
- '刷新当前网格
- Sqlstr = "SELECT Tr_DispatchWash.*,Tr_NowAccount.VoucherId as VoucherId FROM Tr_DispatchWash left outer join Tr_NowAccount on Tr_DispatchWash.WashId=Tr_NowAccount.ChildId where Tr_NowAccount.VoucherNum=4 and tr_DispatchWash.washid='" & dbl_RecordAutoCode & "' order by Tr_DispatchWash.washTime"
- Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
- With CzxsGrid
- Call Jltcwg(Cxnrrec, .Row)
- End With
- End If
- '保存记录成功,函数返回真值
- Bclrsj = True
- Exit Function
- End With
- Swcwcl:
- Cw_DataEnvi.DataConnect.RollbackTrans
- Tsxx = "存盘过程中出现错误,程序自动恢复保存前状态!"
- Call Xtxxts(Tsxx, 0, 1)
- Exit Function
- End Function
- Private Function Cshlrxx(lrztxx As Integer) As Boolean '初始化录入字段信息
- TextChangeLock = True '关闭文本框Chang事件
- If lrztxx = 1 Then
- '增加新记录时将文本框清空
- For jsqte = 0 To Max_Text_Index
- If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
- LrText(jsqte).Text = ""
- LrText(jsqte).Tag = ""
- End If
- TextValiJudgeLock(jsqte) = True
- Next jsqte
- '[>>
- JiText(1).Text = "____-__-__ __:__"
- JiText(0).Text = Format(Xtrq, "yyyy-mm-dd hh:mm")
- '<<]
- Else
- '修改记录时根据记录关键字(编码)从数据表中读入其他字段内容
- With RecTemp
- Sqlstr = "Select * From Tr_DispatchWash Where WashId='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, 0)) & "'"
- Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
- '记录如存在则读入其内容,否则提示记录已被其他人删除
- If Not RecTemp.EOF Then
- LrText(0).Tag = Trim(RecTemp.Fields("VehicleNum") & " ") '车号
- LrText(0).Text = Trim(RecTemp.Fields("VehicleNum") & " ")
- JiText(0).Text = Format(Trim(RecTemp.Fields("WashTime")), "yyyy-mm-dd hh:mm") '要求调洗时间
- If IsNull(Trim(RecTemp.Fields("WashEndTime"))) Then '调洗完毕时间
- JiText(1).Text = "____-__-__ __:__"
- Else
- JiText(1).Text = Format(Trim(RecTemp.Fields("WashEndTime")), "yyyy-mm-dd hh:mm")
- End If
- If Not IsNull(RecTemp.Fields("WashMan")) Then '调洗负责人
- LrText(1).Text = Trim(RecTemp.Fields("WashMan") & "")
- Else
- LrText(1).Text = ""
- End If
- dbl_RecordAutoCode = RecTemp.Fields("WashId")
- Else
- Tsxx = "该记录已经被其他人删除,请刷新当前数据!"
- Call Xtxxts(Tsxx, 0, 4)
- Call Cancel
- TextChangeLock = False
- Exit Function
- End If
- End With
- End If
- Cshlrxx = True
- TextChangeLock = False
- End Function
- Private Sub Scdqjl() '删 除 当 前 记 录
- Dim yhAnswer As Integer
- Dim Str_Parent As String
- Dim Sqlstr As String
- Dim Ts_temp1 As New ADODB.Recordset
- Dim Findrc As New ADODB.Recordset
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
- Exit Sub
- End If
- '非数据行不能删除
- If CzxsGrid.Row < CzxsGrid.FixedRows Then
- Exit Sub
- End If
- '用户确认是否删除记录
- Tsxx = "请确认是否删除当前记录?"
- yhAnswer = Xtxxts(Tsxx, 2, 2)
- If yhAnswer = 2 Then
- Exit Sub
- End If
- On Error GoTo Cwcl
- Cw_DataEnvi.DataConnect.BeginTrans
- '[>>以下需自定义部分
- Cw_DataEnvi.DataConnect.Execute "delete Tr_DispatchWash where WashId = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, 0)) + "'"
- Cw_DataEnvi.DataConnect.Execute "delete Tr_NowAccount where ChildId = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, 0)) + "'and VoucherNum=4 "
- '以上为自定义部分<<]
- Cw_DataEnvi.DataConnect.CommitTrans
- CzxsGrid.RemoveItem CzxsGrid.Row
- Exit Sub
- Cwcl:
- Cw_DataEnvi.DataConnect.RollbackTrans
- If Err.Number = -2147217873 Then '(-2147217873 为SQL Server 2000通过建立外键产生的错误号)
- Tsxx = "该编码已经被使用,不能删除!"
- Call Xtxxts(Tsxx, 0, 1)
- Exit Sub
- Else
- Tsxx = "出现未知情况,该编码不能被删除!"
- Call Xtxxts(Tsxx, 0, 1)
- Exit Sub
- End If
- End Sub
- '*******************以下区域为编写自定义过程区域**********************
- '判断各状态的时间
- Function JiTextptpd() As Boolean
- Dim Sqlstr As String
- Dim jsqte As Long
- Dim str_TempSql As String
- Dim arrVar_TableCon()
- Dim arrVar_TableCon1()
- Dim arr_Var_TableCon2()
- Dim arrVar_TableCon3()
- Dim rs_Tmp As New ADODB.Recordset
- Dim Findrec As New ADODB.Recordset
- On Error GoTo Pdbz
- If Lrzt = 1 Then '各状态增加时的判断
- '先查询出同车号各状态正在进行的记录并找出最大时间与填入记录进行判断
- str_tmp = "select * from Tr_NowAccount where VehicleNum='" & Trim(LrText(0).Text) & "'and LimitMark=0 order by BeginTime "
- Set rs_Tmp = Nothing
- Set rs_Tmp = Cw_DataEnvi.DataConnect.Execute(str_tmp)
- If Not rs_Tmp.RecordCount = 0 Then
- ReDim arrVar_TableCon(rs_Tmp.RecordCount - 1, 2)
- End If
- k = 0
- Do While Not rs_Tmp.EOF()
- arrVar_TableCon(k, 0) = Trim(rs_Tmp.Fields("NowStatus")) '目前状态
- arrVar_TableCon(k, 1) = Format(Trim(rs_Tmp.Fields("BeginTime")), "yyyy-mm-dd hh:mm") '要求时间
- arrVar_TableCon(k, 2) = Format(Trim(rs_Tmp.Fields("EndTime")), "yyyy-mm-dd hh:mm") '完毕时间
- rs_Tmp.MoveNext
- k = k + 1
- Loop
- If Not rs_Tmp.RecordCount = 0 Then
- If JiText(0).Text < arrVar_TableCon(UBound(arrVar_TableCon, 1), 2) Then
- If Trim(JiText(1).Text) = "____-__-__ __:__" Then
- Tsxx = "调洗完毕时间不能为空"
- Call Xtxxts(Tsxx, 0, 1)
- JiText(1).SetFocus
- JiTextptpd = False
- Exit Function
- End If
- End If
- For i = LBound(arrVar_TableCon, 1) To UBound(arrVar_TableCon, 1)
- If i = UBound(arrVar_TableCon, 1) Then
- If JiText(0).Text >= arrVar_TableCon(i, 1) Then
- Tsxx = "此车号正处于" & arrVar_TableCon(i, 0) & "状态,不能进行其他处理!"
- Call Xtxxts(Tsxx, 0, 1)
- JiText(0).SetFocus
- JiTextptpd = False
- Exit Function
- End If
- End If
- If JiText(1).Text <> "____-__-__ __:__" Then
- If JiText(1).Text >= arrVar_TableCon(i, 1) Then
- Tsxx = "此车号正处于" & arrVar_TableCon(i, 0) & "状态,请重新输入时间!"
- Call Xtxxts(Tsxx, 0, 1)
- JiText(1).SetFocus
- JiTextptpd = False
- Exit Function
- End If
- End If
- Next i
- End If
- '查询出各状态同车号已完成的记录并找出最大时间与填入的记录进行判断
- str_tmp = "select * from Tr_NowAccount where VehicleNum='" & Trim(LrText(0).Text) & "'and LimitMark=1 order by BeginTime "
- Set rs_Tmp = Nothing
- Set rs_Tmp = Cw_DataEnvi.DataConnect.Execute(str_tmp)
- If Not rs_Tmp.RecordCount = 0 Then
- ReDim arrVar_TableCon2(rs_Tmp.RecordCount - 1, 2)
- End If
- k = 0
- Do While Not rs_Tmp.EOF()
- arrVar_TableCon2(k, 0) = Trim(rs_Tmp.Fields("NowStatus"))
- arrVar_TableCon2(k, 1) = Format(Trim(rs_Tmp.Fields("BeginTime")), "yyyy-mm-dd hh:mm")
- arrVar_TableCon2(k, 2) = Format(Trim(rs_Tmp.Fields("EndTime")), "yyyy-mm-dd hh:mm")
- rs_Tmp.MoveNext
- k = k + 1
- Loop
- If Not rs_Tmp.RecordCount = 0 Then
- If JiText(0).Text < arrVar_TableCon2(UBound(arrVar_TableCon2, 1), 2) Then
- If Trim(JiText(1).Text) = "____-__-__ __:__" Then
- Tsxx = "调洗完毕时间不能为空"
- Call Xtxxts(Tsxx, 0, 1)
- JiText(1).SetFocus
- JiTextptpd = False
- Exit Function
- End If
- End If
- For i = LBound(arrVar_TableCon2, 1) To UBound(arrVar_TableCon2, 1)
- If JiText(0).Text >= arrVar_TableCon2(i, 1) And JiText(0).Text <= arrVar_TableCon2(i, 2) Then
- Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态,请重新输入时间!"
- Call Xtxxts(Tsxx, 0, 1)
- JiText(0).SetFocus
- JiTextptpd = False
- Exit Function
- End If
- If JiText(1).Text >= arrVar_TableCon2(i, 1) And JiText(1).Text <= arrVar_TableCon2(i, 2) Then
- Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态,请重新输入时间!"
- Call Xtxxts(Tsxx, 0, 1)
- JiText(1).SetFocus
- JiTextptpd = False
- Exit Function
- End If
- If JiText(0) <= arrVar_TableCon2(i, 1) And JiText(1).Text >= arrVar_TableCon2(i, 2) Then
- Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态,请重新输入时间!"
- Call Xtxxts(Tsxx, 0, 1)
- JiText(1).SetFocus
- JiTextptpd = False
- Exit Function
- End If
- Next i
- End If
- Else '修改
- '先查询出同车号各状态正在进行的记录并找出最大时间与填入记录进行判断
- str_tmp = "select * from Tr_NowAccount where VehicleNum='" & Trim(LrText(0).Text) & "'and LimitMark=0 order by BeginTime "
- Set rs_Tmp = Nothing
- Set rs_Tmp = Cw_DataEnvi.DataConnect.Execute(str_tmp)
- If Not rs_Tmp.RecordCount = 0 Then
- ReDim arrVar_TableCon(rs_Tmp.RecordCount - 1, 3)
- End If
- k = 0
- Do While Not rs_Tmp.EOF()
- arrVar_TableCon(k, 0) = Trim(rs_Tmp.Fields("NowStatus"))
- arrVar_TableCon(k, 1) = Format(Trim(rs_Tmp.Fields("BeginTime")), "yyyy-mm-dd hh:mm")
- arrVar_TableCon(k, 2) = Format(Trim(rs_Tmp.Fields("EndTime")), "yyyy-mm-dd hh:mm")
- arrVar_TableCon(k, 3) = rs_Tmp.Fields("VoucherId")
- rs_Tmp.MoveNext
- k = k + 1
- Loop
- If Not rs_Tmp.RecordCount = 0 Then
- For i = LBound(arrVar_TableCon, 1) To UBound(arrVar_TableCon, 1)
- If i = UBound(arrVar_TableCon, 1) Then
- If JiText(0).Text >= arrVar_TableCon(i, 1) And arrVar_TableCon(i, 3) <> CzxsGrid.TextMatrix(CzxsGrid.Row, 1) Then
- Tsxx = "此车号正处于" & arrVar_TableCon(i, 0) & "状态,请重新输入时间!"
- Call Xtxxts(Tsxx, 0, 1)
- JiText(0).SetFocus
- JiTextptpd = False
- Exit Function
- End If
- If JiText(1).Text <> "____-__-__ __:__" Then
- If JiText(1).Text >= arrVar_TableCon(i, 1) And arrVar_TableCon(i, 3) <> CzxsGrid.TextMatrix(CzxsGrid.Row, 1) Then
- Tsxx = "此车号正处于" & arrVar_TableCon(i, 0) & "状态,请重新输入时间!"
- Call Xtxxts(Tsxx, 0, 1)
- JiText(1).SetFocus
- JiTextptpd = False
- Exit Function
- End If
- End If
- End If
- Next i
- str_tmp = "select * from Tr_DispatchWash where WashId='" & dbl_RecordAutoCode & "'and result=0 order by WashEndTime "
- Set Findrec = Nothing
- Set Findrec = Cw_DataEnvi.DataConnect.Execute(str_tmp)
- If Findrec.RecordCount = 0 Then
- If JiText(1).Text = "____-__-__ __:__" Then
- Tsxx = "调洗完毕时间不能为空"
- Call Xtxxts(Tsxx, 0, 1)
- JiText(1).SetFocus
- JiTextptpd = False
- Exit Function
- End If
- End If
- End If
- '先查询出同车号各状态已完成的记录并找出最大时间与填入记录进行判断
- str_tmp = "select * from Tr_NowAccount where VehicleNum='" & Trim(LrText(0).Text) & "'and LimitMark=1 order by BeginTime "
- Set rs_Tmp = Nothing
- Set rs_Tmp = Cw_DataEnvi.DataConnect.Execute(str_tmp)
- If Not rs_Tmp.RecordCount = 0 Then
- ReDim arrVar_TableCon2(rs_Tmp.RecordCount - 1, 3)
- End If
- k = 0
- Do While Not rs_Tmp.EOF()
- arrVar_TableCon2(k, 0) = Trim(rs_Tmp.Fields("NowStatus"))
- arrVar_TableCon2(k, 1) = Format(Trim(rs_Tmp.Fields("BeginTime")), "yyyy-mm-dd hh:mm")
- arrVar_TableCon2(k, 2) = Format(Trim(rs_Tmp.Fields("EndTime")), "yyyy-mm-dd hh:mm")
- arrVar_TableCon2(k, 3) = rs_Tmp.Fields("VoucherId")
- rs_Tmp.MoveNext
- k = k + 1
- Loop
- str_tmp = "select * from Tr_DispatchWash where WashId='" & dbl_RecordAutoCode & "'and result=1 order by washEndTime "
- Set Findrec = Nothing
- Set Findrec = Cw_DataEnvi.DataConnect.Execute(str_tmp)
- If Not Findrec.RecordCount = 0 Then
- If CDate(Findrec.Fields("washEndTime")) = arrVar_TableCon2(UBound(arrVar_TableCon2, 1), 2) Then
- If JiText(1).Text = "____-__-__ __:__" Then
- If JiText(0).Text = arrVar_TableCon2(UBound(arrVar_TableCon2, 1), 1) Then
- JiTextptpd = True
- Exit Function
- End If
- End If
- End If
- End If
- If Not rs_Tmp.RecordCount = 0 Then
- If JiText(0).Text < arrVar_TableCon2(UBound(arrVar_TableCon2, 1), 2) Then
- If Trim(JiText(1).Text) = "____-__-__ __:__" Then
- Tsxx = "调洗完毕时间不能为空"
- Call Xtxxts(Tsxx, 0, 1)
- JiText(1).SetFocus
- JiTextptpd = False
- Exit Function
- End If
- End If
- For i = LBound(arrVar_TableCon2, 1) To UBound(arrVar_TableCon2, 1)
- If JiText(0) >= arrVar_TableCon2(i, 1) And JiText(0).Text <= arrVar_TableCon2(i, 2) And arrVar_TableCon2(i, 3) <> CzxsGrid.TextMatrix(CzxsGrid.Row, 1) Then
- Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态,请重新输入时间!"
- Call Xtxxts(Tsxx, 0, 1)
- JiText(0).SetFocus
- JiTextptpd = False
- Exit Function
- End If
- If JiText(1) >= arrVar_TableCon2(i, 1) And JiText(1).Text <= arrVar_TableCon2(i, 2) And arrVar_TableCon2(i, 3) <> CzxsGrid.TextMatrix(CzxsGrid.Row, 1) Then
- Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态,请重新输入时间!"
- Call Xtxxts(Tsxx, 0, 1)
- JiText(1).SetFocus
- JiTextptpd = False
- Exit Function
- End If
- If JiText(0) <= arrVar_TableCon2(i, 1) And JiText(1).Text >= arrVar_TableCon2(i, 2) And arrVar_TableCon2(i, 3) <> CzxsGrid.TextMatrix(CzxsGrid.Row, 1) Then
- Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态,请重新输入时间!"
- Call Xtxxts(Tsxx, 0, 1)
- JiText(1).SetFocus
- JiTextptpd = False
- Exit Function
- End If
- Next i
- End If
- ' End If
- End If
- JiTextptpd = True
- Exit Function
- Pdbz:
- Tsxx = "出现未知错误!"
- Call Xtxxts(Tsxx, 0, 1)
- JiTextptpd = False
- Exit Function
- End Function
- '*******************以上区域为编写自定义过程区域**********************
- '******************以下为基本处理程序(固定不变)************************'
- Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer) '支持热键操作
- If Shift = 2 Then
- Select Case UCase(Chr(KeyCode))
- Case "P" 'Ctrl+P 打印
- If SzToolbar.Buttons("dy").Visible And SzToolbar.Buttons("dy").Enabled Then
- Call bbyl(False)
- End If
- Case "A" 'Ctrl+A 增加
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
- Exit Sub
- End If
- If SzToolbar.Buttons("zj").Visible And SzToolbar.Buttons("zj").Enabled Then
- Call Toolbjzt
- Lrzt = 1
- Call Cshlrxx(Lrzt)
- LrText(0).Enabled = True
- LrText(0).SetFocus
- End If
- Case "D" 'Ctrl+D 删除
- If SzToolbar.Buttons("sc").Visible And SzToolbar.Buttons("sc").Enabled Then
- Call Scdqjl
- End If
- End Select
- End If
- End Sub
- Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
- Select Case Button.Key
- Case "ymsz" '页面设置
- Dyymctbl.Show 1
- Case "yl" '预 览
- Call bbyl(True)
- Case "dy" '打 印
- Call bbyl(False)
- Case "zj" '增 加
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
- Exit Sub
- End If
- Call Toolbjzt
- Lrzt = 1
- Call Cshlrxx(Lrzt)
- LrText(0).Enabled = True
- LrText(0).SetFocus
- Ydcommand1(0).Enabled = True
- Case "xg" '修 改
- Call Xgdqjl
- Case "sc" '删 除
- Call Scdqjl
- Case "sx" '刷 新
- Call Cxnrtcwg
- Case "bz" '帮 助
- Call F1bz
- Case "fh" '退 出
- Unload Me
- End Select
- End Sub
- Private Sub CzxsGrid_DblClick() '修改当前编码记录
- Call Xgdqjl
- End Sub
- Private Sub Xgdqjl() '修改当前编码记录
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log(Str_RightEdit, Xtczybm, 1, True, False) Then
- BcCommand.Enabled = False
- End If
- If CzxsGrid.Row < CzxsGrid.FixedRows Then
- Exit Sub
- End If
- Call Toolbjzt
- Lrzt = 2
- If Cshlrxx(Lrzt) Then
- LrText(1).SetFocus
- LrText(0).Enabled = False
- Ydcommand1(0).Enabled = False
- End If
- End Sub
- Private Sub Toolbjzt() 'Toolbar状态(编辑状态)
- StTab.TabEnabled(1) = True
- StTab.Tab = 1
- Frame1.Enabled = True
- StTab.TabEnabled(0) = False
- CzxsGrid.Enabled = False
- With SzToolbar
- .Buttons("ymsz").Enabled = False
- .Buttons("dy").Enabled = False
- .Buttons("yl").Enabled = False
- .Buttons("zj").Enabled = False
- .Buttons("xg").Enabled = False
- .Buttons("sc").Enabled = False
- .Buttons("sx").Enabled = False
- End With
- End Sub
- Private Sub Toolfbjzt() 'Toolbar状态(非编辑状态)
- StTab.TabEnabled(0) = True
- StTab.Tab = 0
- CzxsGrid.Enabled = True
- Frame1.Enabled = False
- StTab.TabEnabled(1) = False
- Lrzt = 0
- With SzToolbar
- .Buttons("ymsz").Enabled = True
- .Buttons("dy").Enabled = True
- .Buttons("yl").Enabled = True
- .Buttons("zj").Enabled = True
- .Buttons("xg").Enabled = True
- .Buttons("sc").Enabled = True
- .Buttons("sx").Enabled = True
- End With
- End Sub
- Private Sub BcCommand_Click() '保 存
- If Not Bclrsj Then
- Exit Sub
- End If
- If Lrzt = 2 Then
- Call Toolfbjzt
- End If
- End Sub
- Private Sub QxCommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) '取消
- '避免执行Click程序
- Bln_Cancel = True
- Call Cancel
- End Sub
- Private Sub QxCommand_Click() '取消
- If Bln_Cancel Then
- Bln_Cancel = False
- Exit Sub
- End If
- Call Cancel
- End Sub
- Private Sub Cancel() '取消
- '文本框加锁
- For jsqte = 0 To Max_Text_Index
- TextValiJudgeLock(jsqte) = True
- Next jsqte
- Call Toolfbjzt
- End Sub
- Private Sub CzxsGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long) '网格列发生移动时自动交换网格索引信息
- FnBln_RefreshArray Col, Position, GridStr(), GridInf()
- End Sub
- Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button) '表格格式设置(通用)
- Select Case Button.Key
- Case "bcgs" '保存表格格式
- Call Bcwggs(CzxsGrid, GridCode, GridStr())
- Case "hfmrgs" '恢复默认格式
- Call Hfmrgs(CzxsGrid, GridCode, GridStr())
- Case "szxsxm" '设置显示项目
- Call Szxsxm(CzxsGrid, GridCode)
- End Select
- End Sub
- Private Sub bbyl(bbylte As Boolean) '报表打印预览
- Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
- Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
- Bbxbtgs = 1 '报 表 小 标 题 行 数
- Bbbwhgs = 0 '报 表 表 尾 行 数
- ReDim Bbxbt(1 To Bbxbtgs)
- ReDim bbxbtzzxs(1 To Bbxbtgs)
- If Bbbwhgs <> 0 Then
- ReDim Bbbwh(1 To Bbbwhgs)
- ReDim Bbbwhzzxs(1 To Bbbwhgs)
- End If
- Bbzbt = ReportTitle
- Bbxbt(1) = " "
- bbxbtzzxs(1) = 0 '报表行组织形式(0-居左 1-居中 2-居右)
- Call Scyxsjb(CzxsGrid) '生成报表数据
- Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
- If Not bbylte Then
- Unload DY_Tybbyldy
- End If
- 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)
- 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 Long
- '最大录入文本框索引值
- 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 '其他类型
- If Index = 0 Then
- If Len(LrText(Index).Text) <> 7 And Len(LrText(Index).Text) <> 8 Then
- Tsxx = "车号只能是7位或8位数字或字符!"
- Call Xtxxts(Tsxx, 0, 1)
- LrText(Index).SetFocus
- Exit Function
- End If
- End If
- End Select
- '如果有效则加锁,用户不改变内容则不再进行有效性判断
- TextValiJudgeLock(Index) = True
- '调用文本框事后处理程序
- Call Wbklrwbcl(Index)
- '有效性判断通过则返回True
- TextYxxpd = True
- End Function