包装物管理系统_基础设置_包装物档案.frm

新世纪ERP包装物管理源代码

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                '取消按钮信息传递


'*******     sup_Product
Dim Cxnrrec1 As New ADODB.Recordset       '显示查询内容动态集
Dim GridCode1 As String                   '显示网格网格代码
Dim GridInf1() As Variant                 '整个网格设置信息
Dim Tsxx1 As String                       '系统提示信息
Dim Qslz1 As Long                         '网格隐藏(非操作显示)列数
Dim Sjhgd1 As Double                      '网格数据行高度
Dim GridBoolean1() As Boolean             '网格列信息(布尔型)
Dim GridStr1()  As String                 '网格列信息(字符型)
Dim GridInt1() As Integer                 '网格列信息(整型)
Dim Szzls1 As Integer                     '数组总列数(网格列数-1)

Dim Pmbcsjhs1 As Long                            '屏幕网格保持数据行数(大于等于1)
Dim Fzxwghs1 As Integer                          '辅助项网格行数(包括合计行)
Dim Sfxshjwg1 As Boolean                         '是否显示合计网格
Dim Sfblbzkd1 As Boolean                         '是否保留帮助宽度(字段提供帮助时,是否为按钮保留空间)
Dim Dqlrwgh1 As Long                             '当前录入数据网格行
Dim Dqlrwgl1 As Long                             '当前录入数据网格列
Dim Dqlkwgh1 As Long                             '刚刚离开网格行(不一定为录入行)
Dim Dqlkwgl1 As Long                             '刚刚离开网格列
Dim Dqtoprow1 As Long                            '当前录入状态时最上端可视行
Dim Dqleftcol1 As Long                           '当前录入状态时最左端可视列
Dim Zdlrqnr1 As String                           '字段录入修改前内容(用来判断内容是否修改)
Dim Wbkbhlock1 As Boolean                        '文本框改变值锁
Dim changelock1 As Boolean                       '网格行列改变控制锁(用来区别用户改变.程序改变)
Dim Gdtlock1 As Boolean                          '滚动条滚动控制(用来区别用户改变.程序改变)
Dim Yxxpdlock1 As Boolean                        '字段有效性判断锁(内容不修改不需进行字段有效性判断)
Dim Hyxxpdlock1 As Boolean                       '行有效性判断锁(字段内容不修改不需进行行有效性判断)
Dim Valilock1 As Boolean                         '文本框失去焦点是否进行有效性控制(TRUE 为锁定*限用网格录入)
Dim Shsfts1 As Boolean                           '删除记录行是否提示

'*******     sup_ProLine
Dim Cxnrrec2 As New ADODB.Recordset       '显示查询内容动态集
Dim GridCode2 As String                   '显示网格网格代码
Dim GridInf2() As Variant                 '整个网格设置信息
Dim Tsxx2 As String                       '系统提示信息
Dim Qslz2 As Long                         '网格隐藏(非操作显示)列数
Dim Sjhgd2 As Double                      '网格数据行高度
Dim GridBoolean2() As Boolean             '网格列信息(布尔型)
Dim GridStr2()  As String                 '网格列信息(字符型)
Dim GridInt2() As Integer                 '网格列信息(整型)
Dim Szzls2 As Integer                     '数组总列数(网格列数-1)

Dim Pmbcsjhs2 As Long                            '屏幕网格保持数据行数(大于等于1)
Dim Fzxwghs2 As Integer                          '辅助项网格行数(包括合计行)
Dim Sfxshjwg2 As Boolean                         '是否显示合计网格
Dim Sfblbzkd2 As Boolean                         '是否保留帮助宽度(字段提供帮助时,是否为按钮保留空间)
Dim Dqlrwgh2 As Long                             '当前录入数据网格行
Dim Dqlrwgl2 As Long                             '当前录入数据网格列
Dim Dqlkwgh2 As Long                             '刚刚离开网格行(不一定为录入行)
Dim Dqlkwgl2 As Long                             '刚刚离开网格列
Dim Dqtoprow2 As Long                            '当前录入状态时最上端可视行
Dim Dqleftcol2 As Long                           '当前录入状态时最左端可视列
Dim Zdlrqnr2 As String                           '字段录入修改前内容(用来判断内容是否修改)
Dim Wbkbhlock2 As Boolean                        '文本框改变值锁
Dim changelock2 As Boolean                       '网格行列改变控制锁(用来区别用户改变.程序改变)
Dim Gdtlock2 As Boolean                          '滚动条滚动控制(用来区别用户改变.程序改变)
Dim Yxxpdlock2 As Boolean                        '字段有效性判断锁(内容不修改不需进行字段有效性判断)
Dim Hyxxpdlock2 As Boolean                       '行有效性判断锁(字段内容不修改不需进行行有效性判断)
Dim Valilock2 As Boolean                         '文本框失去焦点是否进行有效性控制(TRUE 为锁定*限用网格录入)
Dim Shsfts2 As Boolean                           '删除记录行是否提示

Dim RecTemp As ADODB.Recordset
Private Sub Form_KeyPress(KeyAscii As Integer)   '控 制 焦 点 转 移

    jdzygs = 10
    
    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 = "包装物档案"
     
    '调入打印页面设置窗体
    XtReportCode = "Cask_Wrappage"
    Load Dyymctbl
    
    '以下为文本框处理程序(读入文本框录入信息)
    TextGroupCode = "Cask_Wrappage"
    Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())
    Call Wbkcsh
    
    '调入网格设置信息
    GridCode = "Cask_Wrappage"
    Call BzWgcsh(CzxsGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Szzls = CzxsGrid.Cols - 1
    
    CzxsGrid.Cols = CzxsGrid.Cols + 2
    CzxsGrid.ColHidden(CzxsGrid.Cols - 1) = True
    CzxsGrid.ColHidden(CzxsGrid.Cols - 2) = True
   '调 入 网 格   附属物
  GridCode1 = "Cask_Appertain"
  Call BzWgcsh(Grid_Layout, GridCode1, GridInf1(), GridBoolean1(), GridInt1(), GridStr1())
  Qslz1 = GridInf1(1)
  Sjhgd1 = GridInf1(2)
  Szzls1 = Grid_Layout.Cols - 1
  Pmbcsjhs1 = GridInf1(3)
  Fzxwghs1 = GridInf1(4)
  Sfblbzkd1 = GridInf1(5)
  Shsfts1 = GridInf1(6)
  Sfxshjwg1 = GridInf1(7)

  '调 入 网 格   包装参数
  GridCode2 = "Cask_Parameter"
  Call BzWgcsh(Grid_Datum, GridCode2, GridInf2(), GridBoolean2(), GridInt2(), GridStr2())
  Qslz2 = GridInf2(1)
  Sjhgd2 = GridInf2(2)
  Szzls2 = Grid_Datum.Cols - 1

  Pmbcsjhs2 = GridInf2(3)
  Fzxwghs2 = GridInf2(4)
  Sfblbzkd2 = GridInf2(5)
  Shsfts2 = GridInf2(6)
  Sfxshjwg2 = GridInf2(7)
  
   '重置网格
    With Grid_Layout
        .Rows = Pmbcsjhs1 + .FixedRows + Fzxwghs1 + 1
        For Jsqte = .FixedRows To .Rows - 1
            .RowHeight(Jsqte) = Sjhgd1
        Next Jsqte
        .Clear 1
        changelock1 = True
        .Select .FixedRows, Qslz1
        changelock1 = False
    End With
    
    With Grid_Datum
        .Rows = Pmbcsjhs2 + .FixedRows + Fzxwghs2 + 1
        For Jsqte = .FixedRows To .Rows - 1
            .RowHeight(Jsqte) = Sjhgd2
        Next Jsqte
        .Clear 1
        changelock2 = True
        .Select .FixedRows, Qslz
        changelock2 = False
    End With

    SzToolbar.Buttons("zh").Enabled = False
    SzToolbar.Buttons("sh").Enabled = False

    '填 充 网 格
    Call Cxnrtcwg
       
    '初始化ToolBar,Tab卡包装物
    StTab.Tab = 0
    StTab.TabEnabled(1) = False
    Frame1.Enabled = False
    
    '设置为非录入包装物
    Lrzt = 0
    
     '编辑(新增、修改、删除)权限索引
    Str_RightEdit = "Cask_WrappageEdit"

 End Sub
 
Private Sub Cxnrtcwg()                               '查询内容填充网格

    Dim Sqlstr As String              '查询连接串
    Dim Jsqte As Long                 '查询临时使用变量
  
    '为加快显示速度,将网格刷新动作冻结
    CzxsGrid.Redraw = False
  
    '[>>查询连接串
    Sqlstr = "SELECT Cask_Wrappage.*,Cask_Sort.SortName,Gy_UnitSet.UnitName  " & _
            "FROM Cask_Wrappage LEFT OUTER JOIN Cask_Sort ON Cask_Wrappage.SortCode =" & _
            "Cask_Sort.SortCode LEFT OUTER JOIN Gy_UnitSet ON Cask_Wrappage.UnitCode =" & _
            "Gy_UnitSet.UnitCode Order By WrappageCode"
    '<<]
    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, Sydz("001", GridStr(), Szzls)) = Trim(!WrappageCode & "")     '包装物编码
        CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = Trim(!WrappageName & "")     '包装物名称
        CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)) = Trim(!UnitName & "")         '计量单位名称
        CzxsGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = Trim(!SortName & "")         '类别名称
        CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = Trim(!Remark & "")           '备注
        CzxsGrid.TextMatrix(Rowjsq, CzxsGrid.Cols - 2) = Trim(!UnitCode & "")                     '计量单位编码
        CzxsGrid.TextMatrix(Rowjsq, CzxsGrid.Cols - 1) = Trim(!SortCode & "")                     '类别编码
    End With
    '以上为自定义部分<<]
    
End Sub

Private Sub Form_Unload(Cancel As Integer)             '窗体卸载

    Set Cxnrrec = Nothing
    Set Rec_CodeSet = Nothing
    Unload Dyymctbl
   
End Sub

Private Function Bclrsj() As Boolean                   '判断录入数据有效性,并保存数据

    Dim Jsqte As Integer
    
    '对文本框录入内容进行为零和为空判断(固定不变)
    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) & "不能为空!"
                    SSTab1.Tab = 0
                    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) & "不能为零!"
                        SSTab1.Tab = 0
                        Call Xtxxts(Tsxx, 0, 1)
                        LrText(Jsqte).SetFocus
                        Bclrsj = False
                        Exit Function
                    End If
                End If
            End If
        Next Jsqte
    
        '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
        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