企业管理

开发平台：
Visual Basic

：源码内容
							VERSION 5.00
Object = "{BEEECC20-4D5F-4F8B-BFDC-5D9B6FBDE09D}#1.0#0"; "vsflex8.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Xs_I_ChoiceConsign 
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "发货单选择"
   ClientHeight    =   5820
   ClientLeft      =   675
   ClientTop       =   720
   ClientWidth     =   9330
   Icon            =   "发货单选择.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form4"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5820
   ScaleWidth      =   9330
   StartUpPosition =   1  '所有者中心
   Begin VB.CheckBox ChkTotal 
      BackColor       =   &H00C0C0C0&
      Caption         =   "合并"
      Height          =   270
      Left            =   465
      TabIndex        =   21
      Top             =   5445
      Width           =   780
   End
   Begin VB.TextBox Flag 
      Height          =   270
      Left            =   -30
      TabIndex        =   19
      Text            =   "0"
      Top             =   60
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.CommandButton Command4 
      Caption         =   "全清"
      Height          =   300
      Left            =   3210
      TabIndex        =   9
      Top             =   420
      Width           =   780
   End
   Begin VB.CommandButton Command3 
      Caption         =   "全选"
      Height          =   300
      Left            =   2340
      TabIndex        =   8
      Top             =   420
      Width           =   780
   End
   Begin MSComctlLib.Toolbar GsToolbar 
      Height          =   525
      Left            =   9210
      TabIndex        =   18
      Top             =   90
      Visible         =   0   'False
      Width           =   2595
      _ExtentX        =   4577
      _ExtentY        =   926
      ButtonWidth     =   1455
      ButtonHeight    =   926
      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
   Begin VB.Frame Frame1 
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      Caption         =   "Frame1"
      Height          =   345
      Left            =   90
      TabIndex        =   3
      Top             =   450
      Width           =   2325
      Begin VB.OptionButton Option2 
         BackColor       =   &H00C0C0C0&
         Caption         =   "赊销"
         Height          =   255
         Left            =   840
         TabIndex        =   5
         Top             =   30
         Width           =   1005
      End
      Begin VB.OptionButton Option1 
         BackColor       =   &H00C0C0C0&
         Caption         =   "现结"
         Height          =   195
         Left            =   90
         TabIndex        =   4
         Top             =   60
         Value           =   -1  'True
         Width           =   1035
      End
   End
   Begin VB.CommandButton Command2 
      Caption         =   "取消(&C)"
      Height          =   300
      Left            =   7425
      TabIndex        =   7
      Top             =   420
      Width           =   975
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确定(&O)"
      Height          =   300
      Left            =   6315
      TabIndex        =   6
      Top             =   420
      Width           =   1005
   End
   Begin VB.CommandButton Ydcommand1 
      Height          =   300
      Index           =   1
      Left            =   7020
      Picture         =   "发货单选择.frx":1042
      Style           =   1  'Graphical
      TabIndex        =   17
      Top             =   60
      Visible         =   0   'False
      Width           =   300
   End
   Begin VB.TextBox LrText 
      Height          =   285
      Index           =   0
      Left            =   1080
      TabIndex        =   0
      Top             =   75
      Width           =   2805
   End
   Begin VB.TextBox LrText 
      Height          =   285
      Index           =   1
      Left            =   5640
      TabIndex        =   1
      Top             =   75
      Width           =   1395
   End
   Begin VB.CommandButton Ydcommand1 
      Height          =   300
      Index           =   0
      Left            =   3870
      Picture         =   "发货单选择.frx":13CC
      Style           =   1  'Graphical
      TabIndex        =   14
      Top             =   60
      Visible         =   0   'False
      Width           =   300
   End
   Begin VB.TextBox Ydtext 
      BackColor       =   &H00C0FFFF&
      BorderStyle     =   0  'None
      Height          =   330
      Left            =   9180
      MultiLine       =   -1  'True
      TabIndex        =   10
      Top             =   2730
      Visible         =   0   'False
      Width           =   1185
   End
   Begin VB.ComboBox YdCombo 
      Height          =   300
      Left            =   9210
      Style           =   2  'Dropdown List
      TabIndex        =   12
      Top             =   3210
      Visible         =   0   'False
      Width           =   1155
   End
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   9180
      Top             =   2100
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   31
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":1756
            Key             =   "yl"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":1C9A
            Key             =   "dy"
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":1DAE
            Key             =   "fq"
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":1EC2
            Key             =   "ymsz"
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":2616
            Key             =   "xg"
         EndProperty
         BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":2A6A
            Key             =   "zh"
         EndProperty
         BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":30DA
            Key             =   "fh"
         EndProperty
         BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":33F6
            Key             =   "xz"
         EndProperty
         BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":350A
            Key             =   "sc"
         EndProperty
         BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":361E
            Key             =   "bc"
         EndProperty
         BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":3732
            Key             =   "cx"
         EndProperty
         BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":3846
            Key             =   "bz"
         EndProperty
         BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":395A
            Key             =   "first"
         EndProperty
         BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":3A6E
            Key             =   "prev"
         EndProperty
         BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":3B82
            Key             =   "next"
         EndProperty
         BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":3C96
            Key             =   "last"
         EndProperty
         BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":3DAA
            Key             =   "sh"
         EndProperty
         BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":42C6
            Key             =   "ye"
         EndProperty
         BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":471A
            Key             =   "xx"
         EndProperty
         BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":4B6E
            Key             =   "shsh"
         EndProperty
         BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":4FC2
            Key             =   "shbc"
         EndProperty
         BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":5416
            Key             =   "shqs"
         EndProperty
         BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":576A
            Key             =   ""
         EndProperty
         BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":5D5E
            Key             =   "qbfq"
         EndProperty
         BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":60B2
            Key             =   "cg"
         EndProperty
         BeginProperty ListImage26 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":698C
            Key             =   ""
         EndProperty
         BeginProperty ListImage27 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":7266
            Key             =   "ph"
         EndProperty
         BeginProperty ListImage28 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":76B8
            Key             =   "dw"
         EndProperty
         BeginProperty ListImage29 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":7B0A
            Key             =   "bcgs"
         EndProperty
         BeginProperty ListImage30 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":7EA4
            Key             =   "mrlk"
         EndProperty
         BeginProperty ListImage31 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "发货单选择.frx":823E
            Key             =   "xsxm"
         EndProperty
      EndProperty
   End
   Begin VB.CommandButton Ydcommand 
      Height          =   300
      Left            =   9300
      Picture         =   "发货单选择.frx":85D8
      Style           =   1  'Graphical
      TabIndex        =   11
      Top             =   660
      Visible         =   0   'False
      Width           =   300
   End
   Begin VSFlex8Ctl.VSFlexGrid WglrGrid 
      Height          =   4485
      Left            =   30
      TabIndex        =   2
      Top             =   780
      Width           =   9225
      _cx             =   5080
      _cy             =   5080
      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       =   16777215
      ForeColor       =   -2147483640
      BackColorFixed  =   12632256
      ForeColorFixed  =   -2147483630
      BackColorSel    =   -2147483635
      ForeColorSel    =   -2147483634
      BackColorBkg    =   -2147483636
      BackColorAlternate=   16777215
      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            =   2
      Cols            =   10
      FixedRows       =   1
      FixedCols       =   1
      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
      AutoSearchDelay =   2
      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
      ShowComboButton =   1
      WordWrap        =   0   'False
      TextStyle       =   0
      TextStyleFixed  =   0
      OleDragMode     =   0
      OleDropMode     =   0
      DataMode        =   0
      VirtualData     =   -1  'True
      DataMember      =   ""
      ComboSearch     =   3
      AutoSizeMouse   =   -1  'True
      FrozenRows      =   0
      FrozenCols      =   0
      AllowUserFreezing=   0
      BackColorFrozen =   0
      ForeColorFrozen =   0
      WallPaperAlignment=   9
      AccessibleName  =   ""
      AccessibleDescription=   ""
      AccessibleValue =   ""
      AccessibleRole  =   24
   End
   Begin VB.Label Lab_Color 
      Appearance      =   0  'Flat
      BackColor       =   &H00E0E0E0&
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H80000008&
      Height          =   255
      Index           =   3
      Left            =   7980
      TabIndex        =   20
      Top             =   5430
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "客户名称:"
      Height          =   195
      Left            =   210
      TabIndex        =   16
      Top             =   120
      Width           =   765
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "日期:"
      Height          =   195
      Left            =   4920
      TabIndex        =   15
      Top             =   120
      Width           =   585
   End
   Begin VB.Label Lab_OperStatus 
      BackColor       =   &H000080FF&
      Caption         =   "1"
      Height          =   345
      Left            =   9240
      TabIndex        =   13
      Top             =   840
      Visible         =   0   'False
      Width           =   345
   End
End
Attribute VB_Name = "Xs_I_ChoiceConsign"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*********************************************************************************************
'*    备        注:程序中所有依实际情况自定义部分均用[>> <<]括起
'*
'*    1.每次调入外部功能窗体，均要加锁ChangeLock=True,窗体关闭后解锁ChangeLock=false
'*
'*    2.网格列存储内容注解
'*
'*    3.Lab_OperStatus 用此标签来标识单据录入状态(默认值为1) 1-浏览 2-修改
'*
'*********************************************************************************************
 '以下为自定义变量
    
 '以下为固定使用变量(网格)
    Dim Cxnrrec As New ADODB.Recordset              '显示查询内容动态集
    Dim Dyymctbl As New DY_Dyymsz                   '打印页面窗体变量
    Dim GridCode As String                          '显示网格网格代码
    Dim GridInf() As Variant                        '整个网格设置信息
    Dim ReportTitle As String                       '报表主标题
    Dim Tsxx As String                              '系统提示信息
    Dim Pmbcsjhs As Long                            '屏幕网格保持数据行数(大于等于1)
    Dim Fzxwghs As Integer                          '辅助项网格行数(包括合计行)
    Dim Sfxshjwg As Boolean                         '是否显示合计网格
    Dim Qslz As Long                                '网格隐藏(非操作显示)列数
    Dim Sjhgd As Double                             '网格数据行高度
    Dim GridBoolean() As Boolean                    '网格列信息(布尔型)
    Dim GridStr()  As String                        '网格列信息(字符型)
    Dim GridInt() As Integer                        '网格列信息(整型)
    Dim Sfblbzkd As Boolean                         '是否保留帮助宽度(字段提供帮助时,是否为按钮保留空间)
    Dim Dqlrwgh As Long                             '当前录入数据网格行
    Dim Dqlrwgl As Long                             '当前录入数据网格列
    Dim Dqlkwgh As Long                             '刚刚离开网格行(不一定为录入行)
    Dim Dqlkwgl As Long                             '刚刚离开网格列
    Dim Dqtoprow As Long                            '当前录入状态时最上端可视行
    Dim Dqleftcol As Long                           '当前录入状态时最左端可视列
    Dim Zdlrqnr As String                           '字段录入修改前内容(用来判断内容是否修改)
    Dim Wbkbhlock As Boolean                        '文本框改变值锁
    Dim Changelock As Boolean                       '网格行列改变控制锁(用来区别用户改变.程序改变)
    Dim Gdtlock As Boolean                          '滚动条滚动控制(用来区别用户改变.程序改变)
    Dim Yxxpdlock As Boolean                        '字段有效性判断锁(内容不修改不需进行字段有效性判断)
    Dim Hyxxpdlock As Boolean                       '行有效性判断锁(字段内容不修改不需进行行有效性判断)
    Dim Valilock As Boolean                         '文本框失去焦点是否进行有效性控制(TRUE 为锁定*限用网格录入)
    Dim Shsfts As Boolean                           '删除记录行是否提示
    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                '取消按钮信息传递
Dim BlChoice As Boolean     '发货单或退货单
Dim TempForm As Object
Private Sub Command1_Click()
    Dim Jsq As Integer
    Dim Rows_int As Integer
    
    With WglrGrid
        For Jsq = 1 To .Rows - 1
            If Trim(.TextMatrix(Jsq, Sydz("001", GridStr(), Szzls))) = "*" Then
                Rows_int = Rows_int + 1
            End If
            If BlChoice Then
                If Trim(.TextMatrix(Jsq, 1)) = "*" And .Cell(flexcpBackColor, Jsq, 0) = Lab_Color(3).BackColor And Val(.TextMatrix(Jsq, Sydz("010", GridStr(), Szzls))) <= 0 Then
                    Tsxx = "货物 ' " & Trim(.TextMatrix(Jsq - 1, Sydz("005", GridStr(), Szzls))) & " ' 的开票数量必须大于零！"
                    Call Xtxxts(Tsxx, 0, 4)
                    Exit Sub
                End If
            Else
                If Trim(.TextMatrix(Jsq, 1)) = "*" And .Cell(flexcpBackColor, Jsq, 0) = Lab_Color(3).BackColor And Val(.TextMatrix(Jsq, Sydz("010", GridStr(), Szzls))) >= 0 Then
                    Tsxx = "货物 ' " & Trim(.TextMatrix(Jsq - 1, Sydz("005", GridStr(), Szzls))) & " ' 的开票数量必须小于零！"
                    Call Xtxxts(Tsxx, 0, 4)
                    Exit Sub
                End If
            End If
        Next
        If Rows_int = 0 Then
            Tsxx = "请选定一个货物！"
            Call Xtxxts(Tsxx, 0, 4)
            Exit Sub
        End If
    End With
    
    '发票
    TempForm.Command1.Tag = "0"
    If Option1.Value = True Then
        TempForm.Option1 = True
    Else
        TempForm.Option2 = True
    End If
    With TempForm.vsFlexGrid1
        .Rows = .FixedRows
        For Jsq = .FixedRows To WglrGrid.Rows - 1
            If Trim(WglrGrid.TextMatrix(Jsq, 1)) = "*" Then
                .Rows = .Rows + 1
                .TextMatrix(.Rows - 1, 0) = WglrGrid.TextMatrix(Jsq, 1)
                .TextMatrix(.Rows - 1, 1) = WglrGrid.TextMatrix(Jsq, Sydz("001", GridStr(), Szzls))     '是否被选中
                .TextMatrix(.Rows - 1, 2) = WglrGrid.TextMatrix(Jsq, Sydz("002", GridStr(), Szzls))     '发货单号
                .TextMatrix(.Rows - 1, 12) = WglrGrid.TextMatrix(Jsq, Sydz("012", GridStr(), Szzls))    '发货ID
                .TextMatrix(.Rows - 1, 3) = WglrGrid.TextMatrix(Jsq, Sydz("003", GridStr(), Szzls))     '仓库
                .TextMatrix(.Rows - 1, 4) = WglrGrid.TextMatrix(Jsq, Sydz("004", GridStr(), Szzls))     '货物编码
                .TextMatrix(.Rows - 1, 5) = WglrGrid.TextMatrix(Jsq, Sydz("005", GridStr(), Szzls))     '货物名称
                .TextMatrix(.Rows - 1, 6) = WglrGrid.TextMatrix(Jsq, Sydz("006", GridStr(), Szzls))     '规格
                .TextMatrix(.Rows - 1, 7) = WglrGrid.TextMatrix(Jsq, Sydz("007", GridStr(), Szzls))     '单位
                .TextMatrix(.Rows - 1, 8) = WglrGrid.TextMatrix(Jsq, Sydz("008", GridStr(), Szzls))     '实收数量
                .TextMatrix(.Rows - 1, 9) = WglrGrid.TextMatrix(Jsq, Sydz("009", GridStr(), Szzls))     '已开票数量
                .TextMatrix(.Rows - 1, 10) = WglrGrid.TextMatrix(Jsq, Sydz("010", GridStr(), Szzls))    '开票数量
                .TextMatrix(.Rows - 1, 11) = WglrGrid.TextMatrix(Jsq, Sydz("011", GridStr(), Szzls))    '单价
                TempForm.Command1.Tag = "1"
            End If
        Next Jsq
    End With
    GtempInvoiceHB = ChkTotal.Value
    Unload Me
End Sub
Private Sub Command2_Click()
    TempForm.Command1.Tag = "0"
    Unload Me
End Sub
Private Sub Command3_Click()
    Dim Jsq As Integer
    
    With WglrGrid
        Changelock = True
        For Jsq = .FixedRows To .Rows - 1
            If .TextMatrix(Jsq, 0) = "*" Then
                .TextMatrix(Jsq, Sydz("001", GridStr(), Szzls)) = ""
                .Row = Jsq
                Call WglrGrid_DblClick
            End If
        Next
        Changelock = False
    End With
End Sub
Private Sub Command4_Click()
    Dim Jsq As Integer
    
    With WglrGrid
        For Jsq = .FixedRows To .Rows - 1
            .TextMatrix(Jsq, 1) = ""
            If .TextMatrix(Jsq, 0) = "*" Then .TextMatrix(Jsq, Sydz("001", GridStr(), Szzls)) = ""
            .TextMatrix(Jsq, Sydz("010", GridStr(), Szzls)) = ""
        Next
    End With
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)      '控制焦点转移和限制录入字符"'"
    Dim jdzygs As Integer
    jdzygs = 2                                      '在单据录入中,此焦点转移控制值一定小于等于文本框个数,否则网格回车键将不支持.
    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()                              '窗 体 装 入
    '初始化各种锁值
    Changelock = False             '网格行列改变控制锁
    Gdtlock = False                '滚动条滚动控制
    Yxxpdlock = True               '字段有效性判断锁
    Hyxxpdlock = True              '行有效性判断锁
    Wbkbhlock = False              '文本框内容改变锁
    Select Case GtempInvoiceType
        Case "Xs_I_InvoiceBill"
            BlChoice = True
            Cw_DataEnvi.DataConnect.Execute ("update Xt_tyhelp set sql_string='SELECT distinct cuscode,cusname FROM Xs_V_ConsignBill where checker<>'''' and abs(recquantity)-abs(invquantity)>0 order by cusname ' WHERE help_code = 'Xs_Cz_Choice'")
            Set TempForm = Xs_I_InvoiceBill
            Xs_I_ChoiceConsign.Caption = "选择发货单"
        Case "Xs_I_UseInvoice"
            BlChoice = True
            Cw_DataEnvi.DataConnect.Execute ("update Xt_tyhelp set sql_string='SELECT distinct cuscode,cusname FROM Xs_V_ConsignBill where checker<>'''' and abs(recquantity)-abs(invquantity)>0 order by cusname ' WHERE help_code = 'Xs_Cz_Choice'")
            Set TempForm = Xs_I_UseInvoice
            Xs_I_ChoiceConsign.Caption = "选择发货单"
        Case "Xs_I_UseRedInvoice"
            BlChoice = False
            Cw_DataEnvi.DataConnect.Execute ("update Xt_tyhelp set sql_string='SELECT distinct cuscode,cusname FROM Xs_V_ConsignBill where checker<>'''' and abs(recquantity)-abs(invquantity)>0 and BillType=''1'' order by cusname ' WHERE help_code = 'Xs_Cz_Choice'")
            Set TempForm = Xs_I_UseRedInvoice
            Xs_I_ChoiceConsign.Caption = "选择退货单"
        Case "Xs_I_RedInvoice"
            BlChoice = False
            Cw_DataEnvi.DataConnect.Execute ("update Xt_tyhelp set sql_string='SELECT distinct cuscode,cusname FROM Xs_V_ConsignBill where checker<>'''' and abs(recquantity)-abs(invquantity)>0 and BillType=''1'' order by cusname ' WHERE help_code = 'Xs_Cz_Choice'")
            Set TempForm = Xs_I_RedInvoice
            Xs_I_ChoiceConsign.Caption = "选择退货单"
    End Select
        
    
    
    TextGroupCode = "Xs_I_ChoiceConsign"
 
    Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())  '读入文本框录入信息
    Call Wbkcsh
    
    '调 入 网 格
    GridCode = "Xs_I_ChoiceConsign"      '网格属性编码
    Call BzWgcsh(WglrGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Pmbcsjhs = GridInf(3)
    Fzxwghs = GridInf(4)
    Sfblbzkd = GridInf(5)
    Shsfts = GridInf(6)
    Sfxshjwg = GridInf(7)
    Szzls = WglrGrid.Cols - 1
    
    '生成查询结果
    WglrGrid.Redraw = False
    'Call Sub_Query
    WglrGrid.Redraw = True
    
    '设置状态为修改状态
    Lab_OperStatus = "2"
 
End Sub
Private Sub Form_Unload(Cancel As Integer)           '窗体卸载
   '卸载打印页面窗体
   Unload Dyymctbl
End Sub
Private Sub Sub_Query()                            '生成查询结果
    Dim RsTemp As New Recordset
    Dim Jsq As Integer
    Dim strTemp As String
    Dim TempCode As String
    
    If RsTemp.State Then RsTemp.Close
    strTemp = "SELECT * FROM Xs_V_ConsignBill where cuscode='" & Trim(LrText(0).Tag) & "' and convert(char,consignDate,112) like '" & _
            Format(LrText(1), "yyyymmdd") & "%' and checker<>''"
    If Flag.Text = 0 Then
        If Xs_IfInvoice = False Then
            strTemp = strTemp + " and ConsignFlag=0 "
        Else
            strTemp = strTemp + " and ConsignFlag=0 and returnmoneyflag='1'"
        End If
    Else
        strTemp = strTemp + " and ConsignFlag=1 and (kdflag=0 or billtype=1 or (kdflag=1 and receiveflag=1))"
    End If
    If BlChoice Then
'        StrTemp = StrTemp + " and billtype=0"
    Else
        strTemp = strTemp + " and billtype=1"
    End If
    strTemp = strTemp + " and abs(recquantity)-abs(invquantity)>0"      '开票数量大于0
    strTemp = strTemp + " order by warecode"
    RsTemp.Open strTemp, Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly
    With WglrGrid
        .Clear 1
        .Rows = .FixedRows + RsTemp.RecordCount
        If RsTemp.RecordCount > 0 Then .Row = .FixedRows
        Do While Not RsTemp.EOF
                .TextMatrix(.Row, 0) = "*"
                .TextMatrix(.Row, Sydz("001", GridStr(), Szzls)) = ""
                .TextMatrix(.Row, Sydz("002", GridStr(), Szzls)) = Trim(RsTemp.Fields("consigncode"))       '发货单
                .TextMatrix(.Row, Sydz("012", GridStr(), Szzls)) = Trim(RsTemp.Fields("consignbillmainid")) '发货单
                .TextMatrix(.Row, Sydz("003", GridStr(), Szzls)) = Trim(RsTemp.Fields("whname"))            '仓库
                .TextMatrix(.Row, Sydz("004", GridStr(), Szzls)) = Trim(RsTemp.Fields("warecode"))          '货物编码
                .TextMatrix(.Row, Sydz("005", GridStr(), Szzls)) = Trim(RsTemp.Fields("mname"))             '货物名称
                .TextMatrix(.Row, Sydz("006", GridStr(), Szzls)) = Trim(RsTemp.Fields("model"))             '规格
                .TextMatrix(.Row, Sydz("007", GridStr(), Szzls)) = Trim(RsTemp.Fields("saleunitname"))      '单位
                .TextMatrix(.Row, Sydz("008", GridStr(), Szzls)) = Val(RsTemp.Fields("Recquantity") & "")   '实收数量
                .TextMatrix(.Row, Sydz("009", GridStr(), Szzls)) = Val(RsTemp.Fields("Invquantity") & "")   '已开票数量
                .TextMatrix(.Row, Sydz("010", GridStr(), Szzls)) = ""                                       '开票数量
                .TextMatrix(.Row, Sydz("011", GridStr(), Szzls)) = Val(RsTemp.Fields("taxUnitPrice") & "")  '含税单价
            TempCode = Trim(RsTemp.Fields("warecode"))
            RsTemp.MoveNext
            If RsTemp.EOF Then
                .AddItem ""
                .Row = .Row + 1
                .TextMatrix(.Row, Sydz("001", GridStr(), Szzls)) = "小计"
                .Cell(flexcpBackColor, .Row, 0, .Row, .Cols - 1) = Lab_Color(3).BackColor
                Exit Do
            End If
            If TempCode <> Trim(RsTemp.Fields("warecode")) Then
                .AddItem ""
                .Row = .Row + 1
                .TextMatrix(.Row, Sydz("001", GridStr(), Szzls)) = "小计"
                .Cell(flexcpBackColor, .Row, 0, .Row, .Cols - 1) = Lab_Color(3).BackColor
            End If
            .Row = .Row + 1
        Loop
    End With
End Sub
Private Sub Wbkcl()                                                 '文本框录入之前处理(根据实际情况)
 Dim xswbrr As String
 With WglrGrid
    Zdlrqnr = Trim(.Text)
    xswbrr = Trim(.Text)
    
    If GridBoolean(.Col, 3) Then   '列表框录入
    
       '填充列表框程序
        Call FillCombo(YdCombo, GridStr(.Col, 5), xswbrr, 0)
    Else
       Wbkbhlock = True
       
         '====以下为用户自定义
           Ydtext.Text = xswbrr
         '====以上为用户自定义
         
       Wbkbhlock = False
       Ydtext.SelStart = Len(Ydtext.Text)
    End If
 End With
End Sub
Private Function sjzdyxxpd(Dqpdwgh As Long, Dqpdwgl As Long)        '录入数据字段有效性判断,同时进行字段录入事后处理
 Dim Str_JudgeText As String            '临时有效性判断字段内容
 Dim Coljsq As Long                     '临时列计数器
 Dim RecTemp As New ADODB.Recordset     '临时使用动态集
 Dim Dbl_Qcye As Double                 '临时期初余额
 
 With WglrGrid
    
    '非录入状态有效性为合法
    If Yxxpdlock Or .Row < .FixedRows Then
       sjzdyxxpd = True
       Exit Function
    End If
 
     Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
     Select Case GridStr(Dqpdwgl, 1)
         
         '以下为自定义部分[
               '1.放置字段有效性判断程序
            Case "010"
                If Not Trim(Str_JudgeText) = "" Then
                    If Not IsNumeric(Trim(.TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)))) Then
                        Tsxx = "数据格式有误!"
                        Lrywlz = Sydz("010", GridStr(), Szzls)
                        GoTo Lrcwcl
                    End If
                If Val(.TextMatrix(Dqpdwgh, Sydz("008", GridStr(), Szzls))) < 0 Then
                    .TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)) = -Abs(.TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)))
                    Tsxx = "开票数量不能小于 "
                Else
                    Tsxx = "开票数量不能大于 "
                    .TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)) = Abs(.TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)))
                End If
                If Abs(.TextMatrix(Dqpdwgh, Sydz("008", GridStr(), Szzls))) - Abs(.TextMatrix(Dqpdwgh, Sydz("009", GridStr(), Szzls))) < Abs(.TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls))) Then
                    Tsxx = Tsxx & Val(.TextMatrix(Dqpdwgh, Sydz("008", GridStr(), Szzls))) - Val(.TextMatrix(Dqpdwgh, Sydz("009", GridStr(), Szzls))) & "  "
                    Lrywlz = Sydz("010", GridStr(), Szzls)
                    GoTo Lrcwcl
                Else
                    If Val(.TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls))) <> 0 Then
                        .TextMatrix(Dqpdwgh, 1) = "*"
                        .TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = "*"
                    Else
                        .TextMatrix(Dqpdwgh, 1) = ""
                        .TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = ""
                        .TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)) = ""
                    End If
                    Call Sub_Total(Dqpdwgh)
                End If
                End If
        End Select
     
     '字段录入正确后为零字段清空
      Call Qkwlzd(Dqpdwgh, Dqpdwgl)
    
     sjzdyxxpd = True
     Yxxpdlock = True
     Exit Function
 End With
  
Lrcwcl:    '录入错误处理
  With WglrGrid
      Call Xtxxts(Tsxx, 0, 1)
      Changelock = True
      .Select Dqpdwgh, Dqpdwgl
      Changelock = False
      Call xswbk
      sjzdyxxpd = False
      Exit Function
   End With
End Function
Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                  '录入数据行有效性判断,同时进行行处理
 Dim Lrywlz As Long                     '录入错误列值
 Dim RecTemp As New ADODB.Recordset     '临时使用动态集
 Dim Sqlstr As String                   '临时查询字符串
 Dim Dbl_Ori(1 To 12) As Double         '科目记录原数据
 Dim Dbl_Now(1 To 12) As Double         '科目记录现数据
 Dim Str_Ccode As String                '操作科目
 Dim Rec_AccSum As New ADODB.Recordset  '科目总帐动态集
 Dim Bln_Foreign As Boolean             '外币核算
 Dim Lng_GridRow As Long                '定位科目所在网格行
 
 With WglrGrid
  If Yxxpdh > (.Rows - .FixedRows) Then Exit Function
  '行没有发生变化则不进行有效性判断
  If Hyxxpdlock Then
     Sjhzyxxpd = True
     Exit Function
  End If
  
   '以下为自定义部分[
        '1.放置行有效性判断程序
           '首先进行为空判断(固定不变)
           For Jsqte = Qslz To .Cols - 1
               If (GridInt(Jsqte, 5) = 1 And Len(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0) Or (GridInt(Jsqte, 5) = 2 And Val(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0) Then
                  Tsxx = GridStr(Jsqte, 2)
                  Lrywlz = Jsqte
                  GoTo Lrcwcl
                  Exit For
               End If
           Next Jsqte
           
         '<<]
   '以上为自定义部分]
 
 Sjhzyxxpd = True
 Hyxxpdlock = True
 Exit Function
End With
Lrcwcl:      '录入错误处理
  With WglrGrid
      Call Xtxxts(Tsxx, 0, 1)
      Changelock = True
      .Select Yxxpdh, Lrywlz
      Changelock = False
      Call xswbk
      Sjhzyxxpd = False
      Exit Function
  End With
End Function
'===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改======================='
Private Sub Lrzdbz()                                                      '录入字段帮助
   If Not Ydcommand.Visible Then
      Exit Sub
   End If
  Valilock = True
  With WglrGrid
       
    Changelock = True        '调入另外窗体必须加锁
       Call Drbmhelp(GridInt(.Col, 6), GridStr(.Col, 3), Trim(Ydtext.Text))
    Changelock = False
    If Len(Xtfhcs) <> 0 Then
       If GridInt(.Col, 7) = 0 Then
          Ydtext.Text = Xtfhcs
       Else
          Ydtext.Text = Xtfhcsfz
       End If
    End If
        
  Valilock = False
  If Ydtext.Visible Then
    Ydtext.SetFocus
  End If
 End With
End Sub
Private Sub Form_Resize()                                                '窗体大小发生变化时,重新显示文本框
   Call Cxxswbk
End Sub
Private Function Fun_Drfrmyxxpd() As Boolean                             '调入其它窗体或功能产生的有效性判断(包括数据回写)
  Fun_Drfrmyxxpd = True
  With WglrGrid
   
   '如果当前网格处于编辑状态,则先进行数据回写再进行有效性判断
  
   If Ydtext.Visible Or YdCombo.Visible Then
        Call Lrsjhx
        If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
           Fun_Drfrmyxxpd = False
           Exit Function
        End If
   End If
   
   '进行行有效性判断
   If Not Sjhzyxxpd(.Row) Then
      Fun_Drfrmyxxpd = False
      Exit Function
   End If
   
  End With
End Function
Private Sub Option1_Click()
    Flag.Text = "0"
    Call Sub_Query
End Sub
Private Sub Option2_Click()
    Flag.Text = "1"
    Call Sub_Query
End Sub
Private Sub WglrGrid_GotFocus()                                     '网格得到焦点
  '网格得到焦点,如果当前选择行为非数据行
  '则调整当前焦点至有效数据行
    With WglrGrid
      If .Row < .FixedRows And .Rows > .FixedRows Then
         Changelock = True
          .Select .FixedRows, .Col
         Changelock = False
      End If
      If .Col < Qslz Then
         Changelock = True
          .Select .Row, Qslz
         Changelock = False
      End If
    End With
End Sub
Private Sub WglrGrid_LostFocus()                                    '录入网格失去焦点
  '用以屏蔽调用其它窗体时发生网格失去焦点事件
  If Changelock Then
     Exit Sub
  End If
  '引发网格RowcolChange事件
  With WglrGrid
    If Not (Ydtext.Visible Or YdCombo.Visible) Then
       .Select 0, 0
    End If
  End With
End Sub
Private Sub WglrGrid_AfterScroll(ByVal OldTopRow As Long, ByVal OldLeftCol As Long, ByVal NewTopRow As Long, ByVal NewLeftCol As Long)                                       '限制用户在录入过程中滚动鼠标
 If Gdtlock Then
    Exit Sub
 End If
 
 With WglrGrid
  If Ydtext.Visible Or YdCombo.Visible Then
     Gdtlock = True
     .TopRow = Dqtoprow
     .LeftCol = Dqleftcol
     Gdtlock = False
     Exit Sub
  End If
  
 End With
End Sub
Private Sub WglrGrid_LeaveCell()                                    '离开单元格
  If Changelock Then
     Exit Sub
  End If
  '记录刚刚离开网格单元的行列值
  Dqlkwgh = WglrGrid.Row
  Dqlkwgl = WglrGrid.Col
  '判断是否需要录入数据回写
  If Not (Ydtext.Visible Or YdCombo.Visible) Then
     Exit Sub
  End If
  Call Lrsjhx
End Sub
Private Sub WglrGrid_RowColChange()                                '网格录入行列发生变化时,进行有效性判断
   Valilock = True       '屏蔽文本框失去焦点进行有效性判断
   With WglrGrid
     If Changelock Then
        Exit Sub
     End If
     If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
        Exit Sub
     End If
     If .Row <> Dqlkwgh Then
        If Not Sjhzyxxpd(Dqlkwgh) Then
           Exit Sub
        End If
     End If
   End With
   Call fhyxh
   Call Xldql
   
End Sub
Private Sub WglrGrid_DblClick()          '鼠标双击网格显示文本框
    Dim Jsq As Integer
    Dim strTemp As String
    Dim DblTemp As Double
    Dim BlTemp As Boolean
    
    With WglrGrid
        If .TextMatrix(.Row, 0) = "*" Then
            If .Col <> Sydz("010", GridStr(), Szzls) Then
                If Trim(.TextMatrix(.Row, Sydz("001", GridStr(), Szzls))) <> "*" And Abs(Val(.TextMatrix(.Row, Sydz("008", GridStr(), Szzls)))) - Abs(Val(.TextMatrix(.Row, Sydz("009", GridStr(), Szzls)))) > 0 Then
                    .TextMatrix(.Row, 1) = "*"
                    .TextMatrix(.Row, Sydz("001", GridStr(), Szzls)) = "*"
                    .TextMatrix(.Row, Sydz("010", GridStr(), Szzls)) = Val(.TextMatrix(.Row, Sydz("008", GridStr(), Szzls))) - Val(.TextMatrix(.Row, Sydz("009", GridStr(), Szzls)))
                Else
                    .TextMatrix(.Row, 1) = ""
                    .TextMatrix(.Row, Sydz("001", GridStr(), Szzls)) = ""
                    .TextMatrix(.Row, Sydz("010", GridStr(), Szzls)) = ""
                End If
                Call Sub_Total(.Row)
            Else
                Call xswbk
            End If
        End If
    End With
End Sub
Private Sub Ycwbk()                      '隐藏文本框,帮助按钮,列表组合框
 Valilock = True
   Ydtext.Visible = False
   YdCombo.Visible = False
   Ydcommand.Visible = False
End Sub
Private Sub YdCombo_KeyDown(KeyCode As Integer, Shift As Integer)        '列表框移动
  With WglrGrid
    Select Case KeyCode
      Case vbKeyEscape                'ESC 键放弃录入
           Valilock = True
            .SetFocus
            Call Ycwbk
           Valilock = False
      Case vbKeyReturn                '回 车 键 =13
           KeyCode = 0
           .SetFocus
           Call Lrsjhx
           Rowjsq = .Row
           Coljsq = .Col + 1
           If Coljsq > .Cols - 1 Then
              If Rowjsq < .Rows - 1 Then
                 Rowjsq = Rowjsq + 1
              End If
              Coljsq = Qslz
           End If
           Do While Rowjsq <= .Rows - 1
              If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
                 Coljsq = Coljsq + 1
                 If Coljsq > .Cols - 1 Then
                    Rowjsq = Rowjsq + 1
                    Coljsq = Qslz
                 End If
              Else
                 Exit Do
              End If
            Loop
            .Select Rowjsq, Coljsq
       Case vbKeyLeft                  '左 箭 头 =37
           If .Col - 1 = Qslz Then
              If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
                 GoTo jzzx
              End If
           End If
           If .Col > Qslz Then
              KeyCode = 0
              .SetFocus
              Call Lrsjhx
              Coljsq = .Col - 1
              Do While Coljsq > Qslz
                 If Coljsq - 1 = Qslz Then
                    If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
                       GoTo jzzx
                    End If
                 End If
                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
                    Coljsq = Coljsq - 1
                 Else
                      Exit Do
                 End If
               Loop
               .Select .Row, Coljsq
           End If
      Case vbKeyRight                 '右 箭 头 =39
            KeyCode = 0
            .SetFocus
            Call Lrsjhx
             Rowjsq = .Row
             Coljsq = .Col + 1
             If Coljsq > .Cols - 1 Then
                If Rowjsq < .Rows - 1 Then
                   Rowjsq = Rowjsq + 1
                End If
                Coljsq = Qslz
             End If
             Do While Rowjsq <= .Rows - 1
                If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
                   Coljsq = Coljsq + 1
                   If Coljsq > .Cols - 1 Then
                      Rowjsq = Rowjsq + 1
                      Coljsq = Qslz
                   End If
                Else
                   Exit Do
                End If
              Loop
              .Select Rowjsq, Coljsq
      Case Else
   End Select
   
jzzx:
   
 End With
End Sub
Private Sub YdCombo_LostFocus()
  With WglrGrid                                    '因为选中网格会先发生Rowcolchange事件置Valiock
    If Not Valilock Then                           '为TRUE
       Call Lrsjhx
       If Not Sjhzyxxpd(Dqlrwgh) Then
          Exit Sub
       End If
    End If
  End With
End Sub
Private Sub Ydcommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
   Call Lrzdbz
End Sub
Private Sub ydtext_KeyDown(KeyCode As Integer, Shift As Integer)
   Dim Rowjsq As Long, Coljsq As Long
  With WglrGrid
    Select Case KeyCode
      Case vbKeyF2
           Call Lrzdbz
      Case vbKeyEscape                'ESC 键放弃录入
           Valilock = True
            Call Ycwbk
           .SetFocus
      Case vbKeyReturn                '回 车 键 =13
           KeyCode = 0
           .SetFocus
           Call Lrsjhx
           Rowjsq = .Row
           Coljsq = .Col + 1
           If Coljsq > .Cols - 1 Then
              If Rowjsq < .Rows - 1 Then
                 Rowjsq = Rowjsq + 1
              End If
              Coljsq = Qslz
           End If
           Do While Rowjsq <= .Rows - 1
              If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
                 Coljsq = Coljsq + 1
                 If Coljsq > .Cols - 1 Then
                    Rowjsq = Rowjsq + 1
                    Coljsq = Qslz
                 End If
              Else
                 Exit Do
              End If
            Loop
            If Rowjsq <= .Rows - 1 Then
               .Select Rowjsq, Coljsq
            End If
      Case vbKeyUp                    '上 箭 头 =38
           KeyCode = 0
           .SetFocus
           Call Lrsjhx
           If .Row > .FixedRows Then
              .Row = .Row - 1
           End If
      Case vbKeyDown                  '下 箭 头 =40
           KeyCode = 0
           .SetFocus
           Call Lrsjhx
           If .Row < .Rows - 1 Then
              .Row = .Row + 1
           End If
       Case vbKeyLeft                  '左 箭 头 =37
           If .Col - 1 = Qslz Then
              If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
                 GoTo jzzx
              End If
           End If
           If Ydtext.SelStart = 0 And .Col > Qslz Then
              KeyCode = 0
              .SetFocus
              Call Lrsjhx
              Coljsq = .Col - 1
              Do While Coljsq > Qslz
                 If Coljsq - 1 = Qslz Then
                    If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
                       GoTo jzzx
                    End If
                 End If
                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
                    Coljsq = Coljsq - 1
                 Else
                      Exit Do
                 End If
               Loop
               .Select .Row, Coljsq
           End If
jzzx:
           
           
      Case vbKeyRight                 '右 箭 头 =39
            wblong = Len(Ydtext.Text)
            If (Ydtext.SelStart = wblong Or Ydtext.SelLength = wblong) Then
               KeyCode = 0
               .SetFocus
               Call Lrsjhx
                Rowjsq = .Row
                Coljsq = .Col + 1
                If Coljsq > .Cols - 1 Then
                   If Rowjsq < .Rows - 1 Then
                      Rowjsq = Rowjsq + 1
                   End If
                   Coljsq = Qslz
                End If
                Do While Rowjsq <= .Rows - 1
                   If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
                      Coljsq = Coljsq + 1
                      If Coljsq > .Cols - 1 Then
                         Rowjsq = Rowjsq + 1
                         Coljsq = Qslz
                      End If
                   Else
                      Exit Do
                   End If
                 Loop
                 .Select Rowjsq, Coljsq
               End If
      Case Else
   End Select
 End With
End Sub
Private Sub ydtext_KeyPress(KeyAscii As Integer)         '录入字符事中控制
  Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
End Sub
Private Sub ydtext_Change()                              '录入事中变化处理
  '防止程序改变但不进行处理
  If Wbkbhlock Then
     Exit Sub
  End If
  With WglrGrid
    '限制字段录入长度
     Wbkbhlock = True
     Call TextChangeLimit(Ydtext, GridInt(.Col, 1))  '去掉无效字符
       Select Case GridInt(.Col, 1)
          Case 8
            Call Sjgskz(Ydtext, Xtjezws - Xtjexsws - 1, Xtjexsws)
          Case 9
            Call Sjgskz(Ydtext, Xtslzws - Xtslxsws - 1, Xtslxsws)
          Case 10
            Call Sjgskz(Ydtext, Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
          Case Else
             If GridInt(.Col, 3) <> 0 Or GridInt(.Col, 4) <> 0 Then
                Call Sjgskz(Ydtext, GridInt(.Col, 3), GridInt(.Col, 4))
             End If
       End Select
      Wbkbhlock = False
  End With
End Sub
Private Sub ydtext_LostFocus()            '如果由于选中网格之外的控件而发生有效性判断(选中网格会先发生Rowcolchange事件置Valiock为TRUE)
  With WglrGrid
    If Not Valilock Then
       Call Lrsjhx
       If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
          Exit Sub
       End If
       If Not Sjhzyxxpd(Dqlrwgh) Then
          Exit Sub
       End If
    End If
  End With
End Sub
Private Sub xswbk()                       '在当前选中单元显示文本框,列表框,帮助按钮(通用)
  Dim Wbkpy As Integer, Wbkpy1 As Integer '文本框偏移量
  
  '如果单据操作状态为浏览状态则不能显示录入载体
   If Trim(Lab_OperStatus.Caption) = "1" Then
      Exit Sub
   End If
   
       
  '显示文本框前返回有效行列（解决滚动条问题）
  Call Xldqh
  Call Xldql
  
  '隐藏文本框,帮助按钮,列表组合框
  Call Ycwbk
  
    With WglrGrid
        Dqlrwgh = .Row
        Dqlrwgl = .Col
        If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
           Exit Sub
        End If
         
        Wbkpy = 30
        Wbkpy1 = 15
        On Error Resume Next
    
    If GridBoolean(.Col, 3) Then
       YdCombo.Left = .CellLeft + .Left + Wbkpy
       YdCombo.Top = .CellTop + .Top + Wbkpy
       YdCombo.Width = .CellWidth - Wbkpy1
       Call Wbkcl
       YdCombo.Visible = True
       YdCombo.SetFocus
       Ydcommand.Visible = False
       Ydtext.Visible = False
    Else
      If GridBoolean(.Col, 2) Then
        Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
        Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
        Ydcommand.Visible = True
      Else
        Ydcommand.Visible = False
      End If
     
      Ydtext.Left = .CellLeft + .Left + Wbkpy
      Ydtext.Top = .CellTop + .Top + Wbkpy
      If Ydcommand.Visible Then
        If Sfblbzkd Then
         Ydtext.Width = .CellWidth - Ydcommand.Width
        Else
         Ydtext.Width = .CellWidth - Wbkpy1
        End If
      Else
         Ydtext.Width = .CellWidth - Wbkpy1
      End If
      Ydtext.Height = .CellHeight - Wbkpy1
      
      If GridInt(.Col, 2) <> 0 Then
         Ydtext.MaxLength = GridInt(.Col, 2)
      Else
         Ydtext.MaxLength = 3000
      End If
      
      Call Wbkcl
      
      Ydtext.Visible = True
      Ydtext.SetFocus
    End If
    Dqtoprow = .TopRow
    Dqleftcol = .LeftCol
    
    '重置锁值
    Valilock = False
    Wbkbhlock = False
 End With
End Sub
Private Sub Cxxswbk()                                                  'Formresize中重新显示文本框,列表框,帮助按钮(通用)
                   
  Dim Wbkpy As Integer, Wbkpy1 As Integer
  Wbkpy = 30
  Wbkpy1 = 15
  With WglrGrid
     If YdCombo.Visible Then
       YdCombo.Left = .CellLeft + .Left + Wbkpy
       YdCombo.Top = .CellTop + .Top + Wbkpy
       YdCombo.Width = .CellWidth - Wbkpy1
     End If
     If Ydcommand.Visible Then
       Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
       Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
     End If
     If Ydtext.Visible Then
       If Ydcommand.Visible Then
         If Sfblbzkd Then
         Ydtext.Width = .CellWidth - Ydcommand.Width
        Else
         Ydtext.Width = .CellWidth - Wbkpy1
        End If
       Else
         Ydtext.Width = .CellWidth - Wbkpy1
       End If
      
       Ydtext.Left = .CellLeft + .Left + Wbkpy
       Ydtext.Top = .CellTop + .Top + Wbkpy
       Ydtext.Height = .CellHeight - Wbkpy1
     End If
   End With
End Sub
Private Sub Lrsjhx()                                                   '文本框录入数据回写
  With WglrGrid
   If YdCombo.Visible Then
    .Text = Trim(YdCombo.Text)
   End If
   If Ydtext.Visible Then
    .Text = Trim(Ydtext.Text)
   End If
   
   '(如果字段录入内容发生变化,则打开有效性判断锁)
   If Zdlrqnr <> Trim(.Text) Then
      Yxxpdlock = False
      Hyxxpdlock = False
   End If
   
   '隐藏文本框,帮助按钮,列表组合框
   Call Ycwbk
   
  End With
End Sub
Private Sub WglrGrid_KeyPress(KeyAscii As Integer)                     '网格接受键盘录入
  Dim Str_ChangeTe As String    '临时交换内容
  Dim Coljsq As Long            '临时列计数器
  Dim Int_SaveKey As Integer    '保存KeyAscii值
  '如果单据操作状态为浏览状态则不能显示录入载体
  If Trim(Lab_OperStatus.Caption) = "1" Then
      Exit Sub
  End If
  
  Int_SaveKey = KeyAscii
  With WglrGrid
    '屏 蔽 回 车 键
   If KeyAscii = vbKeyReturn Then
       KeyAscii = 0
       Rowjsq = .Row
        Coljsq = .Col + 1
        If Coljsq > .Cols - 1 Then
           If Rowjsq < .Rows - 1 Then
              Rowjsq = Rowjsq + 1
           End If
           Coljsq = Qslz
        End If
        Do While Rowjsq <= .Rows - 1
           If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
              Coljsq = Coljsq + 1
              If Coljsq > .Cols - 1 Then
                 Rowjsq = Rowjsq + 1
                 Coljsq = Qslz
              End If
           Else
              Exit Do
           End If
        Loop
         
        If Rowjsq <= .Rows - 1 Then
           .Select Rowjsq, Coljsq
        End If
      Exit Sub
    End If
    '接受用户录入
  Select Case KeyAscii
     Case 0 To 32
          '显示录入载体
          Call xswbk
     Case Else
           '防止非编辑字段SendKeys()出现死循环
          If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
             Exit Sub
          End If
          If GridBoolean(.Col, 3) Then
             '列表框录入
             Call xswbk
          Else
    
            Ydtext.Text = ""
            Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
            If KeyAscii = 0 Then
               Exit Sub
            End If
    
            '调入录入载体
            Call xswbk
            Ydtext.Text = ""
            Valilock = True
              SendKeys Chr(KeyAscii), wait
              DoEvents
            Valilock = False
          End If
     End Select
  End With
End Sub
Private Sub Qkwlzd(sjh As Long, Sjl As Long)                            '清空为零字段
  If Not GridBoolean(Sjl, 5) Then
     Exit Sub
  End If
  With WglrGrid
    If Val(Trim(.TextMatrix(sjh, Sjl))) = 0 Then
       .TextMatrix(sjh, Sjl) = ""
    End If
  End With
End Sub
Private Sub fhyxh()                                                     '返回录入数据有效行,同时让得到焦点网格可见
  With WglrGrid
   If .Row >= .FixedRows Then
      Call Xldqh
   End If
  End With
End Sub
Private Sub Xldqh() '显露当前行
On Error Resume Next
  Dim Toprowte As Long
  With WglrGrid
    Toprowte = 0
    Do While .CellTop + .RowHeight(.Row) + Fzxwghs * Sjhgd > .Height And .TopRow <> Toprowte
       Toprowte = .TopRow
       .TopRow = .TopRow + 1
    Loop
    Toprowte = 0
    Do While .CellTop < .FixedRows * .RowHeight(0) And .TopRow <> Toprowte
       Toprowte = .TopRow
       .TopRow = .TopRow - 1
    Loop
  End With
End Sub
Private Sub Xldql()                                                     '显露当前列
 Dim Leftcolte As Long
 With WglrGrid
   If .Col >= Qslz Then
    If .LeftCol > .Col Then
       .LeftCol = .Col
    End If
    Leftcolte = 0
    Do While .CellLeft + .CellWidth > .Width And .LeftCol <> Leftcolte
       Leftcolte = .LeftCol
       .LeftCol = .LeftCol + 1
    Loop
  End If
 End With
End Sub
Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)
    
    Select Case Button.Key
        Case "bcgs"                                          '保存表格格式
            Call Bcwggs(WglrGrid, GridCode, GridStr())
        Case "hfmrgs"                                        '恢复默认格式
            Call Hfmrgs(WglrGrid, GridCode, GridStr())
        Case "szxsxm"                                        '设置显示项目
            Call Szxsxm(WglrGrid, GridCode)
    End Select
    
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           '金额型
             Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
           Case 9           '数量型
             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)                                                '文本框失去焦点进行有效性判断及相应处理
  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
'        Call Sub_Query
     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
       
               Call Sub_Query
               
   TextValiJudgeLock(Index) = True
   TextYxxpd = True
End Function
Private Sub Sub_Total(Dqh As Long)          '合计开票数量
    Dim Jsq As Integer
    Dim strTemp As String
    Dim DblTemp As Double
    Dim BlTemp As Boolean
    
    With WglrGrid
        strTemp = Trim(.TextMatrix(Dqh, Sydz("004", GridStr(), Szzls)))
        For Jsq = Dqh To .FixedRows Step -1
            If strTemp = Trim(.TextMatrix(Jsq, Sydz("004", GridStr(), Szzls))) Then
                If Trim(.TextMatrix(Jsq, Sydz("001", GridStr(), Szzls))) = "*" Then BlTemp = True
                DblTemp = DblTemp + Val(.TextMatrix(Jsq, Sydz("010", GridStr(), Szzls)))
            End If
        Next
        For Jsq = Dqh + 1 To .Rows - 1
            If strTemp = Trim(.TextMatrix(Jsq, Sydz("004", GridStr(), Szzls))) Then
                If Trim(.TextMatrix(Jsq, Sydz("001", GridStr(), Szzls))) = "*" Then BlTemp = True
                DblTemp = DblTemp + Val(.TextMatrix(Jsq, Sydz("010", GridStr(), Szzls)))
            Else
                .TextMatrix(Jsq, Sydz("010", GridStr(), Szzls)) = DblTemp           '合计开票数量
                .TextMatrix(Jsq, Sydz("011", GridStr(), Szzls)) = .TextMatrix(Jsq - 1, Sydz("011", GridStr(), Szzls))   '含税单价
                If BlTemp Then
                    .TextMatrix(Jsq, 1) = "*"
                Else
                    .TextMatrix(Jsq, 1) = ""
                End If
                Exit For
            End If
        Next
    End With
End Sub

						