frminvoice.frm

金算盘软件代码

    If Button = vbRightButton Then
        MakeListActivityMenu
        clsBill.blnNotRespondKeyPress = True
        PopupMenu frmMain.mnuListActivity
        clsBill.blnNotRespondKeyPress = False
    End If
    clsBill.blnGrdCellDoing = True
    DoEvents
    clsBill.blnGrdCellDoing = False
End Sub

Private Sub GrdCol_RowColChange()
    clsBill.GrdCol_RowColChange
End Sub

Private Sub grdCol_Scroll()
    clsBill.grdCol_Scroll
End Sub

Private Sub imgPicDown_Click(Index As Integer)
   clsBill.picLblInput_Getfocus Index, True
End Sub

Private Sub LblBack_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If clsBill Is Nothing Then Exit Sub
    If clsBill.blnGrdCellDoing Then Exit Sub
    clsBill.LblBack_MouseUp
    If Button = vbRightButton Then
        clsBill.blnGrdCellDoing = True
        MakeListEditMenu
        clsBill.blnNotRespondKeyPress = True
        PopupMenu frmMain.mnuListEdit
        clsBill.blnNotRespondKeyPress = False
        clsBill.blnGrdCellDoing = True
        DoEvents
        clsBill.blnGrdCellDoing = 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 clsBill Is Nothing Then Exit Sub
    If clsBill.blnGrdCellDoing Then Exit Sub
    clsBill.blnGrdCellDoing = True
    clsBill.Field_MouseUp Index, Button, x, y
    
    If Button = vbRightButton Then
        MakeListEditMenu
        clsBill.blnNotRespondKeyPress = True
        PopupMenu frmMain.mnuListEdit
        clsBill.blnNotRespondKeyPress = False
    End If
    clsBill.blnGrdCellDoing = True
    DoEvents
    clsBill.blnGrdCellDoing = False
    
End Sub


Private Sub lblFieldCaption_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If clsBill Is Nothing Then Exit Sub
    If clsBill.blnGrdCellDoing Then Exit Sub
    clsBill.blnGrdCellDoing = True
    clsBill.Field_MouseUp Index, Button, 0, 0
    
    If Button = vbRightButton Then
        MakeListEditMenu
        clsBill.blnNotRespondKeyPress = True
        PopupMenu frmMain.mnuListEdit
        clsBill.blnNotRespondKeyPress = False
    End If
    clsBill.blnGrdCellDoing = True
    DoEvents
    clsBill.blnGrdCellDoing = False
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
    If Index = 3 Then
        If C2lng(lblHead(2).Tag) = 0 Then Exit Sub
        blnEdit = IsCanDo(EditNO(C2lng(lblHead(2).Tag)))   '设置blnEdit标志
        blnView = IsCanDo(EditNO(C2lng(lblHead(2).Tag), False))   '设置blnView标志
        '设置可修改标志
        If blnEdit And C2lng(LblMemo(3).Tag) = gclsBase.OperatorID Then
            clsBill.blnMayChanged = True
        Else
            clsBill.blnMayChanged = False
        End If
        chkPrint(0).Enabled = clsBill.blnMayChanged      '设置待打印按纽
        chkPrint(1).Enabled = clsBill.blnMayChanged       '设置作废按纽
    End If
End Sub


Private Sub lblHead_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If clsBill Is Nothing Then Exit Sub
    If clsBill.blnGrdCellDoing Then Exit Sub
    clsBill.blnGrdCellDoing = True
    Select Case Button
        Case vbRightButton
            clsBill.UpdateMainEditMenu
            MakeListEditMenu
            clsBill.blnNotRespondKeyPress = True
            PopupMenu frmMain.mnuListEdit
            clsBill.blnNotRespondKeyPress = False
            GoTo EndProc
        Case vbLeftButton
            If (Index \ 2) * 2 = Index Then GoTo EndProc
            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
EndProc:
    clsBill.blnGrdCellDoing = True
    DoEvents
    clsBill.blnGrdCellDoing = False
End Sub

Private Sub lblInput_Click(Index As Integer)
     clsBill.picLblInput_Getfocus Index, False
End Sub


Private Sub LblMemo_Click(Index As Integer)
    clsBill.Memo_Click Index
End Sub

Private Sub mclsMainControl_ChildActive()
    SetHelpID C2lng(Me.HelpContextID)
    ResponseMessage
    gclsSys.CurrFormName = Me.hwnd
    clsBill.UpdateMainEditMenu
    If WanNeng Then
        tblReceipt.Refresh
    End If
End Sub

Private Sub mclsMainControl_EditCopy()
    mclsMainControl_ListEditMenu (3)
End Sub

Private Sub mclsMainControl_EditDel()
   mclsMainControl_ListEditMenu (1)
End Sub

Private Sub mclsMainControl_EditDelLine()
    mclsMainControl_ListActivityMenu (1)
End Sub

Private Sub mclsMainControl_EditInActive()
    If chkPrint(1).Value <> 0 Then
        chkPrint(1).Value = 0
    Else
        chkPrint(1).Value = 1
    End If
'    frmMain.mnuEditInActive.Checked = chkPrint(1).Value
    clsBill.UpdateMainEditMenu
End Sub

Private Sub mclsMainControl_EditInsLine()
    mclsMainControl_ListActivityMenu (0)
End Sub

Private Sub mclsMainControl_EditNew()
   mclsMainControl_ListEditMenu (0)
End Sub

Private Sub mclsMainControl_EditPaste()
    mclsMainControl_ListEditMenu (4)
End Sub

Private Sub mclsMainControl_EditSearch()
    mclsMainControl_ListEditMenu (6)
End Sub

Private Sub mclsMainControl_EditShowAll()
    If chkPrint(0).Value <> 0 Then
        chkPrint(0).Value = 0
    Else
        chkPrint(0).Value = 1
    End If
End Sub

Private Sub mclsMainControl_EditShowList()
    ShowRelationList
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 mclsMainControl_ListActivityMenu(ByVal intIndex As Integer)
    Dim strMsg(5) As String, strMsg1(5) As String
    Dim intYesNo As Integer
    Dim i%, j%
    strMsg1(0) = "确实要删除该条应收单记录吗?"
    strMsg1(1) = "确实要删除该条已经作废应收单记录吗?"
    strMsg1(2) = "该张应收单已经收款,删除将要影响对应的收款单记录,确实要删除该条应收单记录吗?"
    strMsg1(3) = "该张应收单已经生成记帐凭证,不能删除!"
    strMsg1(4) = "该张应收单已经生成记帐凭证,不能修改!"
    clsBill.blnKeyDown = False
    Select Case intIndex
        Case 0  '插入记录
            clsBill.InsertTheRow
        Case 1  '删除记录
            If clsBill.lngNowID > 1 Then
                If clsLst.IsVoucher(clsBill.lngNowID) = 1 Then
                    ShowMsg Me.hwnd, strMsg1(3), MB_ICONQUESTION + MB_DEFBUTTON1 + MB_SYSTEMMODAL, "警告信息"
                    Exit Sub
                End If
            End If
            If chkPrint(1).Value = 1 Then
                intYesNo = ShowMsg(Me.hwnd, strMsg1(1), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息")
            ElseIf BillPublic.ActivityIsHX(clsBill.lngNowID) Then
                intYesNo = ShowMsg(Me.hwnd, strMsg1(2), MB_YESNO + MB_ICONEXCLAMATION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "警告信息")
            Else
            intYesNo = ShowMsg(Me.hwnd, strMsg1(0), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息")
            End If
            If intYesNo = IDYES Then
                clsBill.DelTheRow
            End If
        Case 2  'bar
        Case 3  '复制记录
            clsBill.CopyTheRow
        Case 4  '粘贴记录
            clsBill.PasteTheRow
        Case 5  'Bar
        Case 6  '搜索
            frmTreeFind.ShowFind
            If clsBill.bytRegion = FPicture Then
                GrdCol.Refresh
            End If
        Case 7  '查询缺号
            frmBillNo.ShowTypeID C2lng(lblHead(3 - 1).Tag)
            If clsBill.lngNowID > 0 Then
                lblField(1).Caption = GetReceiptNo(40, clsBill.lngNowID)
            End If
            If clsBill.bytRegion = FPicture Then
                GrdCol.Refresh
            End If
            clsBill.SetAFocus
        Case 9  'Sound
            clsBill.blnSound = Not clsBill.blnSound
            SaveSetting App.title, "14" + CStr(gclsBase.OperatorID), "Sound_Invoice", IIf(clsBill.blnSound, "True", "False")
        Case 10 'Tell
            clsBill.blnTell = Not clsBill.blnTell
            SaveSetting App.title, "14" + CStr(gclsBase.OperatorID), "Tell_Invoice", IIf(clsBill.blnTell, "True", "False")
        Case 12 '金额线显示变化
            clsBill.CashLineDisplay
    End Select
End Sub

Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
    Dim strMsg(5) As String
    Dim intYesNo As Integer
    Dim intK As Integer
    Dim i%, j%
    strMsg(0) = "确实要删除该张应收单全部记录吗?"
    strMsg(1) = "确实要删除该张已经作废的应收单吗?"
    strMsg(2) = "该张应收单已经收款,删除将要影响对应的收款单记录,确实要删除该张应收单全部记录吗?"
    strMsg(3) = "该张应收单已经生成记帐凭证,不能删除!"
    strMsg(4) = "该张应收单已经生成记帐凭证,不能修改!"
    clsBill.blnKeyDown = False
    Select Case intIndex
        Case 0, 3, 4
            If clsBill.cmdButton_Click(0) = False Then Exit Sub
        Case 1
            If clsBill.SaveInput2Form = False Then Exit Sub
    End Select
    Select Case intIndex
        Case 0  '插入单据
            If clsBill.lngNowID = 0 And clsBill.blnIsChanged = False Then Exit Sub
            If Not ChangeSaveNote() Then Exit Sub
            ShowANewBill
            'clsBill.GetANewBill lblHead(5 - 1).Tag, lblHead(3 - 1).Tag, lblField(1).Caption
        Case 1  '删除单据
            clsLst.theType = 3
            intK = clsLst.IsVoucher(clsBill.lngNowID)
            If intK = 1 Then
                ShowMsg Me.hwnd, strMsg(3), MB_ICONQUESTION + MB_DEFBUTTON1 + MB_SYSTEMMODAL, "警告信息"
                Exit Sub
            ElseIf intK = -1 Then
                clsBill.lngNowID = 0
                Exit Sub
            End If
            If chkPrint(1).Value = 1 Then
                intYesNo = IDYES 'ShowMsg(Me.hwnd, strMsg(1), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息")
            ElseIf BillPublic.ActivityIsHX(clsBill.lngNowID) Then
                intYesNo = ShowMsg(Me.hwnd, strMsg(2), MB_YESNO + MB_ICONEXCLAMATION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "警告信息")
            Else
'                intYesNo = ShowMsg(Me.hwnd, strMsg(0), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息")
                intYesNo = IDYES
            End If
            If intYesNo = IDYES Then
                If clsBill.DelTheBill(clsBill.lngNowID, 3) Then
                    cmdNext_Click
                Else
'                    ShowMsg Me.hwnd, "删除失败", MB_ICONQUESTION + MB_DEFBUTTON1 + MB_SYSTEMMODAL, "警告信息"
                    clsBill.SetAFocus
                     Exit Sub
                End If
            Else
                clsBill.SetAFocus
            End If
        Case 2  'BAR
        Case 3  '复制单据
            clsBill.SaveBillToCollection
        Case 4  '粘贴单据
            clsBill.LoadBillFromCollection
        Case 5  'BAR
        Case 6  '搜索
            frmTreeFind.ShowFind
        Case 7  '查询单据缺号
            frmBillNo.ShowTypeID C2lng(lblHead(3 - 1).Tag)  'ReceiptTypeID
            If clsBill.lngNowID > 0 Then
                lblField(1).Caption = GetReceiptNo(40, clsBill.lngNowID)
            End If
            clsBill.SetAFocus
        Case 9  'ModifyColWidthDefault
            BillPublic.ModifyColWidthDefault Me
            clsBill.TemplateChange C2lng(lblHead(4).Tag)
            picFooter.Refresh
            clsBill.SetAFocus
        Case 11 'Sound
            clsBill.blnSound = Not clsBill.blnSound
            SaveSetting App.title, "14" + CStr(gclsBase.OperatorID), "Sound_Invoice", IIf(clsBill.blnSound, "True", "False")
        Case 12 'Tell
            clsBill.blnTell = Not clsBill.blnTell
            SaveSetting App.title, "14" + CStr(gclsBase.OperatorID), "Tell_Invoice", IIf(clsBill.blnTell, "True", "False")
        Case 14 '金额线显示变化
            clsBill.CashLineDisplay
        Case 16 '筛选
            mclsMainControl_EditFilter
        Case 17 'LIST
            mclsMainControl_ReceiptList
        Case 18 'Go
            mclsMainControl_ReceiptPosition
        Case 19
            mclsMainControl_FilePrintReceipt
    End Select
End Sub
Private Sub mclsMainControl_ReceiptList()
    CallBillList C2lng(lblHead(2).Tag)
End Sub
Private Sub mclsMainControl_EditFilter()
    CallBillList C2lng(l