-i+

VB开发的ERP系统

        Lab_BillId.Caption = .Fields("CloseBillID")
        Call Sub_ShowBill
    End With
    
End Sub

Private Sub Sub_Prev()             '上 张
    
    With Rec_Query
        If .RecordCount = 0 Then
            Exit Sub
        End If
        If Not .BOF Then
            .MovePrevious
        End If
        
        If Not .BOF Then
            Lab_BillId.Caption = .Fields("CloseBillID")
        Else
            .MoveNext
        End If
        
        Call Sub_ShowBill
    End With
    
End Sub

Private Sub Sub_next()             '下 张
    
    With Rec_Query
        If .RecordCount = 0 Then
            Exit Sub
        End If
        If Not .EOF Then
            .MoveNext
        End If
        
        If Not .EOF Then
            Lab_BillId.Caption = .Fields("CloseBillID")
        Else
            .MovePrevious
        End If
        
        Call Sub_ShowBill
    End With
    
End Sub

Private Sub Sub_Last()              '末 张
    
    With Rec_Query
        If .RecordCount = 0 Then
            Exit Sub
        End If
        .MoveLast
        Lab_BillId.Caption = .Fields("CloseBillID")
        Call Sub_ShowBill
    End With
    
End Sub
    
'[>>===================以下为根据实际业务需要自定义过程区域=============================<<]

'审核,弃审
Private Sub Sub_CheckBill()             '审 核
    '[>>
    '此处可以写入禁止单据审核的理由
    '<<]
    
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log("Ar_GatheringBill_Check", Xtczybm, 1, True) Then
        Exit Sub
    End If
    
    If Fun_CheckCloseBill(Val(Lab_BillId.Caption)) Then
    
        '写入系统操作员
        LrText(14).Text = Xtczy
        
        '设置审核弃审按钮状态
        Call Sub_CheckStatus
        
        '标识单据发生变化
        Bln_BillChange = True
    End If
End Sub

Private Function Fun_AllowEdit() As Boolean                      '判断当前单据是否允许编辑或删除
    
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Fun_AllowEdit = False
    Sqlstr = "Select Checker From RP_CloseBill Where CloseBillID=" & Val(Lab_BillId.Caption)
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With RecTemp
        If Not .EOF Then
            If Trim(.Fields("Checker") & "") <> "" Then
                Tsxx = "该单据已审核确认,不能修改或删除!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If
        End If
    End With
    Fun_AllowEdit = True
    
End Function

Private Sub Combo_Skdlx_Click()             '点击收款单类型下拉框
   Select Case Combo_Skdlx.ListIndex
       Case 0      '到款
         Lab_Title.ForeColor = &H0&
         Lab_Title.Caption = "收款单"
       Case 1      '预收款
         Lab_Title.ForeColor = &HFF0000
         Lab_Title.Caption = "预收款"
       Case 2      '退款单
         Lab_Title.ForeColor = &HFF&
         Lab_Title.Caption = "退款单"
   End Select
End Sub

Private Sub Sub_CancelBill()                '单据核销
        
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log("Ar_GatheringBill_Check", Xtczybm, 1, True) Then
        Exit Sub
    End If
        
    On Error Resume Next
    
    If Combo_Skdlx.ListIndex = 1 Then
         HX_FrmHxCxtj.Combo_Jshxlx.ListIndex = 1                '预收冲应收
    Else
         HX_FrmHxCxtj.Combo_Jshxlx.ListIndex = 0                '到款结算
    End If
    HX_FrmHxCxtj.LrText(0).Tag = LrText(2).Tag                  '客户编码
    HX_FrmHxCxtj.LrText(0).Text = LrText(2).Text                '客户名称
    HX_FrmHxCxtj.Imgebo_ForeignCurr.Text = LrText(5).Text
    HX_FrmHxgl.Timer1.Enabled = True
    HX_FrmHxgl.Show 1
    
End Sub


'[>>===================以上为根据实际业务需要自定义过程区域=============================<<]

'*****************************以下为文本框录入处理程序(固定不变部分)*******************************'

'************以下为文本框录入处理程序(固定不变部分)*************'
Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
    
    '以下为依据实际情况自定义部分[
    
    '在此填写文本框录入事后处理程序
    
    Select Case Index
         Case 5
            Dim Bln_ConVertFlag As Boolean                        '币种折算方式
            Dim Dbl_AccRate As Double                             '币种记帐汇率
            
            Call Sub_GetAccRate(LrText(5).Tag, Bln_ConVertFlag, Dbl_AccRate)    '取外币记帐汇率
            
            TextChangeLock = True
                If Dbl_AccRate <> 0 Then
                    LrText(6).Text = Dbl_AccRate
                Else
                    LrText(6).Text = ""
                End If
                
            TextChangeLock = False
      End Select
    
    ']以上为依据实际情况自定义部分
    
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, 11      '金额型
        Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
    Case 9, 12      '数量型
        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)                                                '文本框失去焦点
    
    '显示相应信息但不能进行有效性判断
    
    Call Wbklrwbcl(Index)
    
End Sub

Private Sub Ydcommand1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)     '按钮提供帮助
    
    '文本框处于非录入状态时不允许调入帮助
    If Not LrText(Index).Enabled Then
        Exit Sub
    End If
    
    Call Text_Help(Index)
    
End Sub

Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
    
    If Not Textboolean(Index, 1) 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
    End If
    
    LrText(Index).SetFocus
    
End Sub

Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息
    
    '填写文本框得到焦点,进行相应信息处理程序
    
End Sub

Private Sub Wbkcsh()                          '录入文本框初始化
    
    Dim Int_TabIndex As Integer         'Tab焦点计数器
    
    '单据录入中文本框焦点由0开始
    LrText(0).TabIndex = 0
    
    '最大录入文本框索引值
    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 jsqte <> 0 Then
                Load LrText(jsqte)
                Load TsLabel(jsqte)
                
                '判断录入文本框是否显示
                If Textboolean(jsqte, 4) Then
                    LrText(jsqte).Visible = True
                    TsLabel(jsqte).Visible = True
                End If
                
                '判断文本框是否可编辑
                If Textboolean(jsqte, 5) Then
                    LrText(jsqte).Enabled = True
                Else
                    LrText(jsqte).Enabled = False
                End If
                
                '判断文本框是否提供帮助
                If Textboolean(jsqte, 1) Then
                    If Not Textboolean(jsqte, 3) Then
                        Load Ydcommand1(jsqte)
                    End If
                End If
            End If
            
            '初始化其内容
            TextChangeLock = True
            LrText(jsqte).Text = ""
            LrText(jsqte).Tag = ""
            If Textint(jsqte, 5) <> 0 Then
                LrText(jsqte).MaxLength = T