frminvoice.frm

金算盘软件代码

      Left            =   3600
      TabIndex        =   25
      Tag             =   "1"
      Top             =   90
      Width           =   630
   End
   Begin VB.Label lblHead 
      BackColor       =   &H80000009&
      BorderStyle     =   1  'Fixed Single
      Height          =   285
      Index           =   1
      Left            =   690
      TabIndex        =   24
      Tag             =   "0"
      Top             =   60
      Width           =   2100
   End
   Begin VB.Label lblCaption 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      Caption         =   "应收单"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   18
         Charset         =   134
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00004000&
      Height          =   360
      Left            =   300
      TabIndex        =   22
      Top             =   510
      Width           =   1080
   End
   Begin VB.Label lblField 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H80000008&
      Height          =   255
      Index           =   0
      Left            =   150
      TabIndex        =   21
      Top             =   1110
      UseMnemonic     =   0   'False
      Visible         =   0   'False
      Width           =   825
   End
   Begin VB.Label lblFieldCaption 
      Alignment       =   2  'Center
      BackColor       =   &H80000002&
      Caption         =   "标题"
      ForeColor       =   &H80000009&
      Height          =   195
      Index           =   0
      Left            =   150
      TabIndex        =   20
      Top             =   900
      UseMnemonic     =   0   'False
      Visible         =   0   'False
      Width           =   825
   End
   Begin VB.Label LblBack 
      Appearance      =   0  'Flat
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H80000008&
      Height          =   5220
      Left            =   150
      TabIndex        =   23
      Top             =   450
      Width           =   7995
   End
End
Attribute VB_Name = "FrmInvoice"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  单据(应收单)
'  作者：王兴元
'  日期：1998.07.2
'==================================================================================

Option Explicit
Public ReceiptTypeID  As Integer
Dim clsBill As BillSet                 '
Dim clsLst As clsListMethod         '确定凭证是否存在等的类模块
Dim WithEvents mclsMainControl As MainControl       '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Dim strColRow() As String   '单据体行复制/粘贴存储区动态数组
Dim lgID As Long
Dim lngYID As Long
Dim srName As String
Dim srCode As String
Dim blnNotResize As Boolean
Dim blnHaveVoucher As Boolean       '确定是否生成了凭证
Dim blnIsCanEventChk_Click As Boolean
Dim intDoNo As Integer  '控制模版处的点击次数

Dim blnWriteForm As Boolean     '是否是数据引入标志(不加载 MSGFORM 窗体)
Dim blnIsClose As Boolean   '关闭标志

Dim strAlpha As String  '单据号前缀
Dim lngDigit As Long    '单据号后缀
Dim lngOldReceiptTypeID As Long        '用来存贮上次的单据类型ID变量
Dim lngHeadDetailID As Long     '表头部分的明细ID
Public lngCancelActivityID As Long '冲销单据的原单据ID存贮变量
Dim blnEdit As Boolean      '填制权限
Dim blnView As Boolean      '查询权限
Private blnPrinted As Boolean '已打印标志
Public mlngItemActivityID As Long '现结标志（采购销售单的单据ID）
    
Private Sub cmbInput_Click()
    Dim lngID As Long
    Dim lngT As Long
    Dim strT As String
    Dim strC As String
    Dim strNo As String
    Dim lngNewReceiptTypeID As Long
    
    lngID = BillPublic.ReceiptNameToTypeID(cmbInput.Text)
'    If lngID = 38 Then
    If lngID = 99 Then
        '应收计息的单子不能改
'        clsBill.blnYSJX = True
        clsBill.blnYSJX = False
        lngYID = clsBill.LastActyId_YSJX
        If lngYID > 0 Then
            ShowAOldBill lngYID
        Else
            ShowMsg Me.hwnd, "没有可以显示的应收计息单据！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "警告信息"
            'Resume
            clsBill.blnYSJX = False
            lngID = lngOldReceiptTypeID
            lblHead(2).Tag = lngOldReceiptTypeID
            lblHead(3).Caption = BillPublic.ReceiptTypeIdToName(lngOldReceiptTypeID)
            getPrevPlateAndBillNo lngID, lngT, strNo
            Call BillPublic.IdToCodeAndName(xTemplatE, lngT, strC, strT)
            lblHead(4).Tag = lngT
            lblHead(5).Caption = strT
            clsBill.bytRegion = FcmdButton
            cmbInput.Move -5000
            lngNewReceiptTypeID = lngOldReceiptTypeID
        End If
    Else
        clsBill.blnYSJX = False
        clsBill.bytRegion = FHead
        clsBill.bytIndex = 3
        
        clsBill.SaveInput2Form
        
        '-----------------------------------
'        Dim strCode As String
'        Dim strName As String
'        lngID = BillPublic.FirstId(xTemplatE, C2lng(LblHead(2).Tag))
'        Call BillPublic.IdToCodeAndName(xTemplatE, lngID, strCode, strName)
'        LblHead(5 - 1).Tag = lngID
'        LblHead(5).Caption = strName
        '-----------------------------------
    End If
    picFooter.Refresh
'
'    lngNewReceiptTypeID = lngid
'    If lngNewReceiptTypeID <> lngOldReceiptTypeID Then
'        '单据类型已经改变
'        If Not ChangeSaveNote() Then
'        '取消后将，进行还原操作
'            lngid = lngOldReceiptTypeID
'            lblHead(2).Tag = lngOldReceiptTypeID
'            lblHead(3).Caption = BillPublic.ReceiptTypeIdToName(lngOldReceiptTypeID)
'            getPrevPlateAndBillNo lngid, lngT, strNo
'            Call BillPublic.IdToCodeAndName(xTemplatE, lngT, strC, strT)
'            lblHead(4).Tag = lngT
'            lblHead(5).Caption = strT
'            clsBill.bytRegion = FFooter
'            cmbInput.Move -5000
'            lngNewReceiptTypeID = lngOldReceiptTypeID
'        Else
'    '调用苏梦的方法对当前操作员最后的模版ID，单据号前缀进行设置
'            getPrevPlateAndBillNo lngid, lngT, strNo
'            clsBill.GetANewBill lngT, lngid, strNo, True, C2Lng(lblHead(0).Tag)
'        End If
'    End If
    
End Sub
Private Sub cmbInput_GotFocus()
    lngOldReceiptTypeID = BillPublic.ReceiptNameToTypeID(cmbInput.Text)
End Sub

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

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If clsBill Is Nothing Then Exit Sub
    If KeyCode = 93 Then
        If clsBill.bytRegion = FGrid Or clsBill.bytRegion = FGrid1 Or clsBill.bytRegion = FPicture Then
            GrdCol_Mouseup vbRightButton, 0, 0, 0
        Else
            Form_MouseUp vbRightButton, 0, 0, 0
        End If
        Exit Sub
    End If
    If Shift = 2 And KeyCode = 65 Then  'CTRL+A
        If Not ChangeSaveNote() Then Exit Sub
    ElseIf Shift = 2 And KeyCode = vbKeyPageDown Then
        cmdButton_Click 0
        Exit Sub
    ElseIf Shift = 2 And KeyCode = vbKeyPageUp Then
        cmdButton_Click 1
        Exit Sub
    ElseIf Shift = 2 And KeyCode = vbKeyReturn Then
        cmdButton_Click 4
        Exit Sub
    End If
    If KeyCode <> Asc(vbTab) Then
        clsBill.Form_KeyDown KeyCode, Shift
    End If
End Sub


Private Sub Form_Load()
'--------------------------
'    Me.Move -5000, -5000
'    Me.Hide
    If blnWriteForm = False Then MsgForm.PleaseWait
'--------------------------
    ReceiptTypeID = 14    '应收单ID
    
    If gclsSys Is Nothing Then Exit Sub
    
    Dim i As Integer
    ReDim strColRow(GrdCol.Cols - 1) As String  '单据体行复制/粘贴存储区
    
    Set clsBill = New BillSet
    clsBill.ReceiptTypeID = ReceiptTypeID
    Set clsBill.Form = Me
    clsBill.blnSound = GetSetting(App.title, "14" + CStr(gclsBase.OperatorID), "Sound_Invoice", "False")
    clsBill.blnTell = GetSetting(App.title, "14" + CStr(gclsBase.OperatorID), "Tell_Invoice", "False")
    
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    
    Set clsLst = New clsListMethod
    
    Me.HelpContextID = 60002
    blnNotResize = False
    FirstReceiptTypeIDAndName ReceiptTypeID, lgID, srName
    lblHead(2).Tag = lgID
    lblHead(3).Caption = srName
    intDoNo = 1
    lngCancelActivityID = 0
    clsBill.blnNotFormActive = True
    Utility.LoadFormSetting Me
End Sub

'窗体尺寸变化处理程序

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If clsBill Is Nothing Then Exit Sub
    If clsBill.blnGrdCellDoing Then Exit Sub
        MakeListEditMenu
    If Button = vbRightButton Then
        clsBill.blnGrdCellDoing = True
        clsBill.blnNotRespondKeyPress = True
        PopupMenu frmMain.mnuListEdit
        clsBill.blnNotRespondKeyPress = False
        clsBill.blnGrdCellDoing = True
        DoEvents
        clsBill.blnGrdCellDoing = 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_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    On Error Resume Next
    
    If (clsBill Is Nothing) Or (gclsSys Is Nothing) Or (mclsMainControl Is Nothing) Then
        Screen.MousePointer = vbDefault
        Unload MsgForm
        Unload Me
        Exit Sub
    End If
    
    If clsBill.blnNotRaiseEvent Then Exit Sub
    If clsBill.blnGrdCellDoing Then
        Cancel = 1
        Exit Sub
    End If
    clsBill.SaveInput2Form
    If Not ChangeSaveNote() Then
        gblnCancel = True
        Cancel = 1
        Exit Sub
    End If
    '存贮最后的GRID的各列的宽度
    BillPublic.SaveColWidthDefault Me
    gclsSys.MainControls.Remove Me
    gclsSys.SendMessage Me.hwnd, 30 + C2lng(lblHead(2).Tag)
    frmInvoiceList.IAmCLosed
    Set clsBill = Nothing
    Set clsLst = Nothing
    Set mclsMainControl = Nothing
    Unload Me
End Sub

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

Private Sub chkPrint1_Click()
    Dim intYN As Integer
    Dim lngWriteOffID() As Long
    
    If blnIsCanEventChk_Click = False Then GoTo EndProc
    If chkPrint(1).Value = 1 Then
        blnIsCanEventChk_Click = False
        chkPrint(1).Value = 0
        blnIsCanEventChk_Click = True
        If ActivityIsHX(clsBill.lngNowID, , True) Then
            If ShowMsg(Me.hwnd, "该张已经核销过的应收单保存后将不能取消作废！您确实要作废吗？", MB_YESNO + MB_DEFBUTTON2 + MB_ICONQUESTION + MB_SYSTEMMODAL, "警告信息") <> IDYES Then
                chkPrint(1).Value = 0
                GoTo EndProc
            End If
        Else
            If ShowMsg(Me.hwnd, "该张应收单保存后将不能取消作废！您确实要作废吗？", MB_YESNO + MB_DEFBUTTON2 + MB_ICONQUESTION + MB_SYSTEMMODAL, "警告信息") <> IDYES Then
                chkPrint(1).Value = 0
                GoTo EndProc
            End If
        End If
'-------- 冲销单据  作废
        If blnIsWriteOffBill(clsBill.lngNowID) Then
            If BillPublic.blnDelWriteOffBillNote(Me.hwnd, C2lng(lblHead(2).Tag), clsBill.lngNowID, "作废") = False Then
                chkPrint(1).Value = 0
                GoTo EndProc
            End If
        Else
            If BillPublic.blnWriteOff(Me.hwnd, C2lng(lblHead(2).Tag), clsBill.lngNowID, "作废", lngWriteOffID()) Then
                chkPrint(1).Value = 0
                GoTo EndProc
            End If
        End If
        blnIsCanEventChk_Click = False
        chkPrint(1).Value = 1
        blnIsCanEventChk_Click = True
    End If

    If chkPrint(1).Value = 0 Then
        Utility.RemoveFormResPicture (1024)
        If clsBill.blnIsDiscount Then
            Cmdbutton(7 + 1).Enabled = False
        Else
            Cmdbutton(7 + 1).Enabled = True
        End If