Here is a version where cut/copy/paste/selectAll work
under editCallback function
PS.Charles...it looks to me that latest 0.2.8 have some problems with simple
new line comment with '
inside if /end if block
must be something with lexer?
$ Filename "ARichLN.exe" ' Oxygen Basic v0.2.8 / Aurel 28.2.2020
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
'use corewin
'create window
INT win
INT x=200,y=220,w=800,h=600,wstyle = WS_MINMAXSIZE
'context menu
% WM_CONTEXTMENU = 123
INT richMenu , mousex , mousey, submenu1
win = SetWindow("RichEdit control ",x,y,w,h,0,wstyle)
''load menu bitmaps...
INT mImg1 = LoadImage(0, "imgData\mImg1.bmp", 0, 16, 16, 24)
INT mImg2 = LoadImage(0, "imgData\mImg2.bmp", 0, 16, 16, 24)
INT mImg3 = LoadImage(0, "imgData\mImg3.bmp", 0, 16, 16, 24)
INT mImg4 = LoadImage(0, "imgData\mImg4.bmp", 0, 16, 16, 24)
'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, "imgData\icOpen.ico", 1, 32, 32, 24) 'load icon...
SendMessage( button1, 247, 1, icon1) 'add icon to button...
'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, 16, 8, 400, "Consolas") : SetRichEditBackColor hRich, RGB(240,234,180)
'create margin on richedit control...
% MARGIN_X = 70
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)
'load menu bitmaps
Wait() 'message loop
'main window callback function ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function WndProc (sys hwnd,wmsg,wparam,lparam) as int callback
win = hwnd
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
MsgBox "Open File","Open"
End If
End Select
'----------------------------------------------------------------------------------------------
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
Case WM_CLOSE
CloseWindow(win)
EndProgram()
Case WM_SIZE
GetSize(win,x,y,w,h)
MoveWindow(hRich, 10, 54, (w-rw/2)+114, (h-36)-32 , 1)
END SELECT
END SELECT
Return Default
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~11
'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,00,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,40,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
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
