frmtakestock.frm

金算盘软件代码

    ReceiptTypeID = 12    '商品盘点单ID
'   -------------------------------
    lblHead(2).Tag = 33
    lblHead(4).Tag = 0
    Dim i As Integer
    
    Set clsBill = New TakeStock
    clsBill.ReceiptTypeID = ReceiptTypeID
    Set clsBill.Form = Me
    Set clsList = New clsStockTaking
    clsList.SethWnd Me.hwnd
    
    blnNotResize = True
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    LoadFormSetting Me
    blnNotResize = False
'    SetHelpID 50010
    If GrdCol.Rows > 2 Then
        GrdCol.Rows = 2
    End If
'    FirstReceiptTypeIDAndName ReceiptTypeID, lgID, srName
'    lblHead(2).Tag = lgID
'    lblHead(3).Caption = srName
   
'    grdCol.CellAlignment = flexAlignLeftCenter
End Sub

Private Sub Form_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 Not blnEdit And Button <> vbRightButton Then Exit Sub
    clsBill.Form_MouseUp Button
End Sub
'窗体尺寸变化处理程序

Private Sub Form_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 Form_Resize()
If clsBill Is Nothing Then Exit Sub
'If grdCol.Visible = False Then Exit Sub
If Not blnNotResize Then clsBill.Form_Resize
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    If gclsSys Is Nothing Or clsBill Is Nothing Then
        Set clsList = Nothing
        frmListStockTaking.IAmCLosed
        Set clsBill = Nothing
        Set mclsMainControl = Nothing      '主控对象
        Unload Me
        Exit Sub
    End If
 
    If Not ChangeSaveNote() Then
        gblnCancel = True
        Cancel = True
        Exit Sub
    End If

    Set clsList = Nothing
    clsBill.MySaveColWidthDefault
    gclsSys.MainControls.Remove Me
'    gclsSys.CurrFormName = ""
    frmListStockTaking.IAmCLosed
    
    Set clsBill = Nothing
    Set mclsMainControl = Nothing      '主控对象
    Unload Me
End Sub

Private Sub chkPrint0_Click()
'    frmMain.mnuEditShowAll.Checked = chkPrint(0).Value
    clsBill.blnIsChanged = True
End Sub

Private Sub chkPrint1_Click()
    If Not clsBill.blnChangeEvent Then Exit Sub
    Dim intYesNo As Integer
   
    If chkPrint(1).Value = 0 Then
        'GrdCol.Refresh
        RefreshRect Me.hwnd, lblCaption.Left + lblCaption.width, GrdCol.top + GrdCol.RowHeight(0), lblCaption.Left + lblCaption.width + 151 * Screen.TwipsPerPixelX, GrdCol.top + GrdCol.RowHeight(0) + 70 * Screen.TwipsPerPixelY
        If IsCanDo(EditNO(C2lng(lblHead(2).Tag))) Then
            blnEdit = True
            clsBill.mblnEdit = blnEdit
        End If
    Else
        clsBill.blnChangeEvent = False
        chkPrint(1).Value = 0
        clsBill.blnChangeEvent = True
        If blnBillIsClosed(33, clsBill.lngNowID) Then
            clsBill.ShowMsgOther Me.hwnd, "本张" & lblCaption.Caption & "已经结帐，不能作废！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "作废单据"
            Exit Sub
        End If
        If blnIsPost Then
             intYesNo = clsBill.ShowMsgOther(Me.hwnd, "本张已盘点处理的" & lblCaption.Caption & "保存后将不能取消作废，您确实要作废吗？", MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL + MB_DEFBUTTON2, "作废单据")
        ElseIf blnEdit Then
             intYesNo = clsBill.ShowMsgOther(Me.hwnd, "本张" & lblCaption.Caption & "保存后将不能取消作废，您确实要作废吗？", MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL + MB_DEFBUTTON2, "作废单据")
'        Else
'            intYesNo = clsbill.showmsgother(Me.hwnd, "本张已盘点处理的" & lblCaption.Caption & "保存后将不能取消作废，您确实要作废吗？", MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL + MB_DEFBUTTON2, "作废单据")
        End If
        If intYesNo = vbNo Then
            Exit Sub
        End If
        clsBill.blnChangeEvent = False
        chkPrint(1).Value = 1
        clsBill.blnChangeEvent = True
        DrawAIcon GrdCol.hwnd, lblCaption.Left + lblCaption.width, GrdCol.RowHeight(0), 1024
        Utility.RemoveFormResPicture (1024)
        blnEdit = False
        clsBill.mblnEdit = blnEdit
    End If
    clsBill.UpdateMainEditMenu
'    frmMain.mnuEditInActive.Checked = chkPrint(1).Value
    clsBill.cmdButtonEnabled(6) = IIf(chkPrint(1).Value = 0 And Not blnIsPost, True, False)
End Sub

Private Sub chkPrint_Click(Index As Integer)
    If Index > 0 And Not IsCanDo(EditNO(C2lng(lblHead(2).Tag))) Then Exit Sub
    If Not IsCanDo(EditNO(C2lng(lblHead(2).Tag))) Then Exit Sub
    clsBill.CHK_CLICK Index
    Select Case Index
        Case 0
            chkPrint0_Click
        Case 1
            chkPrint1_Click
        Case 3  '冲销
    End Select
End Sub

Private Sub cmdButton_Click(Index As Integer)
    If blnNoClick Then
        Exit Sub
    End If
    blnNoClick = True
    If gclsSys Is Nothing Or clsBill Is Nothing Then
        blnNoClick = False
        Unload MsgForm
        Unload Me
        Exit Sub
    End If
    clsBill.cmdButton_Click Index
    Select Case Index
        Case 1
            CmdPrev_Click
        Case 0
            cmdNext_Click
        Case 2
            cmdHome_Click
        Case 3
            CmdEnd_Click
        Case 4
            If SaveBill() Then
                DoEvents
                blnNoClick = False
                Unload Me
                Exit Sub
            End If
        Case 5
            blnNoClick = False
            CmdCancel_Click
            Exit Sub
        Case 6
            If lngSpecialAccountID(1) = 0 Then
                clsBill.ShowMsgOther Me.hwnd, "请先在主菜单“文件（Ｆ）”的“帐套属性－特殊科目”中设置好“待处理流动资产损益”科目后再进行“盘点处理”！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "错误信息"
                blnNoClick = False
                GoTo EndProc
            End If
            If SaveBill() Then
                If cmdButton(6).Enabled Then
                    Me.MousePointer = vbHourglass
                    If MakeBill() Then
                        If gclsSys Is Nothing Then
                           blnNoClick = False
                            Exit Sub
                        End If
                        Me.MousePointer = vbDefault
                        Screen.MousePointer = vbDefault
                        clsBill.cmdButtonEnabled(6) = False
'                        cmdButton(7).Enabled = False
                        chkPrint(1).Enabled = False
                        blnIsPost = True
                        blnEdit = False
                        clsBill.mblnEdit = blnEdit
                        blnNoClick = False
                        Unload Me
                        Exit Sub
                    Else
                        If gclsSys Is Nothing Then
                           blnNoClick = False
                            Exit Sub
                        End If
                        If clsBill Is Nothing Then
                           blnNoClick = False
                            Exit Sub
                        End If
                        Me.MousePointer = vbDefault
                        Screen.MousePointer = vbDefault
                        clsBill.ShowMsgOther Me.hwnd, "无法生成相应的盘盈、盘亏单，不能盘点处理！", MB_ICONINFORMATION + MB_OK + MB_SYSTEMMODAL, "盘点处理"
'                        cmdButton(6).Enabled = True
'                        cmdButton(7).Enabled = True
                        blnEdit = IsCanDo(EditNO(C2lng(lblHead(2).Tag)))
                        clsBill.mblnEdit = blnEdit
                    End If
                End If
            End If
        Case 7              '重新计算
            reCalculate
        Case 8
            CmdPrint_Click
            
    End Select
EndProc:
    If Index <> 5 Then
        DoEvents
        blnNoClick = False
        If Not clsBill Is Nothing Then
            clsBill.ReSetFocus
        End If
    End If
End Sub
Private Sub CmdCancel_Click()
    clsBill.blnIsChanged = False
    Unload Me
End Sub

Private Sub CmdEnd_Click()
    If Not ChangeSaveNote() Then Exit Sub
    Dim lngID As Long
    If blnView Then
        lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 3)
    Else
        lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 3, C2lng(LblMemo(LblMemo.Count - 1).Tag))
    End If
    If lngID = 0 Then Exit Sub
    ShowAOldBill lngID
End Sub

Private Sub cmdHome_Click()
    If Not ChangeSaveNote() Then Exit Sub
    Dim lngID As Long
    If blnView Then
        lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 2)
    Else
        lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 2, C2lng(LblMemo(LblMemo.Count - 1).Tag))
    End If
    If lngID = 0 Then Exit Sub
    ShowAOldBill lngID
End Sub

Private Sub cmdNext_Click()
    If clsBill.lngNowID <> 0 Then
        If clsBill.blnIsChanged Then
            If Not SaveBill() Then Exit Sub
        End If
        Dim lngID As Long
        If blnView Then
            lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 1)
        Else
            lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 1, C2lng(LblMemo(LblMemo.Count - 1).Tag))
        End If
    
        If lngID < 1 And clsBill.lngNowID <> 0 Then
            If Not IsCanDo(EditNO(C2lng(lblHead(2).Tag))) Then Exit Sub
            ShowANewBill
    '        clsBill.GetANewBill C2Lng(lblHead(5 - 1).Tag), C2Lng(lblHead(3 - 1).Tag), lblField(1).Caption
            blnIsPost = False
            Exit Sub
        ElseIf lngID > 0 Then
            ShowAOldBill lngID
        End If
    Else
        If clsBill.blnIsChanged Then
            If Not SaveBill() Then Exit Sub
        End If
        ShowANewBill
    End If
End Sub

Private Sub CmdPrev_Click()
'    If Not ChangeSaveNote() Then Exit Sub
    Dim lngID As Long
    If blnView Then
        lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 0)
    Else
        lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 0, C2lng(LblMemo(LblMemo.Count - 1).Tag))
    End If
    If lngID = 0 Then Exit Sub
    ShowAOldBill lngID
End Sub

Private Sub CmdPrint_Click()
    If clsBill.blnIsChanged Then
        If Not SaveBill() Then Exit Sub
    End If
    If clsBill.lngNowID = 0 Then
        clsBill.ShowMsgOther Me.hwnd, "单据为空，无可打印信息！", MB_OK + MB_SYSTEMMODAL + MB_ICONINFORMATION, "打印单据"
        Exit Sub
    End If

    If clsBill.blnIsPrinted Then
      If clsBill.blnPrintPrintedBill Then
         If clsBill.ShowMsgOther(Me.hwnd, "本张" & lblCaption.Caption & "已经打印，您确实要打印吗？", MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL + MB_DEFBUTTON2, "打印单据") = vbNo Then
            Exit Sub
         End If
      Else
         clsBill.ShowMsgOther Me.hwnd, "本张" & lblCaption.Caption & "已经打印，不能再打印！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL + MB_DEFBUTTON2, "打印单据"
         Exit Sub
      End If
    End If
          
    Dim myPrintclass As PrintClass
    Set myPrintclass = New PrintClass
    Dim blnTmp As Boolean
    Dim lngTmp As Long
    lngTmp = getPrintIDofTemplateID(C2lng(lblHead(4).Tag), blnTmp)
    If blnTmp Then
         If myPrintclass.PrintSameItemReceipt(gclsBase.BaseDB, -4, 33, CStr(clsBill.lngNowID), lngTmp, BillRePrintRight(33)) Then
            If chkPrint(0).Value <> 0 Then
                clsBill.blnChangeEvent = False
                chkPrint(0).Value = 0
                clsBill.blnChangeEvent = True
            End If
            clsBill.blnIsPrinted = True
         End If
    Else
         If myPrintclass.PrintReceipt(gclsBase.BaseDB, -4, 33, CStr(clsBill.lngNowID), lngTmp, BillRePrintRight(33)) Then
            If chkPrint(0).Value <> 0 Then
                clsBill.blnChangeEvent = False
                chkPrint(0).Value = 0
                clsBill.blnChangeEvent = True
            End If
            clsBill.blnIsPrinted = True
         End If
   End If
    Set myPrintclass = Nothing
End Sub
Private Sub Form_Activate()
    If mclsMainControl Is Nothing Then
        Exit Sub
    End If
    SetHelpID Me.HelpContextID
    gclsSys.CurrFormName = Me.hwnd
    ResponseMessage
    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
    If blnFirstIn Then
        blnFirstIn = False