frmwarnlistcard.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 frmWarnListCard 
   Caption         =   "报警器列表"
   ClientHeight    =   3525
   ClientLeft      =   45
   ClientTop       =   270
   ClientWidth     =   6405
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   3525
   ScaleWidth      =   6405
   Begin VB.Data datTerm 
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   ""
      DefaultCursorType=   0  '缺省游标
      DefaultType     =   2  '使用 ODBC
      Exclusive       =   0   'False
      Height          =   375
      Left            =   5064
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   ""
      Top             =   3072
      Visible         =   0   'False
      Width           =   1260
   End
   Begin VB.CheckBox chkShowAll 
      Caption         =   "全部显示"
      Height          =   276
      Left            =   3924
      TabIndex        =   0
      Top             =   3156
      Width           =   1140
   End
   Begin MSFlexGridLib.MSFlexGrid msgTerm 
      Bindings        =   "frmWarnListCard.frx":0000
      Height          =   2832
      Left            =   -24
      TabIndex        =   1
      Tag             =   "ctPayMethod////101"
      Top             =   192
      Width           =   6288
      _ExtentX        =   11113
      _ExtentY        =   5001
      _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 cmdVoucherType 
      Height          =   348
      Index           =   0
      Left            =   -12
      TabIndex        =   2
      Top             =   3132
      WhatsThisHelpID =   5010
      Width           =   1212
      Caption         =   "打印"
      PicturePosition =   196613
      Size            =   "2143;609"
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
End
Attribute VB_Name = "frmWarnListCard"
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 = 149                                    '视图ID

'
'方法及函数
'

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
   ' Dim Query As rdoquery
    strSelectOfSql = mclsList.ListSet.GetSelect
    strFromOfSql = mclsList.ListSet.FromOfSql
    strWhereOfSql = mclsList.ListSet.WhereOfSql
    strSelectOfSql = "Select Note.lngNoteID As id,iif(Note.blnIsDoned,'√','') As 完成," & strSelectOfSql
    If strWhereOfSql <> "" Then
        strWhereOfSql = " where Note.strdate <= format(dateadd('d',Note.bytDay,date()),'yyyy-mm-dd')  " _
           & " and (Note.lngExecutantID=0 OR Note.lngExecutantID=" & gclsBase.OperatorID & ") and " & strWhereOfSql
    Else
        strWhereOfSql = " where Note.strdate <= format(dateadd('d',Note.bytDay,date()),'yyyy-mm-dd')  " _
           & " and Note.lngExecutantID=0 OR Note.lngExecutantID=" & gclsBase.OperatorID
    End If
    strSql = strSelectOfSql & strFromOfSql & strWhereOfSql
    strSql = strReplace(strSql, "Date()", "#" & gclsBase.BaseDate & "#")
    'Set Query = gclsBase.BaseDB.CreateQuery("", strSql)
    'Query.rdoParameters("lngOperatorID") = gclsBase.OperatorID
    'Set recRecordset = Query.openresultset(rdopenstatic)
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    '列表是否为空
    If recRecordset.RowCount = 0 Then
        msgTerm.HighLight = flexHighlightNever      '光标亮条消失
       ' cmdAgain.Enabled = False
       cmdVoucherType(0).Enabled = False
       frmMain.mnuFilePrint.Enabled = False
       'cmdVoucherType(1).Enabled = False
    Else
        msgTerm.HighLight = flexHighlightAlways     '光标亮条显示
        'cmdAgain.Enabled = True
        cmdVoucherType(0).Enabled = True
        frmMain.mnuFilePrint.Enabled = True
        'cmdVoucherType(1).Enabled = True
    End If
    frmMain.mnuFilePrintSetup.Enabled = True
    mclsList.ShowAll = True
    Set GetList = recRecordset
End Function
'按照付款条件ID更新停用标志
Private Function UpdateTermInActive(ByVal lngID As Long, ByVal blnIsDoned As Boolean) As Boolean
    Dim strSql As String
    strSql = "UPDATE [Note] SET blnIsDoned = " & blnIsDoned & " WHERE lngNoteID = " & lngID
    UpdateTermInActive = gclsBase.ExecSQL(strSql)
End Function
Public Property Get TermID() As Long
    With msgTerm
    If .TextArray(.Row * .Cols) <> "" And .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

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

Private Sub chkShowAll_Click()
    msgTerm.Redraw = False
    mclsList.DoShowAll chkShowAll.Value
    msgTerm.Redraw = True
    'cboFindKind_Click
    'UpdateMenuStatus
End Sub

Private Sub cmdVoucherType_Click(Index As Integer)
'    Select Case Index
'        Case 0
'            ' AccountTotail
'        Case 1
'            'Detail
'        Case 2
'           ' frmReminderCard.Show
'
'    End Select
    Dim myPrintclass As PrintClass
    Set myPrintclass = New PrintClass
    myPrintclass.PrintList gclsBase.BaseDB, mclsList.FlexGrid, 66, Me.Caption & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    Set myPrintclass = Nothing
End Sub

'
'窗体 Form 控件
'
Private Sub Form_Load()
    Dim i As Integer
    Dim intSortCol As Integer
    On Error GoTo ErrHandle
'    Me.Hide
'    Me.Left = -30000
    MsgForm.PleaseWait
    Me.HelpContextID = 80008
    '付款条件列表窗体初始化
    Debug.Print "Load Start: ", Timer
    Set mclsList = New list
    mclsList.FlexNoChange = True
    mclsList.FindNoChange = True
    Set mclsList.FlexGrid = msgTerm
    'Set mclsList.FindKind = cboFindKind
    'Set mclsList.Find = txtFind
    'Set mclsList.Again = cmdAgain
    mclsList.ListSet.ViewId = intViewID