frmtakestock.frm

金算盘软件代码

    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 = 63 Then
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除付款条件改变消息
            clsBill.ReGetBillNO
        End If
    Next

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.BuildNoteMsg
    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 IsCanDo(EditNO(C2lng(lblHead(2).Tag))) Then
        clsBill.LblBack_MouseUp Button
    End If
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)
    Select Case Index
        Case 5
            refTmpID_Change
        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
    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_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 = 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 Not blnEdit And Button <> vbRightButton Then Exit Sub
    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
    gclsSys.CurrFormName = Me.hwnd
    clsBill.ReSetFocus
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 33

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(3) = "该张商品盘点单已经盘点处理，不能删除其中的分录！"
    strMsg1(4) = "该张商品盘点单已经盘点处理，不能修改其中的分录！"
    Select Case intIndex
        Case 0  '插入记录
            If blnRowIsDone(GrdCol.Row) Then
                clsBill.ShowMsgOther Me.hwnd, strMsg1(4), MB_ICONQUESTION + MB_DEFBUTTON1 + MB_SYSTEMMODAL, "修改分录"
                Exit Sub
            End If
            clsBill.SaveInput2Form
            clsBill.InsertARow
            GrdCol.col = 1
            clsBill.grdCol_EnterCell
        Case 1  '删除记录
            If clsBill.lngNowID <> 0 Then
                If Not cmdButton(6).Enabled Then
                    clsBill.ShowMsgOther Me.hwnd, strMsg1(3), MB_ICONQUESTION + MB_DEFBUTTON1 + MB_SYSTEMMODAL, "删除分录"
                    Exit Sub
                End If
            End If
            If chkPrint(1).Value = True Then
                intYesNo = clsBill.ShowMsgOther(Me.hwnd, strMsg1(1), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "删除分录")
            Else
                intYesNo = clsBill.ShowMsgOther(Me.hwnd, strMsg1(0), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "删除分录")
            End If
            If intYesNo = IDYES Then
                clsBill.blnCtrlBinding = False
                If GrdCol.Row >= 1 And GrdCol.Rows > 2 Then
                    GrdCol.RemoveItem GrdCol.Row
                    clsBill.setAllItemproperty
                    GrdCol.col = xlngColNo(1)
                ElseIf GrdCol.Row = 1 Then
                    GrdCol.Rows = 1
                    clsBill.InsertARow False
                    GrdCol.Row = 1
                    GrdCol.col = xlngColNo(1)
                    clsBill.setAllItemproperty
                End If
                clsBill.blnCtrlBinding = True
                clsBill.blnIsChanged = True
                clsBill.lngOldRow = -1
                clsBill.grdCol_EnterCell
                clsBill.BuildNoteMsg True
'                For i% = 1 To grdCol.Cols - 1
'                    If grdCol.ColAlignment(i%) = 7 Then lblTotal(i%).Caption = CStr(clsBill.dblTotalOfCol(i%))
'                Next i%
                                
           End If
        Case 2  'bar
        Case 3  '复制记录
            clsBill.CopyARow
        Case 4  '粘贴记录
            If clsBill.PasteARow() Then
               reCalculate GrdCol.Row
            End If
        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 dtmDate1 As Date
    Dim i%, j%
    Select Case intIndex
        Case 0  '插入单据
'            clsBill.GetANewBill lblHead(5 - 1).Tag, lblHead(3 - 1).Tag, lblField(1).Caption
            If clsBill.lngNowID = 0 And clsBill.blnIsChanged = False Then
                Exit Sub
            End If
            ShowANewBill
            blnIsPost = False
        Case 1  '删除单据
            If clsBill.lngNowID = 0 And clsBill.blnIsChanged = False Then
                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
'                intYesNo = clsbill.showmsgother(Me.hwnd, strMsg(0), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "删除分录")
'            End If
'            If intYesNo = IDYES Then
'                If clsBill.lngNowID <> 0 Then
'                    strSql = "DELETE * FROM StockTaking WHERE lngStockTakingID=" & clsBill.lngNowID
'                    gclsBase.BaseDB.Execute strSql
'                    strSql = "DELETE * FROM StockTakingDetail WHERE lngStockTakingID=" & clsBill.lngNowID
'                    gclsBase.BaseDB.Execute strSql
'                    Dim dtmDate1 As Date
'                    dtmDate1 = C2Date(lblField(2).Caption)
'                    clsBill.intAccountYear = gclsBase.FYearOfDate(dtmDate1)   '会计年度
'                    clsBill.bytAccountPeriod = gclsBase.PeriodOfDate(dtmDate1)   '会计期间
'                    blnmaxnodecrease gclsBase.AccountYear, gclsBase.Period, C2Lng(lblHead(2).Tag), strAlphaOfStr(lblField(1).Caption), C2Lng(strDigitOfStr(lblField(1).Caption))
'                End If
            If clsBill.lngNowID = 0 Then
                If clsBill.ShowMsgOther(Me.hwnd, "您确实要删除本张商品盘点单的全部分录吗？", MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL + MB_DEFBUTTON2, "删除单据") = vbYes Then
                    clsBill.blnIsChanged = False