I try to create my own syntax hilight example using Freebasic and RapidQ basic.
This is RapidQ example. Freebasic dll example is in the next post.
Code: Select all
'Based on "Very simple notepad like editor, in less than 200 lines of code! (by William Yu)"
'parser based on RQB2HTML - Rapid-Q BASIC source code to HTML converter by William Yu
'Syntax hilight based on example from Iczelion's Win32 Assembly Tutorial part 35
'http://spiff.tripnet.se/~iczelion/tut35.html
'Andrew Shelkovenko diakin.narod.ru
'May 2004-2024
'Not complete, for example only.
'known parser bugs - with esc sequences, with tabs (for fix tabs replaced by spaces)
'colors choose is not completed.
' not fast, but better then SelStart\SelText.
'$APPTYPE GUI
$INCLUDE "RAPIDQ.INC" '' You don't need them all in this example.
' Background Modes
#define TRANSPARENT 1
#define OPAQUE 2
#define BKMODE_LAST 2
'-- messages
CONST WM_DESTORY = 2
CONST WM_PAINT = &HF
'-- Edit Control Messages
const EM_EXLIMITTEXT = 1077
Public Const EM_GETSEL = &HB0
Public Const EM_SETSEL = &HB1
Public Const EM_GETRECT = &HB2
Public Const EM_SETRECT = &HB3
Public Const EM_SETRECTNP = &HB4
Public Const EM_SCROLL = &HB5
Public Const EM_LINESCROLL = &HB6
Public Const EM_SCROLLCARET = &HB7
Public Const EM_GETMODIFY = &HB8
Public Const EM_SETMODIFY = &HB9
Public Const EM_GETLINECOUNT = &HBA
Public Const EM_LINEINDEX = &HBB
Public Const EM_SETHANDLE = &HBC
Public Const EM_GETHANDLE = &HBD
Public Const EM_GETTHUMB = &HBE
Public Const EM_LINELENGTH = &HC1
Public Const EM_REPLACESEL = &HC2
Public Const EM_GETLINE = &HC4
Public Const EM_LIMITTEXT = &HC5
Public Const EM_CANUNDO = &HC6
Public Const EM_UNDO = &HC7
Public Const EM_FMTLINES = &HC8
Public Const EM_LINEFROMCHAR = &HC9
Public Const EM_SETTABSTOPS = &HCB
Public Const EM_SETPASSWORDCHAR = &HCC
Public Const EM_EMPTYUNDOBUFFER = &HCD
Public Const EM_GETFIRSTVISIBLELINE = &HCE
Public Const EM_SETREADONLY = &HCF
Public Const EM_SETWORDBREAKPROC = &HD0
Public Const EM_GETWORDBREAKPROC = &HD1
Public Const EM_GETPASSWORDCHAR = &HD2
Const EM_CHARFROMPOS = &HD7
Const EM_POSFROMCHAR = &HD6
'-- EDITWORDBREAKPROC code values
Public Const WB_LEFT = 0
Public Const WB_RIGHT = 1
Public Const WB_ISDELIMITER = 2
Type Point
Left As Long
Top As Long
End Type
CONST GWL_WNDPROC = (-4)
CONST GWL_HWNDPARENT = (-8)
declare Function ConvertCodePage(SourceString As String, inPage As long, outPage As long) As String
declare sub DecodUTF8sub ()
declare sub hiliteTxt
Declare Function TabbedTextOut Lib "user32" Alias "TabbedTextOutA" _
(ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, _
ByVal nCount As Long, ByVal nTabPositions As Long, lpnTabStopPositions As Long, ByVal nTabOrigin As Long) As Long
Declare Function SetBkColor Lib "gdi32" Alias "SetBkColor" (ByVal hdc As Long, ByVal crColor As Long) As Long
Declare Function GetBkColor Lib "gdi32" Alias "GetBkColor" (ByVal hdc As Long) As Long
DECLARE FUNCTION SetWindowLongAPI1 LIB "user32" ALIAS "SetWindowLongA" (ByVal hWnd AS LONG, ByVal nIndex AS LONG, ByVal dwNewLong AS LONG) AS LONG
Private Declare Function HideCaret Lib "user32" ALIAS "HideCaret" (ByVal hwnd As Long) As Long
Private Declare Function ShowCaret Lib "user32" ALIAS "ShowCaret" (ByVal hwnd As Long) As Long
Declare Function CallWindowProc1 Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
DECLARE FUNCTION SendMessageApi LIB "user32.dll" ALIAS "SendMessageA" (hWnd AS LONG, Msg AS LONG, wParam AS LONG, lParam AS LONG) AS LONG
Declare Function GetDC Lib "user32" Alias "GetDC"(ByVal hWnd As Long) As Long
Declare Function SetBkMode Lib "gdi32" Alias "SetBkMode" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Declare Function SelectObject Lib "gdi32" Alias "SelectObject" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function SetTextColor Lib "gdi32" Alias "SetTextColor" (ByVal hdc As Long, ByVal crColor As Long) As Long
'!!! ------------------------ SrcEditWndProc ------------------------------
declare FUNCTION SrcEditWndProc (hWnd AS LONG, uMsg AS LONG, wParam AS LONG, lParam AS LONG) AS LONG
declare sub R2Change
dim VisRect as QRect
dim VisPoint as Point
dim VisPoint1 as Point
dim HiLiteFont as QFont
dim HiLiteFont1 as QFont
HiLiteFont.bold=0
HiLiteFont.Name="FixedSys"
HiLiteFont.Name="DejaVu Sans Mono"
defint hdc '-- device handle'
DIM M AS QMEMORYSTREAM
defint FIRSTVISIBLELINE,LastVISIBLELINE
defint FirstChar
'---------------------------------------------'
create MainForm AS QForm
create SrcEdit AS QRichEdit
WantTabs=1
end create
create LogEdit AS QRichEdit
align=albottom
height=100
end create
end create
create DialogBox AS QForm
create EditBox AS QEdit
end create
end create
DIM MainMenu AS QMainMenu
DIM File AS QMenuItem, Edit AS QMenuItem
DIM New AS QMenuItem, Open AS QMenuItem, ReOpen AS QMenuItem
DIM ReOpen1 AS QMenuItem, ReOpen2 AS QMenuItem, ReOpen3 AS QMenuItem
DIM Save AS QMenuItem, SaveAs AS QmenuItem
DIM Break1 AS QMenuItem
DIM ExitEditor AS QMenuItem
DIM Copy AS QMenuItem, Cut AS QMenuItem, Paste AS QMenuItem, SelectAll AS QMenuItem
DIM Search AS QMenuItem, Find AS QMenuItem
DIM DecodUTF8 AS QMenuItem
DIM FileName AS STRING
FileName = "UNTiTLED"
DIM CountFiles AS BYTE
CountFiles = 0
DIM StatusBar AS QStatusBar
StatusBar.Parent = MainForm
StatusBar.AddPanels "0","1","2","3"
StatusBar.Panel(0).Width = 100
StatusBar.Panel(1).Width = 100
StatusBar.Panel(2).Width = 100
StatusBar.Panel(3).Width = 100
StatusBar.Panel(0).Alignment = taCenter
'--*********************************
SUB ExitEditorClick '' Exit item clicked
MainForm.Close
END SUB
'--*********************************
SUB NewClick '' New item clicked
SrcEdit.Clear
FileName = "UNTiTLED"
END SUB
'--*********************************
SUB OpenClick '' Open item clicked
DIM OpenDialog AS QOpenDialog
OpenDialog.InitialDir=curdir$
OpenDialog.Filter ="1.All Files *.*|*.*|_
2.Bas Files *.bas;*.rqb;*.vbs|*.bas;*.rqb;*.vbs|"
OpenDialog.FilterIndex = 1
IF OpenDialog.Execute THEN
FileName = OpenDialog.FileName
'FileName = "C:\_F\bas\rapidq\RQIDE\Projects\sketchbook\ili9486.txt"
SrcEdit.LoadFromFile FileName
SrcEdit.text=REPLACESUBSTR$(SrcEdit.text,chr$(9)," ") '-- заменяем табуляции пробелами'
IF CountFiles = 0 THEN
ReOpen.Enabled = True
ReOpen1.Caption = "&1. "+FileName
ReOpen.Insert 0, ReOpen1
ELSEIF CountFiles = 1 THEN
ReOpen2.Caption = "&2. "+FileName
ReOpen.Insert 1, ReOpen2
ELSEIF CountFiles = 2 THEN
ReOpen3.Caption = "&3. "+FileName
ReOpen.Insert 2, ReOpen3
ELSE
CountFiles = CountFiles - 1
ReOpen1.Caption = "&1. "+RIGHT$(ReOpen2.Caption, LEN(ReOpen2.Caption)-4)
ReOpen2.Caption = "&2. "+RIGHT$(ReOpen3.Caption, LEN(ReOpen3.Caption)-4)
ReOpen3.Caption = "&3. "+FileName
END IF
CountFiles = CountFiles + 1
SrcEdit.Modified = False
END IF
END SUB
'--*********************************
SUB SaveAsClick '' SaveAs item clicked
DIM SaveDialog AS QSaveDialog
IF SaveDialog.Execute THEN
SrcEdit.SaveToFile SaveDialog.FileName
END IF
END SUB
'--*********************************
SUB SaveClick
IF FileName = "UNTiTLED" THEN
SaveAsClick
ELSE
SrcEdit.SaveToFile FileName
END IF
END SUB
SUB CopyClick: SrcEdit.CopyToClipBoard: END SUB '' Oh yeah, that was easy
SUB CutClick: SrcEdit.CutToClipBoard: END SUB
SUB PasteClick: SrcEdit.PasteFromClipBoard: END SUB
SUB SelectAllClick: SrcEdit.SelectAll: END SUB
'--*********************************
SUB Reopen1Click
IF SrcEdit.Modified THEN
SHOWMESSAGE "Abandoning changes"
END IF
SrcEdit.LoadFromFile RIGHT$(ReOpen1.Caption, LEN(ReOpen1.Caption)-4)
SrcEdit.Modified = False
END SUB
'--*********************************
SUB Reopen2Click
IF SrcEdit.Modified THEN
SHOWMESSAGE "Abandoning changes"
END IF
SrcEdit.LoadFromFile RIGHT$(ReOpen2.Caption, LEN(ReOpen2.Caption)-4)
SrcEdit.Modified = False
END SUB
'--*********************************
SUB Reopen3Click
IF SrcEdit.Modified THEN
SHOWMESSAGE "Abandoning changes"
END IF
SrcEdit.LoadFromFile RIGHT$(ReOpen3.Caption, LEN(ReOpen3.Caption)-4)
SrcEdit.Modified = False
END SUB
'--*********************************
SUB FindText '' Primitive search...
SrcEdit.SelStart = INSTR(UCASE$(SrcEdit.Text), UCASE$(EditBox.Text))-1
IF SrcEdit.SelStart > 0 THEN
DIM Font AS QFont
Font.AddStyles(fsBold)
Font.color=clRed
SrcEdit.SelLength = LEN(EditBox.Text)
SrcEdit.SelAttributes = Font
DialogBox.Close
ELSE
SHOWMESSAGE EditBox.Text+" not found."
END IF
END SUB
'--*********************************
SUB FindClick
DIM Button AS QButton
Button.Parent = DialogBox
Button.OnClick = FindText
Button.Caption = "&OK"
Button.Top = 13
Button.Left = 210
Button.Width = 70
EditBox.Parent = DialogBox
EditBox.Top = 15
EditBox.Left = 20
EditBox.Width = 170
DialogBox.BorderStyle = bsDialog
DialogBox.Caption = "Search..."
DialogBox.Width = 300
DialogBox.Height = 80
DialogBox.Center
DialogBox.ShowModal
END SUB
'--*********************************
SUB FormClose (Action AS INTEGER)
Application.Terminate
END SUB
'--*********************************
SUB FormResize
SrcEdit.Width = MainForm.ClientWidth
SrcEdit.Height = MainForm.ClientHeight
END SUB
'--*********************************
SUB RichShowXY (X%, Y%, Shift%)
'StatusBar.Panel(0).Caption ="Row:"+ STR$(SrcEdit.WhereY+1)+ " Col:"+ STR$(SrcEdit.WhereX+1)
R2Change
END SUB
New.Caption = "&New" : New.OnClick = NewClick
Open.Caption = "&Open" : Open.OnClick = OpenClick
ReOpen.Caption = "&ReOpen"
ReOpen.Enabled = False
ReOpen1.Caption = "" : ReOpen1.OnClick = Reopen1Click
ReOpen2.Caption = "" : ReOpen2.OnClick = Reopen2Click
ReOpen3.Caption = "" : ReOpen3.OnClick = Reopen3Click
Save.Caption = "&Save" : Save.OnClick = SaveClick
SaveAs.Caption = "Save &As..." : SaveAs.OnClick = SaveAsClick
Break1.Caption ="-"
ExitEditor.Caption = "E&xit" : ExitEditor.OnClick = ExitEditorClick
File.Caption = "&File"
File.AddItems New,Open,ReOpen,Save,SaveAs,Break1,ExitEditor
Copy.Caption = "&Copy" : Copy.OnClick = CopyClick
Copy.ShortCut = "CTRL+C"
Cut.Caption = "Cu&t" : Cut.OnClick = CutClick
Cut.ShortCut = "CTRL+X"
Paste.Caption = "&Paste" : Paste.OnClick = PasteClick
Paste.ShortCut = "CTRL+V"
SelectAll.Caption = "&Select All" : SelectAll.OnClick = SelectAllClick
Edit.Caption = "&Edit"
Edit.AddItems Copy,Cut,Paste,SelectAll
Find.Caption = "&Find"
Find.OnClick = FindClick
Search.Caption = "&Search"
Search.AddItems Find
DecodUTF8.Caption = "DecodUTF8"
'DecodUTF8.OnClick =DecodUTF8sub ' ConvertLongCP
MainMenu.Parent = MainForm
MainMenu.AddItems File,Edit,Search,DecodUTF8
SrcEdit.Parent = MainForm
SrcEdit.Align = alClient
'SrcEdit.Width = MainForm.ClientWidth
'SrcEdit.Height = MainForm.ClientHeight
SrcEdit.ScrollBars = ssBoth
SrcEdit.PlainText = 0 'True
SrcEdit.WordWrap = False
SrcEdit.OnKeyUp =RichShowXY ' hiliteTxt
'SrcEdit.OnKeyPress = hiliteTxt
'SrcEdit.OnMouseDown = hiliteTxt
SrcEdit.OnMouseUp = hiliteTxt
SrcEdit.OnMouseMove = RichShowXY
SrcEdit.font=HiLiteFont
MainForm.Caption = "Simple, notepad like editor with syntax hilighting"
MainForm.Width = 800
MainForm.Height = 600
MainForm.Center
MainForm.OnResize = FormResize
MainForm.OnClose = FormClose
'--определение новой процедуры SrcEdit'
OldSrcEditWndProc = SetWindowLongAPI(SrcEdit.Handle, GWL_WNDPROC, CODEPTR(SrcEditWndProc))
'print "OldSrcEditWndProc=" ,OldSrcEditWndProc
DIM keyList AS QRichEdit
keyList.Parent = MainForm
keyList.top=SrcEdit.top+SrcEdit.Height+4
'keyList.left=20
keyList.Width =600
keyList.color=&HFAFFC2
keyList.visible=0
result= SendMessageAPI (SrcEdit.handle,EM_EXLIMITTEXT,0,65535*32)
IF fileExists(fullPath$+"keyword.lst") = 0 THEN
'' PRINT "ERROR can't find file keyword.lst "+fullPath$+"keyword.lst"
END
ELSE
'' PRINT "Load file keyword.lst "+fullPath$+"keyword.lst"
keyList.LoadFromFile(fullPath$+"keyword.lst")
END IF
'!!!---------------------------------------------
'FileName = "C:\_F\bas\rapidq\RQIDE\tstremmm26.bas" 'OpenDialog.FileName
FileName = "D:\_F\bas\rapidq\RQIDE\projects\RichEd\HLEditor2022-6remTab9good.bas"
'call AddClrString ("427:FileName ="+(FileName ), clred, LogEdit)
if fileexists(FileName)>0 then
SrcEdit.LoadFromFile FileName
else
Showmessage ("File not found "+FileName)
end if
MainForm.ShowModal
'--- New WinProc SrcEdit ---------------------------------------
FUNCTION SrcEditWndProc (hWnd AS LONG, uMsg AS LONG, wParam AS LONG, lParam AS LONG) AS LONG
Result = CallWindowProc(OldSrcEditWndProc, hWnd, uMsg, wParam, lParam)
SELECT CASE uMsg
CASE WM_PAINT '---- <--------------------------------------
'print "SrcEdit WM_PAINT=",WM_PAINT
'HideCaret hWnd
hdc=GetDC(hWnd) : 'print "hdc=" ,hdc
'__ Set the bitmap's backmode to transparent
'previous_background_mode=SetBkMode (hDC, TRANSPARENT)
previous_background_mode=SetBkMode (hDC, OPAQUE)
'__ select font
Curent = SelectObject(hdc, HiLiteFont.Handle)
rgbPrev = SetTextColor(hdc, HiLiteFont.color)
'__ Get visible rect
M.WriteUDT(VisRect)
result= SendMessageAPI (hWnd,EM_GETRECT,0,M.Pointer)
M.Position = 0
M.ReadUDT(VisRect)
M.Position = 0
'print "Rect.Left=",VisRect.Left, " Rect.top=",VisRect.top
'print "Rect.Right=",VisRect.Right, " Rect.Bottom=",VisRect.Bottom
'__ Get point structure (may be not needed)
VisPoint.Left=VisRect.Left
VisPoint.Top=VisRect.Top
M.Position = 0
M.WriteUDT(VisPoint)
M.Position = 0
'__Get char index from begin
lchar=SendMessageAPI (hWnd,EM_CHARFROMPOS,0,M.Pointer)
'__ get first visible line
line_number= SendMessageAPI (hWnd,EM_LINEFROMCHAR,lchar,0 )
'__ Hehe, more easy (get first visible line )
FIRSTVISIBLELINE= SendMessageAPI (hWnd,EM_GETFIRSTVISIBLELINE,0,0)
FirstChar=SendMessageAPI (hWnd,EM_LINEINDEX,line_number,0)
VisPoint.Left=VisRect.Right
VisPoint.Top=VisRect.Bottom
M.Position = 0
M.WriteUDT(VisPoint)
M.Position = 0
Lastchar=SendMessageAPI (hWnd,EM_CHARFROMPOS,0,M.Pointer)'addr_rect
'print "Lastchar=" ,Lastchar
'__ get LastVISIBLELINE
LastVISIBLELINE=SendMessageAPI (hWnd,EM_LINEFROMCHAR,Lastchar,0 )
'print "LastVISIBLELINE=" ,LastVISIBLELINE
hiliteTxt '-<<<<<<<<<<<<<<<<<<<<<<<<'
END SELECT
END FUNCTION
'-- *****************************************************************************************************************
SUB hiliteTxt
DEFINT useEscapes = FALSE
DIM i AS LONG
DIM j AS LONG
DIM quote AS BYTE
DIM ch AS STRING * 1
DIM token AS STRING
'----------
dim CurPos AS LONG '-- char pos from file beginning
dim StrPos AS LONG '-- firs char in current line position (from file beginning)
'if SrcEdit.SelLength>0 then exit sub 'problem with selection hilighting
StrPos=FirstChar
CurPos=0
j=0
i=0
flDigit=-1
RhWnd=SrcEdit.Handle
'-- use SrcEdit.line()
FOR i =FIRSTVISIBLELINE TO LastVISIBLELINE ' - throught visible lines
quote = FALSE
token = "" '
ch =""
lenline1=len(SrcEdit.line(i))
FOR j = 1 TO len(SrcEdit.line(i)) '- going through the characters in the current line
CurPos=j +StrPos '-
ch = SrcEdit.line(i)[j]
IF instr("+-=<>(){}\/^&*[]:;?,.%^#@!~_' "+chr$(34)+chr$(9), ch) THEN '- if delimiter !!!
' hilight previous token !!!!
IF token <> "" THEN '- if token before - hilite it!
if instr(keyList.Text,ucase$(token))>0 then ' if digit ??? !!!
'-------------------------
SendMessageAPI (rhWnd,EM_POSFROMCHAR,VisPoint1,CurPos-len(token)-1)
rgbPrev = SetTextColor(hdc, clb)
TextOut(hdc, VisPoint1.left, VisPoint1.top, token, len(token))
'-------------------------
ELSEif flDigit=1 then
'-------------------------
SendMessageAPI (rhWnd,EM_POSFROMCHAR,VisPoint1,CurPos-len(token)-1)
rgbPrev = SetTextColor(hdc, clr)
TextOut(hdc, VisPoint1.left, VisPoint1.top, token, len(token))
'-------------------------
flDigit=-1
ELSE
flDigit=-1
END IF
token = "" ' clear token
flDigit=-1
END IF
IF ch = chr$(34) THEN '--- begin string type -----!
token = ""
kk=0
'-------------------------first qt set green color
SendMessageAPI (rhWnd,EM_POSFROMCHAR, VisPoint1,CurPos-1)
rgbPrev = SetTextColor(hdc, clGreen)
TextOut(hdc, VisPoint1.left, VisPoint1.top, ch, len(ch))
'-------------------------
lenline=len(SrcEdit.line(i))
FOR j = j+1 TO lenline '--- char by char !
CurPos=j +StrPos
ch = SrcEdit.line(i)[j]
IF ch = chr$(34) THEN '--- ------- end string! -----------
'------------------------- last qt set green -------
SendMessageAPI (rhWnd,EM_POSFROMCHAR, VisPoint1,CurPos-1)
rgbPrev = SetTextColor(hdc, clGreen)
TextOut(hdc, VisPoint1.left, VisPoint1.top, ch, len(ch))
'-------------------------
kk=1
EXIT FOR
else
token = token + ch ' string token sum
END IF
NEXT J
'j = j+1
'--- end string type
'------------------------- set string token to orange color --------------!!
SendMessageAPI (rhWnd,EM_POSFROMCHAR,VisPoint1,CurPos-len(token)-kk)
rgbPrev = SetTextColor(hdc, clOrange)
TabbedTextOut (hdc, VisPoint1.left, VisPoint1.top, token,len(token),0,0,0)
'TextOut(hdc, VisPoint1.left, VisPoint1.top, token, len(token))
kk=0
token = "" ' clear token!
ch=""
'-------------------------
ELSEIF ch = "'" THEN '!-- comment begin ---------------
RemF:
'---first comment pos
RemPos=CurPos
token = "" '- new token - comment, clear token!
rempos1=j 'RemPos ' rempos1=instr(SrcEdit.line(i),"'")
token =mid$(SrcEdit.line(i),RemPos1, len(SrcEdit.line(i))-RemPos1+1) '! to enf of line
'call AddClrString ("573:token="+(token), clred, LogEdit)
'call AddClrString ("580:len(token)="+str$(len(token)), clred, LogEdit)
j=j+len(token)
CurPos=j +StrPos
'---- comment ---------------
SendMessageAPI (rhWnd,EM_POSFROMCHAR,VisPoint1,RemPos-1)
rgbPrev = SetTextColor(hdc, clDGreen)
TabbedTextOut (hdc, VisPoint1.left, VisPoint1.top, token,len(token),0,0,0)
'TextOut(hdc, VisPoint1.left, VisPoint1.top, token, len(token))
'-------------------------
ch = ""
exit for
ELSEIF ch = "/" THEN '
ch1$ = SrcEdit.line(i)[j+1]
'call AddClrString ("536:ch1$="+(ch1$), clred, LogEdit)
if ch1$ = "/" then goto RemF:
ELSEIF ch = chr$(9) THEN '---- tab !!!!!!!!!!!! replaced by 4 spaces in source
previous_background_mode=SetBkMode (byval hDC, byval OPAQUE)
SendMessageAPI (rhWnd,EM_POSFROMCHAR, VisPoint1,CurPos-1)
rgbPrev = SetTextColor(hdc, clo)
bgcolor= GetBkColor(hDC)
SetBkColor(hdc,clGreen)
'call AddClrString ("579:rgbPrev="+str$(rgbPrev), clred, LogEdit)
TextOut(hdc, VisPoint1.left+2, VisPoint1.top, ch, len(ch))
SetBkColor(hdc,bgcolor)
ch = ""
elseIF instr("+-=<>\/^&*[]:;?,.", ch) THEN
'-------------------------
SendMessageAPI (rhWnd,EM_POSFROMCHAR,VisPoint1,CurPos-1)
rgbPrev = SetTextColor(hdc, &HCA9000)
TextOut(hdc, VisPoint1.left, VisPoint1.top, ch, len(ch))
'-------------------------
ELSEIF instr("()[]{}", ch) THEN
'-------------------------
SendMessageAPI (rhWnd,EM_POSFROMCHAR,VisPoint1,CurPos-1)
rgbPrev = SetTextColor(hdc, cla)
TextOut(hdc, VisPoint1.left, VisPoint1.top, ch, len(ch))
'-------------------------
ELSEIF token <> "" THEN
END IF
token = ""
elseIF instr("1234567890", ch) THEN
if flDigit=-1 then flDigit=1
IF flDigit=1 THEN
ELSE
flDigit=0
END IF
token = token + ch
else
token = token + ch
flDigit=0
END IF
NEXT j
IF token <> "" THEN
if instr(keyList.Text,ucase$(token))>0 then
'-------------------------
SendMessageAPI (rhWnd,EM_POSFROMCHAR,VisPoint1,CurPos-len(token))
rgbPrev = SetTextColor(hdc, clb)
TextOut(hdc, VisPoint1.left, VisPoint1.top, token, len(token))
'-------------------------
ELSEif flDigit=1 then
'-------------------------
SendMessageAPI (rhWnd,EM_POSFROMCHAR,VisPoint1,CurPos-len(token))
rgbPrev = SetTextColor(hdc, clr)
TextOut(hdc, VisPoint1.left, VisPoint1.top, token, len(token))
'-------------------------
flDigit=-1
END IF
END IF
StrPos=StrPos+len(SrcEdit.line(i))+2'StrPos+j
'call AddClrString ("657:StrPos="+str$(StrPos), &H006435, LogEdit)
NEXT i
END SUB ' hiliteTxt
'!************************************************************************'
sub R2Change
RichRow1=str$(SrcEdit.WhereY+1)
RichCol1=str$(SrcEdit.WhereX+1)
'call AddClrString ("8293:RichCol1="+str$(RichCol1), clred, LogEdit)
if SrcEdit.SelStart+1< len(SrcEdit.Text) then
pos1=SrcEdit.SelStart+1
else
pos1=SrcEdit.SelStart
end if
char1$ = str$(asc(mid$(SrcEdit.Text, pos1,1)))
'RichX1.Caption= RichRow1+":"+RichCol1 +" "+char1$
'RichX1.Font.Color=clBlue
SrcEditLen1=len (SrcEdit.text)
'SrcEdit.SelStart=CursWin(WindowsIndex)
'' AddPanels "line ", "col ", "ASCII","char pos"
StatusBar.Panel(0).caption = "Row "+RichRow1+":"+ str$(SrcEdit.LineCount)
StatusBar.Panel(1).caption = "Col "+RichCol1
StatusBar.Panel(3).caption = "Asc "+char1$
StatusBar.Panel(2).caption = "Pos "+str$(pos1)+":"+ str$(SrcEditLen1)
if SrcEditLen<>SrcEdit.LineCount then 'SrcEditLen1 только при изменении числа строк
SrcEditLen=SrcEdit.LineCount
Modiflg=1
end if
'call AddClrString ("8317:Modiflg="+str$(Modiflg), clred, LogEdit)
END SUB
'AddPanels "Row ", "Col ", "Pos ","Asc ", "EOL ",""