frmclearrate.frm

金算盘软件代码

VERSION 5.00
Object = "{D252F124-F62C-11D1-9ABD-444553540000}#1.0#0"; "GADATE.DLL"
Begin VB.Form frmClearRate 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "清除过时汇率"
   ClientHeight    =   1935
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4485
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1935
   ScaleWidth      =   4485
   StartUpPosition =   1  '所有者中心
   Begin GACALENDARLibCtl.Calendar dateedit1 
      Height          =   300
      Index           =   1
      Left            =   1550
      OleObjectBlob   =   "frmClearRate.frx":0000
      TabIndex        =   5
      Top             =   1207
      Width           =   1275
   End
   Begin GACALENDARLibCtl.Calendar dateedit1 
      Height          =   300
      Index           =   0
      Left            =   1550
      OleObjectBlob   =   "frmClearRate.frx":0089
      TabIndex        =   3
      Top             =   757
      Width           =   1275
   End
   Begin VB.CommandButton cmdOK 
      Cancel          =   -1  'True
      Height          =   350
      Index           =   1
      Left            =   3105
      Style           =   1  'Graphical
      TabIndex        =   7
      Tag             =   "1002"
      Top             =   570
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOK 
      Height          =   350
      Index           =   0
      Left            =   3105
      Style           =   1  'Graphical
      TabIndex        =   6
      Tag             =   "1001"
      Top             =   180
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.ComboBox cboCurrency 
      BackColor       =   &H00FFFFFF&
      Height          =   300
      Left            =   1550
      TabIndex        =   1
      Top             =   307
      Width           =   1275
   End
   Begin VB.Label Label1 
      Caption         =   "结束日期(&E)"
      Height          =   195
      Index           =   2
      Left            =   405
      TabIndex        =   4
      Top             =   1260
      Width           =   1050
   End
   Begin VB.Label Label1 
      Caption         =   "开始日期(&B)"
      Height          =   195
      Index           =   1
      Left            =   405
      TabIndex        =   2
      Top             =   810
      Width           =   1050
   End
   Begin VB.Label Label1 
      Caption         =   "币种(&C)"
      Height          =   195
      Index           =   0
      Left            =   405
      TabIndex        =   0
      Top             =   360
      Width           =   1050
   End
End
Attribute VB_Name = "frmClearRate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''
'
'清除过时汇率窗体
'
'作者：郑权
'
'日期：1998-07-03
'
'接口:  ClearRate 显示清除过时汇率窗体
'
'
'
''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Private mlngCurID As Long
'Private WithEvents mclsMainControl As MainControl
Private mRateIsnone As Boolean

Public Sub ClearRate(ByVal lngID As Long)
    mlngCurID = lngID
    InitDate
    InitFrom
    If mRateIsnone = True Then Exit Sub
    If Me.WindowState = 1 Then Me.WindowState = 0
    Show vbModal
    'Refresh
    'ZOrder 0
End Sub

Private Sub cboCurrency_Click()
    If mlngCurID = cboCurrency.ItemData(cboCurrency.ListIndex) Then Exit Sub
    mlngCurID = cboCurrency.ItemData(cboCurrency.ListIndex)
    InitDate
End Sub

Private Sub cmdOK_Click(Index As Integer)
    Dim strNote As String, strSql As String
    Dim blnCleaRate As Boolean
    Dim msgReturn As Integer
    
    If Index = 0 Then
        If dateedit1(0).Text = "" Then
            ShowMsg Me.hwnd, "开始日期不能为空!", vbExclamation + MB_TASKMODAL, Me.Caption
            SendKeys "%{B}"
'            dateedit1(0).SetFocus
            Exit Sub
        End If
        If dateedit1(1).Text = "" Then
           ShowMsg Me.hwnd, "结束日期不能为空!", vbExclamation + MB_TASKMODAL, Me.Caption
            SendKeys "%{E}"
'            dateedit1(0).SetFocus
            Exit Sub
        End If
        If dateedit1(1).Value < dateedit1(0).Value Then
            ShowMsg Me.hwnd, "结束日期不能小于开始日期!", _
                       vbExclamation + MB_TASKMODAL, Me.Caption
            SendKeys "%{E}"
'            dateedit1(1).SetFocus
            Exit Sub
        End If
        strNote = "真要删除" & cboCurrency.Text & dateedit1(0).Text & "--" _
            & dateedit1(1).Text & "之间的汇率?"
        msgReturn = ShowMsg(0, strNote, vbQuestion + vbYesNo + MB_TASKMODAL, Me.Caption)
        If msgReturn = vbYes Then
            strSql = "DELETE FROM Rate WHERE lngCurrencyID=" & mlngCurID _
                & " AND strDate>='" & dateedit1(0).Text & "' AND strDate<='" _
                & dateedit1(1).Text & "'"
            blnCleaRate = gclsBase.ExecSQL(strSql)
        End If
        If blnCleaRate = True Then
           'gclsSys.SendMessage Me.hwnd, Message.msgcurrency
           Unload Me
           Exit Sub
        Else
            Exit Sub
        End If
    End If
    Unload Me
    
End Sub

Private Sub Form_Activate()
 SetHelpID C2lng(Me.HelpContextID)

End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        If Shift = 2 Then
            cmdOK(0).Value = True
        Else
            BKKEY Me.ActiveControl.hwnd, vbKeyTab
        End If
    End If
End Sub

Private Sub Form_Load()
   On Error GoTo ErrHandle
   Me.HelpContextID = 10244
   ' Set mclsMainControl = gclsSys.MainControls.Add(Me)
   Utility.LoadFormResPicture Me
   
    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 Form_Paint()
     FrameBox Me.hwnd, 120, 180, 3000, 1700 '画边框
End Sub

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

Private Sub InitDate()
    Dim recRate As rdoResultset
    
    Set recRate = gclsBase.BaseDB.OpenResultset("SELECT MIN(strDate) AS BeginDate," _
        & "MAX(strDate) AS EndDate FROM Rate WHERE lngCurrencyID=" & mlngCurID, _
        rdOpenStatic)
    If IsNull(recRate!BeginDate) Then
        dateedit1(0).Text = ""
        dateedit1(1).Text = ""
    Else
        dateedit1(0).Text = recRate!BeginDate
        dateedit1(1).Text = recRate!EndDate
    End If
End Sub

Private Sub InitFrom()
    Dim recCurrency As rdoResultset, i As Integer
    Dim strSql As String
    
    strSql = "SELECT Currencys.lngCurrencyID, Currencys.strCurrencyCode, Currencys.strCurrencyName" _
             & " FROM Currencys WHERE lngCurrencyID<>1 and currencys.blnIsInActive=0"

    Set recCurrency = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Do Until recCurrency.EOF
        cboCurrency.AddItem recCurrency!strCurrencyName
        cboCurrency.ItemData(cboCurrency.NewIndex) = recCurrency!lngCurrencyID
        If mlngCurID = recCurrency!lngCurrencyID Then i = cboCurrency.NewIndex
        recCurrency.MoveNext
    Loop
   
    
    If recCurrency.RowCount > 0 Then
        cboCurrency.ListIndex = i
    Else
       ShowMsg 0, "当前一个汇率也没有，不能进行清除过时汇率操作！", _
                vbExclamation + MB_TASKMODAL, Me.Caption
       mRateIsnone = True
       Unload Me
       Exit Sub
    End If
    mRateIsnone = False
    recCurrency.Close
End Sub