frmsubmitadjustbill.frm

金算盘软件代码

    If lngInID = 0 Or lngOutID = 0 Then Exit Sub
    ShowaOldOldbill lngInID, lngOutID, lngInCustomerID, lngOutCustomerID
End Sub

Private Sub cmdHome_Click()
'    If Not ChangeSaveNote() Then Exit Sub
'    Dim lngID As Long
'    lngID = lngOtherBill(C2Lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 2)
'    If lngID = 0 Then Exit Sub
'    showaOldOldbill lngID
    If Not ChangeSaveNote() Then Exit Sub
    Dim lngInID As Long, lngOutID As Long
    Dim lngInCustomerID As Long, lngOutCustomerID As Long
    On Error Resume Next
    ReturnBillID 26, C2Date(lblField(3).Caption), lblField(2).Caption _
        , lngInID, lngOutID, lngInCustomerID, lngOutCustomerID, 2
    lngInActivityID = lngInID
    lngOutActivityID = lngOutID
    On Error GoTo 0
    If lngInID = 0 Or lngOutID = 0 Then Exit Sub
    ShowaOldOldbill lngInID, lngOutID, lngInCustomerID, lngOutCustomerID
End Sub

Private Sub cmdNext_Click()
    Dim lngInID As Long, lngOutID As Long
    Dim lngInCustomerID As Long, lngOutCustomerID As Long
    lngInID = clsBill.lngNowID
    If clsBill.blnIsChanged Then
        If Not SaveBill() Then Exit Sub
    End If
    Dim i As Integer
    If clsBill.lngNowID = 0 Then
        Exit Sub
    End If
    If lngInID > 0 Then
        On Error Resume Next
        ReturnBillID 26, C2Date(lblField(3).Caption), lblField(2).Caption _
            , lngInID, lngOutID, lngInCustomerID, lngOutCustomerID, 1
        lngInActivityID = lngInID
        lngOutActivityID = lngOutID
        On Error GoTo 0
    End If
    If lngInID = 0 Or lngOutID = 0 Then
        If blnEdit Then ShowANewBill
    Else
        ShowaOldOldbill lngInID, lngOutID, lngInCustomerID, lngOutCustomerID
    End If
End Sub

Private Sub CmdNote_Click()
    Dim frmDlg As New frmInOutNotePad
    Dim strOutCode As String, strOutName As String, strOutNote As String
    Dim strInCode As String, strInName As String, strInNote As String
    Dim strSql As String
    Dim rst As rdoResultset
    
    If lblHead(0).Tag = 0 Or lblHead(2).Tag = 0 Then Exit Sub
    If lblHead(0).Tag = lblHead(2).Tag Then
        ShowMsg Me.hWnd, "调出单位和调入单位必须不同！", MB_OK + MB_ICONEXCLAMATION, "修改单据"
        Set frmDlg = Nothing
        Exit Sub
    End If
    '将调入、调出单位的相关信息传给记事薄
    strSql = "SELECT strBillToPostalCode, strCustomerCode,strCustomerName, strNotes ,lngCustomerID " _
        & " FROM Customer WHERE lngCustomerID= " & lblHead(0).Tag _
        & " OR lngCustomerID= " & lblHead(2).Tag
    Set rst = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If rst.EOF Then Exit Sub
    With rst
        .MoveFirst
        Do While Not .EOF
            If !lngCustomerID = lblHead(0).Tag Then
                strOutCode = !strCustomerCode ' Trim(!strBillToPostalCode)
                strOutName = Trim(!strCustomerName)
                strOutNote = Trim(!strNotes)
            Else
                strInCode = !strCustomerCode 'Trim(!strBillToPostalCode)
                strInName = Trim(!strCustomerName)
                strInNote = Trim(!strNotes)
            End If
            .MoveNext
        Loop
        
        frmDlg.EditCard strOutCode, strOutName, strOutNote, strInCode, strInName, strInNote
        '调用结束后，如果不是从记事薄中按取消键退出，则将输入的备注信息保存到表中
        If Not frmDlg.blnCancel Then
            If strInNote = "" Then strInNote = " "
            If strOutNote = "" Then strOutNote = " "
            strSql = "Update Customer SET strNotes='" & strInNote & "' WHERE lngCustomerID=" & lblHead(2).Tag
            gclsBase.ExecSQL strSql
            strSql = "Update Customer SET strNotes='" & strOutNote & "' WHERE lngCustomerID=" & lblHead(0).Tag
            gclsBase.ExecSQL strSql
        End If
    End With
    Set rst = Nothing
    Set frmDlg = Nothing
End Sub

Private Sub CmdPrev_Click()
    If Not ChangeSaveNote() Then Exit Sub
    Dim lngInID As Long, lngOutID As Long
    Dim lngInCustomerID As Long, lngOutCustomerID As Long
    Dim i As Integer
    On Error Resume Next
    ReturnBillID 26, C2Date(lblField(3).Caption), lblField(2).Caption _
        , lngInID, lngOutID, lngInCustomerID, lngOutCustomerID, 0
    lngInActivityID = lngInID
    lngOutActivityID = lngOutID
    On Error GoTo 0
    If lngInID = 0 Or lngOutID = 0 Then
        Exit Sub
    End If
    ShowaOldOldbill lngInID, lngOutID, lngInCustomerID, lngOutCustomerID
End Sub
Private Sub mclsMainControl_FilePrint()
    CmdPrint_Click
End Sub

Private Sub CmdPrint_Click()
    If clsBill.lngNowID = 0 And clsBill.blnIsChanged = False Then
        ShowMsg Me.hWnd, "单据为空，无可打印信息！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "打印单据"
        Exit Sub
    ElseIf GrdCol.Rows <= 1 Then
        ShowMsg Me.hWnd, "单据体为空，不能打印！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "打印单据"
        Exit Sub
    End If
    If clsBill.blnIsPrinted Then
      If clsBill.blnPrintPrintedBill Then
         If ShowMsg(Me.hWnd, "本张" & lblCaption.Caption & "已经打印，您确实要打印吗？", MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL + MB_DEFBUTTON2, "打印单据") = vbNo Then
            Exit Sub
         End If
      Else
         ShowMsg Me.hWnd, "本张" & lblCaption.Caption & "已经打印，不能再打印！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL + MB_DEFBUTTON2, "打印单据"
         Exit Sub
      End If
    End If
          
    
    Dim myPrintclass As New PrintClass
    If clsBill.blnIsChanged Then
        Dim intReturnID As Integer
        
        intReturnID = 6 ' ShowMsg(Me.hwnd, "此单据还没有保存，是否先保存再打印？", MB_ICONQUESTION + MB_YESNO + MB_SYSTEMMODAL, "警告信息")
        If intReturnID = 6 Then
            If Not SaveBill Then
                Exit Sub
            End If
        Else
            Exit Sub
        End If
    End If
    If myPrintclass.PrintReceipt(gclsBase.BaseDB, -1, 26, CStr(lngOutActivityID), getPrintIDofTemplateID(C2lng(lblHead(5).Tag)), BillRePrintRight(26)) Then
         If chkPrint(0).Value <> 0 Then
            clsBill.blnChangeEvent = False
            chkPrint(0).Value = 0
            clsBill.blnChangeEvent = True
         End If
         clsBill.blnIsPrinted = True
    End If
    Set myPrintclass = Nothing
End Sub

Private Sub CmdReceive_Click()
    With FrmPayment
        .Show
        .ZOrder
    End With
End Sub

'Private Sub cmdVoucher_Click()
'    ShowMsg Me.hwnd, "Voucher", MB_OK
'End Sub
Private Sub Form_Activate()
    If mclsMainControl Is Nothing Then
        Exit Sub
    End If
    SetHelpID C2lng(Me.HelpContextID)
    ResponseMessage
    gclsSys.CurrFormName = Me.hWnd
    clsBill.UpdateMainEditMenu
    If blnFirstIn Then
        blnFirstIn = False
        Exit Sub
    End If
    If lblHead(4).Tag = "" Or lblHead(4).Tag = "0" Then
        lblHead(4).Tag = 1
        IdToCodeAndName xTemplatE, C2lng(lblHead(4).Tag), " ", lblHead(5).Caption
    End If
    Form_Resize
    
    If Me.Left + Me.width < 0 Or Me.Left > Screen.width Then
        Me.Left = 300
    End If
End Sub

Private Sub Form_Deactivate()
    frmMain.SetEditUnEnabled
End Sub

Public Sub ResponseMessage()
    Dim vntMessage As Variant
    Dim lngOldID As Long
    '响应消息
    For Each vntMessage In mclsMainControl.Messages
        If vntMessage = Message.msgItem Then  '接收到改变消息
            mclsMainControl.Messages.Remove CStr(vntMessage) '
            lngOldID = refInput1.ID
            clsBill.AddReferOfItem
            refInput1.SeekId lngOldID
        ElseIf vntMessage = Message.msgCustomer Then   '
            mclsMainControl.Messages.Remove CStr(vntMessage) '
            lngOldID = refInput2.ID
            clsBill.AddReferOfCustomer
            refInput2.SeekId lngOldID
        End If
        If vntMessage = 56 Then
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除付款条件改变消息
            clsBill.ReGetBillNO
        End If
    Next

End Sub

Private Sub GrdCol_Mouseup(Button As Integer, Shift As Integer, x As Single, y As Single)
    If blnNotRaiseEvents Then Exit Sub
    clsBill.GrdCol_Mouseup Button, Shift, x, y
    If Button = vbRightButton Then
        MakeListActivityMenu
        clsBill.blnNotRespondKeyPress = True
        PopupMenu frmMain.mnuListActivity
        clsBill.blnNotRespondKeyPress = False
    End If
    blnNotRaiseEvents = True
    DoEvents
    blnNotRaiseEvents = False
End Sub

Private Sub GrdCol_RowColChange()
    clsBill.GrdCol_RowColChange
End Sub

Private Sub grdCol_Scroll()
    clsBill.grdCol_Scroll
End Sub

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

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

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

Private Sub lblHead_Change(index As Integer)
    Select Case index
        Case 5
            refTmpID_Change
        Case 3
            lblField(1).Caption = strDetailMsg(C2lng(lblHead(2).Tag))
        Case 1
            lblField(0).Caption = strDetailMsg(C2lng(lblHead(0).Tag))
    End Select
End Sub

Private Sub lblHead_MouseDown(index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If blnNotRaiseEvents Then Exit Sub
    Select Case Button
        Case vbRightButton
'            clsBill.bytRegion = FHead
'            clsBill.bytIndex = Index
            clsBill.UpdateMainEditMenu
            MakeListEditMenu
            clsBill.blnNotRespondKeyPress = True
            PopupMenu frmMain.mnuListEdit
            clsBill.blnNotRespondKeyPress = False
            Exit Sub
        Case vbLeftButton
            If (index \ 2) * 2 = index Then Exit Sub
            If x >= lblHead(index).width - clsBill.DropButtonWidth And _
               x <= lblHead(index).width And _
               y >= 0 And _
               y <= lblHead(index).Height Then
                clsBill.Head_Click index, True
            Else
                clsBill.Head_Click index, False
            End If
            clsBill.UpdateMainEditMenu
    End Select
    blnNotRaiseEvents = True
    DoEvents
    blnNotRaiseEvents = False
End Sub

Private Sub lblmemo_MouseDown(index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If blnNotRaiseEvents Then Exit Sub
    Select Case Button
        Case vbRightButton
            clsBill.bytRegion = FFooter
            clsBill.bytIndex = index
            clsBill.UpdateMainEditMenu
            MakeListEditMenu
            clsBill.blnNotRespondKeyPress = True
            PopupMenu frmMain.mnuListEdit
            clsBill.blnNotRespondKeyPress = False
            Exit Sub
        Case vbLeftButton
            If index = 3 Then
                    If x >= LblMemo(index).width - clsBill.DropButtonWidth And _
                       x <= LblMemo(index).width And _
                       y >= 0 And _
                       y <= LblMemo(index).Height Then
                        clsBill.Memo_Click index, True
                    Else
                        clsBill.Memo_Click index, False