frmstockbill.frm

金算盘软件代码

Private Sub CmdReceive_Click()
    With FrmPayment
        .Show
        .ZOrder
    End With
End Sub

Private Sub Form_Activate()
    If mclsMainControl Is Nothing Then
        Exit Sub
    End If
    SetHelpID Me.HelpContextID

    ResponseMessage
    If Not clsBill.blnBillCanChange() Then
        blnEdit = False
    Else
        blnEdit = True
    End If
    clsBill.SetBlnSelceted
    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
    gclsSys.CurrFormName = Me.hwnd
    
'    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 '接收到科目改变消息
            If blnEdit And clsBill.blnMayChange Then
                clsBill.AccountChanged
            End If
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除科目改变消息
        End If
        If vntMessage = Message.msgCustomer Then  '接收到单位改变消息
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除付款条件改变消息
            clsBill.setRefer 1
        End If
        If vntMessage = Message.msgItem Then   '接收到商品改变消息
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除付款条件改变消息
            clsBill.setRefer 2
        End If
        If vntMessage = 30 + C2lng(lblHead(2).Tag) Then
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除付款条件改变消息
            clsBill.ReGetBillNO
        End If
        
'        If vntMessage = Message.msgcurrency Then    '接收到币种改变消息
'
'        End If
    Next

End Sub

Private Sub grdCol_DblClick()
    #If conVersionType <> 16 Then
        If C2lng(lblHead(2).Tag) = 8 Then
            If clsBill.blnMayChange Then
                If UCase(TextOfGrid(GrdCol.Row, 47)) = "TRUE" Then
                    If frmInvoiceSelect.ShowMe(Me, Not clsBill.blnMayChange, GrdCol.Row) Then
                         clsBill.ModiRateReadOnly
                        clsBill.WriteTotalRow
                    End If
                End If
            End If
        End If
    #End If
End Sub

Private Sub GrdCol_Mouseup(Button As Integer, Shift As Integer, x As Single, y As Single)
'    If Not frmMain.ActiveForm Is Me Then
'        Me.SetFocus
'    End If

    clsBill.GrdCol_Mouseup Button, Shift, x, y
    If Button = vbRightButton Then
        MakeListActivityMenu
        clsBill.MenuVisible = True
        PopupMenu frmMain.mnuListActivity
        clsBill.MenuVisible = False
    End If
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

    clsBill.grdCol_MouseDown Button, Shift, x, y

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
    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
    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)
    clsBill.Field_MouseUp Index, Button, x, y
End Sub

Private Sub lblHead_Change(Index As Integer)
    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 And chkPrint(1).Value = 0  '设置作废按纽,已作废单据不能取消作废
            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 Not frmMain.ActiveForm Is Me Then
         On Error Resume Next
        Me.SetFocus
    End If
    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_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
    Select Case Button
        Case vbRightButton
            clsBill.bytRegion = FFooter
            clsBill.bytIndex = Index
            clsBill.UpdateMainEditMenu
            Exit Sub
        Case vbLeftButton
            If Index = 3 Then
                    If x >= LblMemo(Index).width - clsBill.DropButtonWidth And _
                       x <= LblMemo(Index).width And _
                       y >= 0 And _
                       y <= LblMemo(Index).Height Then
                        clsBill.Memo_Click Index, True
                    Else
                        clsBill.Memo_Click Index, False
                    End If
            Else
                clsBill.Memo_Click Index
            End If
            clsBill.UpdateMainEditMenu
    End Select
End Sub

Private Sub lblMemo_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 lblNote_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 Index < 2 Then Exit Sub
    Select Case Button
        Case vbRightButton
            clsBill.bytRegion = FNote
            clsBill.bytIndex = Index
            clsBill.UpdateMainEditMenu
            Exit Sub
        Case vbLeftButton
            If Index = 3 Or Index = 5 Then
                    If x >= lblNote(Index).width - clsBill.DropButtonWidth And _
                       x <= lblNote(Index).width And _
                       y >= 0 And _
                       y <= lblNote(Index).Height Then
                        clsBill.Note_Click Index, True
                    Else
                        clsBill.Note_Click Index, False
                    End If
            Else
                clsBill.Note_Click Index
            End If
'            clsBill.UpdateMainEditMenu
    End Select
End Sub

Private Sub lblNote_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 mclsMainControl_ChildActive()
    On Error Resume Next
    If mclsMainControl Is Nothing Then
        Exit Sub
    End If
    SetHelpID Me.HelpContextID
    ResponseMessage
    If Not clsBill.blnBillCanChange() Then
        blnEdit = False
    Else
        blnEdit = True
    End If
    gclsSys.CurrFormName = Me.hwnd
    clsBill.ReSetFocus
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_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_FilePrint()
    CmdPrint_Click
End Sub

Private Sub mclsMainControl_FilePrintReceipt()
    If clsBill.blnIsChanged Then
        If SaveBill() = False Then Exit Sub
    End If
    frmPrintReceipt.ShowfrmPrintReceipt C2lng(lblHead(2).Tag) - 1
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) = "确实要删除该条" & lblCaption.Caption & "分录吗?"
    strMsg1(1) = "确实要删除该条已经作废" & lblCaption.Caption & "分录吗?"
    strMsg1(2) = "该张" & lblCaption.Caption & "已经收款,删除将要影响对应的收款单记录,确实要删除该条" & lblCaption.Caption & "分录吗?"
    strMsg1(3) = "该张" & lblCaption.Caption & "已经生成记帐凭证,不能删除!"
    strMsg1(4) = "该张" & lblCaption.Caption & "已经生成记帐凭证,不能修改!"
    Select Case intIndex
        Case 0  '插入记录
            If Not clsBill.SaveInput2Form() Then
                Exit Sub
            End If
            clsBill.InsertARow
            GrdCol.col = 1
            clsBill.grdCol_EnterCell False
        Case 1  '删除记录
            If UCase(TextOfGrid(GrdCol.Row, 55)) = "TRUE" Then
                clsBill.ShowMsgOther Me.hwnd, "该条采购发票分录选择的单据已经生成凭证，不能删除！", MB_OK + MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "删除分录"