文法著色控制項使用典型範例

frmMain.frm

VERSION 5.00<br />Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"<br />Object = "{BCA00000-0F85-414C-A938-5526E9F1E56A}#4.0#0"; "CASMUI.dll"<br />Begin VB.Form frmMain<br /> Caption = "FileMonitor"<br /> ClientHeight = 8235<br /> ClientLeft = 60<br /> ClientTop = 630<br /> ClientWidth = 9195<br /> Icon = "frmMain.frx":0000<br /> LinkTopic = "Form1"<br /> ScaleHeight = 8235<br /> ScaleWidth = 9195<br /> Begin CodeMax4Ctl.CodeMax CodeMax1<br /> Height = 3855<br /> Left = 0<br /> OleObjectBlob = "frmMain.frx":030A<br /> TabIndex = 1<br /> Top = 405<br /> Width = 6135<br /> End<br /> Begin VB.Timer Timer2<br /> Interval = 3000<br /> Left = 3360<br /> Top = 4800<br /> End<br /> Begin RichTextLib.RichTextBox rtbFile<br /> Height = 375<br /> Left = 0<br /> TabIndex = 0<br /> ToolTipText = "Drag the file to this place"<br /> Top = 0<br /> Width = 6135<br /> _ExtentX = 10821<br /> _ExtentY = 661<br /> _Version = 393217<br /> MultiLine = 0 'False<br /> AutoVerbMenu = -1 'True<br /> OLEDropMode = 1<br /> TextRTF = $"frmMain.frx":03FA<br /> End<br /> Begin VB.Timer Timer1<br /> Interval = 1000<br /> Left = 2760<br /> Top = 4800<br /> End<br /> Begin VB.Label lblMsg<br /> BackStyle = 0 'Transparent<br /> BorderStyle = 1 'Fixed Single<br /> Caption = "Ln 1, Col 0"<br /> Height = 255<br /> Left = 0<br /> TabIndex = 2<br /> Top = 7965<br /> Width = 3255<br /> End<br /> Begin VB.Menu mnuFile<br /> Caption = "&File"<br /> Begin VB.Menu mnuFileOpen<br /> Caption = "&Open"<br /> End<br /> Begin VB.Menu mnuFLine1<br /> Caption = "-"<br /> End<br /> Begin VB.Menu mnuFileDelete<br /> Caption = "&Delete"<br /> Shortcut = ^D<br /> End<br /> Begin VB.Menu mnuFileRContent<br /> Caption = "&Refresh"<br /> Shortcut = ^T<br /> End<br /> Begin VB.Menu mnuFLine2<br /> Caption = "-"<br /> End<br /> Begin VB.Menu mnuFileExit<br /> Caption = "&Exit"<br /> End<br /> End<br /> Begin VB.Menu mnuView<br /> Caption = "&View"<br /> Begin VB.Menu mnuViewSetTop<br /> Caption = "&Set Top"<br /> Shortcut = ^{F3}<br /> End<br /> Begin VB.Menu mnuVLine1<br /> Caption = "-"<br /> End<br /> Begin VB.Menu mnuViewLineNo<br /> Caption = "Line &Numbers"<br /> End<br /> Begin VB.Menu mnuViewLineNoBold<br /> Caption = "Line Number &BoldSel"<br /> End<br /> Begin VB.Menu mnuViewMargin<br /> Caption = "Selection Margin"<br /> End<br /> Begin VB.Menu mnuSelLine<br /> Caption = "Auto Select Line"<br /> End<br /> End<br /> Begin VB.Menu mnuWM<br /> Caption = "Wide&Monitor"<br /> Begin VB.Menu mnuWMForm<br /> Caption = "FormLog"<br /> Shortcut = ^{F1}<br /> End<br /> Begin VB.Menu mnuWMControl<br /> Caption = "ControlLog"<br /> Shortcut = ^{F2}<br /> End<br /> Begin VB.Menu mnuWLine1<br /> Caption = "-"<br /> End<br /> Begin VB.Menu mnuWMRFileName<br /> Caption = "Refresh File &Name"<br /> Shortcut = ^N<br /> End<br /> Begin VB.Menu mnuWMAutoRFileName<br /> Caption = "Auto &Refresh File Name"<br /> Shortcut = ^R<br /> End<br /> Begin VB.Menu mnuWLine2<br /> Caption = "-"<br /> End<br /> Begin VB.Menu mnuWMAnalysis<br /> Caption = "&Analysis VBP"<br /> End<br /> End<br />End<br />Attribute VB_Name = "frmMain"<br />Attribute VB_GlobalNameSpace = False<br />Attribute VB_Creatable = False<br />Attribute VB_PredeclaredId = True<br />Attribute VB_Exposed = False<br />Option Explicit<br />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)<br />Dim sFileTime As String<br />Dim sFileTimeTmp As String<br />Dim isTop As Boolean<br />Dim isRefreshFN As Boolean<br />Dim isLineNumbering As Boolean<br />Dim isDisplayLeftMargin As Boolean<br />Dim isAutoSelLine As Boolean<br />Dim isAnalysisVbp As Boolean<br />Dim isNumberBoldSel As Boolean<br />Dim lngLastLine As Long<br />Dim lngLastSelLine As Long<br />Private Sub Form_Load()<br /> Call initApp<br /> Call mnuViewSetTop_Click<br /> Call mnuWMAutoRFileName_Click<br /> Call mnuViewMargin_Click<br /> Call mnuViewLineNo_Click<br />' Call mnuSelLine_Click<br />End Sub<br />Private Sub Form_Resize()<br /> On Error GoTo Err1<br /> rtbFile.Width = Me.ScaleWidth<br /> lblMsg.Top = Me.ScaleHeight - lblMsg.Height<br /> lblMsg.Width = Me.ScaleWidth<br /> CodeMax1.Width = Me.ScaleWidth<br /> CodeMax1.Height = Me.ScaleHeight - CodeMax1.Top - lblMsg.Height<br />Err1:<br />End Sub<br />Private Sub CodeMax1_MouseUp(ByVal Button As CodeMax4Ctl.cmMouseBtn, ByVal Modifiers As CodeMax4Ctl.cmKeyMod, ByVal X As Long, ByVal Y As Long)<br /> If Not isAutoSelLine Then Exit Sub</p><p> Dim r As New CodeMax4Ctl.Range<br /> Set r = CodeMax1.GetSel(False)</p><p> If lngLastLine <> r.EndLineNo Then<br /> On Error GoTo Err1<br /> CodeMax1.SelectLine r.EndLineNo, True<br /> lngLastLine = r.EndLineNo<br /> End If<br />Err1:<br />End Sub<br />Private Sub CodeMax1_SelChange()<br /> Dim r As New CodeMax4Ctl.Range<br /> Set r = CodeMax1.GetSel(False)<br /> lblMsg.Caption = "Ln " & r.EndLineNo + 1 & ", Col " & r.EndColNo + 1</p><p> If CodeMax1.LineCount = 1 Then CodeMax1.SetLineColor 0, &HFFFFC0<br /> On Error Resume Next<br /> If r.EndLineNo <> lngLastSelLine Then<br /> CodeMax1.SetLineColor lngLastSelLine, vbWhite<br /> lngLastSelLine = r.EndLineNo<br /> CodeMax1.SetLineColor r.EndLineNo, &HFFFFC0<br /> End If<br />End Sub<br />Private Sub mnuViewLineNoBold_Click()<br /> isNumberBoldSel = Not isNumberBoldSel<br /> mnuViewLineNoBold.Checked = isNumberBoldSel<br /> CodeMax1.LineNumberBoldSel = isNumberBoldSel<br />End Sub<br />Private Sub mnuWMAnalysis_Click()<br /> isAnalysisVbp = Not isAnalysisVbp<br /> mnuWMAnalysis.Checked = isAnalysisVbp</p><p> If isAnalysisVbp And isRefreshFN Then<br /> Timer1.Enabled = False<br /> Call mnuWMAutoRFileName_Click<br /> End If<br />End Sub<br />Private Sub mnuWMAutoRFileName_Click()<br /> isRefreshFN = Not isRefreshFN<br /> mnuWMAutoRFileName.Checked = isRefreshFN<br /> Timer2.Enabled = isRefreshFN</p><p> If Timer2.Enabled Then Timer1.Enabled = True<br />End Sub<br />Private Sub mnuSelLine_Click()<br /> isAutoSelLine = Not isAutoSelLine<br /> mnuSelLine.Checked = isAutoSelLine<br />End Sub<br />Private Sub mnuViewLineNo_Click()<br /> isLineNumbering = Not isLineNumbering<br /> mnuViewLineNo.Checked = isLineNumbering<br /> CodeMax1.LineNumbering = isLineNumbering<br />End Sub<br />Private Sub mnuViewMargin_Click()<br /> isDisplayLeftMargin = Not isDisplayLeftMargin<br /> mnuViewMargin.Checked = isDisplayLeftMargin<br /> CodeMax1.DisplayLeftMargin = isDisplayLeftMargin<br />End Sub<br />Private Sub mnuWMControl_Click()<br /> rtbFile.Text = "C:/egmain-ex/Bin/WideMonitor_CtrlLog"<br /> Call mnuWMRFileName_Click<br />End Sub<br />Private Sub mnuWMForm_Click()<br /> rtbFile.Text = "C:/egmain-ex/Bin/WideMonitor_FormLog"<br /> Call mnuWMRFileName_Click<br />End Sub<br />Private Sub mnuFileOpen_Click()<br /> Dim strFile$, strFilter$<br /> strFilter = "log(*.log;)" & Chr$(0) & _<br /> "*.log;" & Chr$(0) & _<br /> "txt(*.txt;)" & Chr$(0) & _<br /> "*.txt;" & Chr$(0) & _<br /> "All Files(*.*)" & Chr$(0) & _<br /> "*.*" & Chr$(0)<br /> strFile = browseFile(Me.hWnd, "Select a file", strFilter)<br /> If strFile <> "" Then rtbFile.Text = strFile<br />End Sub<br />Private Sub mnuFileDelete_Click()<br /> On Error GoTo Err1<br /> Kill rtbFile.Text<br /> Call mnuFileRContent_Click<br />Err1:<br />End Sub<br />Private Sub mnuFileExit_Click()<br /> Unload Me<br />End Sub<br />Private Sub mnuViewSetTop_Click()<br /> isTop = Not isTop<br /> mnuViewSetTop.Checked = isTop<br /> SetWindowPos Me.hWnd, IIf(isTop, -1, -2), 0, 0, 0, 0, 3<br />End Sub<br />Private Sub mnuFileRContent_Click()<br /> On Error GoTo Err1<br /> Call loadFile(rtbFile.Text)<br /> sFileTime = FileDateTime(rtbFile.Text)<br /> Exit Sub<br />Err1:<br /> CodeMax1.Text = ""<br />End Sub<br />Private Sub loadFile(strFile$)<br /> CodeMax1.Text = fileStr(rtbFile.Text)<br /> CodeMax1.SelectLine CodeMax1.LineCount - 1, True<br /> lngLastSelLine = CodeMax1.LineCount - 1<br /> CodeMax1.SetLineColor lngLastSelLine, &HFFFFC0<br />End Sub<br />Private Sub mnuWMRFileName_Click()<br /> Dim l1&<br /> If rtbFile.Text = "" Then Exit Sub<br /> l1 = InStr(LCase(rtbFile.Text), "log")<br /> If l1 > 0 Then rtbFile.Text = Left(rtbFile.Text, l1 + 2) & Format(Now, "yyyymmddhh") & ".log"<br />End Sub<br />Private Sub rtbFile_Change()<br /> Me.Caption = "FileMonitor" & IIf(rtbFile.Text <> "", " - ", "") & rtbFile.Text<br /> If isAnalysisVbp Then<br /> CodeMax1.Text = strAanalysisForms(rtbFile.Text)<br /> Else<br /> Call mnuFileRContent_Click<br /> End If<br />End Sub<br />Private Sub rtbFile_OLEDragDrop(Data As RichTextLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)<br /> Dim strDragFile As String</p><p> If Data.GetFormat(1) Then 'draged is chars block<br /> strDragFile = Data.GetData(1)<br /> ElseIf Data.GetFormat(15) Then 'draged is file object<br /> strDragFile = Data.Files.Item(Data.Files.Count)<br /> End If</p><p> If strDragFile <> "" Then rtbFile.Text = strDragFile<br />End Sub<br />'refesh file content<br />Private Sub Timer1_Timer()<br /> On Error GoTo Err1<br /> If rtbFile.Text = "" Then Exit Sub<br /> sFileTimeTmp = FileDateTime(rtbFile.Text)<br /> If sFileTimeTmp <> sFileTime Then<br /> sFileTime = sFileTimeTmp<br /> Call loadFile(rtbFile.Text)<br /> Me.WindowState = 0</p><p>' If Me.WindowState = 0 Then<br />' Me.WindowState = 0<br />' Else<br />' Me.WindowState = 2<br />' End If<br /> End If<br />Err1:<br />End Sub<br />'init the application controls and vars<br />Private Sub initApp()<br /> lngLastLine = -1<br /> lngLastSelLine = 0<br /> CodeMax1.SetColor cmClrLeftMargin, &HE0E0E0<br /> CodeMax1.SetColor cmClrLineNumberBk, &HE0E0E0<br /> Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2<br />End Sub<br />'Aanalysis forms<br />Private Function strAanalysisForms(strFile As String) As String<br /> Dim strContent As String<br /> Dim l1&, l2&<br /> strContent = fileStr(strFile)<br /> l1 = 1<br /> Do<br /> l1 = InStr(l1, strContent, vbCrLf & "Form=")<br /> If l1 = 0 Then Exit Do<br /> l1 = l1 + Len(vbCrLf & "Form=")<br /> l2 = InStr(l1, strContent, vbCrLf)<br /> strAanalysisForms = strAanalysisForms & Mid(strContent, l1, l2 - l1) & vbCrLf<br /> Loop<br /> If Right(strAanalysisForms, 2) = vbCrLf Then strAanalysisForms = Left(strAanalysisForms, Len(strAanalysisForms) - 2)<br />End Function<br />'refresh the logfile's name<br />Private Sub Timer2_Timer()<br /> Static strLastMin As String<br /> Dim strTemp$, strHHTemp$<br /> strTemp = Format(Now, "hh")<br /> strHHTemp = getFileHour(rtbFile.Text)<br /> If strLastMin <> strTemp Or (strHHTemp <> "" And strHHTemp <> strTemp) Then<br /> strLastMin = strTemp<br /> Call mnuWMRFileName_Click<br /> End If<br />End Sub<br />'get the HH<br />Private Function getFileHour(strFile$) As String<br /> Dim i&<br /> i = InStr(LCase(strFile), ".log")<br /> If i > 0 Then<br /> getFileHour = Mid(strFile, i - 2, 2)<br /> End If<br />End Function<br />Private Function fileStr(ByVal strFileName As String) As String<br /> On Error GoTo Err1<br /> Open strFileName For Input As #1<br /> fileStr = StrConv(InputB$(LOF(1), #1), vbUnicode)<br /> Close #1<br /> If Right(fileStr, 2) = vbCrLf Then fileStr = Left(fileStr, Len(fileStr) - 2)<br /> Exit Function<br />Err1:<br />End Function<br />