currencyslist.frm

金算盘软件代码

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Begin VB.Form frmCurrencysList 
   BackColor       =   &H80000004&
   Caption         =   "币种汇率列表"
   ClientHeight    =   3660
   ClientLeft      =   2190
   ClientTop       =   1815
   ClientWidth     =   6570
   Icon            =   "CurrencysList.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MDIChild        =   -1  'True
   ScaleHeight     =   3660
   ScaleWidth      =   6570
   WhatsThisButton =   -1  'True
   WhatsThisHelp   =   -1  'True
   Begin VB.TextBox txtfind 
      Height          =   300
      Left            =   3240
      TabIndex        =   4
      Text            =   "Text1"
      Top             =   120
      Width           =   2775
   End
   Begin VB.CheckBox chkShowAll 
      Caption         =   "全部显示"
      Height          =   350
      Left            =   3795
      TabIndex        =   8
      Top             =   3210
      Width           =   1095
   End
   Begin VB.CommandButton cmdAgain 
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   6015
      Style           =   1  'Graphical
      TabIndex        =   5
      Tag             =   "1017"
      ToolTipText     =   "再找"
      Top             =   90
      UseMaskColor    =   -1  'True
      Width           =   300
   End
   Begin VB.ComboBox cboFindKind 
      Height          =   300
      ItemData        =   "CurrencysList.frx":0442
      Left            =   720
      List            =   "CurrencysList.frx":0444
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   90
      Width           =   1515
   End
   Begin VB.Data datCurrencys 
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   ""
      DefaultCursorType=   0  '缺省游标
      DefaultType     =   2  '使用 ODBC
      Exclusive       =   0   'False
      Height          =   375
      Left            =   5130
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   ""
      Top             =   3180
      Visible         =   0   'False
      Width           =   1260
   End
   Begin MSFlexGridLib.MSFlexGrid msgCurrencys 
      Bindings        =   "CurrencysList.frx":0446
      Height          =   2655
      Left            =   50
      TabIndex        =   0
      Tag             =   "ctPayMethod////101"
      Top             =   480
      Width           =   6495
      _ExtentX        =   11456
      _ExtentY        =   4683
      _Version        =   393216
      Rows            =   20
      Cols            =   3
      FixedCols       =   0
      BackColor       =   16777215
      BackColorFixed  =   -2147483644
      BackColorSel    =   -2147483646
      BackColorBkg    =   16777215
      Redraw          =   -1  'True
      AllowBigSelection=   0   'False
      FocusRect       =   0
      SelectionMode   =   1
      AllowUserResizing=   1
   End
   Begin VB.Label lblFind 
      AutoSize        =   -1  'True
      Caption         =   "内容(&C)"
      Height          =   180
      Left            =   2460
      TabIndex        =   3
      Top             =   150
      Width           =   630
   End
   Begin VB.Label lblFindKind 
      AutoSize        =   -1  'True
      Caption         =   "查找(&F)"
      Height          =   180
      Left            =   50
      TabIndex        =   1
      Top             =   150
      Width           =   630
   End
   Begin MSForms.CommandButton cmdEdit 
      Height          =   350
      Left            =   50
      TabIndex        =   6
      Tag             =   "1018"
      Top             =   3240
      WhatsThisHelpID =   5010
      Width           =   1215
      Caption         =   "编辑"
      PicturePosition =   196613
      Size            =   "2143;609"
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
   Begin MSForms.CommandButton cmdReport 
      Height          =   345
      Left            =   1200
      TabIndex        =   7
      Tag             =   "1018"
      Top             =   3915
      Visible         =   0   'False
      WhatsThisHelpID =   5010
      Width           =   1215
      Caption         =   "报表"
      PicturePosition =   196613
      Size            =   "2143;609"
      TakeFocusOnClick=   0   'False
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
End
Attribute VB_Name = "frmCurrencysList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''
'   币种汇率列表
'   作者：郑权
'   日期：98.6.23
'   引出属性:IsShowCard 功能：判断币种汇率卡片是否关闭
'   引入参数：msgcurrency 功能：判断常用币种汇率是否发出（增加或修改）改变消息
'
'''''''''''''''''''''''''''''''''''''''
Option Explicit
Private mIsShowCard(1) As Boolean                                  '卡片窗口显示标志
Private mblnCheckNoChange As Boolean                            '不需要响应chkshowAll控件Change事件
Private WithEvents mclsMainControl As MainControl               '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private WithEvents mclsSubClass As SubClass32.SubClass          '钩子对象
Attribute mclsSubClass.VB_VarHelpID = -1
Private WithEvents mclsSubClassform As SubClass32.SubClass
Attribute mclsSubClassform.VB_VarHelpID = -1
Private mclsList As list                                    '列表对象
Attribute mclsList.VB_VarHelpID = -1
Private Const intViewID = 15                                '视图ID

'
'方法及函数
'
'取币种记录集

Public Function GetByCurrencysID(ByVal lngID As Long) As Recordset
    Dim recRecordset As Recordset
    Dim strSql As String
    
    strSql = "Select * From Currencys Where lngCurrencyID = " & lngID
    Set recRecordset = gclsBase.BaseDB.OpenRecordset(strSql, dbRunAsync)
    Set GetByCurrencysID = recRecordset
End Function

'产生币种列表记录集
Public Function GetList() As Recordset
    Dim recRecordset As Recordset
    Dim strSelectOfSql As String
    Dim strFromOfSql As String
    Dim strWhereOfSql As String
    Dim strSql As String
    
    strSelectOfSql = mclsList.ListSet.GetSelect
    strFromOfSql = mclsList.ListSet.FromOfSql
    strWhereOfSql = mclsList.ListSet.WhereOfSql
    strSelectOfSql = "Select Currencys.lngCurrencyID As id,IIF(Currencys.blnIsInActive,'√','') As 停用," & strSelectOfSql
    If strWhereOfSql <> "" Then
       strWhereOfSql = " Where " & strWhereOfSql
    End If
    strSql = strSelectOfSql & strFromOfSql & strWhereOfSql
    'Debug.Print strSql
    Set recRecordset = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
    
    '列表是否为空
    If recRecordset.RecordCount = 0 Then
        msgCurrencys.HighLight = flexHighlightNever
        cmdAgain.Enabled = False
    Else
        'recRecordset.MoveLast
        msgCurrencys.HighLight = flexHighlightAlways
        cmdAgain.Enabled = True
    End If
    mclsList.ShowAll = True
    Set GetList = recRecordset
End Function
'显示列表接口
Public Function ShowList(ByVal lngID As Long) As Boolean
    Dim intCount As Integer
    Dim strSortField As String
    Dim strSortDec As String
    Dim strSql As String
    Dim recTemp As Recordset
    Dim strofFrom As String
    Dim strofWhere As String
    Me.Show
    Me.ZOrder 0
    With mclsList.ListSet
        '得到排序字段
        For intCount = 1 To .Columns
            If .ColumnOrderType(intCount) <> 0 Then
                strSortField = .ColumnFieldName(intCount)
                strSortDec = .ColumnDesc(intCount)
                Exit For
            End If
        Next
        If intCount > .Columns Then
            ShowList = False
            Exit Function
        End If
        strofFrom = .FromOfSql
        strofWhere = .WhereOfSql
    End With
    '根据lngID得到排序字段值
    strSql = "Select " & strSortField & " As " & strSortDec
    If strofWhere <> "" Then
        strofWhere = " where " & strofWhere & "and Currencys.lngCurrencyID=" & lngID
    Else
        strofWhere = " where Currencys.lngCurrencyID=" & lngID
    End If
    strSql = strSql & strofFrom & strofWhere
    Set recTemp = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenForwardOnly)
    With recTemp
        If .RecordCount > 0 Then
            txtfind.Text = recTemp(strSortDec)   '查找
            If msgCurrencys.TextMatrix(msgCurrencys.Row, 0) = lngID Then     '是否找到
                ShowList = True
            Else
                ShowList = False
            End If
        Else
            ShowList = False
        End If
        .Close
    End With
End Function

'反映是否有卡片存在
Public Property Let IsShowCard(ByVal Index As Integer, ByVal vNewValue As Boolean)
   mIsShowCard(Index) = vNewValue
End Property
Public Property Get IsShowCard(ByVal Index As Integer) As Boolean
   IsShowCard = mIsShowCard(Index)
End Property


'按照币种ID更新停用标志
Private Function UpdateCurrencysInActive(ByVal lngID As Long, ByVal blnIsInActive As Boolean) As Boolean
    Dim strSql As String
    
    strSql = "UPDATE Currencys SET blnIsInActive = " & blnIsInActive & " WHERE lngCurrencyID = " & lngID
    
    UpdateCurrencysInActive = gclsBase.ExecSQL(strSql)
End Function

'删除币种ID指定记录
Private Function DelByCurrencysID(ByVal lngID As Long) As Boolean
    Dim strSql As String
    
    strSql = "Delete * From Currencys Where lngCurrencyID = " & lngID
    
    DelByCurrencysID = gclsBase.ExecSQL(strSql)
End Function

'判断币种ID是否使用
Private Function IsUseCurrencysID(ByVal lngID As Long) As Boolean
    Dim recRecordset As Recordset
    Dim strSql As String
    
    strSql = "Select lngCurrencyID From ActivityDetail Where lngCurrencyID = " & lngID
    Set recRecordset = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
    IsUseCurrencysID = (recRecordset.RecordCount >= 1)
    recRecordset.Close
End Function

' 币种ID
Public Property Get CurrencysID() As Long
    With msgCurrencys
        If .TextArray(.Row * .Cols) <> "" And .Row > 0 Then
            CurrencysID = CLng(.TextArray(.Row * .Cols))
        Else
            CurrencysID = 0
        End If
    End With
End Property

' 币种停用标志
Public Property Get CurrencysIsInActive() As Boolean
    If chkShowAll.Value Then
        With msgCurrencys
            CurrencysIsInActive = Not (.TextArray(.Row * .Cols + 1) = "")
        End With
    Else
        CurrencysIsInActive = False
    End If
End Property

'根据列表中记录数，设置菜单可用属性
Private Sub UpdateMenuStatus()
    Dim blnIsnotEmpty As Boolean
    Dim blnFindNoChange As Boolean
    Dim IsHaveRight As Boolean
    
    IsHaveRight = IsCanDo(22, gclsBase.OperatorID)
    With msgCurrencys