frmr_p.frm

金算盘软件代码

Dim srCode As String
Dim blnNotResize As Boolean
Dim blnEdit As Boolean             '可填制权限
Dim blnView As Boolean             '可查询权限
Dim intCurDec As Integer
Dim intRateDec As Integer
Dim blnNotRaiseClick As Boolean             ' 不触发CHECKBOX 的CLICK事件标志
Dim blnNotRaiseEvents As Boolean  '不响应按键事件标志
Public blnIsLoading As Boolean '正在引入数据标志
Private blnFirstIn As Boolean '首次进入窗体（从SHOWANEWTYPEBILL和showaoldbill)标志
Private intBillState As Integer
Private blnPrinted As Boolean '已打印标志
Public ReceiptType As Integer
Public lngVoucherID As Long '凭证ID
Dim strAlpha As String
Dim lngDigit As Long
Dim blnIsClosed As Boolean  '对银行存款科目，以前是否已经关闭标志
Public lngCancelActivityID As Long '冲销单据的原单据ID存贮变量

Dim lngOldAccountID As Long   '旧单子的银行存款科目ID
Dim lngOldCurrencyID As Long  '旧单子的银行存款科目币种ID
Dim strOldCurrAmount As String   '旧单子的银行存款科目原币金额
Dim strOldRate As String      '旧单子的银行存款科目汇率
Dim strOldAmount As String       '旧单子的银行存款科目本币金额
Dim blnWriteForm As Boolean     '是否是数据引入标志(不加载 MSGFORM 窗体)
Dim blnIsClose As Boolean   '关闭标志
Public lngOldDetailID As Long '旧表体名细ID
Public strCondition As String    '筛选条件串
Dim dblAmount As Double   '本币金额
Dim dblCurrAmount As Double   '原币金额
Dim dblDiscountAmount As Double   '本币折扣金额
Dim dblDiscountCurrAmount As Double   '原币折扣金额
Dim dblQuantity As Double   '数量
Public mlngItemActivityID As Long '现结标志（采购销售单的单据ID）


'单据状态标志0---可修改，1---已结算，2----已开票，3--已经入库，4--已开票，5-- 被分摊加工费用
'6--有批次管理的商品已经出库
Private Sub cmbInput_Click()
    clsBill.SaveInput2Form
    If clsBill.bytRegion = FHead Then
        Dim lngID As Long
        Dim lngT As Long
        Dim strT As String
        Dim strC As String
        lngID = BillPublic.ReceiptNameToTypeID(cmbInput.Text)
        lngT = FirstId(xTemplatE, lngID)
        Call BillPublic.IdToCodeAndName(xTemplatE, lngT, strC, strT)
        lblHead(4).Tag = lngT
        lblHead(5).Caption = strT
    End If
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    clsBill.Form_key_Down KeyCode
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If blnNotRaiseEvents Then Exit Sub
    Dim CtrDown As Integer
    If KeyCode = 93 Then
        If clsBill.bytRegion = FGrid Or clsBill.bytRegion = FGrid1 Or clsBill.bytRegion = FPicture Then
            GrdCol_Mouseup vbRightButton, 0, 0, 0
        Else
            Form_MouseUp vbRightButton, 0, 0, 0
        End If
        Exit Sub
    End If
    CtrDown = Shift And vbCtrlMask
    If CtrDown > 0 Then
        Select Case KeyCode
            Case 33     'Ctr+PageUp
                cmdButton_Click 1
            Case 34    'Ctl-PageDown
                cmdButton_Click 0
            Case 13    'ctr_Enter
                cmdButton_Click 4
        End Select
        Debug.Print KeyCode
'    ElseIf KeyCode = 27 Then 'ESCAPE
'        cmdButton_Click 5
    Else
        clsBill.Form_KeyDown KeyCode, Shift
    End If
End Sub

Private Sub Form_Load()

    If ReceiptType = 39 Then
        ReceiptTypeID = 15 '付款单
    Else
        ReceiptTypeID = 16 '收款单ID
    End If
    Set clsBill = New clsR_P 'itemclass 'BillStart
    Set clsLst = New clsListMethod
    clsLst.SethWnd Me.hWnd
    clsLst.theType = ReceiptType
    
    clsBill.ReceiptTypeID = ReceiptTypeID
    Select Case ReceiptType
    Case 39
        Me.Caption = "采购付款"
        cmdButton(5).Caption = "应付筛选(&I)"
        Me.HelpContextID = 61003
    Case 40
        Me.Caption = "销售收款"
        cmdButton(5).Caption = "应收筛选(&I)"
        Me.HelpContextID = 61002
    End Select
    Set clsBill.Form = Me
    blnNotResize = True
    If gclsSys Is Nothing Then Exit Sub
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    blnNotResize = False
    Set GrdCol.MouseIcon = LoadResPicture(101, vbResCursor)
'    FirstReceiptTypeIDAndName ReceiptTypeID, lgID, srName
'    lblHead(2).Tag = lgID
'    lblHead(3).Caption = srName
    '--------WAIT WINDOWS---------
'    Me.Hide
'    Me.Left = -30000
    If blnIsLoading = False Then MsgForm.PleaseWait
    '--------------------------------------
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If blnNotRaiseEvents Then Exit Sub
    clsBill.Form_MouseUp
    If Button = vbRightButton Then
        MakeListEditMenu
        clsBill.blnNotRespondKeyPress = True
        PopupMenu frmMain.mnuListEdit
        If clsBill Is Nothing Then
            blnNotRaiseEvents = False
            Exit Sub
        End If
        clsBill.blnNotRespondKeyPress = False
        blnNotRaiseEvents = True
        DoEvents
        blnNotRaiseEvents = False
    End If
End Sub

'窗体尺寸变化处理程序
Private Sub Form_Resize()
    Debug.Print "resize"
    If Me.Visible = False Then Exit Sub
    If blnNotResize Then
        blnNotResize = False
        Exit Sub
    End If
    clsBill.Form_Resize
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    On Error Resume Next
    If gclsBase Is Nothing Then Exit Sub
    If clsBill Is Nothing Then Exit Sub
    If UnloadMode = vbFormControlMenu Then
        If blnNotRaiseEvents Then
            Cancel = 1
            gblnCancel = True
            Exit Sub
        End If
    End If
    If UnloadMode = vbFormControlMenu Then
        If clsBill Is Nothing Then Exit Sub
        clsBill.cmdButton_Click 0
    End If
    
    If Not ChangeSaveNote() Then
        Cancel = 1
        gblnCancel = True
        Exit Sub
    End If
    
    blnNotRaiseEvents = True
    Me.Visible = False
    gclsSys.MainControls.Remove Me
    frmPayableList.IAmCLosed
    Set clsLst = Nothing
    Set clsBill = Nothing
    Set mclsMainControl = Nothing      '主控对象
    Unload MsgForm
    Unload Me

End Sub

Private Sub chkPrint0_Click()
    clsBill.blnIsChanged = True
'    frmMain.mnuEditShowAll.Checked = chkPrint(0).Value
End Sub

Private Sub chkPrint1_Click()
    If blnNotRaiseClick = True Then Exit Sub
    If Not clsBill.blnChangeEvent Then
        GoTo XXXX
    End If
    If chkPrint(1).Value = 0 Then
        GoTo XXXX
    Else
        blnNotRaiseClick = True
        chkPrint(1).Value = 0
        blnNotRaiseClick = False
        
'        If clsLst.BeforeDelete(True, clsBill.lngNowID, C2lng(lblHead(2).Tag), lblCaption.Caption) <> 1 Then
'            Exit Sub
'        End If
        If ShowMsg(Me.hWnd, "本张" & lblCaption.Caption & "保存后将不能取消作废，您确实要作废吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "保存单据") = vbNo Then
            Exit Sub
        End If
        
        blnNotRaiseClick = True
        chkPrint(1).Value = 1
        blnNotRaiseClick = False
XXXX:
        
        With Me.GrdCol
            RefreshRect .hWnd, .Left + (.width - 140 * Screen.TwipsPerPixelX) \ 2, .RowHeight(0) + (.Height - .RowHeight(0) - 70 * Screen.TwipsPerPixelY) \ 2, .Left + (.width - 140 * Screen.TwipsPerPixelX) \ 2 + 140 * Screen.TwipsPerPixelX, .RowHeight(0) + (.Height - .RowHeight(0) - 70 * Screen.TwipsPerPixelY) \ 2 + 70 * Screen.TwipsPerPixelY
        End With
    
    End If
    
End Sub

Private Sub chkPrint_Click(Index As Integer)
    If blnNotRaiseEvents Then Exit Sub
    clsBill.CHK_CLICK Index
    Select Case Index
        Case 0
            chkPrint0_Click
        Case 1
            chkPrint1_Click
    End Select
End Sub

Private Sub cmdButton_Click(Index As Integer)
    If blnNotRaiseEvents Then Exit Sub
    blnNotRaiseEvents = True
    clsBill.blnKeyDown = False
    If Index = 3 Then
        blnNotRaiseEvents = False
        CmdCancel_Click
        Exit Sub
    End If
    If clsBill Is Nothing Then Exit Sub
    If clsBill.cmdButton_Click(Index) = False Then
        blnNotRaiseEvents = False
        Exit Sub
    End If
     
     Select Case Index
        Case 0
            cmdNext_Click
        Case 1
            CmdPrev_Click
        Case 2
            If BillSave Then
                clsBill.blnIsChanged = False
                blnNotRaiseEvents = False
                Unload Me
                Exit Sub
            End If
        Case 3
'            TestData
            CmdCancel_Click
            Exit Sub
        Case 4 '冲销
            cmdBulidCancel_Click
        Case 5      '筛选
            CmdReceive_Click
        Case 6      '关取凭证
            cmdVoucher_Click
        Case 7      '记事本
            CmdNote_Click
        Case 8
            CmdPrint_Click
    End Select
EndProc:
    If clsBill Is Nothing Then Exit Sub
    blnNotRaiseEvents = True
    DoEvents
    blnNotRaiseEvents = False
End Sub

Private Sub CmdCancel_Click()
    blnNotRaiseEvents = False
    clsBill.blnIsChanged = False
    Unload Me
End Sub
'单据冲销
Private Sub cmdBulidCancel_Click()
    Dim lngOldID As Long
    
    If BillSave() = False Then
        Exit Sub
    End If
    lngOldID = frmWriteOffBill.WriteOffBill(ReceiptType, clsBill.lngNowID, Me.hWnd, , , , True)
    If lngOldID = 0 Then
    Else
        ShowAOldBill ReceiptType, lngOldID, True
    End If
End Sub
Private Sub cmdVoucher_Click()
    lngVoucherID = clsBill.lngVoucher(clsBill.lngNowID)
    If lngVoucherID > 0 Then
        FrmVoucher.ShowAOldBill lngVoucherID
    Else
        ShowMsg Me.hWnd, "凭证不存在！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "警告信息"
        cmdButton(6).Enabled = False
        If WanNeng Then
            tblReceipt.Buttons(ToolBarIndex(6, Me.Name)).Enabled = cmdButton(6).Enabled
        End If
    End If

End Sub
Private Sub CmdNote_Click()
    showNotePad (C2lng(lblHead(0).Tag))
End Sub

Private Sub CmdEnd_Click()
    If Not ChangeSaveNote() Then Exit Sub
    Dim lngID As Long
    lngID = lngOtherBill(ReceiptType, C2Date(lblField(2).Caption), lblField(1).Caption, 3)
    If lngID = 0 Then Exit Sub
    ShowAOldBill ReceiptType, lngID
End Sub

Private Sub cmdHome_Click()
    If Not ChangeSaveNote() Then Exit Sub
    Dim lngID As Long
    lngID = lngOtherBill(ReceiptType, C2Date(lblField(2).Caption), lblField(1).Caption, 2)
    If lngID = 0 Then Exit Sub
    ShowAOldBill ReceiptType, lngID
End Sub

Private Sub cmdNext_Click()
    Dim lngID As Long
    lngID = clsBill.lngNowID
    If Not BillSave() Then Exit Sub
    Dim i As Integer
    
    If clsBill.lngNowID = 0 Then
        Exit Sub
    End If
    If lngID > 0 Then
        lngID = lngOtherBill(ReceiptType, C2Date(lblField(2).Caption), lblField(1).Caption, 1, , True)
    End If
    If lngID < 1 Then
        ShowANewTypeBill ReceiptType
        Exit Sub
    Else
        ShowAOldBill ReceiptType, lngID
    End If
End Sub

Private Function BillSave() As Boolean
    If clsBill.blnIsChanged = False Then
        BillSave = True
        Exit Function
    End If
    
    
    Debug.Print "datavalid_begin" & Time
    If Not clsBill.DataValid Then
        BillSave = False
        Exit Function
    End If
    Debug.Print "datavalid_end" & Time

    If Me.Visible Then MsgForm.PleaseWait "正在保存单据，请稍候…… "
    
    blnNotRaiseEvents = True
    If clsBill.lngNowID = 0 Then
        BillSave = SaveNewBill()
    Else
        If clsBill.blnMayChange Then
            BillSave = SaveModifyBill(clsBill.lngNowID)
        Else
            Dim strSql As String
            strSql = "UPDATE Activity SET blnIsPrint=" & IIf(chkPrint(0).Value = 0, 0, 1) & _
                    " WHERE lngActivityID=" & clsBill.lngNowID