📄
字号:
Height = 300
Index = 0
Left = 990
TabIndex = 0
Text = "0"
Top = 1470
Width = 1650
End
Begin VB.Label Lab_Title
AutoSize = -1 'True
BackColor = &H80000018&
BackStyle = 0 'Transparent
Caption = "单据标题自动调整"
BeginProperty Font
Name = "宋体"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 300
Left = 2730
TabIndex = 8
Top = 750
Width = 2520
End
Begin VB.Label Lab_BillId
AutoSize = -1 'True
BackColor = &H0080C0FF&
Height = 270
Left = 6390
TabIndex = 7
Top = 1320
Visible = 0 'False
Width = 1230
End
Begin VB.Label Lab_Djclzt
BackColor = &H0000FFFF&
Caption = "1"
ForeColor = &H00808080&
Height = 255
Left = 7170
TabIndex = 6
Top = 660
Visible = 0 'False
Width = 285
End
Begin VB.Label Lab_OperStatus
BackColor = &H000080FF&
Caption = "1"
Height = 345
Left = 7710
TabIndex = 5
Top = 1260
Visible = 0 'False
Width = 345
End
Begin VB.Label Lab_Bill
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
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 = "XtCsh_FrmQcYsd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***********************************************************************************************************
'* 模 块 名 称 :期初应收单处理
'* 功 能 描 述 :此功能模块主要完成单据录入、修改、删除、预览打印等。
'* 程序员姓名 :陈恩宇
'* 最后修改人 :陈恩宇
'* 最后修改时间:2001/12/10
'* 备 注:程序中所有依实际情况自定义部分均用[>> <<]括起
'*
'* 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 Bln_ConVertFlag As Boolean '币种折算方式
Dim Dbl_AccRate As Double '币种记帐汇率
Dim Dbl_Bbje As Double '本币金额
']
'以下为固定使用变量(单据)
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_LinkOpen(Cancel As Integer)
End Sub
Private Sub Form_Load() '窗 体 装 入
'初始化各种锁值(Fixed)
changelock = False '网格行列改变控制锁
Gdtlock = False '滚动条滚动控制
Yxxpdlock = True '字段有效性判断锁
Hyxxpdlock = True '行有效性判断锁
Wbkbhlock = False '文本框内容改变锁
'调入单据信息(需要修改BillCode)
BillCode = "0202"
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
'用户退出时写上机日志
Security_Log "Ar_BeginARBill", Xtczybm, 2, False
End Sub
Private Sub Sjcsh(Str_Pzclzt As String) '数据初始化模块(根据实际情况)
Dim Sqlstr As String '查询单据列表条件
'[>>根据实际情况初始化
Select Case Str_Pzclzt
Case "1" '填制单据
'调入用户查询结果动态集
Sqlstr = "SELECT AccListId,BillCode From RP_AccList Where RPFlag='Ar' and BillItemCode='20' and StartFlag=1 ORDER BY AccListID " ' "Where BillDate='" & Xtrq & "'
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 AccListId From RP_AccList " & Str_QueryCondi & " ORDER BY BillDate,PsCode"
Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
Rec_Query.Find "AccListID=" & 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 Ar_V_QcArNote Where AccListId=" & Val(Lab_BillId.Caption)
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With RecTemp
If Not .EOF Then
'[>>显示单据
TextChangeLock = True '文本框加锁
LrText(0).Text = Trim(.Fields("BillCode")) '期初应收单据号
If IsDate(.Fields("BillDate")) Then
LrText(1).Text = Format(.Fields("BillDate"), "yyyy-mm-dd") '单据日期
End If
LrText(2).Tag = Trim(.Fields("PSCode")) '客户编码
LrText(2).Text = Trim(.Fields("CusName") & "") '客户名称
LrText(3).Tag = Trim(.Fields("AccCode") & "") '其它应收编码
LrText(3).Text = Trim(.Fields("CName") & "") '其它应收科目名称
LrText(4).Tag = Trim(.Fields("DeptCode") & "") '部门编码
LrText(4).Text = Trim(.Fields("DeptName") & "") '部门名称
LrText(5).Tag = Trim(.Fields("PersonCode") & "") '经办人编码
LrText(5).Text = Trim(.Fields("PersonName") & "") '经办人
LrText(6).Tag = Trim(.Fields("ForeignCurrCode") & "") '币别编码
LrText(6).Text = Trim(.Fields("ForeignCurrName") & "") '币别编码
LrText(7).Text = Trim(.Fields("YbYsJe") & "") '原币应收金额
LrText(8).Text = Trim(.Fields("AccRate") & "") '记帐汇率
LrText(9).Text = Trim(.Fields("BbYsJe") & "") '本币应收金额
LrText(10).Tag = Trim(.Fields("PayCode") & "") '付款条件编码
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -