Something for fun

[Aurel]

..maybe something for fun ?
and now work far better.
only thing is that trimming not work very well ..i am not sure why? 
looks like problem with strings operations 
compiled with A 041..i don't use latest because i suspect that have more quirks...
anyway something for fun... 
click button  'open'
then click 'scan'

Code: [Select]

$ Filename "ANIscript.exe" ' o2
include "RTL32.inc"
include "awinh.inc"
#lookahead
INT win,wx=100,wy=0,ww=800,wh=600,wstyle = WS_MINMAXSIZE
INT bt0,b0ID=100,bt1,b1ID=101,bt2,b2ID=102 'buttons
INT static1,stID1=10,static2,staticID2=11,static3,staticID3=12,static4,staticID4=13,static5,staticID5=14  'staticTX
INT edit1,ed1ID=200,riched,richID=400,LBoxH,LBid=500,edit2,editID2=50
INT edit3,editID3=51,edit4,editID4=52,edit5,editID5=53,edit6,editID6=54
STRING crlf = chr(13)+chr(10), outBuff="processing..." + crlf
STRING source[1000] ' source lines array
 string pt = Space (255)
'bitmap image handlers -------------------------------------------------
INT bb0,bb1,bb2
'create main window ----------------------------------------------------
win=SetWindow("ANI::v1",wx,wy,ww,wh,0,wstyle)
'crete buttons----------------------------------------------------------
bt0 = SetButton(win,4,60,34,34,"New", 1409384576,0x200,b0ID)  'as image button flat 1409384576 - 1409351808
bb0 = LoadImage(0,"bNew.bmp",0,32,32,16):SendMessage(bt0, 247, 0, bb0) 'add bitmap to button
bt1 = SetButton(win,4,98,34,34,"Open", 1409384576,0x200,b1ID)
bb1 = LoadImage(0,"bOpen.bmp",0,32,32,16):SendMessage(bt1, 247, 0, bb1)
bt2 = SetButton(win,4,140,34,34,"Save", 1409384576,0x200,b2ID)
bb2 = LoadImage(0,"bSave.bmp",0,32,32,16):SendMessage(bt2, 247, 0, bb2)

'create EDIT1 - multiline --------------------------------------------
edit1 = SetEditBox(win,44,480,500,80, outBuff,  WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCROLL,0x200,ed1ID) '50B01004 processing box
'create static control
static1 = SetStatic(win,6,8,54,16,"LINES",0,0,stID1) 'static 'LINES'
static2 = SetStatic(win,6,35,54,16,"LINE >>",0,0,staticID2) 'static 'LINES'
edit2 = SetEditBox(win,50,5,70,20,"num of Lines",0x50800000,0x200,editID2) 'edit for number of lines
edit3 = SetEditBox(win,50,32,710,22,"current Line",0x50800000,0x200,editID2) 'edit for current line
ControlFont(edit3, 15, 8, 400, "Courier New"): SetFocus edit3
static3 = SetStatic(win,120,8,54,16,"T-LINE",0,0,staticID3) 'static 'LINES'
edit4 = SetEditBox(win,160,6,60,20,"Line Num",0x50800000,0x200,editID4)

static4 = SetStatic(win,230,8,54,16,"T-CHAR",0,0,staticID4) 'static 'temp char
edit5 = SetEditBox(win,280,6,60,20,"CHAR",0x50800000,0x200,editID5) ' show char

static5 = SetStatic(win,350,8,54,16,"CHAR-POS",0,0,staticID5) 'static 'charPos
edit6 = SetEditBox(win,410,6,60,20,"POS",0x50800000,0x200,editID6) ' position in line

'create RICHEDIT1 -------------------------------------------------------------------------------
'INT reStyle = WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCROLL|ES_AUTOHSCROLL|ES_SUNKEN
'INT reStyle = 0x508010C4 /::src code line::
riched= SetRichEdit (win, 44,60,500,400,"def a , b, c, d", WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCROLL|ES_AUTOHSCROLL,0x200,richID)
ControlFont(riched, 15, 8, 400, "Courier New") : 'SetRichEditBackColor riched, RGB(250,244,179)
'create listbox for token list ------------------------------------------------------------------
LBoxH = SetListBox(win,660,60,100,300,"",0x50000140|CTLISTNOTIFY|WS_VSCROLL,0x200,LBid)
ControlFont(LBoxH, 12,8, 100, "MS Sans Serif")
SendMessage LboxH, LB_ADDSTRING, 0, strptr "TOKENS"
'----------------------------------------------------------------------
Wait()  'message loop
'----------------------------------------------------------------------
'func main
Function WndProc (sys hwnd,wmsg,wparam,lparam) as sys callback
SELECT hwnd
CASE win
Select wmsg

            'CASE WM_CREATE ?not work
'create richedit
'riched= SetRichEdit (win, 44,60,500,400,"DEF a , b, c, d", 11534468|ES_SUNKEN ,0x200,richID)
                  'UpdateWindow win
'ControlFont(riched, 15, 14, 600, "Courier New")

CASE WM_CLOSE
CloseWindow(win)
EndProgram
                  ExitProcess 0

CASE WM_COMMAND
controlID = LoWord(wParam) 'get control ID
notifyCode = HiWord(wParam) 'get notification message

select controlID
case b1ID  'open file
                       if notifycode=0
   doOpen()
end if

case b0ID 'scan >>>
                       if notifycode=0
   doScan()
end if

                  end select
End Select
END SELECT
RETURN Default
END FUNCTION

'************************************************
'****    A N I -> P R O C E S S I N G    ********
'************************************************

'open source file
Sub doOpen
string fName="", dir="", sep=chr(0) , title="Open File... "
filter = "All Files "+sep+"*.*"+sep+"script files "+sep+"*.txt"
title="Open File... "
fName = FileDialog(dir,filter,title,0,0,"txt")
IF fName = ""  'almost useless ?
SendMessage edit1,WM_SETTEXT,0,strptr("NO FILE ! ") : Return
END IF
'SendMessage status,WM_SETTEXT,0,strptr(fName)
 char tx[500000] : tx =  GetFile fName      'load file into char buffer
'SendMessage riched, 12, 0, strptr(tx)       'show file in richedit
SetText (riched,tx)
string numOfLines : int LineCount : LineCount = SendMessage riched, EM_GETLINECOUNT, 0,0
numOfLines = str(LineCount) : SetText (edit2,numOfLines) ' show result in edit2
outBuff = outBuff + "file_loaded..." + crlf                  : SetText (edit1,outBuff)
outBuff = outBuff + "number of lines : " + numOfLines + crlf : SetText (edit1,outBuff)
frees tx
End Sub

'scan source line -----------------------------------------------------------------------
Sub doScan
string s="", pt = Space (255)
int i ,LineCount=1
LineCount = SendMessage riched, EM_GETLINECOUNT, 0,0 ' get number of Lines
SetText (edit1,"WAIT..scanning >>>>") : MsgBox "OK!","INFO"
'scan each line
For i = 0 to LineCount
    'For p = 0 to 10000000: next p ' delay loop not work well if is alone -> so i use PeekMessage
         while PeekMessage (&wm,0,0,0,Pm_Remove)>0 ' //peek
TranslateMessage (&wm)
DispatchMessage (&wm)
wend
SendMessage (riched, EM_GETLINE, i,strptr pt) ' get line from richedit control
    ' MsgBox pt , "INFO"
     s = ltrim( mid pt, 0, len(pt))                          'trim left part of line
      SetText edit4, str(i)                 'show line number
      SetText(edit3, s)                     'show current line in single-Line edit box
      sleep 250 :s=""                            ' slow down..tweak for your computer
Next i
SetText edit1,"FINISHED!"

End Sub

.

[Charles Pegge]

Thanks Aurel,
r
This works fine with my next OxygenBasic (v43), due for release shortly.

But a definition for SetText is missing from awinh.inc (2017). So I inserted this macro to rectify:

Code: [Select]

macro SetText(h,s) {SendMessage h,WM_SETTEXT,0,s}


[Aurel]

Yes i forget to add SetText function,
When i clean awinh i will add more GUI functions.
..and is that new way for macro function ...?
interesting 

[Aurel]

Charles
is there a way that Ltrim( string) not calculate start position of string properly ?
it looks that start from second character in string..i mean first is ignored?
or i do something wrong...

ps..it looks that problem is connected with richedit control

[Charles Pegge]

Hi Aurel,

Macros are a good replacement for short procedures, like your setText. The syntax is quite flexible:

Code: [Select]

macro SetText(h,s) {SendMessage h,WM_SETTEXT,0,s}

macro SetText(h,s) {
  SendMessage h,WM_SETTEXT,0,s
}

macro SetText(h,s)
{
  SendMessage h,WM_SETTEXT,0,s
}

macro SetText(h,s)
  SendMessage h,WM_SETTEXT,0,s
end macro

macro SetText(h,s) SendMessage h,WM_SETTEXT,0,s

#define SetText(h,s) {SendMessage h,WM_SETTEXT,0,s}

#define SetText(h,s) SendMessage h,WM_SETTEXT,0,s


I am currently working on full macro functions, which may be used in expressions, exactly like a normal function (PB can do this).

PS: I have not encountered any issues with left(), so far

[Aurel]

Hi Charles 

Yes i forget that Macro() is excellent way..
It is problem with richedit control probably with TAB char.
richEdit respond different on XP and different on win7, how work on w10
i don't know ...
aha..when you say PB you mean probably on PowerBasic  -- Parse() function
right?

PS.

PS: I have not encountered any issues with left(), so far

not with left() than with LTRIM()..but i will check this more 

[Charles Pegge]

o2 ltrim strips all left white-space characters (0 to 32) , including tab. Could this be the problem you are seeing?

[Aurel]

no Charles
it looks that last text line is without first sign
for example
instead of  OXYGEN  i get
XYGEN..
it seems that is problem in my forLoop and require LineCount-1
because richedit is zero-based control.

[Aurel]

Hi
fixed some things and added function s = GetText (controlID )
test program is in attachment
first run program then open smaller file called 'LineByLine'
scanning is very slow ...so you can see how scanning work
i hope that is not too sloow 

Code: [Select]

$ Filename "ANIscript.exe" ' o2
include "RTL32.inc"
include "awinh.inc"
#lookahead
INT win,wx=100,wy=0,ww=800,wh=600,wstyle = WS_MINMAXSIZE
INT bt0,b0ID=100,bt1,b1ID=101,bt2,b2ID=102 'buttons
INT static1,stID1=10,static2,staticID2=11,static3,staticID3=12,static4,staticID4=13,static5,staticID5=14  'staticTX
INT edit1,ed1ID=200,riched,richID=400,LBoxH,LBid=500,edit2,editID2=50
INT edit3,editID3=51,edit4,editID4=52,edit5,editID5=53,edit6,editID6=54
STRING crlf = chr(13)+chr(10), outBuff="processing..." + crlf
STRING source[1000] ' source lines array
 string pt = Space (255)
'bitmap image handlers -------------------------------------------------
INT bb0,bb1,bb2
'create main window ----------------------------------------------------
win=SetWindow("ANI::v1",wx,wy,ww,wh,0,wstyle)
'crete buttons----------------------------------------------------------
bt0 = SetButton(win,4,60,34,34,"New", 1409384576,0x200,b0ID)  'as image button flat 1409384576 - 1409351808
bb0 = LoadImage(0,"bScan.bmp",0,32,32,16):SendMessage(bt0, 247, 0, bb0) 'add bitmap to button
bt1 = SetButton(win,4,98,34,34,"Open", 1409384576,0x200,b1ID)
bb1 = LoadImage(0,"bOpen.bmp",0,32,32,16):SendMessage(bt1, 247, 0, bb1)
bt2 = SetButton(win,4,140,34,34,"Save", 1409384576,0x200,b2ID)
bb2 = LoadImage(0,"bProc.bmp",0,32,32,16):SendMessage(bt2, 247, 0, bb2)

'create EDIT1 - multiline --------------------------------------------
edit1 = SetEditBox(win,44,480,500,80, outBuff,  WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCROLL,0x200,ed1ID) '50B01004 processing box
'create static control
static1 = SetStatic(win,6,8,54,16,"LINES",0,0,stID1) 'static 'LINES'
static2 = SetStatic(win,6,35,54,16,"LINE >>",0,0,staticID2) 'static 'LINES'
edit2 = SetEditBox(win,50,5,70,20,"num of Lines",0x50800000,0x200,editID2) 'edit for number of lines
edit3 = SetEditBox(win,50,32,710,22,"current Line",0x50800000,0x200,editID2) 'edit for current line
ControlFont(edit3, 15, 8, 400, "Courier New"): SetFocus edit3
static3 = SetStatic(win,120,8,54,16,"T-LINE",0,0,staticID3) 'static 'LINES'
edit4 = SetEditBox(win,160,6,60,20,"Line Num",0x50800000,0x200,editID4)

static4 = SetStatic(win,230,8,54,16,"T-CHAR",0,0,staticID4) 'static 'temp char
edit5 = SetEditBox(win,280,6,60,20,"CHAR",0x50800000,0x200,editID5) ' show char
ControlFont(edit5, 16, 9, 600, "Courier New")

static5 = SetStatic(win,350,8,54,16,"CHAR-POS",0,0,staticID5) 'static 'charPos
edit6 = SetEditBox(win,410,6,60,20,"POS",0x50800000,0x200,editID6) ' position in line

'create RICHEDIT1 -------------------------------------------------------------------------------
'INT reStyle = WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCROLL|ES_AUTOHSCROLL|ES_SUNKEN
'INT reStyle = 0x508010C4 /::src code line::
riched= SetRichEdit (win, 44,60,500,400,"def a , b, c, d", WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCROLL|ES_AUTOHSCROLL,0x200,richID)
ControlFont(riched, 15, 8, 400, "Courier New") : 'SetRichEditBackColor riched, RGB(250,244,179)
'create listbox for token list ------------------------------------------------------------------
LBoxH = SetListBox(win,660,60,100,300,"",0x50000140|CTLISTNOTIFY|WS_VSCROLL,0x200,LBid)
ControlFont(LBoxH, 12,8, 100, "MS Sans Serif")
SendMessage LboxH, LB_ADDSTRING, 0, strptr "TOKENS"
'----------------------------------------------------------------------
Wait()  'message loop
'----------------------------------------------------------------------
'func main
Function WndProc (sys hwnd,wmsg,wparam,lparam) as sys callback
SELECT hwnd
CASE win
Select wmsg

            'CASE WM_CREATE ?not work
'create richedit
'riched= SetRichEdit (win, 44,60,500,400,"DEF a , b, c, d", 11534468|ES_SUNKEN ,0x200,richID)
                  'UpdateWindow win
'ControlFont(riched, 15, 14, 600, "Courier New")

CASE WM_CLOSE
CloseWindow(win)
EndProgram
                  ExitProcess 0

CASE WM_COMMAND
controlID = LoWord(wParam) 'get control ID
notifyCode = HiWord(wParam) 'get notification message

select controlID
case b1ID  'open file
                       if notifycode=0
   doOpen()
end if

case b0ID 'scan >>>
                       if notifycode=0
   doScan()
end if

                  end select
End Select
END SELECT
RETURN Default
END FUNCTION

'************************************************
'****    A N I -> P R O C E S S I N G    ********
'************************************************

'open source file
Sub doOpen
string fName="", dir="", sep=chr(0) , title="Open File... "
filter = "All Files "+sep+"*.*"+sep+"script files "+sep+"*.txt"
title="Open File... "
fName = FileDialog(dir,filter,title,0,0,"txt")
IF fName = ""  'almost useless ?
SendMessage edit1,WM_SETTEXT,0,strptr("NO FILE ! ") : Return
END IF
'SendMessage status,WM_SETTEXT,0,strptr(fName)
 char tx[500000] : tx =  GetFile fName      'load file into char buffer
'SendMessage riched, 12, 0, strptr(tx)       'show file in richedit
SetText (riched,tx)
string numOfLines : int LineCount : LineCount = SendMessage riched, EM_GETLINECOUNT, 0,0
numOfLines = str(LineCount) : SetText (edit2,numOfLines) ' show result in edit2
outBuff = outBuff + "file_loaded..." + crlf                  : SetText (edit1,outBuff)
outBuff = outBuff + "number of lines : " + numOfLines + crlf : SetText (edit1,outBuff)
frees tx
End Sub

'scan source line -----------------------------------------------------------------------
Sub doScan
string s,sc,cLine
string pt = Space (255)  ' also you may try char pt[255]=""
int i ,LineCount=1 ,crPos
SetText(edit3,"")  ' clear current line box
LineCount = SendMessage riched, EM_GETLINECOUNT, 0,0 ' get number of Lines
SetText (edit1,"WAIT..scanning >>>>") : MsgBox "SCAN FILE","OK!..START"
'scan each line
For i = 0 to LineCount-1
    ' enable events..so i use PeekMessage
         while PeekMessage (&wm,0,0,0,Pm_Remove)>0 ' //peek
TranslateMessage (&wm)
DispatchMessage (&wm)
wend
SendMessage (riched, EM_GETLINE, i, pt) ' get line from richedit control
    ' MsgBox pt , "INFO"
     if pt <> ""
s = Ltrim(pt)               'trim left side
         crPos = instr(pt,chr(13)) : ' check CR position /msgbox "POS:"+str(crPos),"CHR(13).POS"
         s = MID( pt, 1, crPos-1)    ' extract string / text
     else
s=""                         
     end if
     
      SetText edit4, str(i)            'show line number
      SetText(edit3, s)                'show current line in single-Line edit box
      cLine = GetText(edit3)           'get text from edit control
     'msgBox cLine,"LINE:"+str(i)      'check this
'get char func >>>>>>>>>>>>>>>>>>>>>
GetChar(cLine)
      '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
      sleep 300 :s=""                   ' slow down..tweak for your computer
Next i
SetText edit1,"FINISHED!"
End Sub
'-----------------------------------------------------------------------------------------

SUB GetChar(string sLine)
int pos=1,lineSize
string ch,nextCh,tLine
tLine = Mid(sLine,1,Len(sLine))
lineSize=LEN(tLine)
while pos <= lineSize
ch = Mid( tLine,pos,1)
                 sleep 200
                 SetText(edit5,ch)       'show character
                 SetText(edit6,str(pos)) 'show char position in line
                 ch=""
pos=pos+1
wend
End Sub
'-----------------------------------------------------------------------------------------

.

[Aurel]

Sorry people
I forgot to post here update version of
...more for fun....
or like Sheldon Cooper says :::: FUN WITH FLAGS:::: CONTINUE 

Code: [Select]

$ Filename "ANIscript.exe" ' o2
include "RTL32.inc"
include "awinh037.inc"
#lookahead
string KEYWORDS[] = {"CLS","PRINT","IF","ELSE","FOR","TO","NEXT","ENDIF","WHILE","WEND","UNTIL","DOT","LINE","WINDOW"}
string SYMBOLS = ",:=()+-*/<>[]^"
string ALPHABETS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz$#"
string DQ = chr(34)
string NUMBERS = ".0123456789"
string NUMBERS_WITH_DECIMALPOINT = NUMBERS + "."
string ALPHANUMBERS = ALPHABETS + NUMBERS
string ALPHANUMBERS_WITH_UNDERSCORE = ALPHANUMBERS + "_"
STRING tokens , tokenList[1024] ' token list
string crlf = chr(13)+chr(10)
INT tokTypeList[1024]           'token type list
INT tokCount
'------------------------------------------------------------------------

INT win,wx=100,wy=0,ww=840,wh=640,wstyle = WS_MINMAXSIZE
INT bt0,b0ID=100,bt1,b1ID=101,bt2,b2ID=102 'buttons
INT static1,stID1=10,static2,staticID2=11,static3,staticID3=12,static4,staticID4=13,static5,staticID5=14  'staticTX
INT edit1,ed1ID=200,riched,richID=400,LBoxH,LBid=500,edit2,editID2=50
INT edit3,editID3=51,edit4,editID4=52,edit5,editID5=53,edit6,editID6=54
INT ipos ' LB item pos
STRING  outBuff="processing..." + crlf
STRING source[1000] ' source lines array
string pt = Space (255)
'bitmap image handlers -------------------------------------------------
INT bb0,bb1,bb2
'create main window ||||||||||||||||||||||||||||||||||||||||||||||||||||
win=SetWindow("ANI::v3",wx,wy,ww,wh,0,wstyle)
    InitDrawing(win)
    WindowColor( win, 220, 230, 250)
InvalidateRect(win, 0, 0)
'crete buttons||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
bt0 = SetButton(win,4,60,34,34,"New", 1409384576,0x200,b0ID)  'as image button flat 1409384576 - 1409351808
bb0 = LoadImage(0,"bScan.bmp",0,32,32,16):SendMessage(bt0, 247, 0, bb0) 'add bitmap to button
bt1 = SetButton(win,4,98,34,34,"Open", 1409384576,0x200,b1ID)
bb1 = LoadImage(0,"bOpen.bmp",0,32,32,16):SendMessage(bt1, 247, 0, bb1)
bt2 = SetButton(win,4,140,34,34,"Save", 1409384576,0x200,b2ID)
bb2 = LoadImage(0,"bProc.bmp",0,32,32,16):SendMessage(bt2, 247, 0, bb2)

'create EDIT1 - multiline --------------------------------------------
edit1 = SetEditBox(win,44,480,500,100, outBuff,  WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCROLL,0x200,ed1ID) '50B01004 processing box
ControlFont(edit1, 17,7, 100, "Courier New")
'create static control
static1 = SetStatic(win,6,8,54,16,"LINES",0,0,stID1) 'static 'LINES'
static2 = SetStatic(win,6,35,54,16,"LINE >>",0,0,staticID2) 'static 'LINES'
edit2 = SetEditBox(win,50,5,70,20,"num of Lines",0x50800000,0x200,editID2) 'edit for number of lines
edit3 = SetEditBox(win,50,32,710,22,"current Line",0x50800000,0x200,editID2) 'edit for current line
ControlFont(edit3, 15, 8, 400, "Courier New"): SetFocus edit3
static3 = SetStatic(win,120,8,54,16,"T-LINE",0,0,staticID3) 'static 'LINES'
edit4 = SetEditBox(win,160,6,60,20,"Line Num",0x50800000,0x200,editID4)

static4 = SetStatic(win,230,8,54,16,"T-CHAR",0,0,staticID4) 'static 'temp char
edit5 = SetEditBox(win,280,6,60,20,"CHAR",0x50800000,0x200,editID5) ' show char
ControlFont(edit5, 17, 9, 600, "Courier New")

static5 = SetStatic(win,350,8,54,16,"CHAR-POS",0,0,staticID5) 'static 'charPos
edit6 = SetEditBox(win,410,6,60,20,"POS",0x50800000,0x200,editID6) ' position in line

'create RICHEDIT1 ##########################################################################################
'INT reStyle = WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCROLL|ES_AUTOHSCROLL|ES_SUNKEN
'INT reStyle = 0x508010C4 /:rc code line::
riched= SetRichEdit (win, 44,60,500,400,"a = a+b", WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCROLL|ES_AUTOHSCROLL|ES_NOHIDESEL,0x200,richID)
ControlFont(riched, 15, 8, 400, "Courier New") : SetRichEditBackColor riched, RGB(250,244,179)
SetEditSelection( riched, -1,-1):InvalidateRect( riched, 0, 0)

'create listbox for token list ##########################################################################
LBoxH = SetListBox(win,560,60,200,500,"",0x50000140|CTLISTNOTIFY|WS_VSCROLL,0x200,LBid)
ControlFont(LBoxH, 17,7, 100, "Courier New"): TextColor ( win, RGB(100,120,180), RGB(210,220,250))
TextOn( win, 560, 562, "  TOKENS ")  ' print text on window
'SendMessage LboxH, LB_ADDSTRING, 0, "TOKEN-1"
'SendMessage LboxH, LB_ADDSTRING, 0, "TOKEN-2"

'----------------------------------------------------------------------
Wait()  'message loop
'----------------------------------------------------------------------
'func main
Function WndProc (sys hwnd,wmsg,wparam,lparam) as sys callback
SELECT hwnd
    CASE win
        Select wmsg

           CASE WM_CREATE
            'InitDrawing(win)
            'WindowColor( win, 220, 230, 250)

           CASE WM_PAINT
            BitBlt(hDC, 0, 0, ww, wh, hdcMem, 0, 0, SRCCOPY)
            InvalidateRect(win, 0, 0)
               
            CASE WM_CLOSE
                CloseWindow(win)
                EndProgram
                 ExitProcess 0

            CASE WM_COMMAND
                controlID = LoWord(wParam) 'get control ID
                notifyCode = HiWord(wParam) 'get notification message

                select controlID
                    case b1ID  'open file
                      if notifycode=0
                       doOpen()
                    end if

                    case b0ID 'scan >>>
                      if notifycode=0
                       doScan()
                    end if

                 end select
        End Select
END SELECT
RETURN Default
END FUNCTION

'************************************************
'****    A N I -> P R O C E S S I N G    ********
'************************************************

'open source file
Sub doOpen
string fName="", dir="", sep=chr(0) , title="Open File... "
filter = "All Files "+sep+"*.*"+sep+"Bscript files "+sep+"*.bas"
title="Open File... "
fName = FileDialog(dir,filter,title,0,0,"txt")
IF fName = ""  'almost useless ?
SendMessage edit1,WM_SETTEXT,0,strptr("NO FILE ! ") : Return
END IF
'SendMessage status,WM_SETTEXT,0,strptr(fName)
char tx[500000] : tx =  GetFile fName      'load file into char buffer
'SendMessage riched, 12, 0, strptr(tx)       'show file in richedit
SetText (riched,tx)
string numOfLines : INT LineCount : LineCount = SendMessage riched, EM_GETLINECOUNT, 0,0
numOfLines = str(LineCount) : SetText (edit2,numOfLines) ' show result in edit2
outBuff = outBuff + "file_loaded..." + crlf                  : SetText (edit1,outBuff)
outBuff = outBuff + "number of lines : " + numOfLines + crlf : SetText (edit1,outBuff)
frees tx
End Sub

'scan source line -----------------------------------------------------------------------
Sub doScan
string s,sc,cLine, tbuff
string pt = Space (255)  ' also you may try char pt[255]=""
INT i ,LineCount=1 ,crPos, first
ipos=0 : tokCount = 0 'reset item position and token count
SetText(edit3,"")  ' clear current line box
LineCount = SendMessage riched, EM_GETLINECOUNT, 0,0 ' get number of Lines
SetText (edit1,"WAIT..scanning >>>>") : MsgBox "SCAN CODE","OK!..START"
'scan each line
For i = 0 to LineCount-1
   ' enable events..so i use PeekMessage.....................
       ' while PeekMessage (&wm,0,0,0,Pm_Remove)>0 ' //peek
            'TranslateMessage (&wm)
            'DispatchMessage (&wm)
        'wend
    SendMessage (riched, EM_GETLINE, i, pt) ' get line from richedit control
   'first = SendMessage riched, EM_LINEINDEX, i, 0
   ' MsgBox pt , "INFO"
    if pt <> ""
        s = Ltrim(pt)                 'trim left side
        crPos = instr(pt,chr(13)) :   ' check CR position /msgbox "POS:"+str(crPos),"CHR(13).POS"
        s = MID( pt, 1, crPos-1)      ' extract string / text
    else
        s=""                       
    end if
   
     SetText edit4,  str(i)            'show line number
     SetText(edit3, s)                 'show current line in single-Line edit box
     cLine = GetText(edit3)            'get text from edit control
     Tokenizer(cLine)                  'tokenize line
 
     'get char func >>>>>>>>>>>>>>>>>>
        GetChar(cLine)
     '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
        'Sendmessage riched,EM_HIDESEL,i,0
        'SetEditSelection( riched, first,len pt)
        'Sendmessage riched,EM_HIDESEL,i,0
     s="" : 'sleep = 100                  ' slow down..tweak for your computer-200
'SendMessage riched,EM_SCROLL ,1,0
Next i
outBuff = "TOKENIZATION FINISHED!" + crlf : outBuff = outBuff + "Token Count: " + str(tokCount) + crlf
SetText edit1, outBuff
End Sub
'-----------------------------------------------------------------------------------------

SUB GetChar(string sLine)
INT pos=1,lineSize
string ch,nextCh,tLine
    tLine = Mid(sLine,1,Len(sLine))
    lineSize=LEN(tLine)
        while pos <= lineSize
            ch = Mid( tLine,pos,1)
               ' sleep 100  '200
                SetText(edit5,ch)       'show character
                SetText(edit6,str(pos)) 'show char position in line
                ch=""
            pos=pos+1
        wend
End Sub
'-----------------------------------------------------------------------------------------

Function SetEditSelection(INT eHandle, sStart, sEnd)
 SendMessage( ehandle, EM_SETSEL, sstart, send)
End Function

function tokenizer(code as string)
    'print "CODE:" + code
    string token, ch
    'load file?
    '
    INT i,j
    '................................
    'print "CODE-LEN:" + str(len(code))
   '.................................
    i=1
    WHILE i <= len(code)
       
        IF instr(ALPHABETS, mid(code,i,1)) <> 0            'isAlpha
            while i <= len(code) and INSTR(ALPHABETS ,mid(code,i,1)) > 0
                token = token + mid(code, i, 1)           
                 i=i+1
            wend 
            'PRINT "alpha:" str i
           'print token       
            if  ucase(token)= isKeyword(token)   ' search keyword list
                token = token + " ~ KEYWORD" : tokCount++
                 SendMessage LboxH, LB_ADDSTRING, 0, token
                 'ipos++
                 token=""
            else
                token = token + " ~ IDENTIFIER" : tokCount++ 'variabe
                 SendMessage LboxH, LB_ADDSTRING, 0, token
                  'ipos++
                  token=""
            end if
           'token=""
           'i=i+1
         END IF 
       
        IF instr(SYMBOLS, mid(code, i, 1)) > 0 and  i <= len(code)'sym operators
             token = mid(code, i, 1)
              'print token
             byte t at strptr(token)
            select t
             case "+"
            token = "+" + " ~PLUS"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
             case "-"
            token = "-" + " ~MINUS"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case "*"
            token = "*" + " ~MULTI"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case "/"
            token = "/" + " ~DIVIDE"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case "^"
            token = "^" + " ~POWER"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case "("
            token = "(" + " ~LPAREN"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
             case ")"
            token = ")" + " ~RPAREN"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case "["
            token = "[" + " ~LBRACKET"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
             case "]"
            token = "]" + " ~RBRACKET"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case ","
             token = "," + " ~COMMA"
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case ":"
             token = ":" + " ~COLON"
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case "="
             token = "=" + " ~EQUAL"
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            end select
            i=i+1
           token=""
        END IF
 
        IF instr(NUMBERS, mid(code, i, 1)) <> 0 and i <= len(code)   'numbers
            while i <= len(code) and INSTR(NUMBERS,mid(code,i,1)) <> 0
                token = token + mid(code,i,1)
                 i=i+1
             wend
            token = token + "  ~ NUMBER" : tokCount++
             SendMessage LboxH, LB_ADDSTRING, 0, token
             ' ipos++
            token=""
        END IF

        'elseif ch = chr(34) 'quote "
         IF INSTR(mid(code,i,1),DQ) <> 0
            'token = ""
            i = i + 1 ' skip first quote "......
            while mid(code,i,1) <> chr(34) 'string literal inside quotes "......."
                token = token + mid(code,i,1)
                i=i+1
             wend
                'tokens = tokens + token '+ " ~ STRING-LITERAL" + crlf
                 SendMessage LboxH, LB_ADDSTRING, 0, token + " ~STRING": tokCount++
             token=""
             i=i+2 ' skip second quote  ......"
        END IF

        IF mid(code, i, 1) = " "  'whitespace
             'print "WHITE:" + str(i)
            i=i+1 'skip whitespace
        END IF

        'elseif ch = chr(10) ' not used because of CRLF in bufer -> tokens
        'IF i <= len(code) and mid(code,i,1) = chr(10)
            'tokens = tokens + mid(code,i,1) + " :NEWLINE" + crlf ' or end of instruction
         'print "NEWLINE"
          'return 
            'i=i+1
        'END IF
        'else
            'tokens = tokens + ch + " :UNINDENTIFIED - ERROR!" + crlf
            'i=i+1

       
    'PRINT "BEFORE_WEND:" + str(i)
   
    WEND

    'Return token
   ' Return

end function
'...........................................................
function isKeyword(byval tok as string) as string
'string ret
for n = 1 to 14
   if ucase(tok) = KEYWORDS[n]     ' if is KEYWORD
        RETURN KEYWORDS[n] 
   end if
next n
Return ""
end function

'##########################################################
SUB TextColor (wID as INT,byval frontColor as INT,byval  backColor as INT )
hdc = GetDC(wID)
SetTextColor( hDC, frontColor)
SetBkColor( hDC, backColor)
BitBlt(hDCmem, 0, 0, ww, wh, hdc, 0, 0, SRCCOPY)

ReleaseDC( wID, hdc)

END SUB
'########################################################

SUB TextOn(wID as INT,tx as INT,ty as INT,txt as string)

hdc = GetDC(wID)

'draw text to screen DC
TextOut hdc,tx,ty,txt,Len(txt)

'blit screen DC to memDC
BitBlt(hDCmem, 0, 0, ww, wh, hdc, 0, 0, SRCCOPY)

ReleaseDC( wID, hdc)

END SUB
'..........................................................
Sub ELIPSE(INT x, y, r1,r2, color)
hdc=GetDc win
SelectObject(hdc, CreateSolidBrush( color ))
Ellipse Hdc,x,y,r1+x,r2+y
BitBlt(hDCmem, 0, 0, ww, wh, hdc, 0, 0, SRCCOPY)
 ReleaseDC( win, hdc)
End Sub

'##########################################################
SUB InitDrawing
''get current size of window
GetSize(win,0,0,ww,wh)
'get window DC
hdc=GetDC(win)
hdcMem = CreateCompatibleDC(0)
hbmMem = CreateCompatibleBitmap(hdc, ww, wh)
oldBmp = SelectObject( hdcMem, hbmMem )
oldBrush = SelectObject(hdcMem, CreateSolidBrush( RGB(231,223,231)) )
oldPen = SelectObject(hdcMem, CreatePen(PS_SOLID,1,RGB(231,223,231)))
'fill rectangle memDC with brush color
FillRect ( hdcMem,rc, oldBrush)
SetTextColor( hDC,RGB(0,0,0))
SetBkColor( hDC, RGB(231,223,231))
'blit to memDC
BitBlt(hDCmem, 0, 0, ww, wh, hdc, 0, 0, SRCCOPY)

ReleaseDC( win, hdc)
End SUB

'##########################################################
SUB CleanUp

DeleteDC(hdcMem)
DeleteObject(SelectObject(hdcMem, oldBrush))
DeleteObject(SelectObject(hdcMem, oldPen))
DeleteObject(SelectObject(hdcMem, oldBmp))


END SUB
test code::: 

CLS
PRINT "_Hello Aurel!"
a = a+ 100: y=100
For n = 1 To 100
Print a,y,n
Next n

don't be upseted that is just old crappy xp_sp3 
awinh037.inc is in attachment

[Aurel]

Arnold ..and anyone who wish to try
in attachment is a quick fix of ANIscript-tokenizer (transparent)
even if you cannot see processing because is very quick
but you will see some actions...

so unpack content of zip and:

compile ANI_v4.o2bas
click second button ( open file icon)
select file EDBasic.bas      ps...simple interpreter by EdDavis written in qbasic(i think).
open that file in richedit control
then confirm
and relax and watch

file have 347 lines of code

ps.. nice thing to add would be progress bar ?