frmfixedvoucher.frm

金算盘软件代码

        msgVoucher.FixedCols = 0
        msgVoucher.Rows = msgVoucher.FixedRows + 1
        msgVoucher.RowData(1) = 0
        If Not mclsGrid1.Grid Is Nothing Then
            Set mclsGrid1.Grid = Nothing
        End If
        mclsGrid1.ColOfs = 11
        Set mclsGrid1.Grid = msgVoucher
        mclsGrid1.ListSet.ShowListSet (mclsGrid1.ListSet.ViewId)
        Call RefreshGrid
        '写回选择结果
        With msgVoucher
            For i = 1 To .Rows - 1 Step 1
                If InStr(strFixedAlterID, "," & Trim(.TextMatrix(i, 0))) > 0 Then
                    .TextMatrix(i, 10) = "√"
                Else
                    .TextMatrix(i, 10) = " "
                End If
            Next i
        End With
    Case 4   '关联
        If msgVoucher.Rows > 1 Then
            If Val(msgVoucher.TextMatrix(msgVoucher.Row, 0)) > 0 Then
                lngID = msgVoucher.TextMatrix(msgVoucher.Row, 0)
                Unload Me
                DispCardInfo lngID
            End If
        Else
            ShowMsg Me.hwnd, "无变动资料可以关联", vbExclamation, Me.Caption
        End If
    Case 5
        Unload Me
    Case 6   '上一步
        Call PrevStep
    Case 7   '下一步
        Call NextStep
    Case 8   '完成
        Call FinishWizard
    End Select
End Sub
Private Sub Form_Activate()
    On Error Resume Next
    gclsSys.CurrFormName = Me.hwnd
    SetHelpID HelpContextID
    frmMain.SetEditUnEnabled
    If stbVoucher.Tab = stbVoucher.Tabs - 1 Then
        cmdVoucher(8).SetFocus
    Else
        cmdVoucher(7).SetFocus
    End If
End Sub
Private Sub Form_Load()
    Dim strSelect As String
    Dim strWhere As String
    Dim strFrom As String
    Dim strSql As String
    Dim rec1 As rdoResultset
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    mlngFirstType = 0
    stbVoucher.Tab = 0
    mintYear = Year(gclsBase.BaseDate)
    mintNowPeriod = gclsBase.Period
    Call gclsBase.DateOfPeriod(mintYear, mintNowPeriod, mdatStart, mdatEnd)
    With msgVoucherGrid
        .ColWidth(0) = 1920
        .ColWidth(1) = 2300
        .ColWidth(2) = 1420
        .ColWidth(3) = 0
        .ColWidth(4) = 0
        .ColWidth(5) = 0
        .ColWidth(6) = 0
        .ColWidth(7) = 0
        .ColWidth(8) = 0
        .ColWidth(9) = 0
        .ColWidth(10) = 0
        .ColWidth(11) = 0
        .ColWidth(12) = 0
        .ColWidth(13) = 0
        .ColWidth(14) = 0
        .ColWidth(15) = 0
        .CellAlignment = 1
        .ColAlignment(1) = 0
        .Cols = 17
    End With
    mblnVoucherOK = False
    Set mclsGrid1 = New Grid
    msgVoucher.FixedCols = 0
    mclsGrid1.ColOfs = 11
    Set mclsGrid1.Grid = msgVoucher
    mclsGrid1.ListSet.ViewId = mlngViewID
    With msgVoucherGrid
        .ColAlignment(0) = 0
    End With
    Set cmdVoucher(4).Picture = Utility.GetFormResPicture(1010, 0)
    Set cmdVoucher(5).Picture = Utility.GetFormResPicture(1002, 0)
    Set cmdVoucher(6).Picture = Utility.GetFormResPicture(1005, 0)
    Set cmdVoucher(7).Picture = Utility.GetFormResPicture(1006, 0)
    Set cmdVoucher(8).Picture = Utility.GetFormResPicture(1016, 0)
    Set imgVoucher(0).Picture = Utility.GetFormResPicture(140, 0)
    Set imgVoucher(1).Picture = Utility.GetFormResPicture(140, 0)
    Set msgVoucher.MouseIcon = Utility.GetFormResPicture(2001, 2)
    Me.HelpContextID = 60111
End Sub
Private Sub Form_Resize()
    If Me.Left + Me.width < 0 Or Me.Left > Screen.width Then
        Me.Left = 300
    End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Utility.RemoveFormResPicture (1002)
    Utility.RemoveFormResPicture (1005)
    Utility.RemoveFormResPicture (1006)
    Utility.RemoveFormResPicture (1010)
    Utility.RemoveFormResPicture (1016)
    Utility.RemoveFormResPicture (1025)
    Utility.RemoveFormResPicture (2001)
    Utility.RemoveFormResPicture (139)
    gclsSys.MainControls.Remove Me
    Set mclsGrid1 = Nothing
    Set frmFixedVoucher = Nothing
End Sub
'全选
Private Sub Select_All()
    Dim i As Integer
    i = 1
    With msgVoucher
        Do While i < .Rows
            If C2lng(.TextMatrix(i, 2)) > 0 And C2lng(.TextMatrix(i, 3)) > 0 And C2lng(.TextMatrix(i, 4)) > 0 Then
                .TextMatrix(i, 10) = "√"
            Else
                .Row = i
                ShowMsg hwnd, "请指定变动方式的对应科目、凭证类型及模板", vbOKOnly + vbExclamation, Caption
                Exit Sub
            End If
            i = i + 1
        Loop
    End With
End Sub
'取消选择
Private Sub UnSelect_All()
    Dim i As Integer
    i = 1
    With msgVoucher
        Do While i < .Rows
            .TextMatrix(i, 10) = ""
            i = i + 1
        Loop
    End With
End Sub
'条件选择
Private Sub Select_Some()
    Dim strSql As String
    Dim recs1 As rdoResultset
    Dim i As Integer
    Dim strWhere As String
    Dim strWhereString As String
    Dim strSelect As String
    Dim strFrom As String
    If mclsGrid1.ListSet.ListID = 0 Then
        mclsGrid1.ListSet.SaveList
    End If
    Filter.ShowFilter mclsGrid1.ListSet.ListID, 1, , , , , , "", "条件选择"
    mclsGrid1.ListSet.SaveList
    Call UnSelect_All
'    mclsGrid1.ListSet.ViewId = mlngViewID
    With mclsGrid1
        strSelect = "SELECT FixedAlter.lngFixedAlterID "
        strFrom = .ListSet.FromOfSql
        strWhere = "WHERE " & .ListSet.WhereOfSql
        strWhere = strWhere & " AND TO_DATE(FixedAlter.strDate,'YYYY-MM-DD')>=TO_DATE('" & gclsBase.BeginDate & "','YYYY-MM-DD')" _
            & " AND (FixedBalance.dblDebitAmount<>0 OR FixedBalance.dblCreditAmount<>0 " _
            & "OR FixedBalance.dblAlterDeprection<>0) AND ( FixedAlter.blnisVoid = 0 ) " _
            & " And ( Voucher.lngVoucherID IS NULL OR Voucher.lngVoucherID = 0 OR Voucher.blnIsVoid=1 ) AND FixedAlter.blnIsVoucher = 0 " _
            & " AND FixedAlter.intYear * 100 + FixedAlter.bytPeriod <= " & CLng(gclsBase.AccountYear) * 100 + gclsBase.Period
        strWhereString = Filter.GetInitWhere(.ListSet.ListID, 1)
        If strWhereString <> "" Then
            strWhere = strWhere & " AND " & strWhereString
        End If
    End With
    strSql = strSelect & " " & strFrom & " " & strWhere
    Set recs1 = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recs1.EOF Then
        recs1.MoveLast
        recs1.MoveFirst
    End If
    Do While Not recs1.EOF
        i = 1
        With msgVoucher
            Do While i < .Rows
                If recs1!lngFixedAlterID = .TextMatrix(i, 0) And C2lng(.TextMatrix(i, 2)) > 0 And C2lng(.TextMatrix(i, 3)) > 0 And C2lng(.TextMatrix(i, 4)) > 0 Then
                    .TextMatrix(i, 10) = "√"
                    Exit Do
                End If
                i = i + 1
            Loop
        End With
        recs1.MoveNext
    Loop
    recs1.Close
    Set recs1 = Nothing
End Sub
'刷新Grid
Private Sub RefreshGrid()
    Dim strSelect As String
    Dim strWhere As String
    Dim strFrom As String
    Dim strSql As String
    Dim rec As rdoResultset
    Dim strAccountBeginDate As String
    Dim strFilter As String
    
    Set rec = gclsBase.BaseDB.OpenResultset("SELECT strStartDate FROM Business ", rdOpenStatic)
    If Not rec.EOF Then
        strAccountBeginDate = Format(rec!strStartDate, "YYYY-MM-DD")
    End If
    With mclsGrid1
'        strSelect = "SELECT FixedAlter.lngFixedAlterID,FixedCard.lngFixedCardID," _
'            & "FixedMethod.lngAccountID ,FixedMethod.lngVoucherTypeID," _
'            & "FixedMethod.lngTemplateID,FixedMethod.strRemark," _
'            & "(FixedBalance.dblDebitAmount-FixedBalance.dblCreditAmount) AS 变动," _
'            & "FixedMethod.lngFixedMethodID,FixedBalance.dblAlterDeprection ," _
'            & "FixedAlter.lngLastFixedAlterID,IIF(FixedMethod.lngAccountID>0 AND FixedMethod.lngVoucherTypeID " _
'            & "AND FixedMethod.lngTemplateID>0 AND CLng(FixedAlter.intYear)*100+FixedAlter.bytPeriod=" _
'            & CLng(gclsBase.AccountYear) * 100 + gclsBase.Period & ",'√',' ') AS 选择," _
'            & .ListSet.SelectOfSql
        strSelect = "SELECT FixedAlter.lngFixedAlterID,FixedCard.lngFixedCardID," _
            & "FixedMethod.lngAccountID ,FixedMethod.lngVoucherTypeID," _
            & "FixedMethod.lngTemplateID,FixedMethod.strRemark," _
            & "(FixedBalance.dblDebitAmount-FixedBalance.dblCreditAmount) 变动," _
            & "FixedMethod.lngFixedMethodID,FixedBalance.dblAlterDeprection ," _
            & "FixedAlter.lngLastFixedAlterID,DECODE(DECODE(FixedMethod.lngAccountID * FixedMethod.lngVoucherTypeID " _
            & "* FixedMethod.lngTemplateID , 0 , 0 ,1) * FixedAlter.intYear * 100 + FixedAlter.bytPeriod , " _
            & CLng(gclsBase.AccountYear) * 100 + gclsBase.Period & ",'√',' ') 选择," _
            & .ListSet.SelectOfSql
        strFrom = .ListSet.FromOfSql
        strWhere = "WHERE " & .ListSet.WhereOfSql
        strFilter = Filter.GetInitWhere(.ListSet.ListID, 1)
        If Trim(strFilter) <> "" Then
            strWhere = Replace(strWhere, strFilter, "")
            strWhere = strWhere & " (1=1) "
        End If
        
        strWhere = strWhere & " AND TO_DATE(FixedAlter.strDate,'YYYY-MM-DD')>=TO_DATE('" & strAccountBeginDate & "','YYYY-MM-DD')" _
            & " AND (FixedBalance.dblDebitAmount<>0 OR FixedBalance.dblCreditAmount<>0 " _
            & "OR FixedBalance.dblAlterDeprection<>0) AND ( FixedAlter.blnisVoid = 0 ) " _
            & " And ( Voucher.lngVoucherID IS NULL OR Voucher.lngVoucherID = 0 OR Voucher.blnIsVoid=1 ) AND FixedAlter.blnIsVoucher = 0 " _
            & " AND FixedAlter.intYear * 100 + FixedAlter.bytPeriod <= " & CLng(gclsBase.AccountYear) * 100 + gclsBase.Period
    End With
    strSql = strSelect & " " & strFrom & " " & strWhere
    Set datVoucher.Resultset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With msgVoucher
        .SelectionMode = flexSelectionByRow
        .FocusRect = flexFocusNone
        .ColWidth(0) = 0
        .ColWidth(1) = 0
        .ColWidth(2) = 0
        .ColWidth(3) = 0
        .ColWidth(4) = 0
        .ColWidth(5) = 0
        .ColWidth(6) = 0
        .ColWidth(7) = 0
        .ColWidth(8) = 0
        .ColWidth(9) = 0
        .ColWidth(10) = 420
        .Redraw = True
    End With
    mclsGrid1.ListSetToGrid
    mclsGrid1.SetupStyle
End Sub
'上一步
Private Sub PrevStep()
    If stbVoucher.Tab = 1 Then
        stbVoucher.Tab = 0
    End If
    If stbVoucher.Tab = 0 Then
        cmdVoucher(6).Enabled = False
    End If
    cmdVoucher(7).Enabled = True
End Sub
'下一步
Private Sub NextStep()
    If msgVoucher.Rows = 1 Then
        ShowMsg Me.hwnd, "无变动资料可以生成凭证", vbExclamation, Me.Caption
        stbVoucher.Tab = 0
        Exit Sub
    End If
    If stbVoucher.Tab = 0 Then
        stbVoucher.Tab = 1
    End If
    If stbVoucher.Tab = 1 Then
        cmdVoucher(7).Enabled = False
        If Not mblnVoucherOK Then
            '生成凭证
            Call MakeVoucher
        End If
    End If
    If stbVoucher.Tab = 0 Then
        Call Form_Resize
    End If
    cmdVoucher(6).Enabled = True
End Sub
'完成
Private Sub FinishWizard()
    Dim i As Integer
    Dim a As Integer
    Dim vntMessage As Variant
    Dim strSql As String
    Dim blnOK As Boolean
    blnOK = True
    If lngFormHwnd(25) > 0 Then
        If FrmVoucher.blnAutoVoucer(True) Then
            blnOK = False