Code:
$ Filename "ARichLN.exe" ' Oxygen Basic
Include "RTL32.inc"
Include "awinh037.inc"
#lookahead
'use corewin
'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
'! editCallback (byval uWnd as int,byval uMsg as int,byval wParam as int, byval lParam 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
'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=600,h=480,wstyle = WS_MINMAXSIZE
win = SetWindow("RichEdit control ",x,y,w,h,0,wstyle)
INT button0,b0ID=100
button0 = SetButton(win,18,4,80,26,"OPEN (X)",0x50001000,0x200,b0ID)
'richedit
INT hRich
int richID = 400
hRich = SetRichEdit (win, 20,50,500,380,"", 1412518084, 0x200, richID)
'set font & back color
ControlFont(hRich, 16, 8, 400, "Courier New") : 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)
'print "editProc:" + str(editProc)
'int hcont
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_CREATE
'hRich = SetRichEdit (win, 20,50,500,380,"", 1412518084, 0x200, richID)
'hcont = GetDlgItem( win, richID)
'editProc = GetWindowLong( hrich, GWL_WNDPROC)
' print "hcont:" + str(hcont)
'SetWindowLong(hrich, GWL_WNDPROC, @editCallback)
'print "editProc:" + str(editProc)
Case WM_CLOSE
CloseWindow(win)
EndProgram()
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
' Select wMsg
' Case WM_PAINT
dret = CallWindowProc( editProc,hWnd, uMsg,wParam,lParam)
'print "DRET:" + str(dret)
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)
';fnx br = SelectObject,ebx,rv(CreateSolidBrush,bkColor)
'% PATCOPY 0x00F00021
BitBlt (hDC,0,0,MARGIN_X,crect.bottom, hDC,0,0,PATCOPY)
';fn DeleteObject,rv(SelectObject,ebx,br)
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,0,pt.y,sz,len(sz))
line++
wend
RestoreDC(hDC,-1)
DeleteObject(rgn)
ReleaseDC(hwnd,hDC)
end if
end if
return dret
'Return 0
' End Select
Return CallWindowProc (editProc, hwnd, uMsg, wParam, lParam)
'return 0
End Function