frmcostprice.frm

金算盘软件代码

    End If
    SetHelpID Me.HelpContextID
    gclsSys.CurrFormName = Me.hwnd
    ResponseMessage
    
    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
    clsBill.UpdateMainEditMenu
    If blnFirstIn Then
        blnFirstIn = False
    Else
        Form_Resize
    End If
    
    
    If (Me.Left + Me.width) < 0 Or Me.Left > Screen.width Then
        Me.Left = 300
    End If
    
    clsBill.ReSetFocus
End Sub

Public Sub ResponseMessage()
    Dim vntMessage As Variant
    '响应消息
    For Each vntMessage In mclsMainControl.Messages
        If vntMessage = Message.msgAccount Then '接收到科目改变消息
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除付款条件改变消息
        End If
        If vntMessage = Message.msgItem Then   '接收到商品改变消息
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除付款条件改变消息
            clsBill.setRefer 1
        End If
        If vntMessage = 62 Then
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除付款条件改变消息
            clsBill.ReGetBillNO
        End If
    Next
End Sub

'Private Sub grdCol_EnterCell()
'    clsBill.grdCol_EnterCell
'End Sub

Private Sub grdCol_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Not frmMain.ActiveForm Is Me Then
        On Error Resume Next
        Me.SetFocus
    End If
    If Not blnEdit And Button <> vbRightButton Then
        clsBill.bytRegion = FGrid1
        Exit Sub
    End If
    clsBill.GrdCol_Mouseup Button, Shift, x, y

End Sub

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

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 Not frmMain.ActiveForm Is Me Then
        On Error Resume Next
        Me.SetFocus
    End If
    If Not blnEdit And Button <> vbRightButton Then Exit Sub
    clsBill.LblBack_MouseUp Button
    
End Sub

Private Sub LblBack_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then
        MakeListEditMenu
        clsBill.MenuVisible = True
        PopupMenu frmMain.mnuListEdit
        clsBill.MenuVisible = 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 Not frmMain.ActiveForm Is Me Then
         On Error Resume Next
        Me.SetFocus
    End If
    If Not blnEdit And Button <> vbRightButton Then Exit Sub
    clsBill.Field_MouseUp Index, Button, x, y
End Sub


Private Sub lblField_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then
        MakeListEditMenu
        clsBill.MenuVisible = True
        PopupMenu frmMain.mnuListEdit
        clsBill.MenuVisible = False
    End If

End Sub

Private Sub lblFieldCaption_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If Not blnEdit Then Exit Sub
    clsBill.Field_MouseUp Index, Button, x, y
End Sub

Private Sub lblHead_Change(Index As Integer)
    
    If Index = 5 Then
        refTmpID_Change
    End If
    If Index = 1 Then
        lblField(0).Caption = strDetailMsg(C2lng(lblHead(0).Tag))
    End If
End Sub


Private Sub lblHead_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If Not frmMain.ActiveForm Is Me Then
         On Error Resume Next
        Me.SetFocus
    End If
    If Not blnEdit And Button <> vbRightButton Then Exit Sub
    Select Case Button
        Case vbRightButton
'            clsBill.bytRegion = FHead
'            clsBill.bytIndex = Index
            clsBill.UpdateMainEditMenu
            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
End Sub



Private Sub lblHead_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then
        MakeListEditMenu
        clsBill.MenuVisible = True
        PopupMenu frmMain.mnuListEdit
        clsBill.MenuVisible = False
    End If

End Sub

Private Sub LblMemo_Click(Index As Integer)
    If Not blnEdit Then Exit Sub
    clsBill.Memo_Click Index
End Sub


Private Sub mclsMainControl_FilePrint()
    CmdPrint_Click
End Sub

Private Sub mclsMainControl_FilePrintReceipt()
    If clsBill.blnIsChanged Then
        If SaveBill() = False Then Exit Sub
    End If
    frmPrintReceipt.ShowfrmPrintReceipt 34
End Sub

Private Sub mclsMainControl_ListActivityMenu(ByVal intIndex As Integer)

    Dim strMsg(5) As String
    Dim intYesNo As Integer
    Dim i%, j%
    strMsg(0) = "您确实要删除该条入库成本单的分录吗？"
    strMsg(1) = "您确实要删除该张入库成本单的全部分录吗？"
    strMsg(2) = "您确实要删除该条已经分摊入库成本单的分录吗？"
    strMsg(3) = "您确实要删除该张已经分摊入库成本单的全部分录吗？"
    Select Case intIndex
        Case 0  '插入记录
            clsBill.SaveInput2Form
            clsBill.InsertARow
            grdCol.col = 1
            clsBill.grdCol_EnterCell
        Case 1  '删除记录
            If clsBill.rowIsDone(grdCol.Row) Then
                intYesNo = clsBill.ShowMsgOther(Me.hwnd, strMsg(2), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "删除分录")
                If intYesNo = vbYes Then
'                    ClearSaveGoShare grdCol.Row
                End If
            Else
                intYesNo = clsBill.ShowMsgOther(Me.hwnd, strMsg(0), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "删除分录")
            End If
            If intYesNo = IDNO Then Exit Sub
            
            clsBill.blnDeleteARow grdCol.Row
'            clsBill.bytRegion = FcmdButton
'            clsBill.bytIndex = 0
'            clsBill.InputCtrInvisible
            clsBill.grdCol_EnterCell
        Case 2  'bar
        Case 3  '复制记录
            clsBill.CopyARow
        Case 4  '粘贴记录
            clsBill.PasteARow
        Case 5  'Bar
        Case 6  '搜索
            frmTreeFind.ShowFind
        Case 7  '查询缺号
            Dim frmTmp As Form
            Set frmTmp = New frmBillNo
            frmTmp.ShowTypeID C2lng(lblHead(2).Tag)
            Set frmTmp = Nothing
            
    End Select
    '合计行计算
    clsBill.WriteTotal
End Sub

Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
    Dim strMsg(5) As String
    Dim intYesNo As Integer
    Dim i%, j%
    Dim dtmDate1 As Date
    Dim recTmp As rdoResultset
    
    strMsg(0) = "您确实要删除该张入库成本单的全部分录吗？"
    strMsg(1) = "您确实要删除该张已经作废入库成本单的全部分录吗？"
    strMsg(2) = "您确实要删除该张已经分摊入库成本单的全部分录吗？"
    Select Case intIndex
'        Case 0  '插入单据
'            clsBill.GetANewBill lblHead(5 - 1).Tag, lblHead(3 - 1).Tag, lblField(1).Caption
'        Case 1  '删除单据
'            If clsLst.IsVoucher(clsBill.lngNowID) Then
'                clsbill.showmsgother Me.hWnd, strmsg(3), MB_ICONQUESTION + MB_DEFBUTTON1 + MB_SYSTEMMODAL, "删除入库成本单"
'                Exit Sub
'            End If
'            If chkPrint(1).Value = True Then
'                intYesNo = clsbill.showmsgother(Me.hwnd, strMsg(1), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "删除入库成本单")
'            Else
'                For i = 1 To grdCol.Rows - 1
'                    If clsBill.rowIsDone(i) Then Exit For
'                Next
'                If i = grdCol.Rows Then '未发现已分摊行
'                    intYesNo = clsbill.showmsgother(Me.hwnd, strMsg(0), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "删除入库成本单")
'                Else
'                    intYesNo = clsbill.showmsgother(Me.hwnd, strMsg(1), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "删除入库成本单")
'                End If
'            End If
'            If intYesNo = IDYES Then
''                clsBill.DeleteBill (clsBill.lngNowID)
'                Strsql = "DELETE * FROM CostPrice WHERE lngCostPriceID=" & clsBill.lngNowID
'                gclsBase.BaseDB.Execute Strsql
'                Strsql = "DELETE * FROM CostPriceDetail WHERE lngCostPriceID=" & clsBill.lngNowID
'                gclsBase.BaseDB.Execute Strsql
'                Strsql = "DELETE * FROM CostPriceToPurchase WHERE lngCostPriceID=" & clsBill.lngNowID
'                gclsBase.BaseDB.Execute Strsql
'            End If
'            ShowANewBill
'        Case 2  'BAR
        Case 0  '插入单据
            If clsBill.lngNowID = 0 And clsBill.blnIsChanged = False Then
                Exit Sub
            End If
'            clsBill.GetANewBill lblHead(5 - 1).Tag, lblHead(3 - 1).Tag, lblField(1).Caption
            ShowANewBill
        Case 1  '删除单据
            If clsBill.lngNowID = 0 And clsBill.blnIsChanged = False Then
                Exit Sub
            End If
            If clsBill.lngNowID <> 0 Then
               If clsBill.blnIsPrinted Then
                  If clsBill.blnModifyPrintedBill Then
                     If clsBill.ShowMsgOther(Me.hwnd, "本张" & lblCaption.Caption & "已经打印，您确实要删除吗？", MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL + MB_DEFBUTTON2, "删除单据") = vbNo Then
                        Exit Sub
                     End If
                  Else
                     clsBill.ShowMsgOther Me.hwnd, "本张" & lblCaption.Caption & "已经打印，不能删除！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL + MB_DEFBUTTON2, "删除单据"
                     Exit Sub
                  End If
               End If
                If blnBillIsClosed(32, clsBill.lngNowID) Then
                     clsBill.ShowMsgOther Me.hwnd, "本张入库成本单已经结帐，不能删除！", MB_OK + MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "删除单据"
                     Exit Sub
                End If
                If clsBill.ShowMsgOther(Me.hwnd, "您确实要删除本张已经分摊的入库成本单的全部分录吗？", MB_YESNO + MB_SYSTEMMODAL + MB_ICONQUESTION + MB_DEFBUTTON2, "删除单据") = vbYes Then
                    On Error GoTo errhandle1
                    gclsBase.BaseWorkSpace.BeginTrans
                    For i = 1 To grdCol.Rows - 1
                        If Trim(grdCol.TextMatrix(i, 0)) <> "" Then
                            If Not ClearSaveGoShare(i) Then
                                gclsBase.BaseWorkSpace.RollBacktrans
                                Exit Sub
                            End If
                        End If
                    Next
                    strSql = "DELETE FROM CostPrice WHERE lngCostPriceID=" & clsBill.lngNowID
                    gclsBase.BaseDB.Execute strSql
                    strSql = "DELETE FROM CostPriceDetail WHERE lngCostPriceID=" & clsBill.lngNowID
                    gclsBase.BaseDB.Execute strSql
'                    clsBill.GetANewBill lblHead(5 - 1).Tag, lblHead(3 - 1).Tag, lblField(1).Caption
                    dtmDate1 = C2Date(lblField(2).Caption)
'                    clsBill.intAccountYear = gclsBase.FYearOfDate(dtmDate1)   '会计年度
'                    clsBill.bytAccountPeriod = gclsBase.PeriodOfDate(dtmDate1)   '会计期间
                    blnMaxNODecrease gclsBase.FYearOfDate(NewReceiptDate), gclsBase.PeriodOfDate(NewReceiptDate), C2lng(lblHead(2).Tag), _
                        SubStr(strAlphaOfStr(LTrim(strNewReceiptNO)), 1, 6), _
                        strDigitOfStr(LTrim(strNewReceiptNO))

'                    strNewReceiptNO = lblField(1).Caption
'                    NewReceiptDate = gclsBase.BaseDate
'                    blnModifyMaxNO gclsBase.FYearOfDate(NewReceiptDate), gclsBase.PeriodOfDate(NewReceiptDate), C2lng(lblHead(2).Tag), _
'                       SubStr(strAlphaOfStr(LTrim(strNewReceiptNO)), 1, 6), _
'                       strDigitOfStr(LTrim(strNewReceiptNO))
                    
                    gclsBase.BaseWorkSpace.CommitTrans
                    gclsSys.SendMessage Me.hwnd, 30 + C2lng(lblHead(2).Tag)
'                    clsBill.lngNowID = 0
                    clsBill.blnIsChanged = False
                    cmdNext_Click
'                    ShowANewBill , False
                    Exit Sub
errhandle1:
                    gclsBase.BaseWorkSpace.RollBacktrans
                    Exit Sub
                End If
            Else
                If clsBill.ShowMsgOther(Me.hwnd, "您确实要删除本张入库成本单的全部分录吗？", MB_YESNO + MB_SYSTEMMODAL + MB_ICONQUESTION + MB_DEFBUTTON2, "删除单据") = vbYes Then
'                    clsBill.GetANewBill lblHead(5 - 1).Tag, lblHead(3 - 1).Tag, lblField(1).Caption
                    dtmDate1 = C2Date(lblField(2).Caption)
'                    clsBill.intAccountYear = gclsBase.FYearOfDate(dtmDate1)   '会计年度
'                    clsBill.bytAccountPeriod = gclsBase.PeriodOfDate(dtmDate1)   '会计期间
                    blnMaxNODecrease gclsBase.FYearOfDate(NewReceiptDate), gclsBase.PeriodOfDate(NewReceiptDate), C2lng(lblHead(2).Tag), _
                        SubStr(strAlphaOfStr(LTrim(strNewReceiptNO)), 1, 6), _
                        strDigitOfStr(LTrim(strNewReceiptNO))

                    strNewReceiptNO = lblField(1).Caption