frmcommlist.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"
Object = "{F6125AB1-8AB1-11CE-A77F-08002B2F4E98}#2.0#0"; "MSRDC20.OCX"
Begin VB.Form frmCommList 
   Caption         =   "Form1"
   ClientHeight    =   3660
   ClientLeft      =   60
   ClientTop       =   348
   ClientWidth     =   6540
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   3660
   ScaleWidth      =   6540
   Begin MSRDC.MSRDC datCurrencys 
      Height          =   345
      Left            =   5340
      Top             =   3270
      Visible         =   0   'False
      Width           =   1200
      _ExtentX        =   2117
      _ExtentY        =   593
      _Version        =   393216
      Options         =   0
      CursorDriver    =   0
      BOFAction       =   0
      EOFAction       =   0
      RecordsetType   =   1
      LockType        =   3
      QueryType       =   0
      Prompt          =   3
      Appearance      =   1
      QueryTimeout    =   30
      RowsetSize      =   100
      LoginTimeout    =   15
      KeysetSize      =   0
      MaxRows         =   0
      ErrorThreshold  =   -1
      BatchSize       =   15
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Enabled         =   -1  'True
      ReadOnly        =   0   'False
      Appearance      =   -1  'True
      DataSourceName  =   ""
      RecordSource    =   ""
      UserName        =   ""
      Password        =   ""
      Connect         =   ""
      LogMessages     =   ""
      Caption         =   "MSRDC1"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.ComboBox cboFindKind 
      Height          =   300
      ItemData        =   "frmCommList.frx":0000
      Left            =   670
      List            =   "frmCommList.frx":0002
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   90
      Width           =   1515
   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            =   5965
      Style           =   1  'Graphical
      TabIndex        =   4
      Tag             =   "1017"
      ToolTipText     =   "再找"
      Top             =   90
      UseMaskColor    =   -1  'True
      Width           =   300
   End
   Begin VB.CheckBox chkShowAll 
      Caption         =   "全部显示"
      Height          =   350
      Left            =   3745
      TabIndex        =   7
      Top             =   3240
      Width           =   1095
   End
   Begin VB.TextBox txtfind 
      Height          =   300
      Left            =   3190
      TabIndex        =   3
      Text            =   "Text1"
      Top             =   90
      Width           =   2775
   End
   Begin MSFlexGridLib.MSFlexGrid msgCurrencys 
      Bindings        =   "frmCommList.frx":0004
      Height          =   2655
      Left            =   0
      TabIndex        =   5
      Tag             =   "ctPayMethod////101"
      Top             =   480
      Width           =   6495
      _ExtentX        =   11451
      _ExtentY        =   4678
      _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 MSForms.CommandButton cmdReport 
      Height          =   345
      Left            =   1155
      TabIndex        =   8
      TabStop         =   0   'False
      Tag             =   "1018"
      Top             =   3945
      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
   Begin MSForms.CommandButton cmdEdit 
      Height          =   345
      Left            =   0
      TabIndex        =   6
      Tag             =   "1018"
      Top             =   3270
      WhatsThisHelpID =   5010
      Width           =   1215
      Caption         =   "编辑"
      PicturePosition =   196613
      Size            =   "2143;609"
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
   Begin VB.Label lblFindKind 
      AutoSize        =   -1  'True
      Caption         =   "查找(&B)"
      Height          =   180
      Left            =   0
      TabIndex        =   0
      Top             =   150
      Width           =   630
   End
   Begin VB.Label lblFind 
      AutoSize        =   -1  'True
      Caption         =   "内容(&C)"
      Height          =   180
      Left            =   2415
      TabIndex        =   2
      Top             =   150
      Width           =   630
   End
End
Attribute VB_Name = "frmCommList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''
'   币种汇率列表
'   作者：郑权
'   日期：98.6.23
'   引出属性:IsShowCard 功能：判断币种汇率卡片是否关闭
'   引入参数：msgcurrency 功能：判断常用币种汇率是否发出（增加或修改）改变消息
'
'''''''''''''''''''''''''''''''''''''''
Option Explicit
Private mstrListName As String
Private mintListType  As Integer
Private mIsHaveRight As Boolean
Private mIsShowCard(3) 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                                    '列表对象
Private intViewID As Integer                                 '视图ID
Private mblnFirstLoad  As Boolean
'
'方法及函数
'
'取币种记录集

Public Function GetbyListID(ByVal lngID As Long) As rdoResultset
    Dim recRecordset As rdoResultset
    Dim strSql As String
    Select Case mintListType
        Case 1
            strSql = "Select * From Currencys Where lngCurrencyID = " & lngID
        Case 2
            strSql = "Select * From VoucherType Where lngVoucherTypeID = " & lngID
        Case 3
            strSql = "Select * From PaymentMethod Where lngPaymentMethodID = " & lngID
        Case 4
            strSql = "Select * From Term Where lngTermID = " & lngID
    End Select
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Set GetbyListID = recRecordset
End Function

'产生币种列表记录集
Public Function GetList() As Boolean
    Dim recRecordset As rdoResultset
    Dim strSelectOfSql As String
    Dim strFromOfSql As String
    Dim strWhereOfSql As String
    Dim strSql As String
    
    GetList = False
    strSelectOfSql = mclsList.ListSet.GetSelect
    strFromOfSql = mclsList.ListSet.FromOfSql
    strWhereOfSql = mclsList.ListSet.WhereOfSql
    Select Case mintListType
        Case 1
            strSelectOfSql = "Select Currencys.lngCurrencyID As id,decode(Currencys.blnIsInActive,1,'√','') As ""停用""," & strSelectOfSql
        Case 2
            strSelectOfSql = "Select VoucherType.lngVoucherTypeID As id,decode(VoucherType.blnIsInActive,1,'√','') As ""停用""," & strSelectOfSql
        Case 3
            strSelectOfSql = "Select PaymentMethod.lngPaymentMethodID As id,decode(PaymentMethod.blnIsInActive,1,'√','') As ""停用""," & strSelectOfSql
        Case 4
            strSelectOfSql = "Select Term.lngTermID As id,decode(Term.blnIsInActive,1,'√','') As 停用," & strSelectOfSql
    End Select
    If Trim(strWhereOfSql) <> "" Then
       strWhereOfSql = " Where " & strWhereOfSql
    End If
    strSql = strSelectOfSql & strFromOfSql & strWhereOfSql
    'Debug.Print strSql
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    
    '列表是否为空
    Dim blnRecordSetNum As Boolean
    If recRecordset.RowCount = 0 Then
        'If mintListType = 2 Then frmInitVoucherTypeCard.AddCard
        If mintListType = 2 And mblnFirstLoad Then
            frmInitVoucherTypeCard.Show vbModal
            Set frmInitVoucherTypeCard = Nothing
        End If
        Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    End If
    If mblnFirstLoad Then mblnFirstLoad = False
    If recRecordset.RowCount = 0 Then
        msgCurrencys.HighLight = flexHighlightNever
        cmdAgain.Enabled = False
        blnRecordSetNum = True
    Else
        'recRecordset.MoveLast
        msgCurrencys.HighLight = flexHighlightAlways
        cmdAgain.Enabled = True
        blnRecordSetNum = False
    End If
    Set datCurrencys.Resultset = recRecordset
    If datCurrencys.Resultset.RowCount > 0 Then
       datCurrencys.Resultset.MoveLast
    End If
    datCurrencys.Resultset.Close
'    recRecordset.Close
    
    mclsList.ShowAll = True
    'Set GetList = recRecordset
    If mintListType = 2 And blnRecordSetNum Then
        GetList = False
    Else
        GetList = True
    End If
End Function
'显示列表接口
Public Function ShowList(ByVal lngID As Long, ByVal intListType) As Boolean
    Dim intCount As Integer
    Dim strSortField As String
    Dim strSortDec As String
    Dim strSql As String
    Dim recTemp As rdoResultset
    Dim strofFrom As String
    Dim strofWhere As String
'    Me.Show
'    Me.ZOrder 0
    Me.BindingResultSet
    
    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
    Select Case intListType
        Case 1
            
            If Trim(strofWhere) <> "" Then
                strofWhere = " where " & strofWhere & " and Currencys.lngCurrencyID=" & lngID
            Else
                strofWhere = " where Currencys.lngCurrencyID=" & lngID
            End If
        Case 2
            
            If Trim(strofWhere) <> "" Then
                strofWhere = " where " & strofWhere & " and VoucherType.lngVoucherTypeID=" & lngID
            Else
                strofWhere = " where VoucherType.lngVoucherTypeID=" & lngID
            End If
        Case 3
            If Trim(strofWhere) <> "" Then
                strofWhere = " where " & strofWhere & " and PaymentMethod.lngPaymentMethodID=" & lngID
            Else
                strofWhere = " where PaymentMethod.lngPaymentMethodID=" & lngID
            End If
        Case 4
            If Trim(strofWhere) <> "" Then
                strofWhere = " where " & strofWhere & " and lngTermID=" & lngID
            Else
                strofWhere = " where lngTermID=" & lngID
            End If
    End Select
    strSql = strSql & strofFrom & strofWhere
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With recTemp
        If .RowCount > 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
    'Me.msgCurrencys.SetFocus
End Function