📄 frmclassitemlist.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 frmClassItemList
Caption = "项目核算 "
ClientHeight = 3615
ClientLeft = 60
ClientTop = 345
ClientWidth = 6705
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 3615
ScaleWidth = 6705
Begin MSRDC.MSRDC datTerm
Height = 330
Left = 5280
Top = 3240
Visible = 0 'False
Width = 1200
_ExtentX = 2117
_ExtentY = 582
_Version = 327681
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.TextBox txtFind
Height = 300
Left = 3300
TabIndex = 8
Text = "Text1"
Top = 150
Width = 2955
End
Begin VB.CheckBox chkShowAll
Caption = "全部显示"
Height = 350
Left = 3840
TabIndex = 2
Top = 3240
Width = 1095
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 = 6255
Style = 1 'Graphical
TabIndex = 1
Tag = "1017"
ToolTipText = "再找"
Top = 150
UseMaskColor = -1 'True
Width = 300
End
Begin VB.ComboBox cboFindKind
Height = 300
ItemData = "frmClassItemList.frx":0000
Left = 780
List = "frmClassItemList.frx":0002
Style = 2 'Dropdown List
TabIndex = 0
Top = 120
Width = 1515
End
Begin MSFlexGridLib.MSFlexGrid msgTerm
Bindings = "frmClassItemList.frx":0004
Height = 2565
Left = 50
TabIndex = 3
Tag = "ctPayMethod////101"
Top = 570
Width = 6495
_ExtentX = 11456
_ExtentY = 4524
_Version = 65541
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
AutoSize = -1 'True
Caption = "内容(&C)"
Height = 180
Left = 2475
TabIndex = 7
Top = 180
Width = 630
End
Begin VB.Label lblFindKind
AutoSize = -1 'True
Caption = "查找(&F)"
Height = 180
Left = 50
TabIndex = 6
Top = 180
Width = 630
End
Begin MSForms.CommandButton cmdClass2
Height = 345
Index = 1
Left = 1260
TabIndex = 5
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 MSForms.CommandButton cmdClass2
Height = 345
Index = 0
Left = 50
TabIndex = 4
Tag = "1018"
Top = 3210
WhatsThisHelpID = 5010
Width = 1215
Caption = "编辑"
PicturePosition = 196613
Size = "2143;609"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
End
Attribute VB_Name = "frmClassItemList"
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 mblnFormNoRezise As Boolean '不需要响应form_Rezise事件
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 mblnIsSaveListset As Boolean 'Whether or not Save intViewID in list
Private Const intViewID = 52 '视图ID
'Private Const intFormWidth = 5100 '窗体最小宽度
'Private Const intFormHeight = 3000 '窗体最小高度
'
'方法及函数
'
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.SelectOfSql
strFromOfSql = mclsList.ListSet.FromOfSql
strWhereOfSql = mclsList.ListSet.WhereOfSql
strSelectOfSql = "Select Class2.lngClassID As id,decode(Class2.blnIsInActive,'1','√','0','') As ""停用""," & strSelectOfSql
If 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
Public Function ShowList(ByVal lngID As Long) 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
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
If strofWhere <> "" Then
strofWhere = " where " & strofWhere & "and Class2.lngClassID=" & lngID
Else
strofWhere = " where Class2.lngClassID=" & lngID
End If
strSql = strSql & strofFrom & strofWhere
Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, dbOpenForwardOnly)
With recTemp
If .RowCount > 0 Then
txtFind.Text = recTemp(strSortDec) '查找
If msgTerm.TextMatrix(msgTerm.Row, 0) = lngID Then '是否找到
ShowList = True
Else
ShowList = False
End If
Else
ShowList = False
End If
.Close
End With
End Function
'按照付款条件ID提取记录
Public Function GetByTermID(ByVal lngID As Long) As rdoResultset
Dim recRecordset As rdoResultset
Dim strSql As String
strSql = "Select * From Class2 Where lngClassID = " & lngID
Set recRecordset = gclsBase.BaseDB.OpenRecordset(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 Class2 SET blnIsInActive = " & blnIsInActive & " WHERE lngClassID = " & lngID
UpdateTermInActive = gclsBase.ExecSQL(strSql)
End Function
'删除付款条件ID指定记录
Private Function DelByTermID(ByVal lngID As Long) As Boolean
Dim strSql As String
strSql = "Delete * From Class2 Where lngClassID = " & lngID
DelByTermID = gclsBase.ExecSQL(strSql)
End Function
'判断付款条件ID是否使用
Private Function IsUseTermID(ByVal lngID As Long) As Boolean
' Dim recRecordset As Recordset
' Dim strSql As String
'
' 'strSql = "Select lngClassID From Activity Where lngClassID = " & lngID
' 'Set recRecordset = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
' 'IsUseTermID = (recRecordset.RecordCount >= 1)
' 'recRecordset.Close
' strSql = "SELECT lngClassID FROM Class2 " _
' & " WHERE EXISTS(SELECT Ab.lngClassID1 FROM AccountBalance AS Ab WHERE Ab.lngClassID1=" & lngID & ")" _
' & " OR EXISTS (SELECT Ad.lngClassID1 FROM AccountDaily AS Ad WHERE Ad.lngClassID1=" & lngID & ")" _
' & " OR EXISTS (SELECT At.lngClassID1 FROM ACtivitydetail AS At WHERE At.lngClassID1=" & lngID & ")" _
' & " OR EXISTS (SELECT Ap.lngClassID1 FROM ARAPInit AS Ap WHERE Ap.lngClassID1=" & lngID & ")" _
' & " OR EXISTS (SELECT Bg.lngClassID1 FROM BudgetBalance AS Bg WHERE Bg.lngClassID1=" & lngID & ")" _
' & " OR EXISTS (SELECT Cp.lngClassID1 FROM CostPrice AS Cp WHERE Cp.lngClassID1=" & lngID & ")" _
' & " OR EXISTS (SELECT Fa.lngClassID1 FROM FixedAccount AS Fa WHERE Fa.lngClassID1=" & lngID & ")" _
' & " OR EXISTS (SELECT It.lngClassID1 FROM ItemActivity AS It WHERE It.lngClassID1=" & lngID & ")" _
' & " OR EXISTS (SELECT Pc.lngClassID1 FROM Purchaseorder AS Pc WHERE Pc.lngClassID1=" & lngID & ")" _
' & " OR EXISTS (SELECT So.lngClassID1 FROM SaleOrder AS So WHERE So.lngClassID1=" & lngID & ")" _
' & " OR EXISTS (SELECT St.lngClassID1 FROM StockTaking AS St WHERE St.lngClassID1=" & lngID & ")" _
' & " OR EXISTS (SELECT TV.lngClassID1 FROM TransVoucherDetail AS TV WHERE TV.lngClassID1=" & lngID & ")" _
' & " OR EXISTS (SELECT Vd.lngClassID1 FROM VoucherDetail AS Vd WHERE Vd.lngClassID1=" & lngID & ")"
' Set recRecordset = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
' IsUseTermID = (recRecordset.RecordCount >= 1)
' recRecordset.Close
End Function
'得到付款条件ID
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
'根据列表中记录数，设置菜单可用属性
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
.mnuEditNew.Enabled = True
.mnuEditDel.Enabled = blnIsnotEmpty
.mnuEditInActive.Enabled = blnIsnotEmpty
.mnuEditShowAll.Checked = chkShowAll.Value
.mnuEditShowAll.Enabled = True
.mnuEditUse.Enabled = blnIsnotEmpty
.mnuEditColumn.Enabled = True
.mnuEditFilter.Enabled = True
.mnuEditSearch.Enabled = True
.mnuEditNotepad.Enabled = blnIsnotEmpty
.mnuFilePrint.Enabled = True
.mnuFilePrintSetup.Enabled = True
' .mnuAccountVoucher.Enabled = blnIsnotEmpty
.mnuReportQuick.Enabled = blnIsnotEmpty
.mnuToolRefresh.Enabled = True
.mnuEditEdit.Caption = "修改(&N)"
.mnuEditNew.Caption = "新增(&E)"
.mnuEditDel.Caption = "删除(&D)"
End With
If msgTerm.ColSel = 0 Then '无当前选定行
blnFindNoChange = mclsList.FindNoChange
mclsList.FindNoChange = True
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -