frmnotelist.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 frmNotelist 
   Caption         =   "备忘录"
   ClientHeight    =   3660
   ClientLeft      =   108
   ClientTop       =   348
   ClientWidth     =   6660
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form2"
   LockControls    =   -1  'True
   MDIChild        =   -1  'True
   ScaleHeight     =   3660
   ScaleWidth      =   6660
   Visible         =   0   'False
   Begin MSRDC.MSRDC datTerm 
      Height          =   348
      Left            =   4968
      Top             =   3192
      Visible         =   0   'False
      Width           =   1524
      _ExtentX        =   2688
      _ExtentY        =   614
      _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.CheckBox chkShowAll 
      Caption         =   "全部显示"
      Height          =   300
      Left            =   3576
      TabIndex        =   7
      Top             =   3216
      Width           =   1332
   End
   Begin VB.CommandButton cmdAgain 
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   10.8
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   5940
      Style           =   1  'Graphical
      TabIndex        =   4
      Tag             =   "1017"
      Top             =   90
      UseMaskColor    =   -1  'True
      Width           =   300
   End
   Begin VB.TextBox txtFind 
      Height          =   300
      Left            =   4020
      TabIndex        =   3
      Top             =   90
      Width           =   1905
   End
   Begin VB.ComboBox cboFindKind 
      Height          =   300
      Left            =   900
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   90
      Width           =   1695
   End
   Begin MSFlexGridLib.MSFlexGrid msgTerm 
      Bindings        =   "frmNotelist.frx":0000
      Height          =   2565
      Left            =   30
      TabIndex        =   5
      Tag             =   "ctPayMethod////101"
      Top             =   480
      Width           =   6495
      _ExtentX        =   11451
      _ExtentY        =   4530
      _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 
      Caption         =   "内容(&C)"
      Height          =   180
      Left            =   3276
      TabIndex        =   2
      Top             =   150
      Width           =   660
   End
   Begin VB.Label lblFindKind 
      Caption         =   "查找(&B)"
      Height          =   180
      Left            =   48
      TabIndex        =   0
      Top             =   150
      Width           =   660
   End
   Begin MSForms.CommandButton cmdPosition 
      Height          =   345
      Index           =   0
      Left            =   50
      TabIndex        =   6
      Tag             =   "1018"
      Top             =   3210
      WhatsThisHelpID =   5010
      Width           =   1215
      Caption         =   "编辑"
      PicturePosition =   196613
      Size            =   "2143;617"
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
End
Attribute VB_Name = "frmNotelist"
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 = 65                                  '视图ID
Private mblnIsSaveListset As Boolean

'
'方法及函数
'

Public Property Let IsShowCard(ByVal vNewValue As Boolean)
   mIsShowCard = vNewValue
End Property
Public Property Get IsShowCard() As Boolean
  IsShowCard = mIsShowCard
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 Note.lngNoteID As id,decode(Note.blnIsDoned,1,'√','') As ""完成""," & strSelectOfSql
    If Trim(strWhereOfSql) <> "" Then
        strWhereOfSql = " Where  " & strWhereOfSql
    Else
       ' strWhereOfSql = " Where " ' Note.lngExecutantID =0"
    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 Note.lngNoteID As id,decode(Note.blnIsDoned,1,'√','') As ""完成""," _
    & "Note.strDate As ""日期"" ,Note.strNote As ""备忘录"",decode(Note.blnIsDoned,1,'√','') As ""完成"" From Note Where lngNoteID = " & lngID
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Set GetByTermID = recRecordset
End Function

'按照付款条件ID更新停用标志
Private Function UpdateTermIsDone(ByVal lngID As Long, ByVal blnIsDone As Boolean) As Boolean
    Dim strSql As String
    
    strSql = "UPDATE [Note] SET blnIsDoned = " & IIf(blnIsDone, 1, 0) & " WHERE lngNoteID = " & lngID
    UpdateTermIsDone = gclsBase.ExecSQL(strSql)
End Function

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

'判断付款条件ID是否使用
Private Function IsUseTermID(ByVal lngID As Long) As Boolean
    Dim recRecordset As rdoResultset
    Dim strSql As String
    
    strSql = "Select lngNoteID From Item Where lngNoteID = " & lngID
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    IsUseTermID = (recRecordset.RowCount >= 1)
    recRecordset.Close
End Function

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

'得到付款条件停用标志
Public Property Get TermIsDone() As Boolean
    If chkShowAll.Value Then
        With msgTerm
            TermIsDone = Not (.TextArray(.Row * .Cols + 1) = "")
        End With
    Else
        TermIsDone = 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
        .mnuEditEdit.Caption = "修改(&E)"
        .mnuEditNew.Caption = "新增(&N)"
        .mnuEditDel.Caption = "删除(&D)"
        .mnuEditCopy.Enabled = blnIsnotEmpty
        .mnuEditEdit.Enabled = blnIsnotEmpty
        .mnuEditNew.Enabled = True
        .mnuEditDel.Enabled = blnIsnotEmpty
        .mnuEditInActive.Checked = False
        .mnuEditInActive.Visible = False
        .mnuEditInActive.Enabled = blnIsnotEmpty
        .mnuEditShowAll.Checked = chkShowAll.Value
        .mnuEditShowAll.Enabled = True
        .mnuEditFilter.Enabled = True
        .mnuFilePrint.Enabled = True
        .mnuFilePrintSetup.Enabled = True
        .mnuEditColumn = True
       ' .mnuReportQuick.Enabled = blnIsNotEmpty
        .mnuToolRefresh.Enabled = True
'        .mnuListEditMenu(4).Enabled = blnIsNotEmpty
'        .mnuListEditMenu(5).Enabled = blnIsNotEmpty
    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()
    
    '重画其余控件
    On Error Resume Next
    txtFind.width = Me.ScaleWidth - txtFind.Left - ListFormBottom - cmdAgain.width - 15
    cmdAgain.Left = txtFind.Left + txtFind.width
    cmdPosition(0).top = Me.ScaleHeight - cmdPosition(0).Height - ListFormBottom
    'cmdPosition(1).top = cmdPosition(0).top
    'cmdPosition(2).Top = cmdPosition(0).Top
    chkShowAll.top = cmdPosition(0).top
    chkShowAll.Left = Me.ScaleWidth - chkShowAll.width - ListFormBottom
   
    '重画MS FlexGrid 控件
    With msgTerm
        .Left = ListFormLeft
        .width = Me.ScaleWidth - ListFormLeft - ListFormRight
        .Height = Me.ScaleHeight - ListUpAreaHeight - ListDownAreaHeight
    End With
   
End Sub