frmstartperiod.frm

金算盘软件代码

Private Sub LblBack_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If blnNotRaiseEvents Then Exit Sub
    If Button = vbRightButton Then
        clsBill.LblBack_MouseUp
        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 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
        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 Then Exit Sub
    clsBill.Field_MouseUp Index, Button, x, y
    blnNotRaiseEvents = True
    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
    Select Case Index
        Case 5
            refTmpID_Change
        Case 3
            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(5).Tag) = gclsBase.OperatorID Then
                clsBill.blnMayChange = True
            Else
                clsBill.blnMayChange = False
            End If
'            chkPrint(0).Enabled = clsBill.blnMayChange      '设置待打印按纽
            chkPrint(1).Enabled = clsBill.blnMayChange       '设置作废按纽
        
            clsBill.ReceiptTypeChange
        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.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 Then Exit Sub
    clsBill.Memo_Click Index
    blnNotRaiseEvents = True
    DoEvents
    blnNotRaiseEvents = False
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_EditSearch()
    frmTreeFind.ShowFind
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%
    
    strMsg1(0) = "确实要删除该条商品期初分录吗？"
    strMsg1(1) = "确实要删除该条已经作废商品期初分录吗？"
    
        
    clsBill.blnKeyDown = False
    Select Case intIndex
        Case 0  '插入记录
            If Not clsBill.CHK_CLICK(0) Then Exit Sub
            clsBill.InsertARow
            GrdCol.col = 1
            clsBill.grdCol_EnterCell False
        Case 1  '删除记录
            If chkPrint(1).Value = True Then
                intYesNo = ShowMsg(Me.hWnd, strMsg1(1), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "删除分录")
            ElseIf C2Dbl(clsBill.TextMatrix(GrdCol.Row, 44)) > 0 Then
                    ShowMsg Me.hWnd, "本条分录已有对应出库记录，不能删除！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "删除分录"
                    clsBill.SetAFocus
                    Exit Sub
            Else
                intYesNo = ShowMsg(Me.hWnd, strMsg1(0), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "删除分录")
            End If
            If intYesNo = IDYES Then
                clsBill.blnCtrlBinding = False
                If Not clsBill.blnDeleteARow(GrdCol.Row) Then
                    ShowMsg Me.hWnd, "删除当前分录失败！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "删除分录"
                    clsBill.SetAFocus
                    Exit Sub
                End If
                clsBill.blnCtrlBinding = True
                clsBill.grdCol_EnterCell
                clsBill.BuildNoteMsg True
                clsBill.WriteTotalRow
           Else
                clsBill.SetAFocus
           End If
        Case 2, 5 'bar
        Case 3  '复制记录
            clsBill.CopyARow
        Case 4  '粘贴记录
            clsBill.PasteARow
            clsBill.BuildNoteMsg True
        Case 6  '搜索
            frmTreeFind.ShowFind
        Case 7  '查询缺号
             frmBillNo.ShowTypeID C2lng(lblHead(2).Tag)
             If clsBill.lngNowID > 0 Then
                lblField(1).Caption = GetReceiptNo(99, clsBill.lngNowID)
             End If
             clsBill.SetAFocus
'             Dim frmDlg As New frmBillNo
'             frmDlg.ShowTypeID ReceiptTypeID
        Case 8  '模板表体列宽恢复
            ModifyColWidthDefault Me
            clsBill.TemplateChange C2lng(lblHead(4).Tag)
    End Select
    If intIndex < 4 Then
        MakeListActivityMenu
    End If
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) = "确实要删除该张已经作废商品期初单全部记录吗?"
    clsBill.blnKeyDown = False
    Select Case intIndex
        Case 0  '插入单据
            If clsBill.SaveInput2Form(True) = False Then Exit Sub
            clsBill.CHK_CLICK (9)
            If clsBill.lngNowID = 0 And clsBill.blnIsChanged = False Then Exit Sub
            ShowANewTypeBill C2lng(lblHead(2).Tag)
        Case 1  '删除单据
                If Not clsLst.DeleteStartPeriod(clsBill.lngNowID, False) Then
                    clsBill.SetAFocus
                    Exit Sub
                Else
                    gclsSys.SendMessage Me.hWnd, 30 + C2lng(lblHead(2).Tag)
                    gclsSys.SendMessage Me.hWnd, msgItem
                    
                    Dim dtmDate1 As Date
                    dtmDate1 = C2Date(lblField(2).Caption)
                    clsBill.intAccountYear = 0 'gclsBase.FYearOfDate(dtmDate1)   '会计年度
                    clsBill.bytAccountPeriod = 0 ' gclsBase.PeriodOfDate(dtmDate1)   '会计期间
                    blnMaxNODecrease clsBill.intAccountYear, clsBill.bytAccountPeriod, C2lng(lblHead(2).Tag), strAlphaOfStr(lblField(1).Caption), C2lng(strDigitOfStr(lblField(1).Caption))
                    
                    clsBill.blnIsChanged = False
                    cmdNext_Click
                End If
        Case 2, 5 'BAR
        Case 3  '复制单据
            clsBill.SaveBillToCollection
            MakeListEditMenu
            clsBill.SetAFocus
        Case 4  '粘贴单据
            clsBill.LoadBillFromCollection
            MakeListEditMenu
            clsBill.SetAFocus
        Case 6  '搜索
            frmTreeFind.ShowFind
        Case 7  '查询单据缺号
             frmBillNo.ShowTypeID C2lng(lblHead(2).Tag)
            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 C2lng(lblHead(2).Tag), False
End Sub
Private Sub mclsMainControl_EditFilter()
    CallBillList C2lng(lblHead(2).Tag), 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(C2lng(lblHead(2).Tag), clsBill.lngNowID, Me.hWnd, , clsBill.intAccountYear, clsBill.bytAccountPeriod)
    Else
        lngOldID = frmWriteOffBill.SeekBill(C2lng(lblHead(2).Tag), 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

'ID号变化(单据修改进入时有效)
Public Sub ShowAOldBill(ByVal ActivityID As Long)
    On Error GoTo ErrHandle
    blnNotRaiseEvents = True
    frmMain.Enabled = False
    If chkPrint(0).Visible Then
    End If
    frmMain.Enabled = True
    If clsBill Is Nothing Then
        blnNotRaiseEvents = False
        Exit Sub
    End If
    If ActivityID = 0 Then
        ShowANewBill
        blnNotRaiseEvents = False
        Unload MsgForm
        Exit Sub
    End If
    
    If Me.Visible Then
        Me.ZOrder
        If clsBill.cmdButton_Click(0) = False Then
            blnNotRaiseEvents = False
            Unload MsgForm
            Exit Sub
        End If
    End If
    If clsBill.blnIsChanged Then
        Me.ZOrder 0
        If Not ChangeSaveNote() Then
            blnNotRaiseEvents = False
            Unload MsgForm
            Exit Sub
        End If
    End If
    
    clsBill.blnRefresh = False
    clsBill.lngNowID = ActivityID
    Debug.Print "loadbill" & Time
    clsBill.ClearRowProperty
    LoadBill clsBill.lngNowID
    If clsBill.lngNowID = 0 Then
        GoTo ErrHandle
    End If
    Debug.Print "loadbill" & Time
    clsBill.blnRefresh = True
    clsBill.blnMayChange = True

    blnEdit = IsCanDo(EditNO(C2lng(lblHead(2).Tag)))   '设置blnEdit标志
    blnView = IsCanDo(EditNO(C2lng(lblHead(2).Tag), False))   '设置blnView标志
    If blnEdit = False And blnView = False Then
        Unload MsgForm
        Unload Me
        Exit Sub
    End If
    '设置可修改标志
'    If clsBill.lngNowID > 0 And lngVoucherID > 0 Then
'        clsBill.blnMayChange = False '已生成记帐凭证不可修改
'    Else
'    chkPrint(1).Visible = True
    If blnEdit And C2lng(LblMemo(5).Tag) = gclsBase.OperatorID Then
        If intBillState > 0 Then
            clsBill.blnMayChange = False