Post Reply 
Social Buttons
 
Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
ANI-v4
02-03-2019, 08:42 AM
Post: #1
ANI-v4
Because i want some colors in Richedit control i am looking into good example and funny i found my own from Ionicwind forum
written in EBasic ..still working well on win7 ..yes

Code:
/*
color code in rich edit control
ibasic pro code
jos de jong, 2007
*/

'Declarations
$INCLUDE "windows.inc"
int rich
CONST EM_FINDTEXT = (WM_USER + 56)
TYPE CHARRANGE
    INT cpMin
    INT cpMax
ENDTYPE
TYPE FINDTEXT
    CHARRANGE chrg
    POINTER lpstrText
ENDTYPE

'create a list with keywords
CONST kewordCount = 9
DEF keyword[kewordCount]:STRING
keyword[0] = "IF"
keyword[1] = "THEN"
keyword[2] = "ELSE"
keyword[3] = "ENDIF"
keyword[4] = "WHILE"
keyword[5] = "ENDWHILE"
keyword[6] = "DO"
keyword[7] = "FOR"
keyword[8] = "NEXT"


DEF d1:Dialog
CREATEDIALOG d1,0,0,587,360,0x80C80080,0,"Color code demo",&Handler
CONTROL d1,@RICHEDIT,"",7,35,570,294,0x50B010C4,1
SETFONT d1, "Courier New", 20, 700, @SFITALIC | 0x00FF0000, 1
DOMODAL d1
END


'______________________________________________________________________________
SUB Handler
    SELECT @MESSAGE
        CASE @IDINITDIALOG
            CENTERWINDOW d1
            SETFONT d1, "Courier New", 20, 700, @SFITALIC | 0x00FF0000, 1
            'let the rich edit control send a message when the contents have changed
            mask = CONTROLCMD(d1,1,@RTGETEVENTMASK)
            CONTROLCMD d1, 1, @RTSETEVENTMASK, mask | @ENMKEYEVENTS |@ENMCHANGE
    
            SETCONTROLTEXT d1, 1, "This program can highlight keywords\nlike then and if and while...\n\nAlso the words For, next, etc."

            applyColorSheet(d1, 1)

        CASE @IDCONTROL
            SELECT @CONTROLID
                CASE 1:'richedit
                    SELECT @NOTIFYCODE
                        CASE @ENCHANGE
                            'the contents of the richedit are changed
                            applyColorLine(d1, 1)
                    ENDSELECT
            ENDSELECT
    
    ENDSELECT
    RETURN
ENDSUB



'______________________________________________________________________________
/*
This function adjusts the colors of all lines in the sheet
*/
SUB applyColorSheet(dlg:DIALOG, ctl:INT)
INT char_start, char_end
INT linenum, linecount

    'hide the selection and get the current caret position
    CONTROLCMD dlg, ctl, @RTHIDESEL, 1
    CONTROLCMD dlg, ctl, @RTGETSELECTION, char_start, char_end

    linecount = CONTROLCMD(dlg, ctl, @RTGETLINECOUNT)
    FOR linenum = 0 TO linecount-1
        colorize(dlg, ctl, linenum)
    NEXT linenum

    'restore the original caret position and show the selection again
    CONTROLCMD dlg, ctl, @RTSETSELECTION, char_start, char_end
    CONTROLCMD dlg, ctl, @RTHIDESEL, 0

    RETURN
ENDSUB


'______________________________________________________________________________
/*
This function adjusts the colors of the current line
*/
SUB applyColorLine(dlg:DIALOG, ctl:INT)
INT char_start, char_end
INT linenum

    'hide the selection and get the current caret position
    CONTROLCMD dlg, ctl, @RTHIDESEL, 1
    CONTROLCMD dlg, ctl, @RTGETSELECTION, char_start, char_end

    linenum = CONTROLCMD (dlg, ctl, @RTLINEFROMCHAR, char_start)
    colorize(dlg, ctl, linenum)

    'restore the original caret position and show the selection again
    CONTROLCMD dlg, ctl, @RTSETSELECTION, char_start, char_end
    CONTROLCMD dlg, ctl, @RTHIDESEL, 0

    RETURN
ENDSUB

'______________________________________________________________________________
/*
This function adjusts the colors of the keywords on the given linenum
*/
SUB colorize(dlg:DIALOG, ctl:INT, linenum:INT)
INT lineStart, lineLength
INT i
INT p, pLine

    lineStart = CONTROLCMD (dlg, ctl, @RTCHARFROMLINE, linenum)
    lineLength = CONTROLCMD (dlg, ctl, @RTGETLINELENGTH, linenum)

    'uncolor the whole line, set black color
    CONTROLCMD dlg, ctl, @RTSETSELECTION, lineStart, lineStart + lineLength
    CONTROLCMD dlg, ctl, @RTSETSELCOLOR, RGB(0, 0, 0)

    'check the keywords one by one, if they occur on this line
    FOR i=0 TO kewordCount-1
        p = lineStart-1
        DO
            p = RTFINDTEXT(dlg, ctl, keyword[i], p+1, lineStart + lineLength, True, True)
            IF p >= 0
                'the keyword is found at the current line. color it
                CONTROLCMD dlg, ctl, @RTSETSELECTION, p, p+LEN(keyword[i])
                CONTROLCMD dlg, ctl, @RTSETSELCOLOR, RGB(255, 0, 0)

                ''you can also add making the text uppercase and things like that...
                'CONTROLCMD dlg, ctl, @RTREPLACESEL, UCASE$(keyword[i])
            ENDIF
        UNTIL p < 0
    NEXT i

    RETURN
ENDSUB


'________________________________________________________________________
SUB RTFINDTEXT(w:DIALOG, ctl:INT, Searchtext:STRING, start_pos:INT, end_pos:INT, ignore_case:INT, match_word:INT), INT
'Searches for the given searchtext, in characters from start_pos to end_pos.
'You can choose to select ignore_case and match_word. ignore_case=1-match_case
'Returns the position of the first found match. If there is no match, then returns -1
INT pos
INT flags

    FINDTEXT MyFindtext
    MyFindtext.chrg.cpMin = start_pos
    MyFindtext.chrg.cpMax = end_pos
    MyFindtext.lpstrText = Searchtext
    flags = FR_MATCHCASE*(1-ignore_case) | FR_WHOLEWORD*match_word
    pos = SENDMESSAGE(w, EM_FINDTEXT, flags, MyFindtext, ctl)

    RETURN pos
ENDSUB
Find all posts by this user
Quote this message in a reply
02-03-2019, 08:44 AM
Post: #2
RE: ANI-v4
and here is ANIv4 :

Code:
' ANIscript v4(32bit)/(043-o2)  - by Aurel - 1.2.2019
$ Filename "ANI_v4.exe" ' v4
include "RTL32.inc"
include "awinh037.inc"
#lookahead
string KEYWORDS[] = {"CLS","PRINT","IF","ELSE","ENDIF","FOR","TO","NEXT","SUB","RETURN","CIRCLE","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 , tokList[4096]   'token list / string array of tokens
string crlf = chr(13)+chr(10)   'end of line CRLF
INT tokTypeList[4096]           'token type list / int array
INT tokIDList[1024]             'token ID list / variable adress-index (int array)
INT tokCount                    'token count / number of tokens
INT wout                        'windouw output id
'------------------------------------------------------------------------
'token constants
'tokOPERATOR = 1         ' + - * / < = > & ! |  { <= , >= (8,9) }
% tokPLUS = 1
% tokMINUS = 2
% tokMULTI = 3
% tokDIVIDE = 4
% tokLESS = 5
% tokEQUAL = 6
% tokGREAT = 7
% tokAND = 10
% tokOR = 11
% tokNOT = 12
' paren,brackets... ( ) , [ ] , { } , :
% tokLPAREN  = 13
% tokRPAREN = 14  
% tokLBRACKET = 15
% tokRBRACKET = 16
% tokLBRACE = 17  
% tokRBRACE = 18
% tokCOMMA = 19
% tokCOLON = 20
' variable  - numeric , string , pointer
% tokNUMVAR = 21
% tokSTRVAR = 22
% tokPTRVAR = 23
' numeric func() , string func() , number , quoted string  , comment
% tokNUMFUNC = 24
% tokSTRFUNC = 25
% tokNUMBER = 26
% tokQUOTED = 27
% tokCOMMENT = 28
' keywords ...
% tokDEFNUM = 30    'defnum
% tokDEFSTR = 31    'defstr
% tokWINDOW = 32    'window
% tokPRINT  = 33    'print
% tokIF     = 34    'if
% tokELSE   = 35    'else
% tokENDIF  = 36    'endif
% tokFOR    = 37    'for
% tokTO     = 38    'to
% tokNEXT   = 39    'next
% tokSUB    = 40    'sub
% tokRETURN = 41    'return
% tokFUNC   = 42    'func

% tokCIRCLE = 50    'circle
% tokDOT    = 51    'dot/pset
% tokLINE   = 52    'line
% tokRECT   = 53    'rectangle


'------------------------------------------------------------------------
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[4096] ' 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_AUT​OVSCROLL,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_AUTOVSCR​OLL|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_AUTOVSCR​OLL|ES_AUTOHSCROLL|ES_NOHIDESEL,0x200,richID)
ControlFont(riched, 15, 8, 400, "Courier New") : SetRichEditBackColor riched, RGB(250,248,199)
SetEditSelection( riched, -1,-1):InvalidateRect( riched, 0, 0)
'set richedit text color
CHARFORMAT cf
cf.cbSize      = SizeOf(CHARFORMAT)
cf.dwMask      = CFM_COLOR
cf.dwEffects   = 0
cf.yHeight     = 200
cf.yOffset     = 0
cf.crTextColor = RGB(150,0,0)
cf.bCharSet    = ANSI_CHARSET
cf.bPitchAndFamily = 0
'szFaceName[LF_FACESIZE]
SendMessage riched, EM_SETCHARFORMAT, SCF_ALL, &cf

'create listbox for token list ##########################################################################
LBoxH = SetListBox(win,560,60,256,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

                 case B2ID ' run/proc
                      if notifycode=0
                       InterpretTokens()
                    end if

                 end select
        End Select
'<<<<< window output - our display >>>>>>>>>>>>>>>>>>>>>
    CASE wout
        Select wmsg

             CASE WM_CLOSE
                    CloseWindow(wout)
                   ' EndProgram()
                   ' ExitProcess 0

         End Select
'<<<<<<<<<<<<<<<<<<<<<<o>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
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("EMPTY FILENAME ! ") : 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)      
SetText (riched,tx)                          'show text in richedit control
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   ' free tx buffer
'reset listbox content ------------------
SendMessage LBoxH,LB_RESETCONTENT,0, NULL
End Sub

'Scan source line -----------------------------------------------------------------------
Sub doScan
string s,sc,cLine,sLine, tbuff
string pt = Space (256)                 ' 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"+crlf + LineCount,"OK!..START"
'scan each line
For i = 0 to LineCount-1
'label again <<<<<<
pt=Space(256)  ' create line buffer
   ' 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
sLine = Ltrim(pt)  'trim left side of line
   ' MsgBox pt , "INFO"..............................................................................
    IF  Len(sLine) > 1
        crPos = instr(sLine,chr(13)) :   ' check CR position /msgbox "POS:"+str(crPos),"CHR(13).POS"
        s = MID( sLine, 1, crPos-1)      ' extract string / text
    ELSE
      ' MsgBox (sLine + str(LineCount) , "EMPTY LINE")
        s=" "                         'clear s                  
    END IF
  
        SetText edit4,  str(i)            'show line number
        SetText(edit3, s)                 'show current line in single-Line edit box
        IF s <> " "                        'if line is not empty
          cLine = GetText(edit3)            'get text from edit control        
          Tokenizer(cLine)                  'tokenize line
          'get char func >>>>>>>>>>>>>>>>>>
          GetChar(cLine)
          '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
        END IF
        'Sendmessage riched,EM_HIDESEL,i,0
        'SetEditSelection( riched, first,len pt)
        'Sendmessage riched,EM_HIDESEL,i,0
         s="" : sLine="" : pt=""      ' clear string buffers
        'sleep = 100                  ' slow down..tweak for your computer-200    
        'SendMessage riched,EM_SCROLL ,1,0
    'END IF : '...............................................................................​......
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,tokTyp
    '................................
    '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 "TCount:" + str tokcount
           'print token        
            if  ucase(token)= isKeyword(token)                                  ' search keyword list
                 tokCount++ : tokList[tokCount] = token                         ' add key token to list
                 tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp  ' add tokType to list
                 token = token + " ~KEYWORD~~~~~~ "
                 SendMessage LboxH, LB_ADDSTRING, 0, token
                 token="" : tokTyp = 0
            else
            tokCount++
                tokList[tokCount] = token : ' add ident to list
                token = token + " ~IDENTIFIER~~~~ " : 'variabe
                SendMessage LboxH, LB_ADDSTRING, 0, token
                  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 "+"
             tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
             token = "+" + " ~PLUS~~~~~~~ " + str(tokTyp)
               SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

             case "-"
             tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
               token = "-" + " ~MINUS~~~~~~ " + str(tokTyp)
               SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
               tokList[tokCount] = token

            case "*"
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
              token = "*" + " ~MULTI~~~~~~~ " + str(tokTyp)
              SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case "/"
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
             token = "/" + " ~DIVIDE~~~~~~~ " + str(tokTyp)
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case "^"
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
              token = "^" + " ~POWER~~~~" + str(tokTyp)
              SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case "("
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
              token = "(" + " ~LPAREN~~~" + str(tokTyp)
              SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case ")"
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
               token = ")" + " ~RPAREN~~~" + str(tokTyp)
               SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case "["
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
              token = "[" + " ~LBRACKET~" + str(tokTyp)
              SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case "]"
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
              token = "]" + " ~RBRACKET~" + str(tokTyp)
              SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case ","
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
              token = "," + " ~COMMA~~~~" + str(tokTyp)
              SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case ":"
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
              token = ":" + " ~COLON~~~" + str(tokTyp)
              SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case "="
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
              token = "=" + " ~EQUAL~~~" + str(tokTyp)
              SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

           case "&"
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
             token = "&" + " ~AND~~~~~~" + str(tokTyp)
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

           case "|"
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
             token = "|" + " ~OR~~~~~~" + str(tokTyp)
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

          case "!"
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
             token = "!" + " ~NOT~~~~~" + str(tokTyp)
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

          case ">"
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
             token = ">" + " ~GREAT~~~~~" + str(tokTyp)
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

          case "<"
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
             token = "<" + " ~LESS~~~~~" + str(tokTyp)
             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
             tokList[tokCount] = token
            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++
                 tokList[tokCount] = token
             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

       IF mid(code, i, 1) = "'"  'comment
            i=i+1 ' skip char " ' "
            'loop untill you get end of line chr(10)
            while i <= len(code) AND mid(code, i, 1) <> chr(13)
            i=i+1 'skip chars under comment
            wend
            i=i+1
        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
'......................................................................
Function SetTokenType(byval tok as string) as int
'return token Type
    if tok = "+" : return tokPLUS        : end if
    if tok = "-" : return tokMINUS       : end if
    if tok = "*" : return tokMULTI       : end if
    if tok = "/" : return tokDIVIDE      : end if
    if tok = "&" : return tokAND         : end if
    if tok = "|" : return tokOR          : end if
    if tok = "!" : return tokNOT         : end if
    if tok = "(" : return tokLPAREN      : end if
    if tok = ")" : return tokRPAREN      : end if
    if tok = "[" : return tokLBRACKET    : end if
    if tok = "]" : return tokRBRACKET    : end if
    if tok = "{" : return tokLBRACE      : end if
    if tok = "}" : return tokRBRACE      : end if
    if tok = "," : return tokCOMMA       : end if
    if tok = ":" : return tokCOLON       : end if
    if tok = "=" : return tokEQUAL       : end if
    if tok = ">" : return tokGREAT       : end if
    if tok = "<" : return tokLESS        : end if

    'keywords...
    if Ucase(tok) = "WINDOW" : return tokWINDOW     : end if
    


End Function

'*********************************************************************
'::::::::::::::  INTERPRETER  ::::::::::::::::::::::::::::::::::::::::
'*********************************************************************
Function InterpretTokens()
'read tokens from token list and iterpret them (execute)
INT tc=1, itemp1,itemp2
STRING t, arg1, arg2

t = tokList[1] 'get token from list
'print t
'INT p at strptr t


IF ucase(t) = "WINDOW" then
  print "INSTRUCTION : Window executed!" 'info
  tc++ : arg1 = tokList[tc]   'get next token
  tc=tc+2 : arg2 = tokList[tc]   'get next token skiping comma
  itemp1 = val(arg1) : itemp2 = val(arg2)  'arguments to values
'create new window
  wout = CreateWindowEx ( 0x200,"Oxygen","ANI - Display", 524288 , 200, 200, itemp1, itemp2, 0, 0, null, 0)
  ShowWindow wout,1 : UpdateWindow wout


END IF


End Function


'***********************************************************************
'::::::::::::::::  INTERPRETER  END OF CODE  :::::::::::::::::::::::::::
'***********************************************************************

Function execWindow( INT winW,winH)
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
Find all posts by this user
Quote this message in a reply
Post Reply 


Forum Jump:


User(s) browsing this thread: