frmdlinvoice.frm

金算盘软件代码

      Caption         =   "(无)"
      Height          =   285
      Left            =   6300
      TabIndex        =   17
      Top             =   345
      Width           =   1140
   End
   Begin VB.Label lblExplan 
      AutoSize        =   -1  'True
      Caption         =   "可核销金额"
      Height          =   180
      Index           =   2
      Left            =   5340
      TabIndex        =   16
      Top             =   405
      Width           =   900
   End
   Begin VB.Label lblExplan 
      AutoSize        =   -1  'True
      Caption         =   "币种"
      Height          =   180
      Index           =   1
      Left            =   3360
      TabIndex        =   15
      Top             =   405
      Width           =   360
   End
   Begin VB.Label lblExplan 
      AutoSize        =   -1  'True
      Caption         =   "单位"
      Height          =   180
      Index           =   0
      Left            =   105
      TabIndex        =   14
      Top             =   405
      Width           =   360
   End
   Begin VB.Label hLb 
      Alignment       =   1  'Right Justify
      BackColor       =   &H80000005&
      Height          =   255
      Index           =   0
      Left            =   2400
      TabIndex        =   12
      Top             =   4470
      Width           =   855
   End
   Begin VB.Label hLb 
      Alignment       =   1  'Right Justify
      BackColor       =   &H80000005&
      Height          =   255
      Index           =   1
      Left            =   3360
      TabIndex        =   11
      Top             =   4470
      Width           =   855
   End
End
Attribute VB_Name = "frmdlInvoice"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'标题：应收款核销
'日期：1998.07.02
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'功能:               将生成的业务、商品、期初SQL语句中的Where部分中的标志转换成相应的表达式。
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Private Const mintFormHeight = 4018                                           '当前窗体的最小高度
Private Const mintFormWidth = 7368                                            '当前窗体的最小宽度
Private Const lngOffsetCol = 13                                               '列偏移行数
Private Const mintARAPFlagCol = 0
Private Const mintDetailIDCol = 1
Private Const mintTableIDCol = 2
Private Const mintCheckCol = 3
Private Const mintLastChkAmtCol = 4
Private Const mintLastChkDiscCol = 5
Private Const mintLastChkQtyCol = 6
Private Const mintTotalQtyCol = 7
Private Const mintTotalAmtCol = 8
Private Const mintFactorCol = 9
Private Const mintAutoDiscCol = 10
Private mintEditAmtCol As Integer
Private mintEditQtyCol As Integer
Private mintEditDiscCol As Integer
Private mintBalAmtCol As Integer
Private mintBalQtyCol As Integer
Private mintBalDiscCol As Integer
Private mstrActivityFrom As String

Private WithEvents mclsGrid As Grid                                          '声明类模块
Attribute mclsGrid.VB_VarHelpID = -1
Private WithEvents mclsMainControl As MainControl   'MainControl类
Attribute mclsMainControl.VB_VarHelpID = -1
Private mblnFind As Boolean
Private mblnSort As Boolean
Private mlngLastSortedType As Long
Private mlngLastSortedCol As Long

Private mlngAccountID As Long
Private mlngCustomerID As Long                                               '单位ID
Private mlngCurrencyID As Long                                               '币种ID
Private mlngCashID As Long                                                   '单据业务ID
Private mlngCashDetailID As Long                                             '单据业务明细ID
Private mstrCustomerName As String                                           '单位名称
Private mstrCurrencyName As String                                           '币种名称
Private mdtmEndDate As Date
Private mstrCheckNumber As String

Private mlngVoucherID As Long
Private mlngDiscActivityID As Long
Private mintCurrencyDec As Integer                                           '币种保留小数点位数
Private mblnFormNoRezise As Boolean                                          '窗体是否允许Resize
Private mdblReceiveAmount As Double                                          '可核销金额
Private mdblPaymentAmount As Double
Private mdblRestAmount As Double                                             '可核销金额
Private mdblDiffAmount As Double                                             '可核销差额
Private mdblLastChkAmt As Double                                             '本次原核销金额之和
Private mblnModify As Boolean                                                '修改
Private mintDirection As Integer
Private mblnIsAR As Boolean                                                  '应收或应付款核销
Private mstrARType As String
Private mdblCashAmount As Double                                             '
Private mdblCashQuantity As Double
Private mlngViewID2 As Long                                                  '视图ID号50:1146

'应收应付、收款付款入口
Public Sub SetParameters(lngDetailID As Long)
    mlngCashDetailID = lngDetailID
    If GetActivity(lngDetailID) Then
        mstrCustomerName = CustomerName(mlngCustomerID)
        mstrCurrencyName = CurrencyName(mlngCurrencyID)
        mintCurrencyDec = CurrencyDec(mlngCurrencyID)
        If gclsBase.ControlAccount Then
            mlngViewID2 = 50
        Else
            If gVersionType = vtAccount Then
                mlngViewID2 = 1147
            Else
                mlngViewID2 = 1146
            End If
        End If
        chkSameAccount.top = 225
        If mblnIsAR Then
            Caption = "应收核销"
        Else
            Caption = "应付核销"
        End If
        InitGrid
        Show vbModal
    End If
End Sub

'记帐凭证入口
Public Sub SetVoucher(lngDetailID As Long)
    mlngCashDetailID = lngDetailID
    If GetVoucher(lngDetailID) Then
        mstrCustomerName = CustomerName(mlngCustomerID)
        mstrCurrencyName = CurrencyName(mlngCurrencyID)
        mintCurrencyDec = CurrencyDec(mlngCurrencyID)
        If gclsBase.ControlAccount Then
            mlngViewID2 = 50
            chkSameAccount.top = 225
        Else
            If gVersionType = vtAccount Then
                mlngViewID2 = 1147
            Else
                mlngViewID2 = 1146
            End If
            chkCheckNo.Visible = True
        End If
        If mblnIsAR Then
            Caption = "应收核销"
        Else
            Caption = "应付核销"
        End If
        InitGrid
        Show vbModal
    End If
End Sub

'商品业务入口
Public Sub SetItemActivity(lngDetailID As Long)
    mlngCashDetailID = lngDetailID
    If GetItemActivity(lngDetailID) Then
        mstrCustomerName = CustomerName(mlngCustomerID)
        mstrCurrencyName = CurrencyName(mlngCurrencyID)
        mintCurrencyDec = CurrencyDec(mlngCurrencyID)
        If gclsBase.ControlAccount Then
            mlngViewID2 = 50
        Else
            If gVersionType = vtAccount Then
                mlngViewID2 = 1147
            Else
                mlngViewID2 = 1146
            End If
        End If
        chkSameAccount.top = 225
        If mblnIsAR Then
            Caption = "应收核销"
        Else
            Caption = "应付核销"
        End If
        InitGrid
        Show vbModal
    End If
End Sub

Private Sub chkSameAccount_Click()
    If Not mclsGrid Is Nothing Then
        If mblnModify Then
            If ShowMsg(Me.hwnd, "数据已被修改，是否先保存？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "应收款核销") = IDYES Then
                If mstrActivityFrom = "现金银行" Then
                     If ltxtAccount.ID <= 0 And mintEditDiscCol > 0 Then
                        If C2Dbl(hLb(mintEditDiscCol)) <> 0 Then
                            ShowMsg hwnd, "请指定折扣科目！", vbExclamation + vbOKOnly, Caption
                            ltxtAccount.SetFocus
                            Exit Sub
                        End If
                     End If
                End If
                SaveData False
            Else
                mnuUndoCheck_Click False
            End If
        End If
        
        If chkSameAccount.Value = 1 Then
            SaveSet 1, "应收应付核销", "相同科目", "1", True, "Long"
        Else
            SaveSet 1, "应收应付核销", "相同科目", "0", True, "Long"
        End If
        
        msgGrid.FixedCols = 0
        msgGrid.Rows = 1
        Set datAR.Resultset = GetList()
        FindColPosition
        mclsGrid.ColOfs = lngOffsetCol
        mclsGrid.SetupStyle
        ShowTotalRow
        datAR.Resultset.Close
    End If
End Sub

Private Sub chkCheckNo_Click()
    If Not mclsGrid Is Nothing Then
        If mblnModify Then
            If ShowMsg(Me.hwnd, "数据已被修改，是否先保存？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "应收款核销") = IDYES Then
                If mstrActivityFrom = "现金银行" Then
                     If ltxtAccount.ID <= 0 And mintEditDiscCol > 0 Then
                        If C2Dbl(hLb(mintEditDiscCol)) <> 0 Then
                            ShowMsg hwnd, "请指定折扣科目！", vbExclamation + vbOKOnly, Caption
                            ltxtAccount.SetFocus
                            Exit Sub
                        End If
                     End If
                End If
                SaveData False
            Else
                mnuUndoCheck_Click False
            End If
        End If
        
        If chkCheckNo.Value = 1 Then
            SaveSet 1, "应收应付核销", "相同对帐号", "1", True, "Long"
        Else
            SaveSet 1, "应收应付核销", "相同对帐号", "0", True, "Long"
        End If
        
        msgGrid.FixedCols = 0
        msgGrid.Rows = 1
        Set datAR.Resultset = GetList()
        FindColPosition
        mclsGrid.ColOfs = lngOffsetCol
        mclsGrid.SetupStyle
        ShowTotalRow
        datAR.Resultset.Close
    End If
End Sub

Private Sub Form_Activate()
    SetHelpID HelpContextID
    frmMain.SetEditUnEnabled
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 27 Then
        If Not txtEdit.Visible Then
            Cmdall_Click 1
            KeyCode = 0
        End If
    End If
End Sub

Private Sub InitGrid()
    Dim intCount As Integer
    RefreshLtxtAcc
    RefreshTemplate
    Set mclsGrid.Grid = msgGrid
    msgGrid.FixedCols = 0
    msgGrid.Rows = 1
    mclsGrid.ListSet.ViewId = mlngViewID2
    For intCount = 1 To mclsGrid.ListSet.Columns
        If mclsGrid.ListSet.ColumnFormat(intCount) = 3 Then
            mclsGrid.ListSet.ColumnFieldDec(intCount) = mintCurrencyDec
        End If
    Next intCount
    Set datAR.Resultset = GetList()                          '取SQL语句并绑定数据到FLEXGRID
    FindColPosition
    For intCount = 0 To lngOffsetCol - 1