frmlistright.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 frmListRight 
   Caption         =   "操作员权限列表"
   ClientHeight    =   3648
   ClientLeft      =   60
   ClientTop       =   348
   ClientWidth     =   6552
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MDIChild        =   -1  'True
   ScaleHeight     =   3648
   ScaleWidth      =   6552
   Begin MSRDC.MSRDC datTerm 
      Height          =   312
      Left            =   4992
      Top             =   3312
      Visible         =   0   'False
      Width           =   1044
      _ExtentX        =   1842
      _ExtentY        =   550
      _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        =   "frmListRight.frx":0000
      Left            =   720
      List            =   "frmListRight.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            =   6240
      Style           =   1  'Graphical
      TabIndex        =   4
      Tag             =   "1017"
      ToolTipText     =   "再找"
      Top             =   90
      UseMaskColor    =   -1  'True
      Width           =   300
   End
   Begin VB.CheckBox chkShowAll 
      Caption         =   "全部显示"
      Height          =   225
      Left            =   3870
      TabIndex        =   7
      Top             =   3300
      Width           =   1095
   End
   Begin VB.TextBox txtFind 
      Height          =   300
      Left            =   3240
      TabIndex        =   3
      Text            =   "Text1"
      Top             =   90
      Width           =   3015
   End
   Begin MSFlexGridLib.MSFlexGrid msgTerm 
      Bindings        =   "frmListRight.frx":0004
      Height          =   2655
      Left            =   60
      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 cmdER 
      Height          =   345
      Index           =   1
      Left            =   1140
      TabIndex        =   8
      TabStop         =   0   'False
      Tag             =   "1018"
      Top             =   3780
      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 cmdER 
      Height          =   345
      Index           =   0
      Left            =   50
      TabIndex        =   6
      Tag             =   "1018"
      Top             =   3210
      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            =   50
      TabIndex        =   0
      Top             =   150
      Width           =   630
   End
   Begin VB.Label lblFind 
      AutoSize        =   -1  'True
      Caption         =   "内容(&C)"
      Height          =   180
      Left            =   2400
      TabIndex        =   2
      Top             =   150
      Width           =   630
   End
End
Attribute VB_Name = "frmListRight"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'统计核算模块
'      作者：欧中建
'      日期：1998.6.10
'1.1 所用类模块：List
'1.2 所用钩子函数：mclsSubClass，mclsSubClassForm。

Option Explicit
Private mIsShowCard 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 Const intViewID = 35                                    '视图ID
Private mblnIsSaveListset As Boolean                             'Whether or not save lngViewID in List

'
'方法及函数
'
Public Property Let IsShowCard(ByVal vNewValue As Boolean)
   mIsShowCard = vNewValue
End Property

'产生付款条件列表记录集
Public Function GetList() As rdoResultset
    Dim recRecordset As rdoResultset
    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 Operator.lngOperatorID As id,decode(Operator.blnIsInActive,1,'√','') As ""停用""," & strSelectOfSql
    If Trim(strWhereOfSql) <> "" Then
        strWhereOfSql = " Where  " & strWhereOfSql
    End If
    strSql = strSelectOfSql & strFromOfSql & strWhereOfSql
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    
    '列表是否为空
    If recRecordset.RowCount = 0 Then
        msgTerm.HighLight = flexHighlightNever      '光标亮条消失
        cmdAgain.Enabled = False
    Else
        msgTerm.HighLight = flexHighlightAlways     '光标亮条显示
        cmdAgain.Enabled = True
    End If
    mclsList.ShowAll = True
    Set GetList = recRecordset
End Function

'按照付款条件ID提取记录
Public Function GetByTermID(ByVal lngID As Long) As rdoResultset
    Dim recRecordset As rdoResultset
    Dim strSql As String
    
    strSql = "Select * From Operator Where lngOperatorID = " & lngID
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Set GetByTermID = recRecordset
End Function

'按照付款条件ID更新停用标志
Private Function UpdateTermInActive(ByVal lngID As Long, ByVal blnIsInActive As Boolean) As Boolean
    Dim strSql As String
    
    strSql = "UPDATE Operator SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE lngOperatorID = " & lngID
    UpdateTermInActive = gclsBase.ExecSQL(strSql)
End Function

'删除付款条件ID指定记录
Private Function DelByTermID(ByVal lngID As Long) As Boolean
    Dim strSql As String
    strSql = "Delete  From Class1 Where lngClassID = " & lngID
    DelByTermID = gclsBase.ExecSQL(strSql)
End Function

'判断付款条件ID是否使用
Private Function IsUseTermID(ByVal lngID As Long) As Boolean

End Function

'得到付款条件ID
Public Property Get TermID() As Long
    With msgTerm
        If .TextArray(.Row * .Cols) <> "" And .Row > 0 And .ColSel <> 0 And .RowHeight(.Row) > 0 Then
            TermID = CLng(.TextArray(.Row * .Cols))
        Else
            TermID = 0
        End If
    End With
End Property

'得到付款条件停用标志
Public Property Get TermIsInActive() As Boolean
    If chkShowall.Value Then
        With msgTerm
            TermIsInActive = Not (.TextArray(.Row * .Cols + 1) = "")
        End With
    Else
        TermIsInActive = False
    End If
End Property

'根据列表中记录数，设置菜单可用属性
Private Sub UpdateMenuStatus()
    Dim blnIsnotEmpty As Boolean
    Dim blnFindNoChange As Boolean
    
    If msgTerm.Rows > 1 And msgTerm.ColSel <> 0 And msgTerm.RowHeight(msgTerm.Row) > 0 Then
        blnIsnotEmpty = True
    Else
        blnIsnotEmpty = False
    End If
    With frmMain
        .mnuEditCopy.Enabled = blnIsnotEmpty
        .mnuEditEdit.Enabled = blnIsnotEmpty
        .mnuEditEdit.Caption = "修改操作员(&E)"
        .mnuEditNew.Enabled = True
        .mnuEditNew.Caption = "新增操作员(&N)"
        .mnuEditDel.Enabled = blnIsnotEmpty
        .mnuEditDel.Caption = "删除操作员(&D)"
        .mnuEditInActive.Checked = False
        .mnuEditInActive.Visible = False
        .mnuEditInActive.Enabled = blnIsnotEmpty
        .mnuEditShowAll.Checked = chkShowall.Value
        .mnuEditShowAll.Enabled = True
        .mnuEditColumn.Enabled = True
        .mnuEditFilter.Enabled = True
        .mnuFilePrint.Enabled = True
        .mnuFilePrintSetup.Enabled = True
        '.mnuAccountVoucher.Enabled = blnIsNotEmpty
        '.mnuReportQuick.Enabled = blnIsNotEmpty
        .mnuToolRefresh.Enabled = True
    End With
    
    If msgTerm.ColSel = 0 Then  '无当前选定行
        blnFindNoChange = mclsList.FindNoChange
        mclsList.FindNoChange = True
        txtFind.Text = ""
        mclsList.FindNoChange = blnFindNoChange
        cmdAgain.Enabled = False
    End If
    frmMain.SetToolBar
End Sub

'重画Form
Private Sub RedrawForm()
    '重画MS FlexGrid 控件
    On Error Resume Next
    With msgTerm
        .Left = ListFormLeft
        .width = Me.ScaleWidth - ListFormLeft - ListFormRight
        .Height = Me.ScaleHeight - ListUpAreaHeight - ListDownAreaHeight
    End With
    
    '重画其余控件
    txtFind.width = Me.ScaleWidth - txtFind.Left - ListFormBottom - cmdAgain.width - 15
    cmdAgain.Left = txtFind.Left + txtFind.width
    cmdER(0).top = Me.ScaleHeight - cmdER(0).Height - ListFormBottom
    cmdER(1).top = cmdER(0).top
    'cmdClass1(2).Top = cmdClass1(0).Top
    chkShowall.top = cmdER(0).top