frmstockbill.frm

金算盘软件代码

      Visible         =   0   'False
      Width           =   630
   End
   Begin VB.Label lblHead 
      BackColor       =   &H80000005&
      BorderStyle     =   1  'Fixed Single
      Height          =   315
      Index           =   5
      Left            =   6480
      TabIndex        =   2
      Tag             =   "2"
      Top             =   60
      Visible         =   0   'False
      Width           =   1590
   End
End
Attribute VB_Name = "FrmStockBill"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  单据（采购单）窗体
'  作者：蔡奇科
'  日期：1998.07.2
'
' 方法：
'  ShowANewBill         新增单据
'  SHowAOldBill         修改单据
'  ShowANewTypeBill  新增一指定类型单据
' 函数
' SaveBill                  保存当前单据
' getID                     取当前单据的ID号
' getFID                   取第I个FIELD的ID号
' ReponseMessage       消息处理
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Dim ReceiptTypeID  As Integer
Dim intReceiptTypeID  As Integer
Dim clsBill As itemclass           '
Dim clsLst As clsPurchase        '删除销售单类模块
Dim WithEvents mclsMainControl As MainControl       '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Dim lgID As Long
Dim srName As String
Dim srCode As String
Dim blnNotResize As Boolean
Dim blnEdit As Boolean             '可填制权限
Dim blnView As Boolean             '可查询权限
Dim blnChkNotClick As Boolean          '触发CHKPRINT(2)的CLICK事件标志
Dim blnAlertMenuChecked As Boolean             '“报警”开关
Dim lngVoucherID As Long                      '记帐凭证ID
Dim lngTakeStockID As Long        '盘点表业务ID
Dim blnOldIsInvoice As Boolean    '原单据带开票标志
Dim frmTmp As Form
Dim frmTmp2 As Form
Public strNewReceiptNO As String
Public NewReceiptDate As Date
Public blnIsLoading As Boolean '正在引入数据标志
Private blnFirstIn As Boolean
Private blnNoClick As Boolean

Private Sub cmbInput_Click()
    
'        Static blnFirst As Boolean
'        blnChkNotClick = True
'        clsBill.SaveInput2Form
'        DoEvents
'        blnChkNotClick = False
'
'        clsBill.bytRegion = FHead
'        clsBill.bytIndex = 3
'        If clsBill.bytRegion = FHead Then
'            Dim lngID As Long, lngT As Long
'            Dim strT As String, strC As String
'            lngID = lblHead(2).Tag
'            lngT = FirstId(xTemplatE, lngID)
'            Call BillPublic.IdToCodeAndName(xTemplatE, lngT, strC, strT)
'            lblHead(4).Tag = lngT
'            lblHead(5).Caption = strT
'        End If
End Sub
'Private Sub cmdFooter_Click(Index As Integer)
'    clsBill.cmdFooter_Click Index
'    If Index = 0 Then
'        '关联订单
'        Dim lngDetailID As Long
'        Dim lngID As Long
'        If C2Lng(clsbill.TextOfGrid(grdCol.Row, 28)) = 0 Then
'            clsbill.ShowMsgOther Me.hwnd, "请先通过选择订单输入商品，再使用关联订单！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "关联订单"
'            Exit Sub
'        End If
'        lngDetailID = C2Lng(clsbill.TextOfGrid(grdCol.Row, 29))
'        If lngDetailID = 0 Then
'            clsbill.ShowMsgOther Me.hwnd, "商品“" & clsbill.TextOfGrid(grdCol.Row, 1) & "”未选择订单！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "关联订单"
'            Exit Sub
'        End If
'        lngID = Detail2ActivityIDOfOrder(lngDetailID)
'        If lngID = 0 Then
'            If grdCol.Row = 0 Then Exit Sub
'            clsbill.ShowMsgOther Me.hwnd, "商品“" & clsbill.TextOfGrid(grdCol.Row, 1) & "”无采购订单或未选择订单！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "关联订单"
'            Exit Sub
'        End If
'        FrmPurchaseOrder.ShowAOldBill lngID
'    ElseIf Index = 1 Then
'        '选择订单
'        Select Case C2Lng(lblHead(2).Tag)
'            Case 2, 3, 4 '商品采购2,直运3,受托入库4
'                frmdlSelectPurchaseReceipt.GivemeParameter Me, C2Lng(lblHead(0).Tag), clsBill.getFieldID(7), clsBill.lngNowID
'                clsBill.blnIsChanged = True
'        End Select
'        Select Case C2Lng(lblHead(2).Tag)
'        Case 2, 4, 6, 9, 10, 11     '“验收入库”不置灰
'            cmdButton(9).Enabled = True
'        End Select
'    ElseIf Index = 2 Then
'        '全部选定
'        Select Case C2Lng(lblHead(2).Tag)
'            Case 2, 3, 4 '商品采购2,直运3,受托入库4
'                frmdlSelectAllPurchaseReceipt.GivemeParameter Me, C2Lng(lblHead(0).Tag), clsBill.getFieldID(7), clsBill.lngNowID
'                clsBill.blnIsChanged = True
'        End Select
'        Select Case C2Lng(lblHead(2).Tag)
'        Case 2, 4, 6, 9, 10, 11     '“验收入库”不置灰
'            cmdButton(9).Enabled = True
'        End Select
'    End If
'End Sub


Private Sub curInput_KeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer)
'    Form_KeyDown KeyCode, Shift
End Sub

Private Sub curInput_KeyUp(ByVal KeyCode As Integer, ByVal Shift As Integer)
'    Form_KeyUp KeyCode, Shift
End Sub

Private Sub Form_Deactivate()
    frmMain.SetEditUnEnabled
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
        clsBill.Form_KeyDown KeyCode, Shift

End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    clsBill.Form_KeyUp KeyCode, Shift
   If KeyCode = 93 Then
        If Not Me.ActiveControl Is GrdCol And clsBill.bytRegion <> FGrid Then
            MakeListEditMenu
            clsBill.MenuVisible = True
            PopupMenu frmMain.mnuListEdit
            clsBill.MenuVisible = False
        Else
            MakeListActivityMenu
            clsBill.MenuVisible = True
            PopupMenu frmMain.mnuListActivity
            clsBill.MenuVisible = False
        End If
    ElseIf KeyCode = vbKeyPageUp Then
        If Shift = vbCtrlMask Then
            cmdButton_Click 1
        End If
    ElseIf KeyCode = vbKeyPageDown Then
        If Shift = vbCtrlMask Then
            cmdButton_Click 0
        End If
    ElseIf KeyCode = 13 Then
        If Shift = vbCtrlMask Then
            cmdButton_Click 4
        End If
    End If
    
End Sub

Private Sub Form_Load()
    SetDtm
'    Me.Hide
'    Me.Left = -30000
    blnFirstIn = True
    blnNoClick = False

'   -------------------------------
    ReceiptTypeID = 2    '采购单ID
'   -------------------------------
    Dim i As Integer
        
    Set clsBill = New itemclass
    Set clsLst = New clsPurchase
    clsLst.SethWnd Me.hwnd
    
    clsBill.ReceiptTypeID = ReceiptTypeID
    Set clsBill.Form = Me
    If blnIsLoading = False Then
        clsBill.ShowWaitForm
    End If
    blnNotResize = True
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    LoadFormSetting Me
    blnNotResize = False
    
'    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
    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
        If Not clsBill.SaveInput2Form() Then Exit Sub
        clsBill.InputCtrInvisible
        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 Not blnNotResize Then clsBill.Form_Resize
'    grdCol.top = grdCol.top + 1000
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    Unload MsgForm
    
    
    If gclsSys Is Nothing Or clsBill Is Nothing Then
        Set clsBill = Nothing
        Set clsLst = Nothing        '确定凭证是否存在等的类模块
        Set mclsMainControl = Nothing      '主控对象
        lngFormHwnd(intReceiptTypeID) = 0
        Set frmStockSales(intReceiptTypeID) = Nothing
        Unload Me
        Exit Sub
    End If

    If Not ChangeSaveNote() Then
        gblnCancel = True
        Cancel = True
        Exit Sub
    End If
'    Dim dtmDate1 As Date
'    If clsBill.lngNowID = 0 Then
'        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
    SaveColWidthDefault Me
    Set clsBill = Nothing
    Set clsLst = Nothing        '确定凭证是否存在等的类模块

    gclsSys.MainControls.Remove Me

'    frmListPurchase.IAmCLosed
    
    Set clsBill = Nothing
    Set clsLst = Nothing        '确定凭证是否存在等的类模块
    Set mclsMainControl = Nothing      '主控对象
    lngFormHwnd(C2lng(lblHead(2).Tag)) = 0
    Set frmStockSales(C2lng(lblHead(2).Tag)) = Nothing
    Unload Me
End Sub
Private Sub chkPrint1_Click()
    Dim i As Long
    
    If Not clsBill.blnChangeEvent Then Exit Sub
    If chkPrint(1).Value = 0 Then
        If chkPrint(2).Visible Then
            chkPrint(2).Enabled = (Not blnOldIsInvoice) And IsCanDo(EditNO(8))
            If chkPrint(3).Visible Then
                chkPrint(3).Enabled = (chkPrint(2).Value = 1)
            End If
        End If
        clsBill.cmdButtonEnabled(7) = clsBill.ButtonEnabled(7)
        clsBill.cmdButtonEnabled(9) = clsBill.ButtonEnabled(9)
        clsBill.cmdButtonEnabled(10) = clsBill.ButtonEnabled(10)
        clsBill.cmdButtonEnabled(11) = clsBill.ButtonEnabled(11)
'        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
            clsBill.blnMayChange = clsBill.blnBillCanChange
        End If
    Else
        For i = 1 To GrdCol.Rows - 1
            If C2lng(clsBill.TextOfGrid(i, 44)) <> 0 Then
                chkPrint(1).Value = 0
                clsBill.ShowMsgOther Me.hwnd, "第" & i & "行" & lblCaption.Caption & "批次商品已经发生销售或采购退货业务，不能作废！", MB_OK + MB_ICONINFORMATION + MB_SYSTEMMODAL, "作废单据"
                Exit Sub
            End If
        Next
        clsBill.blnChangeEvent = False
        chkPrint(1).Value = 0
        clsBill.blnChangeEvent = True
        
        If clsLst.BeforeDelete(True, clsBill.lngNowID, C2lng(lblHead(2).Tag), lblCaption.Caption) <> 1 Then
'            chkPrint(1).Value = 0
            Exit Sub
        End If
        
        If clsBill.ShowMsgOther(Me.hwnd, "本张" & lblCaption.Caption & "保存后将不能取消作废，您确实要作废吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "作废单据") = vbNo Then
'            chkPrint(1).Value = 0
            Exit Sub
        End If
'        If clsLst.BeforeDelete(True, clsBill.lngNowID, C2lng(LblHead(2).Tag), lblCaption.Caption) <> 1 Then
''            chkPrint(1).Value = 0
'            Exit Sub
'        End If
        clsBill.blnChangeEvent = False
        chkPrint(1).Value = 1
        clsBill.blnIsChanged = True
        clsBill.blnChangeEvent = True
        If chkPrint(2).Visible Then
            chkPrint(2).Enabled = False
            If chkPrint(3).Visible Then
                chkPrint(3).Enabled = False
            End If
        End If
        clsBill.cmdButtonEnabled(7) = False
        clsBill.cmdButtonEnabled(9) = False
        clsBill.cmdButtonEnabled(10) = False
        clsBill.cmdButtonEnabled(11) = False
        DrawAIcon GrdCol.hwnd, lblCaption.Left + lblCaption.width, GrdCol.RowHeight(0), 1024
        Utility.RemoveFormResPicture (1024)
'        blnEdit = False
        clsBill.blnMayChange = False
    End If
    clsBill.UpdateMainEditMenu
'    frmMain.mnuEditInActive.Checked = chkPrint(1).Value
End Sub
Private Sub chkPrint3_Click()
    If Not clsBill.blnChangeEvent Then Exit Sub
    clsBill.blnChangeEvent = False
    chkPrint(3).Value = 1 - chkPrint(3).Value
    clsBill.blnChangeEvent = True
'    clsBill.blnIsChanged = True
'    If chkPrint(3).Value = 0 Then
'    Else
        If SaveBill() = False Then
'            clsBill.blnChangeEvent = False
'            chkPrint(3).Value = 0
'            clsBill.blnChangeEvent = True
            Exit Sub
        End If
        Dim lngResult As Long
        
        lngResult = frmCashSettle.ShowMe(Me)
        If lngResult = 1 Then
            clsBill.blnChangeEvent = False
            chkPrint(3).Value = 1
            clsBill.blnChangeEvent = True
        ElseIf lngResult = -1 Then
            clsBill.blnChangeEvent = False
            chkPrint(3).Value = 0
            clsBill.blnChangeEvent = True
        End If

        clsBill.blnBillCanChange
'    End If
End Sub

Private Sub chkPrint_Click(Index As Integer)