frmstartdate.frm

金算盘软件代码

VERSION 5.00
Object = "{D252F124-F62C-11D1-9ABD-444553540000}#1.0#0"; "GADATE.DLL"
Begin VB.Form frmStartDate 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "银行对帐启用日期"
   ClientHeight    =   1740
   ClientLeft      =   2760
   ClientTop       =   2490
   ClientWidth     =   4845
   HelpContextID   =   10221
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1740
   ScaleWidth      =   4845
   StartUpPosition =   2  '屏幕中心
   Begin GACALENDARLibCtl.Calendar dteStart 
      Height          =   285
      Left            =   1860
      OleObjectBlob   =   "frmStartDate.frx":0000
      TabIndex        =   1
      Top             =   420
      Width           =   1395
   End
   Begin VB.TextBox txtInput 
      Height          =   285
      Left            =   1860
      MaxLength       =   15
      TabIndex        =   3
      Top             =   1020
      Width           =   1395
   End
   Begin VB.CommandButton cmdOk 
      Cancel          =   -1  'True
      Height          =   350
      Index           =   1
      Left            =   3570
      Style           =   1  'Graphical
      TabIndex        =   5
      Tag             =   "1002"
      Top             =   540
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOk 
      Height          =   350
      Index           =   0
      Left            =   3570
      Style           =   1  'Graphical
      TabIndex        =   4
      Tag             =   "1001"
      Top             =   150
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.Label lblEducation 
      AutoSize        =   -1  'True
      Caption         =   "对帐单期初余额(&B)"
      Height          =   180
      Index           =   1
      Left            =   270
      TabIndex        =   2
      Top             =   1080
      Width           =   1530
   End
   Begin VB.Label lblEducation 
      Caption         =   "启用日期(&D)"
      Height          =   195
      Index           =   0
      Left            =   270
      TabIndex        =   0
      Top             =   450
      Width           =   1005
   End
End
Attribute VB_Name = "frmStartDate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                                                                                                '
'                功能:   完成银行对帐启用日期的设置、修改                                           '
'                作者：     苏涛                                                                  '
'
'                日期：98-10-06
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Option Explicit

Private mblnIsNew As Boolean
Private mblnIsCancel As Boolean
Private mbytDec As Byte
Private mlngAcnID As Long
Private mlngCurID As Long
Private mstrDate As String

Public Property Let AccountID(ByVal NewValue As Long)
    mlngAcnID = NewValue
End Property

Public Property Get Cancel() As Boolean
    Cancel = mblnIsCancel
End Property

Public Property Let CurrencyID(ByVal NewValue As Long)
    mlngCurID = NewValue
End Property

Public Property Get StartDate() As String
    StartDate = mstrDate
End Property

Public Property Let StartDate(ByVal NewValue As String)
    mstrDate = NewValue
End Property

Private Sub cmdOK_Click(Index As Integer)
    Dim recX As rdoResultset, strSql As String
    Dim dblBalance As Double, strEndDate As String
    
    If Index = 0 Then
        If Not DateIsValid Then
            dteStart.SetFocus
            Exit Sub
        End If
        mstrDate = dteStart.Text
        strEndDate = mstrDate
        dblBalance = TxtToDouble(txtInput.Text)
        If mblnIsNew Then
            strSql = "INSERT INTO BankDetail(lngBankDetailID,lngAccountID,lngCurrencyID,strDate," _
                & "strRemark,intDirection,dblBalance,lngOperatorID) VALUES(" & GetNewID("BankDetail") & "," _
                & mlngAcnID & "," & mlngCurID & ",'" & mstrDate & "','期初余额',9," _
                & dblBalance & "," & gclsBase.OperatorID & ")"
            gclsBase.ExecSQL strSql
        Else
            strSql = "UPDATE BankDetail SET strDate='" & mstrDate & "',dblBalance =" _
                & dblBalance & " WHERE lngAccountID=" & mlngAcnID _
                & " AND lngCurrencyID=" & mlngCurID & " AND intDirection=9"
            gclsBase.ExecSQL strSql
            
'            strSql = "SELECT * FROM BankInfo WHERE lngAccountID=" & mlngAcnID _
'                & " AND lngCurrencyID=" & mlngCurID
'            Set recX = gclsBase.BaseDB.openresultset(strSql, rdopenstatic)
'            If Not recX.EOF Then
'                If mstrDate > recX!strEndDate Then
'                    strEndDate = mstrDate
'                Else
'                    strEndDate = recX!strEndDate
'                End If
'            End If
'            recX.Close
            
'            strSql = "SELECT * FROM BankDetail WHERE lngAccountID=" & mlngAcnID _
                & " AND lngCurrencyID=" & mlngCurID & " AND strDate<='" _
                & strEndDate & "' AND NOT blnIsMatch ORDER BY strDate,lngBankDetailID"
            strSql = "SELECT * FROM BankDetail WHERE lngAccountID=" & mlngAcnID _
                & " AND lngCurrencyID=" & mlngCurID & " AND intDirection<>9 ORDER BY strDate,lngBankDetailID"
            Set recX = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            Do Until recX.EOF
                If recX!strDate < mstrDate Then
                    strSql = "UPDATE BankDetail Set dblBalance=0 WHERE lngBankDetailID=" & recX!lngBankDetailID
                Else
                    dblBalance = dblBalance - recX!intDirection * recX!dblAmount
                    strSql = "UPDATE BankDetail Set dblBalance=" & dblBalance & " WHERE lngBankDetailID=" & recX!lngBankDetailID
                End If
                If recX("strDate") > strEndDate Then strEndDate = recX("strDate")
                gclsBase.ExecSQL strSql
                recX.MoveNext
            Loop
            recX.Close
            
            strSql = "DELETE BankInit WHERE strDate>='" & mstrDate & "'"
            gclsBase.ExecSQL strSql
'            strSql = "UPDATE BankInfo SET strStartDate='" & mstrDate _
'                & "',strEndDate='" & strEndDate & "',dblEndBalance=" & dblBalance _
'                & " WHERE lngAccountID=" & mlngAcnID & " AND  lngCurrencyID=" & mlngCurID
'            gclsBase.ExecSQL strSql
        End If
        strSql = "INSERT INTO BankInfo Values(" & mlngAcnID & "," & mlngCurID _
            & ",'" & mstrDate & "','" & strEndDate & "'," _
            & dblBalance & ")"
        gclsBase.ExecSQL strSql
        mblnIsCancel = False
    End If
    Unload Me
End Sub

Private Function DateIsValid() As Boolean
    Dim recX As rdoResultset, strSql As String
    Dim strStartDate As String, strEndDate As String
    
    DateIsValid = False
    strSql = "SELECT * FROM Business"
    Set recX = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    strStartDate = recX!strStartDate
    recX.Close
    
    strSql = "SELECT * FROM AccountYear WHERE intYear=" & gclsBase.AccountYear
    Set recX = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    strEndDate = recX!strEndDate
    recX.Close
    
    If dteStart.Text < strStartDate Then
        ShowMsg hwnd, "对帐启用日期不能小于帐套启用日期!", vbExclamation, Caption
    ElseIf dteStart.Text > strEndDate Then
        ShowMsg hwnd, "对帐启用日期不能大于本会计年度结束日期!", vbExclamation, Caption
    Else
        DateIsValid = True
    End If
End Function

Private Sub dteStart_KeyPress(KeyAscii As Integer, bCancel As Long)
    If KeyAscii = vbKeyReturn Then
        BKKEY dteStart.hwnd, vbKeyTab
    End If
End Sub

Private Sub dteStart_KeyUp(KeyCode As Integer, Shift As Integer, bCancel As Long)
    If KeyCode = vbKeySpace Then
        dteStart.DropDownPanel
    End If
End Sub

Private Sub Form_Activate()
    SetHelpID Me.HelpContextID
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        BKKEY Me.ActiveControl.hwnd, vbKeyTab
    End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn And Shift = 2 Then
        cmdOk(0).Value = True
    End If
End Sub

Private Sub Form_Load()
    Dim recX As rdoResultset, strSql As String
    Dim edtErrReturn As ErrDealType
    
    On Error GoTo ErrHandle
'    SetHelpID hwnd, 10221
    Utility.LoadFormResPicture Me
    dteStart.Text = mstrDate
    
    mblnIsCancel = True
    strSql = "SELECT * FROM Currencys WHERE lngCurrencyID=" & mlngCurID
    Set recX = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recX.EOF Then
        mbytDec = recX!bytCurrencydec
    End If
    recX.Close
    
    strSql = "SELECT * FROM BankDetail WHERE lngAccountID=" & mlngAcnID _
        & " AND lngCurrencyID=" & mlngCurID & " AND intDirection=9"
    Set recX = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recX.EOF Then
        mblnIsNew = False
        If recX!dblBalance <> 0 Then txtInput.Text = recX!dblBalance
    Else
        mblnIsNew = True
    End If
    recX.Close
    
'    strSql = "SELECT * FROM BankInfo WHERE lngAccountID=" & mlngAcnID _
'        & " AND lngCurrencyID=" & mlngCurID
'    Set recX = gclsBase.BaseDB.openresultset(strSql, rdopenstatic)
'    mblnIsNew = recX.EOF
'    recX.Close
    Exit Sub
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload Me
    End If
End Sub

Private Sub Form_Paint()
  FrameBox Me.hwnd, 120, 150, 3405, 150 + 1365
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    Utility.UnLoadFormResPicture Me
End Sub

Private Sub txtInput_Change()
    If Not IsNum(txtInput.Text, mbytDec) Then BKKEY txtInput.hwnd
End Sub