frmadjust.frm

金算盘软件代码

    blnNotRaiseEvents = True
    clsBill.Field_MouseUp Index, Button, x, y
    
    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
    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 = True Then Exit Sub
    blnNotRaiseEvents = True
    clsBill.Field_MouseUp Index, Button, x, y
    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
    End If
    blnNotRaiseEvents = True
    DoEvents
    blnNotRaiseEvents = 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
End Sub


Private Sub lblHead_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If blnNotRaiseEvents = True Then Exit Sub
    Select Case Button
        Case vbRightButton
            clsBill.UpdateMainEditMenu
            MakeListEditMenu
            clsBill.blnNotRespondKeyPress = True
            PopupMenu frmMain.mnuListEdit
            If clsBill Is Nothing Then
                blnNotRaiseEvents = False
                Exit Sub
            End If
            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_Click(Index As Integer)
    If blnNotRaiseEvents = True Then Exit Sub
    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_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
End Sub

Private Sub mclsMainControl_EditInsLine()
    mclsMainControl_ListActivityMenu (0)
End Sub

Private Sub mclsMainControl_EditNew()
   mclsMainControl_ListEditMenu (0)
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_ListActivityMenu(ByVal intIndex As Integer)
    Dim strMsg(5) As String, strMsg1(5) As String
    Dim intYesNo As Integer
    Dim i%, j%
    clsBill.CHK_CLICK 0
    strMsg1(0) = "确实要删除该条调拨单记录吗?"
    strMsg1(1) = "确实要删除该条已经作废调拨单记录吗?"
    strMsg1(2) = "该张调拨单已经收款,删除将要影响对应的收款单记录,确实要删除该条调拨单记录吗?"
    strMsg1(3) = "该张调拨单已经生成记帐凭证,不能删除!"
    strMsg1(4) = "该张调拨单已经生成记帐凭证,不能修改!"
    Select Case intIndex
        Case 0  '插入记录
            clsBill.InsertARow
            GrdCol.col = 1
            clsBill.grdCol_EnterCell
            MakeListActivityMenu
            clsBill.blnIsChanged = True
        Case 1  '删除记录
            If chkPrint(1).Value = True Then
                intYesNo = ShowMsg(Me.hWnd, strMsg1(1), MB_YESNO + MB_ICONQUESTION + 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
                
                '10月19日修改处
               '----------------------------------------------------
                arrDeleteActivityDetailID = arrDeleteActivityDetailID & "," & C2lng(GrdCol.TextMatrix(GrdCol.Row, 0))
                arrDeleteActivityDetailID = arrDeleteActivityDetailID & "," & C2lng(GrdCol.TextMatrix(GrdCol.Row, 26))
               '----------------------------------------------------
                
                clsBill.blnCtrlBinding = False
                If GrdCol.Row >= 1 And GrdCol.Rows > 2 Then
                    GrdCol.RemoveItem GrdCol.Row
                ElseIf GrdCol.Row >= 1 Then
                        If GrdCol.Rows = 2 Then
                            GrdCol.Rows = 1
                            clsBill.lngOldRow = 0
                        Else
                            GrdCol.RemoveItem GrdCol.Row
                        End If
                    End If
                clsBill.blnIsChanged = True
                clsBill.blnCtrlBinding = True
                clsBill.grdCol_EnterCell
                clsBill.BuildNoteMsg True
                clsBill.WriteTotalRow
                MakeListActivityMenu
            Else
                clsBill.SetAFocus
            End If
        Case 2  'bar
        Case 3  '复制记录
            clsBill.CopyARow
            clsBill.grdCol_EnterCell
            MakeListActivityMenu
        Case 4  '粘贴记录
            clsBill.PasteARow
            clsBill.grdCol_EnterCell
            MakeListActivityMenu
        Case 5  'Bar
        Case 6  '搜索
            frmTreeFind.ShowFind
        Case 7  '查询缺号
            frmBillNo.ShowTypeID ReceiptTypeID
            If clsBill.lngNowID > 0 Then
                lblField(1).Caption = GetReceiptNo(99, clsBill.lngNowID)
            End If
            clsBill.SetAFocus
    End Select
End Sub

Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
    Dim strMsg(5) As String
    Dim intYesNo As Integer
    Dim i%, j%
    
    strMsg(0) = "确实要删除该张调拨单全部记录吗?"
    strMsg(1) = "确实要删除该张已经作废调拨单全部记录吗?"
    strMsg(2) = "该张调拨单已经收款,删除将要影响对应的收款单记录,确实要删除该张调拨单全部记录吗?"
    strMsg(3) = "该张调拨单已经生成记帐凭证,不能删除!"
    strMsg(4) = "该张调拨单已经生成记帐凭证,不能修改!"
    
    Select Case intIndex
        Case 0  '插入单据
            clsBill.CHK_CLICK 9
            If clsBill.blnIsChanged Then
                If ChangeSaveNote = False Then Exit Sub
            ElseIf clsBill.lngNowID = 0 Then
                Exit Sub
            End If
'            clsBill.GetANewBill lblHead(5 - 1).Tag, lblHead(3 - 1).Tag, lblField(1).Caption
            ShowANewBill
        Case 1  '删除单据
            Dim mclsAdjust  As New clsAdjust
            If Not mclsAdjust.DeleteAdjust(m_lngInActivityID) Then Exit Sub
            clsBill.blnIsChanged = False
            cmdNext_Click
            'ShowANewBill
            gclsSys.SendMessage Me.hWnd, 58
        Case 2  'BAR
        Case 3  '复制单据
            clsBill.SaveBillToCollection
            MakeListEditMenu
            clsBill.SetAFocus
        Case 4  '粘贴单据
            clsBill.LoadBillFromCollection
            MakeListEditMenu
            clsBill.SetAFocus
        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(99, clsBill.lngNowID)
            End If
            clsBill.SetAFocus
        Case 8  '模板表体列宽恢复
            ModifyColWidthDefault Me
            clsBill.TemplateChange C2lng(lblHead(4).Tag)
            clsBill.SetAFocus
        Case 10 '筛选
            mclsMainControl_EditFilter
        Case 11 'LIST
            mclsMainControl_ReceiptList
        Case 12 'go
            mclsMainControl_ReceiptPosition
        Case 13
            mclsMainControl_FilePrintReceipt
    End Select
End Sub
Private Sub mclsMainControl_ReceiptList()
    CallBillList 28, False
End Sub

Private Sub mclsMainControl_EditFilter()
    CallBillList 28, True
End Sub

Private Sub mclsMainControl_ReceiptPosition()
    BuildCancelBill False
End Sub
'单据冲销
Private Sub BuildCancelBill(Optional ByVal GenCancel As Boolean = True)
    Dim lngOldID As Long
    
    clsBill.blnKeyDown = False
    If ChangeSaveNote() = False Then
        Exit Sub
    End If
    If GenCancel Then
        lngOldID = frmWriteOffBill.WriteOffBill(28, clsBill.lngNowID, Me.hWnd, , clsBill.intAccountYear, clsBill.bytAccountPeriod)
    Else
        lngOldID = frmWriteOffBill.SeekBill(28, clsBill.lngNowID, Me.hWnd, , clsBill.intAccountYear, clsBill.bytAccountPeriod)
    End If
    If lngOldID = 0 Then
    Else
        ShowAOldBill lngOldID
    End If
End Sub
Private Sub refTmpID_Change()
    clsBill.TemplateChange C2lng(lblHead(4).Tag)
End Sub

'
' 编辑菜单
Private Sub MakeListEditMenu()
    Dim intCnt As Integer
    
    clsBill.UpdateMainEditMenu
    With frmMain
        For intCnt = .mnuListEditMenu.Count - 1 To 1 Step -1
            Unload .mnuListEditMenu(intCnt)
        Next
        Load .mnuListEditMenu(1)
        
        Load .mnuListEditMenu(2)
        Load .mnuListEditMenu(3)
        Load .mnuListEditMenu(4)
        Load .mnuListEditMenu(5)
        Load .mnuListEditMenu(6)
        Load .mnuListEditMenu(7)
        Load .mnuListEditMenu(8)
        Load .mnuListEditMenu(9)
        Load .mnuListEditMenu(10)
        Load .mnuListEditMenu(11)
        Load .mnuListEditMenu(12)
        Load .mnuListEditMenu(13)
        .mnuListEditMenu(13).Caption = "成批打印(&Y)"        '
        .mnuListEditMenu(13).Enabled = True
        
        Utility.CloneMenu .mnuEditNew, .mnuListEditMenu(0)
        Utility.CloneMenu .mnuEditDel, .mnuListEditMenu(1)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(2)
        Utility.CloneMenu .mnuEditCopy, .mnuListEditMenu(3)
        Utility.CloneMenu .mnuEditPaste, .mnuListEditMenu(4)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(5)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(9)
        .mnuListEditMenu(3).Caption = "复制单据(&C)"
        .mnuListEditMenu(4).Caption = "粘贴单据(&P)"
        .mnuListEditMenu(3).Visible = True
        .mnuListEditMenu(3).Enabled = True
        .mnuListEditMenu(4).Visible = True
        If clsBill.CollectionNotEmpty = False Then
            .mnuListEditMenu(4).Enabled = False
        ElseIf chkPrint(1).Value = 1 Or clsBill.blnMayChange = False Then
            .mnuListEditMenu(4).Enabled = False
        Else
            .mnuListEditMenu(4).Enabled = True
        End If
        
        
        .mnuListEditMenu(5).Visible = True
        Utility.CloneMenu .mnuEditSearch, .mnuListEditMenu(6)       ' 搜索
        .mnuListEditMenu(7).Caption = "编号查询及整理(&Q)"
        .mnuListEditMenu(7).Enabled = True
        .mnuListEditMenu(8).Caption = "单据模板表体列宽恢复(&W)"
        .mnuListEditMenu(8).Enabled = True
        .mnuListEditMenu(10).Caption = "筛选(&F)"        '
        .mnuListEditMenu(10).Enabled = True
        .mnuListEditMenu(11).Caption = "单据列表(&L)"        '
        .mnuListEditMenu(11).Enabled = True
        .mnuListEditMenu(12).Caption = "单据定位(&B)"        '
        .mnuListEditMenu(12).Enabled = True
        .SetToolBar True
    End With
End Sub
'业务菜单
Private Sub MakeListActivityMenu()
    Dim intCnt As Integer
    
    clsBill.UpdateMainEditMenu
    With frmMain
        For intCnt = .mnuListActivityMenu.Count - 1 To 1 Step -1
            Unload .mnuListActivityMenu(intCnt)
        Next
        Load .mnuListActivityMenu(1)
        Load .mnuListActivityMenu(2)
        Load .mnuListActivityMenu(3)
        Load .mnuListActivityMenu(4)
        Load .mnuListActivityMenu(5)
        Load .mnuListActivityMenu(6)
 '       Load .mnuListActivityMenu(7)
        
        Utility.CloneMenu .mnuEditInsLine, .mnuListActivityMenu(0)
        Utility.CloneMenu .mnuEditDelLine, .mnuListActivityMenu(1)
        Utility.CloneMenu .mnuEditBar2, .mnuListActivityMenu(2)

        .mnuListActivityMenu(2).Visible = True
        .mnuListActivityMenu(3).Caption = "复制记录(&C)"
        .mnuListActivityMenu(4).Caption = "粘贴记录(&P)"
        If GrdCol.Rows <= 1 Then
            .mnuListActivityMenu(3).Enabled = False
        Else
            .mnuListActivityMenu(3).Enabled = True