📄 frmwarnlist.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 frmWarnList
Caption = "报警列表"
ClientHeight = 3684
ClientLeft = 60
ClientTop = 348
ClientWidth = 6636
KeyPreview = -1 'True
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 3684
ScaleWidth = 6636
Begin MSRDC.MSRDC datTerm
Height = 312
Left = 5184
Top = 3264
Visible = 0 'False
Width = 1188
_ExtentX = 2096
_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.CheckBox chkShowAll
Caption = "全部显示"
Height = 276
Left = 4008
TabIndex = 2
Top = 3264
Width = 1140
End
Begin MSFlexGridLib.MSFlexGrid msgTerm
Bindings = "frmWarnList.frx":0000
Height = 2835
Left = 60
TabIndex = 0
Tag = "ctPayMethod////101"
Top = 300
Width = 6285
_ExtentX = 11091
_ExtentY = 4995
_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 = 72
TabIndex = 1
Top = 3240
WhatsThisHelpID = 5010
Width = 1212
Caption = "打印"
PicturePosition = 196613
Size = "2143;609"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
End
Attribute VB_Name = "frmWarnList"
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
Private mblnLoad As Boolean
'
'方法及函数
'
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 Note.lngNoteID As id,decode(Note.blnIsDoned,1,'√','') As ""完成""," & strSelectOfSql
If Trim(strWhereOfSql) <> "" Then
strWhereOfSql = " where Note.strdate <= To_Char(To_Date('" & Format(gclsBase.BaseDate, "yyyy-mm-dd") & "','rrrr-mm-dd')+ Note.bytDay,'rrrr-mm-dd') " _
& "And (Note.lngExecutantID = 0 Or Note.lngExecutantID = " & gclsBase.OperatorID & ") And " & strWhereOfSql
Else
strWhereOfSql = " where To_Char(To_Date('" & Format(gclsBase.BaseDate, "yyyy-mm-dd") & "','rrrr-mm-dd')+ Note.bytDay,'rrrr-mm-dd') " _
& " And Note.lngExecutantID = 0 Or Note.lngExecutantID = " & gclsBase.OperatorID
End If
strSql = strSelectOfSql & strFromOfSql & strWhereOfSql
strSql = strReplace(strSql, "SYSDATE", "To_Date('" & Format(gclsBase.BaseDate, "yyyy-mm-dd") & "','yyyy-mm-dd')")
'Set Query = gclsBase.BaseDB.CreateQueryDef("", strSql)
'Query.Parameters("lngOperatorID") = gclsBase.OperatorID
'Set recRecordset = Query.OpenRecordset(dbOpenSnapshot)
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 = " & IIf(blnIsDoned, 1, 0) & " 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 + 100
End With
'重画其余控件
' txtFind.Width = Me.ScaleWidth - txtFind.Left - ListFormBottom - cmdAgain.Width - 15
' cmdAgain.Left = txtFind.Left + txtFind.Width
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
mclsList.ReGetColCaption
myPrintclass.PrintList gclsBase.BaseDB, mclsList.FlexGrid, 89, Me.Caption & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
'mclsList.AddReGetColCaption
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
mblnLoad = True
Me.HelpContextID = 80008
frmMain.mnuToolAlert.Tag = Me.hwnd
'付款条件列表窗体初始化
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
mclsList.InitFlexGrid
' Set datTerm.Resultset = GetList()
' If Not datTerm.Resultset.EOF Then datTerm.Resultset.MoveLast
' datTerm.Resultset.Close
' 'Set datTerm.Recordset = Nothing
' mclsList.SetFlexGrid
' 'mclsList.InitcboFindKind
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -