Post Reply 

Share on Facebook Share on Twitter

micro Editor E2
09-21-2022, 04:31 AM
Post: #1
micro Editor E2
simple Richedit control based code editor for microA

Code:
/* *******************************************************
'** 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
Find all posts by this user
Quote this message in a reply
Post Reply 


Forum Jump:


User(s) browsing this thread: