frmcurrencynew.frm

金算盘软件代码

    cboMode.ItemData(cboMode.NewIndex) = 1
    cboMode.AddItem "向前"
    cboMode.ItemData(cboMode.NewIndex) = 2
    cboMode.AddItem "向后"
    cboMode.ItemData(cboMode.NewIndex) = 3
'    SendKeys "%{C}"
     Exit Sub
    Dim edtErrReturn As ErrDealType
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload Me
    End If
End Sub

Private Sub InitCard(Optional strName As String = "")
    Dim reccur As rdoResultset, strSql As String
    Dim i As Integer
    
    If mlngCurID = 0 Then
       mblnIsNew = True
    Else
       mblnIsNew = False
    End If
    msgRate.ColWidth(2) = 1660
    
    mblnIsInit = True
    mblnisFirstEdit = True
    If Not mblnIsNew Then
        strSql = "SELECT * FROM Currencys WHERE lngCurrencyID=" & mlngCurID
        Set reccur = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If reccur.EOF Then
            ShowMsg 0, "当前币种已被其它用户删除！", vbExclamation + MB_TASKMODAL, Caption
            Unload Me
            Exit Sub
        End If
        mstrOldCurCode = reccur!strCurrencyCode
        txtCurrency(0).Text = mstrOldCurCode
        txtCurrency(1).Text = reccur!strCurrencyName
        txtspin(0).Value = reccur!bytCurrencydec
        txtspin(1).Value = reccur!bytRateDec
        optMode(1).Value = reccur!blnIsIndirect
        chkStop.Value = IIf(reccur!blnIsInActive, 1, 0)
        cboMode.ListIndex = reccur!bytMatchmethod - 1
        cmdOK(2).Visible = False
        Caption = "修改币种"
        reccur.Close
        If mlngCurID = 1 Then '本位币的处理
           txtspin(0).Value = 2
           txtspin(1).Value = 2
           txtCurrency(0).Enabled = False
           txtCurrency(0).BackColor = &H80000004
           For i = 0 To 1
               txtspin(i).Enable = False
               txtspin(i).BackColor = &H80000004
           Next
           chkStop.Enabled = False
           cboMode.Enabled = False
           cboMode.BackColor = &H80000004
           'txtspin(1).BackColor = &H80000004
           For i = 0 To 1
               'txtspin(i).Enabled = False
               optMode(i).Enabled = False
               cboYP(i).Enabled = False
               cboYP(i).BackColor = &H80000004
           Next
           For i = 3 To 7
               lblTitle(i).Enabled = False
           Next
           
           mclsGrid.SetupStyle
           msgRate.Enabled = False
           msgRate.BackColor = &H80000004
           mblnIsInit = False
           txtRate.MaxLength = 7 + txtspin(1).Value + 1
           Exit Sub
        End If
           
        If CurrencyIsUsed(mlngCurID) Then
            optMode(0).Enabled = False
            optMode(1).Enabled = False
        End If
    
    Else
        cmdOK(2).Visible = True
        Caption = "新增币种"
        txtCurrency(1).Text = strName
        cboMode.ListIndex = 0
        txtspin(0).Value = 2
        txtspin(1).Value = 4
        optMode(0).Value = True
        optMode(1).Value = False
    End If
    mblnGridIsFirst = True
    initYearPeriod  '初始化年度和期间
    mintOldRow = 1
    mintOldCol = 2
    mblnIsChanged = False
    InitGrid
    mblnGridIsFirst = False
    mblnisFirstEdit = False
    txtRate.MaxLength = 7 + txtspin(1).Value + 1
    mblnIsInit = False
   ' SendKeys "%{C}"
End Sub
 '初始化年度和期间
Private Sub initYearPeriod()
    Dim strSql As String
    Dim recYP As rdoResultset
    Dim intYear As Integer
    Dim intCount As Integer
    Dim i As Integer
    
    strSql = "select intYear,bytPeriodNO FROM AccountYear order by intYear"
    Set recYP = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recYP.RowCount <> 0 Then
       cboYP(0).Clear
       Do Until recYP.EOF
          cboYP(0).AddItem recYP.rdoColumns(0)
          recYP.MoveNext
       Loop
       intYear = gclsBase.AccountYear
       If cboYP(0).ListCount > 0 Then
          intCount = cboYP(0).ListCount
          For i = 0 To intCount - 1
              If intYear = cboYP(0).list(i) Then
                 cboYP(0).ListIndex = i
                 Exit For
              End If
          Next
       End If
    End If
End Sub
Private Sub InitForm()
    If txtCurrency(0) = "" Or UCase(txtCurrency(0)) = "TEXT" Then
       txtCurrency(0) = ""
    Else
       txtCurrency(0) = GetNextCode(txtCurrency(0).Text)
       txtCurrency(0).SetFocus
       txtCurrency(0).SelStart = 0
       txtCurrency(0).SelLength = Len(txtCurrency(0).Text)
    End If
    txtCurrency(1) = ""
    txtRate.Text = ""
    mCurrencyIsSave = False
    mlngCurID = 0
    mblnGridIsFirst = True
    initYearPeriod
    mblnGridIsFirst = False
    InitCard
   ' SendKeys "%{C}"
    
    
End Sub

Private Sub InitGrid()
    Dim dtmSDate As Date, dtmEDate As Date, i As Integer
    Dim recBEDate As rdoResultset, recRate As rdoResultset
    Dim strSql As String, strFormat As String
    Dim strRate As String
    
    If txtspin(1).Text = 0 Then
       strRate = "0"
    Else
       strRate = "0."
       For i = 1 To Val(txtspin(1).Text)
           strRate = strRate & "0"
       Next
    End If
    
    strFormat = msgRate.FormatString
    msgRate.Clear
    msgRate.FormatString = strFormat
    msgRate.ColWidth(0) = 0
    strSql = "SELECT strStartDate,strEndDate FROM AccountPeriod WHERE " _
        & "intYear=" & mintYear & " AND bytPeriod=" & mbytPeriod
    Set recBEDate = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recBEDate.EOF Then Exit Sub
    
    dtmSDate = CDate(recBEDate!strStartDate)
    dtmEDate = CDate(recBEDate!strEndDate)
    msgRate.Rows = dtmEDate - dtmSDate + 2
    
  '  If Not mblnIsNew Then
     If mlngCurID <> 0 Then
        strSql = "SELECT * FROM " & "Rate WHERE lngCurrencyID=" & mlngCurID & " AND " _
            & "strDate>='" & Format(recBEDate!strStartDate, "yyyy-mm-dd") _
            & "' AND strDate<='" & Format(recBEDate!strEndDate, "yyyy-mm-dd") & "' ORDER BY strDate"
        Set recRate = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    End If
    For i = 1 To msgRate.Rows - 1
        msgRate.TextMatrix(i, 1) = Format$(dtmSDate, "yyyy-mm-dd")
'        If Not mblnIsNew Then
         If mlngCurID <> 0 Then
            If Not recRate.EOF Then
                If recRate!strDate = msgRate.TextMatrix(i, 1) Then
                    msgRate.TextMatrix(i, 0) = "H"
                    msgRate.TextMatrix(i, 2) = Format(recRate!dblRate, strRate)
                    recRate.MoveNext
                End If
            End If
         End If
         dtmSDate = DateAdd("d", 1, dtmSDate)
    Next i
    recBEDate.Close
    If Not recRate Is Nothing Then recRate.Close
    If msgRate.Rows > 1 Then
'       txtRate.Text = msgRate.TextMatrix(1, 2)
       msgRate.Row = 1
    End If
    msgRate.FixedAlignment(1) = flexAlignCenterCenter
    msgRate.FixedAlignment(2) = flexAlignCenterCenter
    msgRate.col = 2
    mclsGrid.SetupStyle
'    mclsGrid.SetWriteCol 2
End Sub

Private Sub Form_Paint()
    FrameBox Me.hwnd, 150, 170, 2917.5, 3705
    FrameBox Me.hwnd, 345, 2572.5, 2775, 3510
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim intResponse As Integer
    
    If UnloadMode = vbFormControlMenu Then
        If mblnIsChanged Then
            intResponse = ShowMsg(0, "当前币种汇率已被修改，是否保存？", _
                vbYesNoCancel + vbQuestion + MB_TASKMODAL, Caption)
            If intResponse = vbYes Then
                Cancel = Not UpdateData()
                gclsBase.BaseWorkSpace.CommitTrans
            ElseIf intResponse = vbCancel Then
                Cancel = True
            Else
                gclsBase.BaseWorkSpace.RollBacktrans
            End If
        Else
            gclsBase.BaseWorkSpace.RollBacktrans
        End If
    End If
    If Not Cancel Then mblnIsChanged = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
    'gclsSys.MainControls.Remove Me
    Utility.RemoveFormResPicture 139
    Utility.RemoveFormResPicture 1001
    Utility.RemoveFormResPicture 1002
    Utility.RemoveFormResPicture 1009
End Sub




Private Sub mclsGrid_BeforeSave(blnCancel As Boolean)
    Dim i As Integer
    Dim strRate As String
    
    If txtspin(1).Text = 0 Then
       strRate = "0"
    Else
       strRate = "0."
       For i = 1 To Val(txtspin(1).Text)
           strRate = strRate & "0"
       Next
    End If
    
    If txtRate.Text <> "" Then
       txtRate.Text = Format(txtRate.Text, strRate)
       msgRate.TextMatrix(msgRate.Row, 2) = txtRate.Text
       txtRate.Visible = False
    End If
End Sub

Private Sub msgRate_DblClick()
    If msgRate.Row = 0 Then Exit Sub
    If msgRate.col = 2 Then
        If Not IsPeriodClose Then EditGrid 0
    End If
End Sub

Private Sub msgRate_EnterCell()
    With msgRate
    If .Row = 0 Then Exit Sub
    mintOldRow = .Row
    End With
End Sub

Private Sub msgRate_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        If msgRate.col < msgRate.Cols - 1 Then
            BKKEY msgRate.hwnd, vbKeyRight
        ElseIf msgRate.Row < msgRate.Rows - 1 Then
            msgRate.Row = msgRate.Row + 1
            BKKEY msgRate.hwnd, vbKeyHome
        End If
    ElseIf KeyAscii <> vbKeyRight And KeyAscii <> vbKeyHome Then
        If msgRate.col = 2 Then
            If Not IsPeriodClose Then EditGrid KeyAscii
        End If
    End If
End Sub

Private Sub msgRate_Scroll()
    txtRate.Visible = False
End Sub

Private Sub optMode_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    mblnIsChanged = True
End Sub

Private Sub optMode_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    mblnIsChanged = True
End Sub

Private Sub UpdateRate()
    Dim i As Integer
    Dim strRate As String
    
    If txtspin(1).Text = 0 Then
       strRate = "0"
    Else
       strRate = "0."
       For i = 1 To Val(txtspin(1).Text)
           strRate = strRate & "0"
       Next
    End If
    With msgRate
         For i = 1 To .Rows - 1
             If .TextMatrix(i, 2) <> "" Then
                .TextMatrix(i, 2) = Format(.TextMatrix(i, 2), strRate)
             End If
         Next
    End With
End Sub



Private Sub txtCurrency_Change(Index As Integer)
    If ContainErrorChar(txtCurrency(Index).Text, "'|") Then
       BKKEY txtCurrency(Index).hwnd
       Exit Sub
    End If
    Select Case Index
        Case 0
             If StrLen(txtCurrency(Index).Text) > 4 Then
                BKKEY txtCurrency(Index).hwnd
                Exit Sub
             End If
        Case 1
             If StrLen(txtCurrency(Index).Text) > 10 Then
                BKKEY txtCurrency(Index).hwnd
                Exit Sub
             End If
    End Select
    If Not mblnIsInit Then mblnIsChanged = True
End Sub

'Private Sub txtCurrency_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
'    With msgRate
'    Select Case KeyCode
'    Case vbKeyReturn
'        If .Row < .Rows - 1 Then .Row = .Row + 1
''        EditGrid 0
'    Case vbKeyUp
'        If .Row > 1 Then
'            .Row = .Row - 1
''            msgRate.SetFocus
'        End If
'    Case vbKeyDown
'        If .Row < .Rows - 1 Then
'            .Row = .Row + 1
''            msgRate.SetFocus
'        End If
'    Case Else
'        .TextMatrix(mintOldRow, 2) = FormatShow(txtRate.Text, txtspin(1).Value)
'        .RowData(mintOldRow) = -1
'    End Select
'    End With
'End Sub
'
Private Sub txtRate_Change()
    On Error Resume Next
    If txtRate.Text = "" Then Exit Sub
    If Not IsNum(Trim(txtRate.Text), txtspin(1).Value, True) Then
        BKKEY txtRate.hwnd
    Else
        msgRate.TextMatrix(msgRate.Row, 2) = FormatShow(Trim(txtRate.Text), txtspin(1).Value)
    End If
    mblnIsChanged = True
End Sub
'判断数据存了一次盘后，再存，是否有重复
Private Function IsSame() As Boolean
        Dim reccur As rdoResultset
        Dim strSql As String
        
        IsSame = False
        strSql = "select * from currencys WHERE (strCurrencyCode='" _
            & txtCurrency(0).Text & "' OR strCurrencyName='" _
            & txtCurrency(1).Text & "') AND lngCurrencyID<>" _
            & mlngCurID
        Set reccur = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If reccur.EOF Then
            reccur.Close
            Exit Function
        End If
        
        If reccur!strCurrencyCode = txtCurrency(0).Text Then