Author Topic: GUI: Syntax Highlight in RichEdit  (Read 255 times)

0 Members and 1 Guest are viewing this topic.

Offline Zlatko Vid

  • Newbie
  • *
  • Posts: 47
  • User-Rate: +0/-0
GUI: Syntax Highlight in RichEdit
« on: September 27, 2020, 05:12:00 PM »
Hello
here is a simple Syntax Highlighting  in RichEdit control using awinh037.inc
it is small code editor with line numbers which i use in micro(A) Interpreter.
enjoy !

Code: [Select]
/* *******************************************************
'** micro(A) editor / o2 v043 - 26.8.2020 by Aurel **
'*******************************************************
*/
$ Filename "microE2.exe"
Include "RTL32.inc"
Include "awinh037.inc"
#lookahead

'api calls for subclasing + some GDI functions(! you can put it inside include file)
! CallWindowProc Lib "user32.dll" Alias "CallWindowProcA"(sys pPrevWndFunc ,hWnd ,uMsg ,wParam ,lParam ) as int
! GetDlgItem Lib "user32.dll" Alias "GetDlgItem" (ByVal hDlg As INT, ByVal nIDDlgItem As INT) As INT
! GetTextMetrics Lib "gdi32.dll" Alias "GetTextMetricsA" (ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long
'! DrawText Lib "user32.dll" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
! GetCaretPos Lib "user32.dll" Alias "GetCaretPos"(lpPoint AS POINTAPI) as INT
! wsprintf Lib "user32.dll" Alias "wsprintfA" (ByVal lpzBuffer as sys, ByVal lpzFormat As String, Byval Number as int) As int

! SaveDC Lib "gdi32.dll" (ByVal hdc As int) As int
! RestoreDC Lib "gdi32.dll" (ByVal hdc As int, ByVal nSavedDC As int) As sys
! CreateRectRgn Lib "gdi32.dll" (ByVal X1 As int, ByVal Y1 As int, ByVal X2 As int, ByVal Y2 As int) As int
! SelectClipRgn Lib "gdi32.dll" (ByVal hdc As int, ByVal hRgn As int) As int
'use corewin
! GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hctl As int, ByVal nIndex As int) As int
! SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hctl As int, ByVal nIndex As int, byval dwNewLong As int) As int
! GetSystemMenu Lib "user32.dll" (ByVal hwnd As Int, ByVal revert As Int) As Int
! EnableMenuItem Lib "user32.dll" (ByVal menu As Int, ByVal IDeEnableItem As Int, ByVal enable As Int) As Int
'declare function GetWindowLongPtr Lib "user32.dll" Alias "GetWindowLongPtrA"(ByVal hctl As Long, ByVal gwlData As Long) As int
'declare function SetWindowLongPtr Lib "user32.dll" Alias "SetWindowLongPtrA" (ByVal hctl As long, ByVal nIndex As Long, dwNewLong As sys) As int
! BitBlt Lib "gdi32.dll" (ByVal hDestDC As int, ByVal x As int, ByVal y As int, ByVal nWidth As int, ByVal nHeight As int, ByVal hSrcDC As int, ByVal xSrc As int, ByVal ySrc As int, ByVal dwRop As int) As int
'Declare Sub Colorize(byval line_num as Int)
'+% EM_GETTEXTLENGTHEX = 1119
% RTGETTEXTLENGTH = 18
'use corewin
'file path
char tx[500000]
string compName="\microA_Interpreter.exe"   ' for oxygen change path to \gxo2.exe
char cdPath[256]
string crlf = chr(13)+chr(10)
string tempFile
'string cdPath
GetCurrentDir 256,strptr cdPath
'GetTempPath ( 256, strptr cdPath)
cdPath = cdPath + compName
INT win 'main window
INT x=200,y=220,w=800,h=600,wstyle = WS_MINMAXSIZE
'context menu
% WM_CONTEXTMENU = 123
INT richMenu , mousex , mousey, submenu1
INT cFont=1
win = SetWindow("micro Edit: ",x,y,w,h,0,wstyle)
''load menu bitmaps...
INT mImg1 = LoadImage(0, "micData\mImg1.bmp", 0, 16, 16, 24)
INT mImg2 = LoadImage(0, "micData\mImg2.bmp", 0, 16, 16, 24)
INT mImg3 = LoadImage(0, "micData\mImg3.bmp", 0, 16, 16, 24)
INT mImg4 = LoadImage(0, "micData\mImg4.bmp", 0, 16, 16, 24)
INT mImg5 = LoadImage(0, "micData\mImg5.bmp", 0, 16, 16, 24)
'create file path box  ---------------------------------------------------------------------
int ed1ID = 99
int edit1 = SetEditBox(win,10,538,560,20,"FILE PATH",0x50004000,0x200,ed1ID)
'buttons init...............................................................................
'icon button -> 1409351744 , normal -> 0x50001000
'IconButton( bhwnd ,_bx , _by , _bw, _bh, _ibicon , _bflag , _ext , _cID )
INT button1, b1ID = 100 : % ICONBUTTON = 1409351744
button1 = SetButton(win,10,2,48,48,"", ICONBUTTON, 0,b1ID)
INT icon1 = LoadImage(0, "micData\icOpen.ico", 1, 32, 32, 24) 'load icon...
SendMessage( button1, 247, 1, icon1)                        'add icon to button...
'...........................................................................................
INT button2, b2ID = 101
button2 = SetButton(win,60,2,48,48,"", ICONBUTTON, 0,b2ID)
INT icon2 = LoadImage(0, "micData\icSave.ico", 1, 32, 32, 24)
SendMessage( button2, 247, 1, icon2)
'...........................................................................................
INT button3, b3ID = 102
button3 = SetButton(win,110,2,48,48,"", ICONBUTTON, 0,b3ID)
INT icon3 = LoadImage(0, "micData\icCompile.ico", 1, 32, 32, 24)
SendMessage( button3, 247, 1, icon3)   
'............................................................................................
INT button4 , b4ID = 103
button4 = SetButton(win,160,2,48,48,"", ICONBUTTON, 0,b4ID)
INT icon4 = LoadImage(0, "micData\icRun.ico", 1, 32, 32, 24)
SendMessage( button4, 247, 1, icon4)
'...........................................................................................
INT button5 , b5ID = 104
button5 = SetButton(win,210,2,48,48,"", ICONBUTTON, 0,b5ID)
INT icon5 = LoadImage(0, "micData\icFont.ico", 1, 32, 32, 24)
SendMessage( button5, 247, 1, icon5)
                     
'richedit...................................................................................
INT hRich : INT richID = 400 : INT rx = 10,ry = 54, rw = 600, rh = 480
hRich = SetRichEdit (win, rx, ry, rw, rh,"", 1412518084, 0x200, richID)
'set font & back color......................................................................
ControlFont(hRich, 14, 9, 400, "Consolas") : SetRichEditBackColor hRich, RGB(240,234,180)
'create margin on richedit control...
% MARGIN_X = 64
SendMessage hRich, EM_SETMARGINS, EC_LEFTMARGIN, MARGIN_X
INT editProc = GetWindowLong( hRich, GWL_WNDPROC)
'subclass richedit to his own callback function
SetWindowLong(hRich, GWL_WNDPROC, @editCallback)

'init context popup_menu and set client rect to richedit
RECT rcRE
RichEditPopUpMenu()
'enable menu items - MF_ENABLED = 0
EnableMenuItem ( richMenu, 700, 0)
'init keywords and selections for richedit control
CHARFORMAT cf
% keywordCount = 30
STRING keyword[30]
InitSyntaxHighlightning()
INT mask
% ENMKEYEVENTS    = 65536
% ENMCHANGE       = 1
% EM_HIDESELECTION = 1087

'set focus to richedit control
SetFocus hRich
'let the richedit control send a message when the contents have changed
'SendMessage(hRich, RTSETEVENTMASK , mask | ENMKEYEVENTS | ENMCHANGE , 0)
SendMessage hRich, EM_SETEVENTMASK , 0, ENMCHANGE | ENMKEYEVENTS 
'(WM_USER + 38)
'SendMessage hRich, WM_SETTEXT, 0, strptr "var a"
 'SendMessage(hRich, WM_SETREDRAW, -1, 0)


Wait()  'message loop

'main window callback function ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function WndProc (sys hwnd,wmsg,wparam,lparam) as int callback
win = hwnd
'locals
INT cLine, CurrentStartPos , CurrentEndPos

SELECT hwnd

CASE win

SELECT wmsg

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() : HighlightLine(cLine)
                  End If
CASE b2ID
                           'save file
                           If notifycode=0
                           doSave()
                  End If
                       CASE b3ID
                           'compile file
                           If notifycode=0
                           doCompile()
                  End If

                      ' CASE b4ID
                          'just run file ..not yet

                       CASE b5ID
                          'change font 1/2
                          If notifycode=0
                           if cfont =1
                            cfont=cfont+1
                           else
                           cfont=cfont-1
                           end if
                           doFont()
                 End If

           CASE richID
               If notifycode = 768 'EN_CHANGE -> the contents of the richedit are changed
                  'The following returns the index (0-based) of the line containing the current character.
                  ' SendMessage hRich, EM_HIDESELECTION, ,0
SendMessage hRich,EM_GETSEL, @CurrentStartPos ,0
                  cLine = SendMessage hRichEdit,EM_LINEFROMCHAR, CurrentStartPos,0
                  SendMessage hRich, EM_HIDESELECTION, 1, 0
                      HighlightLine(cLine)

if GetAsyncKeyState(VK_RETURN) = 1
                       HighlightLine(cLine-1)
                  end if

           SendMessage hRich, EM_SETSEL,  CurrentStartPos,CurrentStartPos  ' Return cursor to its correct position.
           SendMessage hRich,EM_SETMODIFY,0,0
           SendMessage hRich, EM_HIDESELECTION, 0,0


               End if


                     
                      End Select
'~~~~~ select context menu items ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
               
'----------------------------------------------------------------------------------------------
              Case WM_CONTEXTMENU
                  mousex = LoWord(lParam) : mousey = HiWord(lParam)  'get mouse coordinate
                   GetClientRect(hRich, rcRE)
TrackPopupMenu (richMenu, 0, mousex, mousey, 0, hRich, rcRE )   'put context menu where mouse is
'TrackPopupMenu (hMenu As INT, wFlags As INT, x As INT, y As INT, nReserved As INT, hwnd As INT, lprc As RECT) As INT
                return 0

Case WM_CLOSE
CloseWindow(win)
EndProgram()

              Case WM_SIZE
GetSize(win,x,y,w,h)
MoveWindow(hRich, 10, 54, (w-rw/2)+114, (h-56)-32 , 1)
                  MoveWindow(edit1, 10, h-26, 560, 21 , 1)            'h-30)-32
               '+ edit1 = SetEditBox(win,10,538,560,20,"FILE PATH",0x50004000,0x200,ed1ID

             

END SELECT
         

END SELECT

Return Default
End Function
'///////////////////////////////////////////////////////////////////////////////////////////
Sub HighlightLine(Line as int)
'locals Linetext is text buffer/ subroutine from PureBasic forum
   string LineText=space(256),inst,check : INT StartPos, EndPos, LeftPos, RightPos, a
 '  SendMessage (riched, EM_GETLINE, i, strptr lineText) ' get line from richedit control
  SendMessage hRich,EM_GETLINE, Line, LineText  : Linetext = LCase(LineText)
  'Get the character index's of both ends of the line.
  StartPos = SendMessage (hRich,EM_LINEINDEX, Line,0)
  EndPos = StartPos + Len(LineText)
  cf.cbSize = 60
  cf.dwMask =  CFM_BOLD | CFM_COLOR
  cf.dwEffects = CFM_BOLD ' comment this line if you don't need bold
 'Left = StartPos
  'Restore BasicKeywords
  For a = 1 To 30
    LeftPos = StartPos
    ''''Read.s inst$
    inst = keyword[a] : 'print "INST_KEY:" + inst
    'Repeat >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
     Do
      'RightPos = <pureBasic->FindString(LineText, inst, LeftPos-StartPos+1) + StartPos / i use INSTR() function
       RightPos = INSTR(LeftPos-StartPos+1, LineText, inst)  + StartPos
      If RightPos = StartPos 'No occurrences found.
        'print "No occurrences found"
        LeftPos = EndPos
        Else
        ';******
        LeftPos = RightPos-1 : RightPos = RightPos + Len(inst)-1
        ';******
        ';check$=Mid(LineText,right+1,1)
        check = Mid(LineText,RightPos + 1 - StartPos,1)
           'print "CHEK:" + check ' Debug check string as blank space or cr13 or Left paren
          If check = " " or check = chr(13) or check = "("
            SendMessage hRich, EM_SETSEL, LeftPos, RightPos  'Highlight the word.
            LeftPos = RightPos
            cf.crTextColor = RGB(0,0,200)
            'cf.dwEffects = 0
            SendMessage hRich, EM_SETCHARFORMAT, SCF_SELECTION, cf
         
           SendMessage hRich, EM_SETSEL, LeftPos, LeftPos+1    'Highlight the word.         
           cf.crTextColor = RGB(0,0,0)
           SendMessage hRich, EM_SETCHARFORMAT, SCF_SELECTION, cf

           Else
            LeftPos = RightPos + 1
             'print "YES" ';Debug "yes"
        End If
      End If
    'Until LeftPos = EndPos <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    if LeftPos = EndPos : exit do : end if
    End Do
 
  Next a

END SUB

'////////////////////////////////////////////////////////////////////////
SUB InitSyntaxHighlightning()
'init keywords and selections for richedit control
keyword[1]  = "if"
keyword[2]  = "else"
keyword[3]  = "endif"
keyword[4]  = "wcolor"
keyword[5]  = "fcolor"
keyword[6]  = "bcolor"
keyword[7]  = "pset"
keyword[8]  = "line"
keyword[9]  = "circle"
keyword[10] = "rect"
keyword[11] = "func"
keyword[12] = "endfn"
keyword[13] = "winsize"
keyword[14] = "swap"
keyword[15] = "print"
keyword[16] = "sin"
keyword[17] = "cos"
keyword[18] = "tan"
keyword[19] = "sqr"
keyword[20] = "rand"
keyword[21] = "rnd"
keyword[22] = "abs"
keyword[23] = "log"
keyword[24] = "goto"
keyword[25] = "while"
keyword[26] = "wend"
keyword[27] = "label"
keyword[28] = "var"
keyword[29] = "str"
keyword[30] = "ptr"

END SUB
'///////////////////////////////////////////////////////////////////////////

'-------------------------------------------------------------------------
FUNCTION setRichTextColor( BYVAL NewColor AS INT) AS INT
' setRichTextColor sets the textcolor for selected text in a Richedit control.
' &HFF - read, &HFF0000 - blue, &H008000 - dark green, &H0 is black, etc.
   CHARFORMAT cf
   cf.cbSize      = sizeOf(cf)       'Length of structure -> set 60
   cf.dwMask      = CFM_COLOR        'Set mask to colors only
   cf.crTextColor = NewColor         'Set the new color value
   SendMessage(hRich, EM_SETCHARFORMAT, SCF_SELECTION, cf)
END FUNCTION                                                             

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'richedit callback function
Function editCallback(sys hwnd , uMsg, wParam , lParam ) as int callback
POINTAPI  pt
CHAR sz[16]
DWORD lc
RECT crect
INT rgn
int dret
INT hDC
int line
int charpos

     dret = CallWindowProc( editProc,hWnd, uMsg,wParam,lParam)


    if uMsg = WM_PAINT
        lc=SendMessage(hwnd,EM_GETLINECOUNT,0,0)
        if lc
            hDC = GetDC(hwnd)
            SaveDC(hDC)
            GetClientRect(hwnd, crect)
            rgn = CreateRectRgn(crect.left,crect.top,crect.right,crect.bottom)
            SelectClipRgn(hDC,rgn)
            BitBlt (hDC,0,0,MARGIN_X,crect.bottom, hDC,0,0,PATCOPY)
           
            line=SendMessage(hwnd,EM_GETFIRSTVISIBLELINE,0,0)
            while line <= lc
                charpos = SendMessage(hwnd,EM_LINEINDEX,line,0)
                exit if charpos = -1
                SendMessage(hwnd,EM_POSFROMCHAR,pt,charpos)
                exit if pt.y > crect.bottom
                'wide char
                wsprintf(&sz,"%lu",line+1)
                TextOut(hDC,25,pt.y,sz,len(sz))
                line++
            wend
            RestoreDC(hDC,-1)
            DeleteObject(rgn)
            ReleaseDC(hwnd,hDC)
        end if 
    elseif uMsg = WM_COMMAND
            select wparam
               case 700 : SendMessage(hwnd,WM_CUT,0,0)
               case 701 : SendMessage(hwnd,WM_COPY,0,0)
case 702 : SendMessage(hwnd,WM_PASTE,0,0)
case 703 : SendMessage(hwnd,EM_SETSEL ,0,-1)

             

              end select

              'select hiword(wparam)
              ' case EN_CHANGE
                 ' print "changed.."
                 'applyColorLine()
            'end select
   
   
    end if
    return dret     
 
 Return CallWindowProc (editProc, hwnd, uMsg, wParam, lParam)

End Function
'-------------------------------------------------------------------------
SUB RichEditPopUpMenu()
  richMenu = CreatePopupMenu ()
'addsub menu items with ID
AppendMenu (richMenu, 0, 700, strptr "CUT")
SetMenuItemBitmaps(richMenu, 0 , MF_BYPOSITION , mImg1, 0) 'add menu item bitmap
AppendMenu (richMenu, 0, 701, strptr "COPY")
SetMenuItemBitmaps(richMenu, 1,  MF_BYPOSITION , mImg2, 0)
AppendMenu (richMenu, 0, 702, strptr "PASTE")
SetMenuItemBitmaps(richMenu, 2,  MF_BYPOSITION , mImg3, 0)
AppendMenu (richMenu, 0, 703, strptr "SELECT_ALL")
SetMenuItemBitmaps(richMenu, 3,  MF_BYPOSITION , mImg4, 0)

END SUB

'-----------------------------------------------------------------------------------
Sub doOpen()

INT hsize=0,LineCount,Ln
'bstring tx="" ' use bstring for text on scintilla
string dir, filter , title ,fName
string sep=chr(0)
'filter = "All Files"+sep+"*.*"+sep"Text files"+sep+"*.txt"+ sep
filter = "All files "+sep+"*.*"+sep+"micro(A) files "+sep+"*.bas"
title = "Open File... "

fName = FileDialog(dir,filter,title,0,0,"bas")
'print "FNAME:" + fName
'fileName = fName
IF LEN(fname) = 0
   MsgBox "File Opening Canceled!" , "microEdit :: INFO!"
Return
END IF

SendMessage edit1,WM_SETTEXT, 0,  strptr(fname)
'SendMessage status,WM_SETTEXT,0, byval strptr(fName)
 tx =  GetFile fName
SendMessage hRich,WM_SETTEXT, 0, strptr(tx)
tempFile = fName
'get line count...
LineCount = SendMessage hRich, EM_GETLINECOUNT, 0,0 ' get number of Lines
'MsgBox "Lines: " + str(LineCount),"m(A):Line Count->" 'comment this line without message
'Highlight each line one by one in a for/loop...
IF LineCount > 0
   For Ln = 0 to LineCount
       HighlightLine(Ln)
   Next Ln
END IF

End Sub
'--------------------------------------------------------------------
Sub doSave()

INT hsize=0,found,c
string dir="",filePath,filter,title,fName
string ext=".bas"

filter= "micro(A) Files (*.bas)"
title="Save File... "    'for Oxygen change to *.o2bas

fName = FileDialog(dir,filter,title,0,1,"bas")

If fName="" then Return
  IF RightS(fname,4) <> ".bas"  'for microA set number to 4 , .bas
    fname = fname + ext
  END IF
print fname
'hsize = SendMessage hRich, EM_GETTEXTLENGTHEX, 0, 0
'print "HSIZE:" + str(hsize)
SendMessage hRich,WM_GETTEXT, 4096,tx
print "TX:" + tx
'exit if empty
'IF hsize = 0
'MsgBox "Document is Empty!" ,"micro Edit"
'Return    ' ->->->
'END IF
'else -> save file

SendMessage hRich,WM_GETTEXT, 4096,tx

c=PutFile fName,tx
tempFile = fname

End Sub
'--------------------------------------------------------------
SUB doCompile
char ln[256]
string fn=""
SendMessage edit1, WM_GETTEXT, 256, strptr ln
fn = Trim(ln)
'print "doCompile-FN:" + fn

IF LEN(fn) < 1
MsgBox "File Not Open!","Error::File"
Return
End If
int sRet
autosave()  ' do autoSave
'(sys hwnd, string lpOperation, lpFile, lpParameters, lpDirectory, sys nShowCmd) as sys
sRet = ShellExecute(0,"open", cdPath, chr(34) + fn + chr(34),"" , 5) ' if work sRet = 42
If sRet = 2 then MsgBox "Compiler microA Not Found!"+ crlf + "Enter new compiler path!" , " microA Path"
'sRet = ShellExecute 0,"open","gxo2.exe","-c "+ fn,"",5
'sRet = ShellExecute 0,"open",cdPath,cOption & chr(34) & fName & chr(34),"",5 'fb

END SUB
'--------------------------------------------------------------
SUB doFont
   if cFont=1 : ControlFont(hRich, 14, 9, 400, "Consolas"):end if
   if cFont=2 : ControlFont(hRich, 16, 8, 400, "Consolas"):end if
END SUB
'--------------------------------------------------------------
Sub autoSave()

SendMessage hRich,WM_GETTEXT, 4096,tx
PutFile tempFile,tx

End Sub

Offline Zlatko Vid

  • Newbie
  • *
  • Posts: 47
  • User-Rate: +0/-0
Re: GUI: Syntax Highlight in RichEdit
« Reply #1 on: September 30, 2020, 09:49:35 PM »
If you need keywords for example in RED just add this few lines
you can see above editor picture:

Code: [Select]
/* *******************************************************
'** micro(A) editor / o2 v043 - 26.8.2020 by Aurel **
'*******************************************************
*/
$ Filename "microE2.exe"
Include "RTL32.inc"
Include "awinh037.inc"
#lookahead

'api calls for subclasing + some GDI functions(! you can put it inside include file)
! CallWindowProc Lib "user32.dll" Alias "CallWindowProcA"(sys pPrevWndFunc ,hWnd ,uMsg ,wParam ,lParam ) as int
! GetDlgItem Lib "user32.dll" Alias "GetDlgItem" (ByVal hDlg As INT, ByVal nIDDlgItem As INT) As INT
! GetTextMetrics Lib "gdi32.dll" Alias "GetTextMetricsA" (ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long
'! DrawText Lib "user32.dll" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
! GetCaretPos Lib "user32.dll" Alias "GetCaretPos"(lpPoint AS POINTAPI) as INT
! wsprintf Lib "user32.dll" Alias "wsprintfA" (ByVal lpzBuffer as sys, ByVal lpzFormat As String, Byval Number as int) As int

! SaveDC Lib "gdi32.dll" (ByVal hdc As int) As int
! RestoreDC Lib "gdi32.dll" (ByVal hdc As int, ByVal nSavedDC As int) As sys
! CreateRectRgn Lib "gdi32.dll" (ByVal X1 As int, ByVal Y1 As int, ByVal X2 As int, ByVal Y2 As int) As int
! SelectClipRgn Lib "gdi32.dll" (ByVal hdc As int, ByVal hRgn As int) As int
'use corewin
! GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hctl As int, ByVal nIndex As int) As int
! SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hctl As int, ByVal nIndex As int, byval dwNewLong As int) As int
! GetSystemMenu Lib "user32.dll" (ByVal hwnd As Int, ByVal revert As Int) As Int
! EnableMenuItem Lib "user32.dll" (ByVal menu As Int, ByVal IDeEnableItem As Int, ByVal enable As Int) As Int
'declare function GetWindowLongPtr Lib "user32.dll" Alias "GetWindowLongPtrA"(ByVal hctl As Long, ByVal gwlData As Long) As int
'declare function SetWindowLongPtr Lib "user32.dll" Alias "SetWindowLongPtrA" (ByVal hctl As long, ByVal nIndex As Long, dwNewLong As sys) As int
! BitBlt Lib "gdi32.dll" (ByVal hDestDC As int, ByVal x As int, ByVal y As int, ByVal nWidth As int, ByVal nHeight As int, ByVal hSrcDC As int, ByVal xSrc As int, ByVal ySrc As int, ByVal dwRop As int) As int
'Declare Sub Colorize(byval line_num as Int)
'+% EM_GETTEXTLENGTHEX = 1119
% RTGETTEXTLENGTH = 18
'use corewin
'file path
char tx[500000]
string compName="\microA_Interpreter.exe"   ' for oxygen change path to \gxo2.exe
char cdPath[256]
string crlf = chr(13)+chr(10)
string tempFile
'string cdPath
GetCurrentDir 256,strptr cdPath
'GetTempPath ( 256, strptr cdPath)
cdPath = cdPath + compName
INT win 'main window
INT x=200,y=220,w=800,h=600,wstyle = WS_MINMAXSIZE
'context menu
% WM_CONTEXTMENU = 123
INT richMenu , mousex , mousey, submenu1
INT cFont=1
win = SetWindow("micro Edit: ",x,y,w,h,0,wstyle)
''load menu bitmaps...
INT mImg1 = LoadImage(0, "micData\mImg1.bmp", 0, 16, 16, 24)
INT mImg2 = LoadImage(0, "micData\mImg2.bmp", 0, 16, 16, 24)
INT mImg3 = LoadImage(0, "micData\mImg3.bmp", 0, 16, 16, 24)
INT mImg4 = LoadImage(0, "micData\mImg4.bmp", 0, 16, 16, 24)
INT mImg5 = LoadImage(0, "micData\mImg5.bmp", 0, 16, 16, 24)
'create file path box  ---------------------------------------------------------------------
int ed1ID = 99
int edit1 = SetEditBox(win,10,538,560,20,"FILE PATH",0x50004000,0x200,ed1ID)
'buttons init...............................................................................
'icon button -> 1409351744 , normal -> 0x50001000
'IconButton( bhwnd ,_bx , _by , _bw, _bh, _ibicon , _bflag , _ext , _cID )
INT button1, b1ID = 100 : % ICONBUTTON = 1409351744
button1 = SetButton(win,10,2,48,48,"", ICONBUTTON, 0,b1ID)
INT icon1 = LoadImage(0, "micData\icOpen.ico", 1, 32, 32, 24) 'load icon...
SendMessage( button1, 247, 1, icon1)                        'add icon to button...
'...........................................................................................
INT button2, b2ID = 101
button2 = SetButton(win,60,2,48,48,"", ICONBUTTON, 0,b2ID)
INT icon2 = LoadImage(0, "micData\icSave.ico", 1, 32, 32, 24)
SendMessage( button2, 247, 1, icon2)
'...........................................................................................
INT button3, b3ID = 102
button3 = SetButton(win,110,2,48,48,"", ICONBUTTON, 0,b3ID)
INT icon3 = LoadImage(0, "micData\icCompile.ico", 1, 32, 32, 24)
SendMessage( button3, 247, 1, icon3)   
'............................................................................................
INT button4 , b4ID = 103
button4 = SetButton(win,160,2,48,48,"", ICONBUTTON, 0,b4ID)
INT icon4 = LoadImage(0, "micData\icRun.ico", 1, 32, 32, 24)
SendMessage( button4, 247, 1, icon4)
'...........................................................................................
INT button5 , b5ID = 104
button5 = SetButton(win,210,2,48,48,"", ICONBUTTON, 0,b5ID)
INT icon5 = LoadImage(0, "micData\icFont.ico", 1, 32, 32, 24)
SendMessage( button5, 247, 1, icon5)
                     
'richedit...................................................................................
INT hRich : INT richID = 400 : INT rx = 10,ry = 54, rw = 600, rh = 480
hRich = SetRichEdit (win, rx, ry, rw, rh,"", 1412518084, 0x200, richID)
'set font & back color......................................................................
ControlFont(hRich, 14, 9, 400, "Consolas") : SetRichEditBackColor hRich, RGB( 230, 230, 230 ) 'RGB(240,234,180)rgb( 182, 207, 248 )
'create margin on richedit control...
% MARGIN_X = 64
SendMessage hRich, EM_SETMARGINS, EC_LEFTMARGIN, MARGIN_X
INT editProc = GetWindowLong( hRich, GWL_WNDPROC)
'subclass richedit to his own callback function
SetWindowLong(hRich, GWL_WNDPROC, @editCallback)

'init context popup_menu and set client rect to richedit
RECT rcRE
RichEditPopUpMenu()
'enable menu items - MF_ENABLED = 0
EnableMenuItem ( richMenu, 700, 0)
'init keywords and selections for richedit control
CHARFORMAT cf
% keywordCount = 30
STRING keyword[32]
InitSyntaxHighlightning()
INT mask
% ENMKEYEVENTS    = 65536
% ENMCHANGE       = 1
% EM_HIDESELECTION = 1087

'set focus to richedit control
SetFocus hRich
'let the richedit control send a message when the contents have changed
'SendMessage(hRich, RTSETEVENTMASK , mask | ENMKEYEVENTS | ENMCHANGE , 0)
SendMessage hRich, EM_SETEVENTMASK , 0, ENMCHANGE | ENMKEYEVENTS 
'(WM_USER + 38)
'SendMessage hRich, WM_SETTEXT, 0, strptr "var a"
 'SendMessage(hRich, WM_SETREDRAW, -1, 0)
INT Scanning = 0


Wait()  'message loop

'main window callback function ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function WndProc (sys hwnd,wmsg,wparam,lparam) as int callback
win = hwnd
'locals
INT cLine, CurrentStartPos , CurrentEndPos

SELECT hwnd

CASE win

SELECT wmsg

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 b2ID
                           'save file
                           If notifycode=0
                           doSave()
                  End If
                       CASE b3ID
                           'compile file
                           If notifycode=0
                           doCompile()
                  End If

                      ' CASE b4ID
                          'just run file ..not yet

                       CASE b5ID
                          'change font 1/2
                          If notifycode=0
                           if cfont =1
                            cfont=cfont+1
                           else
                           cfont=cfont-1
                           end if
                           doFont()
                 End If

           CASE richID
               If notifycode = 768 'EN_CHANGE -> the contents of the richedit are changed
                  'The following returns the index (0-based) of the line containing the current character.
                  ' SendMessage hRich, EM_HIDESELECTION, ,0
SendMessage hRich,EM_GETSEL, @CurrentStartPos ,0
                  cLine = SendMessage hRichEdit,EM_LINEFROMCHAR, CurrentStartPos,0
                  SendMessage hRich, EM_HIDESELECTION, 1, 0
                      HighlightLine(cLine)

if GetAsyncKeyState(VK_RETURN) = 1
                       HighlightLine(cLine-1)
                  end if

                SendMessage hRich, EM_SETSEL,  CurrentStartPos,CurrentStartPos  ' Return cursor to its correct position.
                SendMessage hRich,EM_SETMODIFY,0,0
                SendMessage hRich, EM_HIDESELECTION, 0,0


               End if


                     
                      End Select
'~~~~~ select context menu items ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
               
'----------------------------------------------------------------------------------------------
              Case WM_CONTEXTMENU
                  mousex = LoWord(lParam) : mousey = HiWord(lParam)  'get mouse coordinate
                   GetClientRect(hRich, rcRE)
TrackPopupMenu (richMenu, 0, mousex, mousey, 0, hRich, rcRE )   'put context menu where mouse is
'TrackPopupMenu (hMenu As INT, wFlags As INT, x As INT, y As INT, nReserved As INT, hwnd As INT, lprc As RECT) As INT
                return 0

Case WM_CLOSE
CloseWindow(win)
EndProgram()

              Case WM_SIZE
GetSize(win,x,y,w,h)
MoveWindow(hRich, 10, 54, (w-rw/2)+114, (h-56)-32 , 1)
                  MoveWindow(edit1, 10, h-26, 560, 21 , 1)            'h-30)-32
               '+ edit1 = SetEditBox(win,10,538,560,20,"FILE PATH",0x50004000,0x200,ed1ID

             

END SELECT
         

END SELECT

Return Default
End Function
'///////////////////////////////////////////////////////////////////////////////////////////
Sub HighlightLine(Line as int)
'locals Linetext is text buffer/ subroutine from PureBasic forum
   string LineText=space(256),inst,check : INT StartPos, EndPos, LeftPos, RightPos, a, b
 '  SendMessage (riched, EM_GETLINE, i, strptr lineText) ' get line from richedit control
  SendMessage hRich,EM_GETLINE, Line, LineText  : Linetext = LCase(LineText)
  'Get the character index's of both ends of the line.
  StartPos = SendMessage (hRich,EM_LINEINDEX, Line,0)
  EndPos = StartPos + Len(LineText)
  cf.cbSize = 60
  cf.dwMask =  CFM_BOLD | CFM_COLOR
  cf.dwEffects = CFM_BOLD ' comment this line if you don't need bold
 'Left = StartPos
  'BasicKeywords in BLUE
  For a = 1 To 32
    LeftPos = StartPos
    ''''Read.s inst$
    inst = keyword[a] : 'print "INST_KEY:" + inst
    'Repeat >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
     Do
      'RightPos = <pureBasic->FindString(LineText, inst, LeftPos-StartPos+1) + StartPos / i use INSTR() function
       RightPos = INSTR(LeftPos-StartPos+1, LineText, inst)  + StartPos
      If RightPos = StartPos 'No occurrences found.
        'print "No occurrences found"
        LeftPos = EndPos
        Else
        ';******
        LeftPos = RightPos-1 : RightPos = RightPos + Len(inst)-1
        ';******
        ';check$=Mid(LineText,right+1,1)
        check = Mid(LineText,RightPos + 1 - StartPos,1)
           'print "CHEK:" + check ' Debug check string as blank space or cr13 or Left paren
          If check = " " or check = chr(13) or check = "("
            SendMessage hRich, EM_SETSEL, LeftPos, RightPos  'Highlight the word.
            LeftPos = RightPos
            cf.crTextColor = RGB(0,0,200)

            If LCase(inst) = "var" : cf.crTextColor = RGB(200,0,0) : end if
   If LCase(inst) = "str" : cf.crTextColor = RGB(200,0,0) : end if
            If LCase(inst) = "ptr" : cf.crTextColor = RGB(200,0,0) : end if

            SendMessage hRich, EM_SETCHARFORMAT, SCF_SELECTION, cf
         
           SendMessage hRich, EM_SETSEL, LeftPos, LeftPos+1    'Highlight the wor/default black       
           cf.crTextColor = RGB(0,0,0)
           SendMessage hRich, EM_SETCHARFORMAT, SCF_SELECTION, cf

           Else
            LeftPos = RightPos + 1
             'print "YES" ';Debug "yes"
        End If
      End If
    'Until LeftPos = EndPos <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    if LeftPos = EndPos : exit do : end if
    End Do
 
  Next a

END SUB

'////////////////////////////////////////////////////////////////////////
SUB InitSyntaxHighlightning()
'init keywords and selections for richedit control
keyword[1]  = "if"
keyword[2]  = "else"
keyword[3]  = "endif"
keyword[4]  = "wcolor"
keyword[5]  = "fcolor"
keyword[6]  = "bcolor"
keyword[7]  = "pset"
keyword[8]  = "line"
keyword[9]  = "circle"
keyword[10] = "rect"
keyword[11] = "func"
keyword[12] = "endfn"
keyword[13] = "winsize"
keyword[14] = "swap"
keyword[15] = "print"
keyword[16] = "sin"
keyword[17] = "cos"
keyword[18] = "tan"
keyword[19] = "sqr"
keyword[20] = "rand"
keyword[21] = "rnd"
keyword[22] = "abs"
keyword[23] = "log"
keyword[24] = "round"
keyword[25] = "int"

keyword[26] = "goto"
keyword[27] = "while"
keyword[28] = "wend"
keyword[29] = "label"
keyword[30] = "var"
keyword[31] = "str"
keyword[32] = "ptr"

END SUB
'///////////////////////////////////////////////////////////////////////////

'-------------------------------------------------------------------------
FUNCTION setRichTextColor( BYVAL NewColor AS INT) AS INT
' setRichTextColor sets the textcolor for selected text in a Richedit control.
' &HFF - read, &HFF0000 - blue, &H008000 - dark green, &H0 is black, etc.
   CHARFORMAT cf
   cf.cbSize      = sizeOf(cf)       'Length of structure -> set 60
   cf.dwMask      = CFM_COLOR        'Set mask to colors only
   cf.crTextColor = NewColor         'Set the new color value
   SendMessage(hRich, EM_SETCHARFORMAT, SCF_SELECTION, cf)
END FUNCTION                                                             

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'richedit callback function
Function editCallback(sys hwnd , uMsg, wParam , lParam ) as int callback
POINTAPI  pt
CHAR sz[16]
DWORD lc
RECT crect
INT rgn
int dret
INT hDC
int line
int charpos

     dret = CallWindowProc( editProc,hWnd, uMsg,wParam,lParam)


    if uMsg = WM_PAINT
        lc=SendMessage(hwnd,EM_GETLINECOUNT,0,0)
        if lc
            hDC = GetDC(hwnd)
            SaveDC(hDC)
            GetClientRect(hwnd, crect)
            rgn = CreateRectRgn(crect.left,crect.top,crect.right,crect.bottom)
            SelectClipRgn(hDC,rgn)
            BitBlt (hDC,0,0,MARGIN_X,crect.bottom, hDC,0,0,PATCOPY)
           
            line=SendMessage(hwnd,EM_GETFIRSTVISIBLELINE,0,0)
            while line <= lc
                charpos = SendMessage(hwnd,EM_LINEINDEX,line,0)
                exit if charpos = -1
                SendMessage(hwnd,EM_POSFROMCHAR,pt,charpos)
                exit if pt.y > crect.bottom
                'wide char
                wsprintf(&sz,"%lu",line+1)
                TextOut(hDC,25,pt.y,sz,len(sz))
                line++
            wend
            RestoreDC(hDC,-1)
            DeleteObject(rgn)
            ReleaseDC(hwnd,hDC)
        end if 
    elseif uMsg = WM_COMMAND
            select wparam
               case 700 : SendMessage(hwnd,WM_CUT,0,0)
               case 701 : SendMessage(hwnd,WM_COPY,0,0)
case 702 : SendMessage(hwnd,WM_PASTE,0,0)
case 703 : SendMessage(hwnd,EM_SETSEL ,0,-1)
           end select

'elseif uMsg = WM_VSCROLL
           ' If Scanning = 1 : return  : End if   

             
              'select hiword(wparam)
              ' case EN_CHANGE
                 ' print "changed.."
                 'applyColorLine()
            'end select
   
   
    end if
    return dret     
 
 Return CallWindowProc (editProc, hwnd, uMsg, wParam, lParam)

End Function
'-------------------------------------------------------------------------
SUB RichEditPopUpMenu()
  richMenu = CreatePopupMenu ()
'addsub menu items with ID
AppendMenu (richMenu, 0, 700, strptr "CUT")
SetMenuItemBitmaps(richMenu, 0 , MF_BYPOSITION , mImg1, 0) 'add menu item bitmap
AppendMenu (richMenu, 0, 701, strptr "COPY")
SetMenuItemBitmaps(richMenu, 1,  MF_BYPOSITION , mImg2, 0)
AppendMenu (richMenu, 0, 702, strptr "PASTE")
SetMenuItemBitmaps(richMenu, 2,  MF_BYPOSITION , mImg3, 0)
AppendMenu (richMenu, 0, 703, strptr "SELECT_ALL")
SetMenuItemBitmaps(richMenu, 3,  MF_BYPOSITION , mImg4, 0)

END SUB

'-----------------------------------------------------------------------------------
Sub doOpen()

INT hsize=0,LineCount,Ln
'bstring tx="" ' use bstring for text on scintilla
string dir, filter , title ,fName
string sep=chr(0)
'filter = "All Files"+sep+"*.*"+sep"Text files"+sep+"*.txt"+ sep
filter = "All files "+sep+"*.*"+sep+"micro(A) files "+sep+"*.bas"
title = "Open File... "

fName = FileDialog(dir,filter,title,0,0,"bas")
'print "FNAME:" + fName
'fileName = fName
IF LEN(fname) = 0
   MsgBox "File Opening Canceled!" , "microEdit :: INFO!"
Return
END IF

SendMessage edit1,WM_SETTEXT, 0,  strptr(fname)
'SendMessage status,WM_SETTEXT,0, byval strptr(fName)
 tx =  GetFile fName
SendMessage hRich,WM_SETTEXT, 0, strptr(tx)
tempFile = fName
'get line count...
LineCount = SendMessage hRich, EM_GETLINECOUNT, 0,0 ' get number of Lines
'MsgBox "Lines: " + str(LineCount),"m(A):Line Count->" 'comment this line without message
'Highlight each line one by one in a for/loop...

SendMessage(hRich, WM_SETREDRAW, 0, 0)
IF LineCount > 0
   For Ln = 0 to LineCount
       HighlightLine(Ln)
   Next Ln
END IF
SendMessage(hRich, WM_SETREDRAW, -1, 0)
InvalidateRect(hRich, 0, 0) : UpdateWindow hRich


End Sub
'--------------------------------------------------------------------
Sub doSave()

INT hsize=0,found,c
string dir="",filePath,filter,title,fName
string ext=".bas"

filter= "micro(A) Files (*.bas)"
title="Save File... "    'for Oxygen change to *.o2bas

fName = FileDialog(dir,filter,title,0,1,"bas")

If fName="" then Return
  IF RightS(fname,4) <> ".bas"  'for microA set number to 4 , .bas
    fname = fname + ext
  END IF
print fname
'hsize = SendMessage hRich, EM_GETTEXTLENGTHEX, 0, 0
'print "HSIZE:" + str(hsize)
SendMessage hRich,WM_GETTEXT, 4096,tx
print "TX:" + tx
'exit if empty
'IF hsize = 0
'MsgBox "Document is Empty!" ,"micro Edit"
'Return    ' ->->->
'END IF
'else -> save file

SendMessage hRich,WM_GETTEXT, 4096,tx

c=PutFile fName,tx
tempFile = fname

End Sub
'--------------------------------------------------------------
SUB doCompile
char ln[256]
string fn=""
SendMessage edit1, WM_GETTEXT, 256, strptr ln
fn = Trim(ln)
'print "doCompile-FN:" + fn

IF LEN(fn) < 1
MsgBox "File Not Open!","Error::File"
Return
End If
int sRet
autosave()  ' do autoSave
'(sys hwnd, string lpOperation, lpFile, lpParameters, lpDirectory, sys nShowCmd) as sys
sRet = ShellExecute(0,"open", cdPath, chr(34) + fn + chr(34),"" , 5) ' if work sRet = 42
If sRet = 2 then MsgBox "Compiler microA Not Found!"+ crlf + "Enter new compiler path!" , " microA Path"
'sRet = ShellExecute 0,"open","gxo2.exe","-c "+ fn,"",5
'sRet = ShellExecute 0,"open",cdPath,cOption & chr(34) & fName & chr(34),"",5 'fb

END SUB
'--------------------------------------------------------------
SUB doFont
INT LineCount,Ln
LineCount = SendMessage hRich, EM_GETLINECOUNT, 0,0
   if cFont=1 : ControlFont(hRich, 14, 9, 400, "Consolas")
      IF LineCount > 0 :For Ln = 0 to LineCount : HighlightLine(Ln) :Next Ln :END IF
   end if
   if cFont=2 : ControlFont(hRich, 16, 8, 400, "Consolas")
      IF LineCount > 0 :For Ln = 0 to LineCount : HighlightLine(Ln) :Next Ln :END IF
   end if
END SUB
'--------------------------------------------------------------
Sub autoSave()

SendMessage hRich,WM_GETTEXT, 4096,tx
PutFile tempFile,tx

End Sub