语法着色控件使用典型范例
2009-05-15 20:31
281 查看
frmMain.frm
VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Object = "{BCA00000-0F85-414C-A938-5526E9F1E56A}#4.0#0"; "CASMUI.dll"
Begin VB.Form frmMain
Caption = "FileMonitor"
ClientHeight = 8235
ClientLeft = 60
ClientTop = 630
ClientWidth = 9195
Icon = "frmMain.frx":0000
LinkTopic = "Form1"
ScaleHeight = 8235
ScaleWidth = 9195
Begin CodeMax4Ctl.CodeMax CodeMax1
Height = 3855
Left = 0
OleObjectBlob = "frmMain.frx":030A
TabIndex = 1
Top = 405
Width = 6135
End
Begin VB.Timer Timer2
Interval = 3000
Left = 3360
Top = 4800
End
Begin RichTextLib.RichTextBox rtbFile
Height = 375
Left = 0
TabIndex = 0
ToolTipText = "Drag the file to this place"
Top = 0
Width = 6135
_ExtentX = 10821
_ExtentY = 661
_Version = 393217
MultiLine = 0 'False
AutoVerbMenu = -1 'True
OLEDropMode = 1
TextRTF = $"frmMain.frx":03FA
End
Begin VB.Timer Timer1
Interval = 1000
Left = 2760
Top = 4800
End
Begin VB.Label lblMsg
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Caption = "Ln 1, Col 0"
Height = 255
Left = 0
TabIndex = 2
Top = 7965
Width = 3255
End
Begin VB.Menu mnuFile
Caption = "&File"
Begin VB.Menu mnuFileOpen
Caption = "&Open"
End
Begin VB.Menu mnuFLine1
Caption = "-"
End
Begin VB.Menu mnuFileDelete
Caption = "&Delete"
Shortcut = ^D
End
Begin VB.Menu mnuFileRContent
Caption = "&Refresh"
Shortcut = ^T
End
Begin VB.Menu mnuFLine2
Caption = "-"
End
Begin VB.Menu mnuFileExit
Caption = "&Exit"
End
End
Begin VB.Menu mnuView
Caption = "&View"
Begin VB.Menu mnuViewSetTop
Caption = "&Set Top"
Shortcut = ^{F3}
End
Begin VB.Menu mnuVLine1
Caption = "-"
End
Begin VB.Menu mnuViewLineNo
Caption = "Line &Numbers"
End
Begin VB.Menu mnuViewLineNoBold
Caption = "Line Number &BoldSel"
End
Begin VB.Menu mnuViewMargin
Caption = "Selection Margin"
End
Begin VB.Menu mnuSelLine
Caption = "Auto Select Line"
End
End
Begin VB.Menu mnuWM
Caption = "Wide&Monitor"
Begin VB.Menu mnuWMForm
Caption = "FormLog"
Shortcut = ^{F1}
End
Begin VB.Menu mnuWMControl
Caption = "ControlLog"
Shortcut = ^{F2}
End
Begin VB.Menu mnuWLine1
Caption = "-"
End
Begin VB.Menu mnuWMRFileName
Caption = "Refresh File &Name"
Shortcut = ^N
End
Begin VB.Menu mnuWMAutoRFileName
Caption = "Auto &Refresh File Name"
Shortcut = ^R
End
Begin VB.Menu mnuWLine2
Caption = "-"
End
Begin VB.Menu mnuWMAnalysis
Caption = "&Analysis VBP"
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function SetWindowPos& Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
Dim sFileTime As String
Dim sFileTimeTmp As String
Dim isTop As Boolean
Dim isRefreshFN As Boolean
Dim isLineNumbering As Boolean
Dim isDisplayLeftMargin As Boolean
Dim isAutoSelLine As Boolean
Dim isAnalysisVbp As Boolean
Dim isNumberBoldSel As Boolean
Dim lngLastLine As Long
Dim lngLastSelLine As Long
Private Sub Form_Load()
Call initApp
Call mnuViewSetTop_Click
Call mnuWMAutoRFileName_Click
Call mnuViewMargin_Click
Call mnuViewLineNo_Click
' Call mnuSelLine_Click
End Sub
Private Sub Form_Resize()
On Error GoTo Err1
rtbFile.Width = Me.ScaleWidth
lblMsg.Top = Me.ScaleHeight - lblMsg.Height
lblMsg.Width = Me.ScaleWidth
CodeMax1.Width = Me.ScaleWidth
CodeMax1.Height = Me.ScaleHeight - CodeMax1.Top - lblMsg.Height
Err1:
End Sub
Private Sub CodeMax1_MouseUp(ByVal Button As CodeMax4Ctl.cmMouseBtn, ByVal Modifiers As CodeMax4Ctl.cmKeyMod, ByVal X As Long, ByVal Y As Long)
If Not isAutoSelLine Then Exit Sub
Dim r As New CodeMax4Ctl.Range
Set r = CodeMax1.GetSel(False)
If lngLastLine <> r.EndLineNo Then
On Error GoTo Err1
CodeMax1.SelectLine r.EndLineNo, True
lngLastLine = r.EndLineNo
End If
Err1:
End Sub
Private Sub CodeMax1_SelChange()
Dim r As New CodeMax4Ctl.Range
Set r = CodeMax1.GetSel(False)
lblMsg.Caption = "Ln " & r.EndLineNo + 1 & ", Col " & r.EndColNo + 1
If CodeMax1.LineCount = 1 Then CodeMax1.SetLineColor 0, &HFFFFC0
On Error Resume Next
If r.EndLineNo <> lngLastSelLine Then
CodeMax1.SetLineColor lngLastSelLine, vbWhite
lngLastSelLine = r.EndLineNo
CodeMax1.SetLineColor r.EndLineNo, &HFFFFC0
End If
End Sub
Private Sub mnuViewLineNoBold_Click()
isNumberBoldSel = Not isNumberBoldSel
mnuViewLineNoBold.Checked = isNumberBoldSel
CodeMax1.LineNumberBoldSel = isNumberBoldSel
End Sub
Private Sub mnuWMAnalysis_Click()
isAnalysisVbp = Not isAnalysisVbp
mnuWMAnalysis.Checked = isAnalysisVbp
If isAnalysisVbp And isRefreshFN Then
Timer1.Enabled = False
Call mnuWMAutoRFileName_Click
End If
End Sub
Private Sub mnuWMAutoRFileName_Click()
isRefreshFN = Not isRefreshFN
mnuWMAutoRFileName.Checked = isRefreshFN
Timer2.Enabled = isRefreshFN
If Timer2.Enabled Then Timer1.Enabled = True
End Sub
Private Sub mnuSelLine_Click()
isAutoSelLine = Not isAutoSelLine
mnuSelLine.Checked = isAutoSelLine
End Sub
Private Sub mnuViewLineNo_Click()
isLineNumbering = Not isLineNumbering
mnuViewLineNo.Checked = isLineNumbering
CodeMax1.LineNumbering = isLineNumbering
End Sub
Private Sub mnuViewMargin_Click()
isDisplayLeftMargin = Not isDisplayLeftMargin
mnuViewMargin.Checked = isDisplayLeftMargin
CodeMax1.DisplayLeftMargin = isDisplayLeftMargin
End Sub
Private Sub mnuWMControl_Click()
rtbFile.Text = "C:\egmain-ex\Bin\WideMonitor_CtrlLog"
Call mnuWMRFileName_Click
End Sub
Private Sub mnuWMForm_Click()
rtbFile.Text = "C:\egmain-ex\Bin\WideMonitor_FormLog"
Call mnuWMRFileName_Click
End Sub
Private Sub mnuFileOpen_Click()
Dim strFile$, strFilter$
strFilter = "log(*.log;)" & Chr$(0) & _
"*.log;" & Chr$(0) & _
"txt(*.txt;)" & Chr$(0) & _
"*.txt;" & Chr$(0) & _
"All Files(*.*)" & Chr$(0) & _
"*.*" & Chr$(0)
strFile = browseFile(Me.hWnd, "Select a file", strFilter)
If strFile <> "" Then rtbFile.Text = strFile
End Sub
Private Sub mnuFileDelete_Click()
On Error GoTo Err1
Kill rtbFile.Text
Call mnuFileRContent_Click
Err1:
End Sub
Private Sub mnuFileExit_Click()
Unload Me
End Sub
Private Sub mnuViewSetTop_Click()
isTop = Not isTop
mnuViewSetTop.Checked = isTop
SetWindowPos Me.hWnd, IIf(isTop, -1, -2), 0, 0, 0, 0, 3
End Sub
Private Sub mnuFileRContent_Click()
On Error GoTo Err1
Call loadFile(rtbFile.Text)
sFileTime = FileDateTime(rtbFile.Text)
Exit Sub
Err1:
CodeMax1.Text = ""
End Sub
Private Sub loadFile(strFile$)
CodeMax1.Text = fileStr(rtbFile.Text)
CodeMax1.SelectLine CodeMax1.LineCount - 1, True
lngLastSelLine = CodeMax1.LineCount - 1
CodeMax1.SetLineColor lngLastSelLine, &HFFFFC0
End Sub
Private Sub mnuWMRFileName_Click()
Dim l1&
If rtbFile.Text = "" Then Exit Sub
l1 = InStr(LCase(rtbFile.Text), "log")
If l1 > 0 Then rtbFile.Text = Left(rtbFile.Text, l1 + 2) & Format(Now, "yyyymmddhh") & ".log"
End Sub
Private Sub rtbFile_Change()
Me.Caption = "FileMonitor" & IIf(rtbFile.Text <> "", " - ", "") & rtbFile.Text
If isAnalysisVbp Then
CodeMax1.Text = strAanalysisForms(rtbFile.Text)
Else
Call mnuFileRContent_Click
End If
End Sub
Private Sub rtbFile_OLEDragDrop(Data As RichTextLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim strDragFile As String
If Data.GetFormat(1) Then 'draged is chars block
strDragFile = Data.GetData(1)
ElseIf Data.GetFormat(15) Then 'draged is file object
strDragFile = Data.Files.Item(Data.Files.Count)
End If
If strDragFile <> "" Then rtbFile.Text = strDragFile
End Sub
'refesh file content
Private Sub Timer1_Timer()
On Error GoTo Err1
If rtbFile.Text = "" Then Exit Sub
sFileTimeTmp = FileDateTime(rtbFile.Text)
If sFileTimeTmp <> sFileTime Then
sFileTime = sFileTimeTmp
Call loadFile(rtbFile.Text)
Me.WindowState = 0
' If Me.WindowState = 0 Then
' Me.WindowState = 0
' Else
' Me.WindowState = 2
' End If
End If
Err1:
End Sub
'init the application controls and vars
Private Sub initApp()
lngLastLine = -1
lngLastSelLine = 0
CodeMax1.SetColor cmClrLeftMargin, &HE0E0E0
CodeMax1.SetColor cmClrLineNumberBk, &HE0E0E0
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
End Sub
'Aanalysis forms
Private Function strAanalysisForms(strFile As String) As String
Dim strContent As String
Dim l1&, l2&
strContent = fileStr(strFile)
l1 = 1
Do
l1 = InStr(l1, strContent, vbCrLf & "Form=")
If l1 = 0 Then Exit Do
l1 = l1 + Len(vbCrLf & "Form=")
l2 = InStr(l1, strContent, vbCrLf)
strAanalysisForms = strAanalysisForms & Mid(strContent, l1, l2 - l1) & vbCrLf
Loop
If Right(strAanalysisForms, 2) = vbCrLf Then strAanalysisForms = Left(strAanalysisForms, Len(strAanalysisForms) - 2)
End Function
'refresh the logfile's name
Private Sub Timer2_Timer()
Static strLastMin As String
Dim strTemp$, strHHTemp$
strTemp = Format(Now, "hh")
strHHTemp = getFileHour(rtbFile.Text)
If strLastMin <> strTemp Or (strHHTemp <> "" And strHHTemp <> strTemp) Then
strLastMin = strTemp
Call mnuWMRFileName_Click
End If
End Sub
'get the HH
Private Function getFileHour(strFile$) As String
Dim i&
i = InStr(LCase(strFile), ".log")
If i > 0 Then
getFileHour = Mid(strFile, i - 2, 2)
End If
End Function
Private Function fileStr(ByVal strFileName As String) As String
On Error GoTo Err1
Open strFileName For Input As #1
fileStr = StrConv(InputB$(LOF(1), #1), vbUnicode)
Close #1
If Right(fileStr, 2) = vbCrLf Then fileStr = Left(fileStr, Len(fileStr) - 2)
Exit Function
Err1:
End Function
内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理 
相关文章推荐
- 语法着色控件使用典型范例
- swift基础语法之控件使用02
- 【转贴】GridView、DetailsView等控件的结合使用范例讲解
- MFC TabCtrl控件使用范例
- .net验证控件的属性与使用技巧---总结及正则表达式语法
- 使用 ASP.NET 语法创建 Web 服务器控件模板
- listbox的一个控件使用范例
- FCKeditor2.6.4控件及其使用范例
- jquery控件 jtable 使用范例
- 新控件使用范例
- .net验证控件的属性与使用技巧---总结及正则表达式语法
- WebUploader 图片上传控件使用范例
- Visual Basic.NET 2008控件使用范例详解这本书怎么样
- listbox的一个控件使用范例
- winfrom如何做一个语法着色控件
- [全文下载/试读]补充，上集Ch. 3 -- Panel控件与常用属性，范例:问卷系统，动态产生「子问题」(使用障眼法)
- [C#][控件]WebBrowser 使用范例
- 容器控件之PlaceHolder控件使用范例
- swift基础语法之控件使用02
- JavaScript正则表达式语法及使用范例大全