Post Reply 

Share on Facebook Share on Twitter

Richedit control - margin with line numbers
02-23-2020, 12:20 AM
Post: #1
Richedit control - margin with line numbers
Finally get it to work
thanks to CHarles and ARnold

$ Filename "ARichLN.exe" ' Oxygen Basic
Include ""
Include ""

'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)


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

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


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

        End Select


Return Default
End Function
'richedit callback function
Function editCallback(sys hwnd , uMsg, wParam , lParam ) as int callback
CHAR sz[16]
RECT crect
INT rgn
int dret
int line
int charpos

' Select wMsg
   ' Case WM_PAINT

         dret = CallWindowProc( editProc,hWnd, uMsg,wParam,lParam)
          'print "DRET:" + str(dret)

    if uMsg = WM_PAINT
        if lc
            hDC = GetDC(hwnd)
            GetClientRect(hwnd, crect)
            rgn = CreateRectRgn(crect.left,,crect.right,crect.bottom)
            ';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)
            while line <= lc
                charpos = SendMessage(hwnd,EM_LINEINDEX,line,0)
                exit if charpos == -1
                exit if pt.y > crect.bottom
                'wide char
        end if      
    end if
    return dret

      'Return 0
' End Select
Return CallWindowProc (editProc, hwnd, uMsg, wParam, lParam)
'return 0
End Function
Find all posts by this user
Quote this message in a reply
Post Reply 

Forum Jump:

User(s) browsing this thread: