润滑管理_润滑标准编辑.frm

新世纪ERP设备管理源代码

      ForeColor       =   &H00000000&
      Height          =   225
      Left            =   7170
      TabIndex        =   3
      Top             =   6360
      Width           =   735
   End
   Begin VB.Label TsLabel 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "单据号："
      Height          =   180
      Index           =   0
      Left            =   210
      TabIndex        =   2
      Top             =   1530
      Width           =   765
   End
End
Attribute VB_Name = "Dev_LubricatEditFrom"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***********************************************************************************************************
'*    模 块 名 称 :设备润滑标准登记
'*    程序员姓名  :王哲
'*    最后修改人  :王哲
'*    最后修改时间:2001/12/18
'*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
'*
'*    1.每次调入外部功能窗体，均要加锁ChangeLock=True,窗体关闭后解锁ChangeLock=false
'*                                    TextValiLock=True             TextValiLock=false
'*
'*    2.Lab_OperStatus 用此标签来标识单据录入状态(默认值为1) "1"-浏览 "2"-新增 "3"-修改
'*
'*    3.Lab_Djclzt 用此标签来标识单据处理状态(默认值为1) "1"-填制单据  "2"-查询单据列表  "3"-明细帐联查单据
'*
'*    4.原则:只要单据能够存盘(无论修改或新增)则其必须接受完整性及有效性规则检查
'*
'*    5.支持热键操作:打印:Ctrl+P 新增:F5 修改:F3 存盘:F6
'***********************************************************************************************************
 
'[以下为根据实际情况设置变量
Dim Bln_BillChange As Boolean                   '标识单据是否发生改动
Dim Rec_Query As New ADODB.Recordset            '单据组查询结果动态集(保存当前单据组ID)
Public Str_QueryCondi As String                 '单据组查询条件(接收单据列表传递查询条件)
']

'以下为固定使用变量(单据)
Dim BillCode As String                          '单据设计编码(索引号)
Dim Var_Bill() As Variant                       '用来返回单据设计信息
Dim ReportTitle As String                       '报表主标题
Dim Tsxx As String                              '系统提示信息
Dim Dyymctbl As New DY_Dyymsz                   '打印页面窗体变量

'以下为固定使用变量(文本框)
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 TextChangeLock As Boolean                   '文本框内容变换控制锁
    
Private Sub Form_KeyPress(KeyAscii As Integer)      '控 制 焦 点 转 移
   
    Dim jdzygs As Integer
    jdzygs = 50
    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()                                                        '窗 体 装 入

    '初始化各种锁值(Fixed)
    Changelock = False             '网格行列改变控制锁
    Gdtlock = False                '滚动条滚动控制
    Yxxpdlock = True               '字段有效性判断锁
    Hyxxpdlock = True              '行有效性判断锁
    Wbkbhlock = False              '文本框内容改变锁
   
    '调入单据信息(需要修改BillCode)
    BillCode = "2511"
    Call Sub_ReadBillInfo(BillCode, Me, Var_Bill())
    Lab_Title = Var_Bill(2)
    Lab_Title.Move (Me.Width - Lab_Title.Width) / 2, 800
    
    '报表编码
    XtReportCode = Var_Bill(5)
    Load Dyymctbl
  
    '以下为文本框处理程序(Fixed)
    TextGroupCode = Var_Bill(3)
 
    Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())  '读入文本框录入信息
    Call Wbkcsh
      
    '单据变动置为False(Fixed)
    Bln_BillChange = False
    
    '调入数据初始化模块(Fixed)
    Lab_Djclzt.Caption = Xtcdcs
    Call Sjcsh(Trim(Lab_Djclzt.Caption))
      
End Sub

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

    '是否保存已修改单据
    Dim YAnswer As Integer
    If Lab_OperStatus.Caption = "2" Or Lab_OperStatus.Caption = "3" Then
        Tsxx = "单据尚未保存,是否退出?"
        YAnswer = Xtxxts(Tsxx, 2, 2)
        If YAnswer <> 1 Then
            Cancel = 1
            Exit Sub
        End If
    End If
    
    '卸载打印页面窗体
    Unload Dyymctbl
    
    '判断单据是否发生变化,并返回相应标识
    If Bln_BillChange Then
        Xtfhcs = "1"
    Else
        Xtfhcs = "0"
    End If
   
End Sub

Private Sub Sjcsh(Str_Pzclzt As String)              '数据初始化模块(根据实际情况)
    Dim Sqlstr As String       '查询单据列表条件

    '[>>根据实际情况初始化
    Select Case Str_Pzclzt
        Case "1"   '填制单据
      
            '调入用户查询结果动态集
            Sqlstr = "SELECT LubricatefileID From Dev_LubricateFile  ORDER BY LubricatefileID"
            Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
      
            '新增单据
            Call Sub_AddBill
        Case "2"   '查询单据(单据列表)
        
            '填充查询单据标识
            Lab_BillId.Caption = XT_BillID
            Str_QueryCondi = Xtcdcsfz
                
            Call Sub_ShowBill
       
            Call Sub_OperStatus("10")
      
            '调入用户查询结果动态集,并定位该单据
            Sqlstr = "SELECT LubricatefileID From Dev_V_LubricateFile  " & Str_QueryCondi & " ORDER BY LubricatefileID"
            Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            Rec_Query.Find "LubricatefileID=" & Val(Lab_BillId.Caption)
        Case "3"   '明细帐联查单据
            '设置工具条显示
            With Tlb_Action
                .Buttons("xz").Enabled = False             '新增
                .Buttons("xg").Enabled = False             '修改
                .Buttons("sc").Enabled = False             '删除
                .Buttons("fgh0").Enabled = False           '分隔行
                .Buttons("zh").Enabled = False             '增行
                .Buttons("sh").Enabled = False             '删行
                .Buttons("fgh1").Enabled = False           '分隔行
                .Buttons("bc").Enabled = False             '保存
                .Buttons("fq").Enabled = False             '放弃
                .Buttons("shsh").Enabled = False           '审核
                .Buttons("shqs").Enabled = False           '弃审
                .Buttons("fgh2").Enabled = False           '分隔行
                .Buttons("first").Enabled = False          '首张
                .Buttons("prev").Enabled = False           '上张
                .Buttons("next").Enabled = False           '下张
                .Buttons("last").Enabled = False           '末张
                .Buttons("fgh5").Enabled = False           '分割行
            End With
            Call Sub_ShowBill
      
            '设置操作状态为浏览
            Lab_OperStatus.Caption = "1"
      
            '录入文本框
            For jsqte = Max_Text_Index To 0 Step -1
                LrText(jsqte).Enabled = False
            Next jsqte
    End Select
  
    '<<]
  
End Sub

Private Sub Sub_ShowBill()                                          '根据当前单据ID显示整张单据内容
   
    '过程默认参数为当前窗体中单据ID:Lab_BillID
    Dim Sqlstr As String                           '临时使用字符串
    Dim RecTemp As New ADODB.Recordset             '临时使用动态集
    Dim jsqte As Long                              '临时计数器

    '本张单据查询字符串
    Sqlstr = "SELECT Dev_V_LubricateFile.* FROM Dev_V_LubricateFile " & _
            " Where LubricatefileID=" & Val(Lab_BillId.Caption)
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
      
    With RecTemp
        If Not .EOF Then
            '[>>显示单据
            TextChangeLock = True     '文本框加锁
            LrText(0).Text = Trim(.Fields("LubricateFileCode"))         '标准单号
            LrText(1).Text = Trim(.Fields("DEVID") & "")                '设备编号
            LrText(2).Text = Trim(.Fields("DName"))                     '设备名称
            LrText(3).Text = Trim(.Fields("Model") & "")                '规格型号
            LrText(4).Text = Trim(.Fields("DeptName") & "")             '所属部门
            LrText(5).Text = Trim(.Fields("LubricateName") & "")        '润滑油名称
            LrText(5).Tag = Trim(.Fields("LubricateCode") & "")         '润滑油编号
            LrText(6).Text = Trim(.Fields("LubricateModel") & "")       '规格型号
            LrText(7).Text = Trim(.Fields("LubricatePoint") & "")       '加油点
            LrText(8).Text = Val(.Fields("ExChange"))                   '换油量
            LrText(9).Text = Val(.Fields("ExchangeCyc"))                '换油周期
            LrText(10).Text = Val(.Fields("CheckCyc"))                  '检查周期
            LrText(11).Text = Val(.Fields("YearWastage"))               '年消耗量

            TextChangeLock = False    '文本框解锁
            '<<]
        End If
    End With
      
    '设置审核弃审按钮状态
    Call Sub_CheckStatus
       
End Sub

Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button)             '用户点击工具条
     
    '屏蔽文本框,下拉组合框有效性判断
    Valilock = True
     
    '屏蔽网格失去焦点产生的有效性判断
    Changelock = True
       
    Select Case Button.Key
        Case "yl"                                            '预 览
            BillTextPrint Lab_Title, LrText, TextGroupCode, XtReportCode, False
        Case "dy"                                            '打 印
            Dim Yhanswer As Integer      '打印提示
            
            '用户确认是否打印单据
            Tsxx = "请确认是否打印当前单据?"
            Yhanswer = Xtxxts(Tsxx, 2, 2)
            If Yhanswer = 2 Then
                Exit Sub
            End If
            BillTextPrint Lab_Title, LrText, TextGroupCode, XtReportCode, True
        Case "xz"                                            '新 增
            Call Sub_AddBill
        Case "xg"                                            '修 改
            Call Sub_EditBill
        Case "sc"                                            '删 除
            Call Sub_DeleteBill
        Case "bc"                                            '保 存
            Call Sub_SaveBill
        Case "fq"                                            '放 弃
            Call Sub_AbandonBill
        Case "shsh"                                          '审 核
            Call Sub_CheckBill
        Case "shqs"                                          '弃 审
            Call Sub_AbandonCheck
        Case "first"                                         '首 张
            Call Sub_First
        Case "prev"                                          '上 张
            Call Sub_Prev
        Case "next"                                          '下 张
            Call Sub_Next
        Case "last"                                          '末 张
            Call Sub_Last
        Case "bz"                                            '帮 助
            Call F1bz
        Case "fh"                                            '退 出
            Unload Me
    End Select
       
    '解 锁
    Valilock = False
    Changelock = False
    TextChangeLock = False
        
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)     '支持热键操作
   
    Select Case KeyCode
        Case vbKeyF5          '增加单据
            If Tlb_Action.Buttons("xz").Enabled And Tlb_Action.Buttons("xz").Visible Then
                Call Sub_AddBill
            End If
        Case vbKeyF3          '修改单据
            If Tlb_Action.Buttons("xg").Enabled And Tlb_Action.Buttons("xg").Visible Then
                Call Sub_EditBill
            End If
        Case vbKeyF6          '保存单据
            If Tlb_Action.Buttons("bc").Enabled And Tlb_Action.Buttons("bc").Visible Then
                Call Sub_SaveBill
            End If
    End Select

End Sub

Private Sub Sub_OperStatus(Str_Status As String)                 '工具条依据不同状态所进行的变化
  
    With Tlb_Action
        Select Case Str_Status
            Case "10"   '浏览((列表)调入单据处理时的进入状态、(列表)新增状态时放弃录入)
                '工具条
                .Buttons("dy").Enabled = True       '打印
                .Buttons("yl").Enabled = True       '预览
                .Buttons("xz").Enabled = True       '新增
                .Buttons("xg").Enabled = True       '修改
                .Buttons("sc").Enabled = True       '删除
                .Buttons("bc").Enabled = False      '保存
                .Buttons("fq").Enabled = False      '放弃
                .Buttons("first").Enabled = True    '首张
                .Buttons("prev").Enabled = True     '上张
                .Buttons("next").Enabled = True     '下张
                .Buttons("last").Enabled = True     '末张
                .Buttons("bz").Enabled = True       '帮助
                .Buttons("fh").Enabled = True       '退出
                
                '设置审核弃审按钮状态
                Call Sub_CheckStatus
                
                '设置文本框录入状态
                Call Sub_LrtextStatus(False)
            Case "20"   '新增单据(（录入）新增一张单据 、（列表）新增一张单据)
                 '工具条
                 .Buttons("dy").Enabled = False      '打印
                 .Buttons("yl").Enabled = False      '预览
                 .Buttons("xz").Enabled = False      '新增
                 .Buttons("xg").Enabled = False      '修改
                 .Buttons("sc").Enabled = False      '删除
                 .Buttons("bc").Enabled = True       '保存
                 .Buttons("fq").Enabled = True       '放弃
                 .Buttons("first").Enabled = False   '首张
                 .Buttons("prev").Enabled = False    '上张
                 .Buttons("next").Enabled = False    '下张
                 .Buttons("last").Enabled = False    '末张
                 .Buttons("bz").Enabled = True       '帮助
                 .Buttons("fh").Enabled = True       '退出
                 
                 '设置文本框录入状态
                 Call Sub_LrtextStatus(True)
            Case "30"   '修改(（录入）调入修改功能、（列表）调入修改功能)
                '工具条
                .Buttons("dy").Enabled = False      '打印
                .Buttons("yl").Enabled = False      '预览
                .Buttons("xz").Enabled = False      '新增
                .Buttons("xg").Enabled = False      '修改
                .Buttons("sc").Enabled = False      '删除
                .Buttons("bc").Enabled = True       '保存
                .Buttons("fq").Enabled = True       '放弃
                .Buttons("first").Enabled = False   '首张
                .Buttons("prev").Enabled = False    '上张
                .Buttons("next").Enabled = False    '下张
                .Buttons("last").Enabled = False    '末张
                .Buttons("bz").Enabled = True       '帮助
                .Buttons("fh").Enabled = True       '退出
                
                '设置文本框录入状态
                Call Sub_LrtextStatus(True)
        End Select
    End With