📄 +ަ
字号:
ForeColor = &H00000000&
Height = 225
Left = 9030
TabIndex = 4
Top = 6330
Width = 735
End
Begin VB.Label Lab_Checker
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
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_FrmLubricateAnalyzeJsdcl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***********************************************************************************************************
'* 模 块 名 称 :润滑油分析处理
'* 程序员姓名 :孔令岩
'* 最后修改人 :王哲
'* 最后修改时间:2001/10/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 = "2510"
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 LubricateAnalyzeID From Dev_LubricateAnalyze Where anadate='" & Xtrq & "' ORDER BY LubricateAnalyzeID"
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 LubricateAnalyzeID From Dev_LubricateAnalyze " & Str_QueryCondi & " ORDER BY LubricateAnalyzeID"
Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
Rec_Query.Find "LubricateAnalyzeID=" & 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 * " & _
" FROM Dev_V_LubricateAnalyze " & _
" Where LubricateAnalyzeID=" & Val(Lab_BillId.Caption)
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With RecTemp
If Not .EOF Then
'[>>显示单据
TextChangeLock = True '文本框加锁
LrText(0).Text = Trim(.Fields("AnaCode")) '分析票号
LrText(1).Tag = Trim(.Fields("LubricateCode")) '润滑油编码
LrText(1).Text = Trim(.Fields("LubricateName") & "") '润滑油名称
LrText(2).Text = Trim(.Fields("LubricateModel") & "") '润滑油型号
LrText(3).Text = Trim(.Fields("Devid") & "") '设备编号
LrText(4).Text = Trim(.Fields("Dname")) '设备名称
LrText(5).Text = Trim(.Fields("Model") & "") '规格型号
LrText(6).Text = Trim(.Fields("DeptName") & "") '所属部门
If IsDate(.Fields("ANADate")) Then
LrText(7).Text = Format(.Fields("ANADate"), "yyyy-mm-dd") '检验日期
End If
LrText(8).Text = Trim(.Fields("UseDeptname") & "") '用油单位
LrText(9).Text = Trim(.Fields("NewLbrQuakity") & "") '新油性质
LrText(10).Text = Trim(.Fields("UseLbrQuality") & "") '在用油性质
LrText(11).Text = Trim(.Fields("Conclusion") & "") '结论
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("shsh").Enabled = False '审核
.Buttons("shqs").Enabled = False '弃审
.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 '保存
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -