frmsalesbill.frm

金算盘软件代码

      Visible         =   0   'False
      Width           =   630
   End
   Begin VB.Label lblHead 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "单位(C)"
      Height          =   180
      Index           =   0
      Left            =   60
      TabIndex        =   25
      Tag             =   "0"
      Top             =   135
      Visible         =   0   'False
      Width           =   630
   End
   Begin VB.Label lblHead 
      BackColor       =   &H80000005&
      BorderStyle     =   1  'Fixed Single
      Height          =   315
      Index           =   3
      Left            =   4290
      TabIndex        =   1
      Tag             =   "1"
      Top             =   90
      Visible         =   0   'False
      Width           =   1110
   End
   Begin VB.Label lblHead 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      Caption         =   "模板(D)"
      ForeColor       =   &H80000008&
      Height          =   180
      Index           =   4
      Left            =   5880
      TabIndex        =   26
      Top             =   135
      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             =   90
      Visible         =   0   'False
      Width           =   1590
   End
End
Attribute VB_Name = "FrmSalesBill"
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 clsSales             '销售单删除类模块
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 lngVoucherID As Long                       '记帐凭证ID
Dim lngTakeStockID As Long        '盘点表业务ID
Dim blnOldIsInvoice As Boolean    '原单据带开票标志
Dim blnAlertMenuChecked   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          '触发CHKPRINT(2)的CLICK事件标志
    clsBill.SaveInput2Form
'''    DoEvents
    blnChkNotClick = False          '触发CHKPRINT(2)的CLICK事件标志
    
    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 = C2lng(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 curInput_KeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer)
    Select Case KeyCode
    Case vbKeySpace
        If C2lng(lblHead(2).Tag) = 13 Then
            If clsBill.bytRegion = FGrid And (clsBill.lngOldCol = 6 Or clsBill.lngOldCol = 7) Then
                clsBill.GetDiscPrice
            End If
        End If
    End Select
End Sub

Private Sub Form_Deactivate()
    frmMain.SetEditUnEnabled
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))
'        lngID = Detail2ActivityIDOfOrder(lngDetailID, False)
'        If lngDetailID = 0 Then
'            clsbill.ShowMsgOther Me.hwnd, "商品“" & clsBill.TextOfGrid(grdCol.Row, 1) & "”未选择订单！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "关联订单"
'            Exit Sub
'        End If
'        If lngID = 0 Then
'            If grdCol.Row = 0 Then Exit Sub
'            clsbill.ShowMsgOther Me.hwnd, "商品“" & clsBill.TextOfGrid(grdCol.Row, 1) & "”无销售订单或未选择订单！", MB_OK + MB_SYSTEMMODAL, "关联订单"
'            Exit Sub
'        End If
'        FrmSaleOrder.ShowAOldBill lngID
'    ElseIf Index = 1 Then
'        '选择订单
'        Select Case C2Lng(lblHead(2).Tag)
'            Case 13, 14, 15, 18        '商品销售13, 直运销售14,委托出库15,分期出库18
'                frmdlSelectSaleReceipt.GivemeParameter Me, C2Lng(lblHead(0).Tag), clsBill.getFieldID(7), clsBill.lngNowID
'                clsBill.blnIsChanged = True
'            Case 14 '直运销售
'                '选择商品
'        End Select
'        Select Case C2Lng(lblHead(2).Tag)
'        Case 13, 15, 17, 18, 21, 24 '“验收入库”不置灰
'            cmdButton(9).Enabled = True
'        End Select
'    ElseIf Index = 2 Then
'        '全部选定
'        Select Case C2Lng(lblHead(2).Tag)
'            Case 13, 14, 15, 18        '商品销售13,直运销售14, 委托出库15,分期出库18
'                frmdlSelectAllSaleReceipt.GivemeParameter Me, C2Lng(lblHead(0).Tag), clsBill.getFieldID(7), clsBill.lngNowID
'                clsBill.blnIsChanged = True
'            Case 14 '直运销售
'                '选择商品
'        End Select
'        Select Case C2Lng(lblHead(2).Tag)
'        Case 13, 15, 17, 18, 21, 24 '“验收入库”不置灰
'            cmdButton(9).Enabled = True
'        End Select
'    End If
'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 = 4    '销售单ID
'   -------------------------------
    Dim i As Integer
        
    Set clsBill = New itemclass
    Set clsLst = New clsSales
    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
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
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    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
        Cancel = True
        gblnCancel = 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
'    frmListSales.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
'    Set Me = Nothing
End Sub

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

Private Sub chkPrint1_Click()
    Dim strMsgUnable As String
    Dim strMsgAsk As String
    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(20))
            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(11) = clsBill.ButtonEnabled(11)
        clsBill.cmdButtonEnabled(12) = clsBill.ButtonEnabled(12)
        clsBill.cmdButtonEnabled(13) = clsBill.ButtonEnabled(13)
        
        '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
        clsBill.blnChangeEvent = False
        chkPrint(1).Value = 0
        clsBill.blnChangeEvent = True
        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
        
        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