frmstriprigout.frm

金算盘软件代码

    coCustomer2ID
    coCustomer3ID
    coCustomer4ID
    coCustomer5ID
    coCustomer6ID
    coDblFactor
    coBatchPositionID
    coPositionQuantity
End Enum

Private Sub cmbInput_Click()
    If blnNotRaiseEvents Then Exit Sub
    If blnMouse = False Then Exit Sub
    clsBill.SaveInput2Form
End Sub
Private Sub cmbInput_KeyDown(KeyCode As Integer, Shift As Integer)
'    If KeyCode <> 13 Then
        blnMouse = False
'    End If
End Sub

Private Sub cmbInput_KeyUp(KeyCode As Integer, Shift As Integer)
    blnMouse = True
End Sub

Private Sub curInput_LostFocus()
    'clsBill.SaveInput2Form
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()
    Dim i As Long
    ReceiptTypeID = 10 '商品期初ID
    Me.HelpContextID = 50018
    Set clsBill = New clsStripRigOut 'BillStart
    clsBill.ReceiptTypeID = ReceiptTypeID
    #If conWan = 1 Then
        For i = 0 To lblHead.UBound
            lblHead(i).top = lblHead(i).top + tblReceipt.Height
        Next i
        LblBack.top = LblBack.top + tblReceipt.Height
        lblCaption.top = lblCaption.top + tblReceipt.Height
        tblReceipt.Visible = True
'        Me.BackColor = RGB(255, 122, 122)
    #End If
    Set clsBill.Form = Me
    
    blnNotResize = True
    If gclsSys Is Nothing Then Exit Sub
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    blnNotResize = False
    
    FirstReceiptTypeIDAndName ReceiptTypeID, lgID, srName
    lblHead(2).Tag = lgID
    lblHead(3).Caption = srName
'    Me.Hide
'    Me.Left = -30000
    If blnIsLoading = False Then MsgForm.PleaseWait
    If WanNeng Then
        SetToolBarTextImage tblReceipt, 2, ReceiptTypeID
    End If
    clsBill.AddReferOfItem
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()
    If Not blnNotResize Then clsBill.Form_Resize
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If gclsSys 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 Not ChangeSaveNote Then
            Cancel = 1
            gblnCancel = True
            Exit Sub
        End If
    
    
'    SaveColWidthDefault Me
    gclsSys.MainControls.Remove Me
    frmListCompose.IAmCLosed
    Set clsBill = Nothing
    Set mclsMainControl = Nothing      '主控对象
    Unload MsgForm
    Unload Me
End Sub

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

Private Sub chkPrint1_Click()
    Dim intYesNo As Integer
    If chkPrint(1).Value = 1 And blnIsCanEventChk_Click Then
        blnNotRaiseEvents = True
        chkPrint(1).Value = 0
        blnNotRaiseEvents = False
        intYesNo = ShowMsg(Me.hWnd, "该拆卸组装单作废后将不能取消作废，您确实要作废吗？", MB_YESNO + MB_SYSTEMMODAL + MB_DEFBUTTON2 + MB_ICONQUESTION, "提示信息")
        blnNotRaiseEvents = True
        If intYesNo = IDYES Then
            chkPrint(1).Value = 1
        End If
        blnNotRaiseEvents = False
    End If
    clsBill.blnIsChanged = True
    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 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
    clsBill.cmdButton_Click Index
    Select Case Index
        Case 0
            cmdNext_Click
        Case 1
            CmdPrev_Click
        Case 2
            cmdHome_Click
        Case 3
            CmdEnd_Click
        Case 4
            If SaveBill Then
                clsBill.blnIsChanged = False
                blnNotRaiseEvents = False
                Unload Me
            End If
        Case 5
            CmdCancel_Click
        Case 6
            FrmVoucher.ShowAOldBill lngVoucherID
        Case 7
            CmdPrint_Click
            clsBill.SetAFocus
    End Select
    blnNotRaiseEvents = True
    DoEvents
    blnNotRaiseEvents = False
End Sub

Private Sub CmdCancel_Click()
    clsBill.blnIsChanged = False
    blnNotRaiseEvents = False
    Unload Me
End Sub

Private Sub CmdEnd_Click()
    If Not ChangeSaveNote Then Exit Sub
'    Dim lngID As Long
'    lngID = lngOtherBill(C2Lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 3)
'    If lngID = 0 Then Exit Sub
    Dim lngActivityID1 As Long, lngActivityID2 As Long
    
    '此处需返回该张单据的两个ID
    ReturnBillID C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption _
        , lngActivityID1, lngActivityID2, 3
    If lngActivityID1 = 0 Or lngActivityID2 = 0 Then Exit Sub
    ShowaOldOldbill lngActivityID1, lngActivityID2
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
    Dim lngActivityID1 As Long, lngActivityID2 As Long
    
    '此处需返回该张单据的两个ID
    ReturnBillID C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption _
        , lngActivityID1, lngActivityID2, 2
    If lngActivityID1 = 0 Or lngActivityID2 = 0 Then Exit Sub
    ShowaOldOldbill lngActivityID1, lngActivityID2

End Sub

Private Sub cmdNext_Click()
    Dim lngID As Long
    lngID = clsBill.lngNowID
    If clsBill.blnIsChanged Then
        If SaveBill() = False Then
            Exit Sub
        End If
    ElseIf clsBill.lngNowID = 0 Then
        Exit Sub
    End If
    If lngID = 0 Then
        chkPrint(1).Value = 0
        ShowANewBill
        Exit Sub
    End If
    
    Dim i As Integer
    chkPrint(1).Value = 0
    clsBill.blnIsChanged = False
    Dim lngActivityID1 As Long, lngActivityID2 As Long
    
    '此处需返回该张单据的两个ID
    ReturnBillID C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption _
        , lngActivityID1, lngActivityID2, 1
    If lngActivityID1 = 0 Or lngActivityID2 = 0 Then
        If blnEdit Then ShowANewBill
        If clsBill.blnIsChanged Then clsBill.blnIsChanged = False
    Else
        ShowaOldOldbill lngActivityID1, lngActivityID2
    End If
End Sub


Private Sub CmdPrev_Click()
    If Not ChangeSaveNote Then Exit Sub
    Dim lngActivityID1 As Long, lngActivityID2 As Long
    Dim i As Integer
    '此处需返回该张单据的两个ID
    On Error Resume Next
    chkPrint(1).Value = 0
    clsBill.blnIsChanged = False
    ReturnBillID C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption _
        , lngActivityID1, lngActivityID2, 0
    On Error GoTo 0
    If lngActivityID1 = 0 Or lngActivityID2 = 0 Then
        Exit Sub
    End If
    ShowaOldOldbill lngActivityID1, lngActivityID2
End Sub

Private Sub grdCol_GotFocus()
    clsBill.grdCol_GotFocus
End Sub

Private Sub grdCol1_GotFocus()
    clsBill.grdCol1_GotFocus
End Sub

Private Sub mclsMainControl_FilePrint()
    CmdPrint_Click
End Sub
Private Sub mclsMainControl_FilePrintReceipt()
    If clsBill.lngNowID > 0 Then
        If clsBill.blnIsChanged Then
            If SaveBill() = False Then Exit Sub
        End If
    End If
    PrintReceipt C2lng(lblHead(2).Tag)
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.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
            ShowAOldBill clsBill.lngNowID
        Else
            Exit Sub
        End If
    End If
    Dim i As Long
    For i = 1 To grdCol1.Rows - 1
        grdCol1.TextMatrix(i, 28) = NumberConvert(grdCol1.TextMatrix(i, 4), C2Dbl(grdCol1.TextMatrix(i, 24)), True)
    Next
    For i = 1 To GrdCol.Rows - 1
        GrdCol.TextMatrix(i, 28) = NumberConvert(GrdCol.TextMatrix(i, 4), C2Dbl(GrdCol.TextMatrix(i, 24)), True)
    Next
    Dim myPrintclass As New PrintClass
    If myPrintclass.PrintReceipt(gclsBase.BaseDB, -3, C2lng(lblHead(2).Tag), CStr(lngInActivityID), getPrintIDofTemplateID(C2lng(lblHead(5).Tag)), BillRePrintRight(C2lng(lblHead(2).Tag))) Then
        If clsBill.blnMayDelete = True And BillRePrintRight(C2lng(lblHead(2).Tag), True) = False Then
            clsBill.blnMayDelete = False
        End If
        If cmdButton(7).Enabled And BillRePrintRight(C2lng(lblHead(2).Tag)) = False Then
            cmdButton(7).Enabled = False
        End If
        If WanNeng Then
            tblReceipt.Buttons(8).Enabled = cmdButton(7).Enabled
        End If
        clsBill.UpdateMainEditMenu
    End If
    Set myPrintclass = Nothing
    clsBill.SetAFocus
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 gclsSys Is Nothing Then Exit Sub
    SetHelpID C2lng(Me.HelpContextID)
    ResponseMessage
    If gclsSys Is Nothing Then Exit Sub
    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