?? frmloglist.frm
字號:
End Sub
'右鍵菜單
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton And frmMain.ActiveForm Is Me Then
MakeListEditMenu
PopupMenu frmMain.mnuListEdit
End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode = vbFormControlMenu And mIsShowCard Then
MsgBox "請先關閉清除卡片!", vbExclamation
Cancel = True
frmClearLog.Show
frmClearLog.ZOrder 0
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
mclsList.SaveListSet
frmMain.mnuToolLog.Tag = 0
Set mclsSubClass = Nothing
Set mclsSubClassform = Nothing
Set mclsList = Nothing
gclsSys.MainControls.Remove Me
Set mclsMainControl = Nothing
End Sub
Private Sub Form_Resize()
On Error Resume Next
If Me.WindowState = 1 Then Exit Sub
If Me.Left + Me.width < 0 Or Me.Left > Screen.width Then
Me.Left = 300
End If
RedrawForm
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
On Error Resume Next
If KeyAscii = vbKeyEscape Then
Unload Me
ElseIf KeyAscii = vbKeyReturn Then
BKKEY Me.ActiveControl.hwnd, vbKeyTab
End If
End Sub
Private Sub Form_Activate()
SetHelpID Me.HelpContextID
gclsSys.CurrFormName = Me.hwnd
mclsMainControl_ChildActive
' If msgTerm.Enabled Then msgTerm.SetFocus
msgTerm.Redraw = True
UpdateMenuStatus
If (Me.Left + Me.width < 0 Or Me.Left > Screen.width) Then Me.Left = 300
If Me.WindowState = 1 Then Me.WindowState = 0
End Sub
'
'查找條件類型 ComboBox 控件
'
Private Sub cboFindKind_Click()
Dim i As Integer
Dim intWidth As Integer
Dim strFind As String
Dim intSortCol As Integer
mclsList.ReGetColCaption
With msgTerm
.Redraw = False
For i = 1 To .Cols - 1
If .TextMatrix(0, i) = cboFindKind.Text Then
'保存新排序列內容
If .RowHeight(.Row) > 0 Then strFind = .TextMatrix(.Row, i)
'重新排序
mclsList.FixrowSortBold i
Exit For
End If
Next
End With
'恢復以前選定行
If msgTerm.Rows > 1 Then
If txtFind.Text = strFind Then
txtFind_Change
Else
txtFind.Text = strFind
End If
End If
msgTerm.Redraw = True
End Sub
Private Sub mclsMainControl_ChildActive()
Dim vntMessage As Variant
SetHelpID Me.HelpContextID
'響應消息
For Each vntMessage In mclsMainControl.Messages
If vntMessage = Message.msglog Then '接收到付款條件改變消息
mclsMainControl_ToolRefresh
mclsMainControl.Messages.Remove CStr(vntMessage) '清除付款條件改變消息
End If
Next
mclsMainControl.Messages.Clear
UpdateMenuStatus
End Sub
Private Sub mclsMainControl_FilePrintSetup()
Dim MyPrintSet As PrintClass
Set MyPrintSet = New PrintClass
MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList.FlexGrid, , , , 34, " " & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
Set MyPrintSet = Nothing
End Sub
Private Sub mclsMainControl_ListReportMenu(ByVal intIndex As Integer)
Report.ShowListReport 1381, 34
End Sub
Private Sub mclsSubClassForm_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
Dim MinMax As MINMAXINFO
If Msg = WM_GETMINMAXINFO Then
CopyMemory MinMax, ByVal lParam, Len(MinMax)
MinMax.ptMinTrackSize.x = 430
MinMax.ptMinTrackSize.y = 250
CopyMemory ByVal lParam, MinMax, Len(MinMax)
Result = 0
End If
End Sub
Private Sub msgTerm_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton Then
Form_MouseDown Button, Shift, x, y
End If
End Sub
'
'查找內容 TextBox 控件
'
Private Sub txtFind_Change()
mclsList.TextFind txtFind.Text
End Sub
Private Sub txtFind_KeyDown(KeyCode As Integer, Shift As Integer)
Dim intSelLen As Integer
If KeyCode = 8 Then
intSelLen = txtFind.SelLength
If txtFind.SelStart > 0 Then txtFind.SelStart = txtFind.SelStart - 1
txtFind.SelLength = intSelLen + 1
End If
End Sub
'
'響應主控對象事件
'
'刪除記錄
Private Sub mclsMainControl_EditDel()
Dim lngID As Long
Dim recRecordset As rdoResultset
lngID = TermID
If mIsShowCard Then
' If lngID = frmTermCard.TermID Then
' MsgBox "不能刪除當前編輯的付款條件!", vbExclamation
' frmTermCard.SetFocus
' Exit Sub
' End If
End If
Set recRecordset = GetByTermID(lngID)
'If recRecordset.RecordCount = 0 Then '當前付款條件已被其他用戶刪除
' mclsMainControl_ToolRefresh
'Else
If IsUseTermID(lngID) Then
MsgBox "當前編輯的付款條件正在使用,不能刪除!", vbExclamation
Else
If recRecordset!blnIsDetail Then
If DelByTermID(lngID) Then
' mclsMainControl_ToolRefresh
With msgTerm
.RowHeight(.Row) = 0
.RowData(.Row) = 1
mclsList.SetFlexRow
End With
gclsSys.SendMessage CStr(Me.hwnd), Message.msglog
End If
Else
ShowMsg "不是末級編碼,不能刪除!", vbCritical, Me.Caption
End If
End If
'End If
recRecordset.Close
End Sub
'篩選
Private Sub mclsMainControl_EditFilter()
If mclsList.ListSet.ListID < 1 Then mclsList.ListSet.SaveList
Filter.ShowFilter mclsList.ListSet.ListID, 1, , , , , mblnFlage
If Not mblnFlage Then Exit Sub
mclsList.SaveListSet
mclsList.ListSet.ViewId = intViewID
msgTerm.Cols = 0
Set datTerm.Resultset = GetList(True)
If Not datTerm.Resultset.EOF Then datTerm.Resultset.MoveLast
datTerm.Resultset.Close
'Set datTerm.Recordset = Nothing
mclsList.SetFlexGrid
UpdateMenuStatus
'初始化查找復合列表框
mclsList.InitcboFindKind
'If chkShowAll.Value = 0 Then
mclsList.DoShowAll False
End Sub
'欄目設置
Private Sub mclsMainControl_EditColumn()
Dim strFind As String
Dim strSort As String
Dim intCount As Integer
With msgTerm
strFind = .TextMatrix(.Row, mclsList.SortCol)
strSort = cboFindKind.Text
If mclsList.ListSet.ShowListSet(intViewID) Then
.Redraw = False
msgTerm.Cols = 0
Set datTerm.Resultset = GetList(True)
If Not datTerm.Resultset.EOF Then datTerm.Resultset.MoveLast
datTerm.Resultset.Close
'Set datTerm.Recordset = Nothing
mclsList.SetFlexGrid
UpdateMenuStatus
'初始化查找復合列表框
mclsList.InitcboFindKind
For intCount = 0 To cboFindKind.ListCount - 1
If cboFindKind.list(intCount) = strSort Then
txtFind.Text = strFind
Exit For
End If
Next intCount
'If chkShowAll.Value = 0 Then
mclsList.DoShowAll False
.Redraw = True
End If
End With
End Sub
'刷新
Private Sub mclsMainControl_ToolRefresh()
Dim strOldSort As String
Dim strOldText As String
Me.MousePointer = vbHourglass
With msgTerm
'保存當前排序列
strOldSort = cboFindKind.Text
strOldText = .TextMatrix(.Row, mclsList.SortCol)
mclsList.SaveListColWidth
.Redraw = False
'刷新列表記錄
.Cols = 0
Set datTerm.Resultset = GetList(True)
If Not datTerm.Resultset.EOF Then datTerm.Resultset.MoveLast
datTerm.Resultset.Close
'Set datTerm.Recordset = Nothing
mclsList.SetFlexGrid
'恢復以前排序列
cboFindKind.Text = strOldSort
cboFindKind.Text = strOldSort
.Redraw = False
If .Rows > 1 Then
txtFind.Text = strOldText
End If
mclsList.DoShowAll False
'更新菜單狀態
UpdateMenuStatus
.Redraw = True
'發出付款條件消息
End With
Me.MousePointer = vbDefault
End Sub
'打印
Private Sub mclsMainControl_FilePrint()
Dim myPrintclass As PrintClass
Set myPrintclass = New PrintClass
mclsList.ReGetColCaption
myPrintclass.PrintList gclsBase.BaseDB, mclsList.FlexGrid, 34, Me.Caption & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
mclsList.AddReGetColCaption
Set myPrintclass = Nothing
End Sub
'響應“編輯”菜單
Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
Select Case intIndex
Case 0:
frmClearLog.ClearLog TermID, FilterTerm
Me.ZOrder 0
Case 2:
'DoClear
mclsMainControl_EditFilter
Case 4:
mclsMainControl_EditColumn
Case 6
mclsMainControl_ToolRefresh
Case 7:
mclsMainControl_FilePrint
End Select
End Sub
'
' 編輯菜單
'
Private Sub MakeListEditMenu()
Dim intCnt As Integer
With frmMain
For intCnt = .mnuListEditMenu.Count - 1 To 1 Step -1
Unload .mnuListEditMenu(intCnt)
Next
.mnuListEditMenu(0).Caption = "清除"
.mnuListEditMenu(0).Visible = True
If mclsList.FlexGrid.Rows > 1 Then
.mnuListEditMenu(0).Enabled = True
Else
.mnuListEditMenu(0).Enabled = False
End If
Load .mnuListEditMenu(1)
Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(1)
'Utility.CloneMenu .mnuEditColumn, .mnuListEditMenu(1)
' .mnuListEditMenu(1).Caption = "取消篩選"
' .mnuListEditMenu(1).Enabled = mblnFlage
' .mnuListEditMenu(1).Visible = True
Load .mnuListEditMenu(2)
Utility.CloneMenu .mnuEditFilter, .mnuListEditMenu(2)
Load .mnuListEditMenu(3)
Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(3)
.mnuListEditMenu(3).Visible = False
Load .mnuListEditMenu(4)
Utility.CloneMenu .mnuEditColumn, .mnuListEditMenu(4)
Load .mnuListEditMenu(5)
Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(5)
Load .mnuListEditMenu(6)
Utility.CloneMenu .mnuToolRefresh, .mnuListEditMenu(6)
Load .mnuListEditMenu(7)
Utility.CloneMenu .mnuFilePrint, .mnuListEditMenu(7)
End With
End Sub
'
' 報表菜單
'
Private Sub MakeListReportMenu()
Dim intCnt As Integer
With frmMain
For intCnt = .mnuListReportMenu.Count - 1 To 1 Step -1
Unload .mnuListReportMenu(intCnt)
Next
.mnuListReportMenu(0).Caption = "操作日志表(&T)"
.mnuListReportMenu(0).Enabled = True
' .mnuListReportMenu(0).Visible = False
End With
End Sub
'“鉤子”事件
Private Sub mclsSubClass_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
'“鉤子”事件處理
mclsList.HookProc Msg, wParam, lParam, mclsSubClass
End Sub
'取消篩選
'Private Sub UndoFilter()
' 'Filter.ShowFilter mclsList.ListSet.ListID, 1
' mclsList.SaveListSet
' mclsList.ListSet.ViewId = intViewID
' msgTerm.Cols = 0
' Set datTerm.Recordset = GetList(False)
' If Not datTerm.Recordset.EOF Then datTerm.Recordset.MoveLast
' datTerm.Recordset.Close
' 'Set datTerm.Recordset = Nothing
' mclsList.SetFlexGrid
' UpdateMenuStatus
' '初始化查找復合列表框
' mclsList.InitcboFindKind
' 'If chkShowAll.Value = 0 Then
' mclsList.DoShowAll False
'
'End Sub
'操作日志表
Private Sub OperatorLogTable()
End Sub
'清除
Private Sub DoClear()
End Sub
Public Property Get FilterTerm() As String
Dim FromOfSql As String
Dim strWhereOfSql As String
Dim strSql As String
FromOfSql = mclsList.ListSet.FromOfSql
strWhereOfSql = mclsList.ListSet.WhereOfSql
If strWhereOfSql <> "" Then
strSql = "lnglogID In ( Select Log.lngLogid " & FromOfSql & " Where " & strWhereOfSql & ")"
End If
FilterTerm = strSql
End Property
Public Function BindingResultSet()
Me.Hide
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
Me.Show
Me.ZOrder 0
End Function
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -