?? frmloglist.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 frmLogList
Caption = "上機日志"
ClientHeight = 3672
ClientLeft = 60
ClientTop = 348
ClientWidth = 6876
KeyPreview = -1 'True
LinkTopic = "Form2"
LockControls = -1 'True
MDIChild = -1 'True
ScaleHeight = 3672
ScaleWidth = 6876
Begin MSRDC.MSRDC datTerm
Height = 324
Left = 5136
Top = 3192
Visible = 0 'False
Width = 1164
_ExtentX = 2053
_ExtentY = 572
_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 = 255
Left = 3960
TabIndex = 7
Top = 3210
Visible = 0 'False
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 = 4
Tag = "1017"
ToolTipText = "再找"
Top = 90
UseMaskColor = -1 'True
Width = 300
End
Begin VB.ComboBox cboFindKind
Height = 300
ItemData = "frmLogList.frx":0000
Left = 870
List = "frmLogList.frx":0002
Style = 2 'Dropdown List
TabIndex = 1
Top = 90
Width = 1515
End
Begin VB.TextBox txtFind
Height = 300
Left = 3330
TabIndex = 3
Text = "Text1"
Top = 90
Width = 2925
End
Begin MSFlexGridLib.MSFlexGrid msgTerm
Bindings = "frmLogList.frx":0004
Height = 2475
Left = 90
TabIndex = 5
Tag = "ctPayMethod////101"
Top = 480
Width = 6495
_ExtentX = 11451
_ExtentY = 4360
_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
AutoSize = -1 'True
Caption = "內容(&C)"
Height = 180
Left = 2565
TabIndex = 2
Top = 150
Width = 630
End
Begin VB.Label lblFindKind
AutoSize = -1 'True
Caption = "查找(&B)"
Height = 180
Left = 45
TabIndex = 0
Top = 150
Width = 630
End
Begin MSForms.CommandButton cmdPosition
Height = 345
Index = 0
Left = 50
TabIndex = 6
Tag = "1018"
Top = 3240
WhatsThisHelpID = 5010
Width = 1215
Caption = "編輯"
PicturePosition = 196613
Size = "2143;609"
FontName = "宋體"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin MSForms.CommandButton cmdPosition
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
End
Attribute VB_Name = "frmLogList"
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 '列表對象
Dim mblnFlage As Boolean
Private Const intViewID = 34 '視圖ID
'
'方法及函數
'
Public Property Let IsShowCard(ByVal vNewValue As Boolean)
mIsShowCard = vNewValue
End Property
'產生付款條件列表記錄集
Public Function GetList(blnCondition As Boolean) 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 Log.lngLogID As id,''As ""停用""," & strSelectOfSql
If Trim(strWhereOfSql) <> "" Then
strWhereOfSql = " Where " & strWhereOfSql
End If
If blnCondition Then
strSql = strSelectOfSql & strFromOfSql & strWhereOfSql
Else
strSql = strSelectOfSql & strFromOfSql
End If
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 Log Where lngLogID = " & 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 Log SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE lngLogID = " & lngID
UpdateTermInActive = gclsBase.ExecSQL(strSql)
End Function
'刪除付款條件ID指定記錄
Private Function DelByTermID(ByVal lngID As Long) As Boolean
Dim strSql As String
strSql = "Delete From Log Where lngLogID = " & 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 lngLogID From Item Where lngLogID = " & 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 Then
If .TextMatrix(.Row, 0) <> "" Then TermID = CLng(.TextArray(.Row * .Cols))
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
.mnuEditFilter.Enabled = True
.mnuEditColumn.Enabled = True
.mnuFilePrint.Enabled = True
.mnuFilePrintSetup.Enabled = True
' .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
cmdPosition(0).top = Me.ScaleHeight - cmdPosition(0).Height - ListFormBottom
cmdPosition(1).top = cmdPosition(0).top
' chkShowAll.Top = cmdPosition(0).Top
' chkShowAll.Left = Me.ScaleWidth - chkShowAll.Width - ListFormBottom
End Sub
Private Sub cmdPosition_Click(Index As Integer)
Select Case Index
Case 0
MakeListEditMenu
PopupMenu frmMain.mnuListEdit, , cmdPosition(0).Left, cmdPosition(0).top + cmdPosition(0).Height
Case 1
MakeListReportMenu
PopupMenu frmMain.mnuListReport, , cmdPosition(1).Left, cmdPosition(1).top + cmdPosition(1).Height
End Select
End Sub
Private Sub Form_Deactivate()
frmMain.SetEditUnEnabled
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 = 80004
frmMain.mnuToolLog.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(True)
' If Not datTerm.Resultset.EOF Then datTerm.Resultset.MoveLast
' datTerm.Resultset.Close
' 'Set datTerm.Recordset = Nothing
' mclsList.SetFlexGrid
' mclsList.InitcboFindKind
' mclsList.FlexNoChange = False
' mclsList.FindNoChange = False
'
' With msgTerm
' If .Rows > 1 Then msgTerm.Row = 1
' .col = 0
' .ColSel = .Cols - 1
' End With
' Debug.Print "Load End: ", Timer
' mclsList.DoShowAll False
' UpdateMenuStatus
Set mclsMainControl = gclsSys.MainControls.Add(Me)
'設置鉤子對象
Set mclsSubClass = New SubClass32.SubClass
mclsSubClass.hwnd = msgTerm.hwnd
mclsSubClass.Messages(WM_PAINT) = True
mclsSubClass.Messages(WM_LBUTTONUP) = True
mclsSubClass.Messages(WM_LBUTTONDOWN) = True
mclsSubClass.Messages(WM_MOUSEMOVE) = True
Set mclsSubClassform = New SubClass32.SubClass
mclsSubClassform.hwnd = Me.hwnd
mclsSubClassform.Messages(WM_GETMINMAXINFO) = True
Unload MsgForm
Exit Sub
Dim edtErrReturn As ErrDealType
ErrHandle:
edtErrReturn = Errors.ErrorsDeal
If edtErrReturn = edtResume Then
Resume
Else
On Error Resume Next
Unload MsgForm
Unload Me
End If
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -