Author Topic: Subclassing in a WINDOW  (Read 3020 times)

0 Members and 1 Guest are viewing this topic.

Aurel

  • Guest
Subclassing in a WINDOW
« on: February 20, 2020, 12:03:52 pm »
Hello Charles....and others ..of course

when subclassing work in a Dialog based app,as you may see in topic about line numbers.
But in Window based app from what i tried ,and believe me i tried all possible options using all possible
examples i can find on net to make it right.

No mather what version of SetWindowLong  i use ,program simply crush when i try to run.
Compilation work fine witohut errors.
I tried with both older A043 and with last 0.2.8 varsion 32 bit.
I tried the same method which is used in dialog app to get it work as you can see in code.
I am using awinh037.inc  with which i compiled and run my AurelEdit program in latest 0.2.8 version so i think
that is not problem in include ( i hope)

I don't know how to run this code using wincore ? sorry...

here is code:
Code: [Select]
$ Filename "ARichLN.exe" ' Oxygen Basic
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"(lpPrevWndFunc AS INT,hWnd AS INT,Msg AS INT,wParam AS INT,lParam AS INT) as INT
'! SetWindowLong Lib "user32.dll" Alias "SetWindowLongA"(hwnd AS int, nIndex AS INT, dwNewLong AS SYS) as INT
Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hctl As Long, ByVal nIndex As Long,byval dwNewLong As int) As Long
! 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 Long, ByVal lpzFormat As String, Byval Number as Long) As long

'! editCallback (byval uWnd as int,byval uMsg as int,byval wParam as int, byval lParam as int) as int
Declare Function SaveDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Declare Function RestoreDC Lib "gdi32.dll" (ByVal hdc As Long, ByVal nSavedDC As Long) As Long
Declare Function CreateRectRgn Lib "gdi32.dll" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Declare Function SelectClipRgn Lib "gdi32.dll" (ByVal hdc As Long, ByVal hRgn As Long) As Long
'! SetWindowLongPtr Lib "user32.dll" Alias "SetWindowLongA" (ByVal hctl As sys, ByVal nIndex As Long, ByVal dwNewLong As sys) As sys
'extern lib "user32.dll"
'! SetWindowLong "SetWindowLongA"

'create window
INT win,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,richID = 400
'hRich = SetRichEdit (win, 20,50,500,380,"", 1412518084, 0x200, richID)
'create margin on richedit control
% MARGIN_X = 70
SendMessage hRich, EM_SETMARGINS, EC_LEFTMARGIN, MARGIN_X
'subclass richedit to his own callback function
sys editProc '= SetWindowLong (GetDlgItem( win, richID), 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
'dret = CallWindowProc(editProc,hWnd, wMsg,wParam,lParam)
Select wmsg

Case WM_CREATE
                  hRich = SetRichEdit (win, 20,50,500,380,"", 1412518084, 0x200, richID)
                  '..............     next line cause app crush  ????    .........................               
editProc = SetWindowLong( GetDlgItem( hwnd, richID), GWL_WNDPROC, @editCallback)
                 '.................................................................................
               
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
sys rgn
int dret
sys 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
' 0 Return CallWindowProc (editProc, hwnd, uMsg, wParam, lParam)
 'return 0
End Function

 

Aurel

  • Guest
Re: Subclassing in a WINDOW
« Reply #1 on: February 20, 2020, 12:52:46 pm »
Hi
Charles , i have found in folder examples\WinGUI
program callled  UniversalButtons ,program is really cool and remind me on old abandoned compiler
which use same shapes for gui elements...
how ever i found this method of subclassing which is used in that program
i hope that should work :

'Subclass all the buttons to the same procedure...
    glpButtonProc = GetWindowLongPtr(hButton, GWL_WNDPROC)
 
    SetWindowLongPtr(hButton, GWL_WNDPROC, @ButtonProc)

Aurel

  • Guest
Re: Subclassing in a WINDOW
« Reply #2 on: February 21, 2020, 07:37:47 am »
Hi Charles

I am stuck with this two api calls.
I am using last o2 0.2.8.

After i create richedit control i use api GetWindowLongPtr ( hwnd,gwlData) 
and app compile fine ...then when i tried to run i get error that function is not loaded.
Same function is used in example UniversalButton and there work...  ???
I am now totally confused, how is possible that same function not work ?

Just to let you know i declerd it first on usual way...then
when not work i tried with
extern lib "user32.dll"

also compile fine but exit with same error
then i tried
uses user
also nothing
then with
include "user.inc"
also nothing

Arnold

  • Hero Member
  • *****
  • Posts: 977
Re: Subclassing in a WINDOW
« Reply #3 on: February 21, 2020, 12:25:30 pm »
Hi Aurel,

if you do not include corewin.inc (e.g. dialogs.inc already includes corewin.inc) you should check user.inc and windata.inc to find out how Charles handled Set/GetWindowLong and Set/GetWindowLongPtr for 32 and 64 bit mode. As already stated, the Set/GetWindowLongPtr functions are not provided in the 32-bit version of user32.dll and a work-around must be used to satisfy both systems.

Aurel

  • Guest
Re: Subclassing in a WINDOW
« Reply #4 on: February 21, 2020, 11:00:14 pm »
Quote
if you do not include corewin.inc (e.g. dialogs.inc already includes corewin.inc) you should check user.inc and windata.inc to find out how Charles handled Set/GetWindowLong and Set/GetWindowLongPtr for 32 and 64 bit mode. As already stated, the Set/GetWindowLongPtr functions are not provided in the 32-bit version of user32.dll and a work-around must be used to satisfy both systems.

Hi Roland
Thanks on points...i looked into user.inc and i found this:

#ifdef mode64bit
  ! GetClassLongPtr   "GetClassLongPtrA"
  ! SetClassLongPtr   "SetClassLongPtrA"
  ! GetWindowLongPtr  "GetWindowLongPtrA"
  ! SetWindowLongPtr  "SetWindowLongPtrA"

  ! GetClassLongPtrW
  ! SetClassLongPtrW
  ! GetWindowLongPtrW
  ! SetWindowLongPtrW

#endif

In winData.inc is also similar:

#ifndef mode64bit
    def GetClassLongPtr   GetClassLong
    def SetClassLongPtr   SetClassLong
    def GetWindowLongPtr  GetWindowLong
    def SetWindowLongPtr  SetWindowLong

    def GetClassLongPtrW  GetClassLongW
    def SetClassLongPtrW  SetClassLongW
    def GetWindowLongPtrW GetWindowLongW
    def SetWindowLongPtrW SetWindowLongW
  #endif

And in MinWin.inc is this:

#ifdef mode64bit
  ! GetWindowLongPtr "GetWindowLongPtrA"          '2
  ! SetWindowLongPtr "SetWindowLongPtrA"          '3
#endif


As i can see there is  and looks to me that is only for 64bit systems, but how then work on 32bit in example
UniversalButton ...that must be some kind of trick?
Only difference is that is def used insted ! - declare function ..right.
« Last Edit: February 21, 2020, 11:23:09 pm by Aurel »

Aurel

  • Guest
Re: Subclassing in a WINDOW
« Reply #5 on: February 21, 2020, 11:29:57 pm »
In program UniversalButton button is subclassed inside function

Code: [Select]
'-----------------------------------------------------------------------------
' Step Three: -Create the button, Subclass it,
'             -Create the instance data,
'             -and Return the new buttons handle.
'-----------------------------------------------------------------------------
function FinalCreateTheButton(string szCaption,   ' caption
                              dword Wstyle,       ' style                     
                              RECT *rc,           ' top/left corner
                              sys hparent,        ' parent hWnd
                              int ID) as sys      ' ID

    sys hButton
    dword dWstyle
   
    tagCTLDATA *ptCD  'PTR

    'default style...
    dWstyle = BS_OWNERDRAW or WS_TABSTOP or _
              BS_PUSHBUTTON or BS_NOTIFY 'or WS_DISABLED
    dwstyle = dWstyle or Wstyle

    'Create the owner-draw push button...
    hButton  =  CreateWindowEx(0,"BUTTON",
                               szCaption,
                               dWstyle,
                               rc.Left, rc.Top,
                               rc.Right, rc.Bottom,
                               hparent, ID,
                               ghInst,  null )
    if hButton = 0 then mbox "Error in FinalCreateTheButton: Cannot CreateWindowEx hbutton"

    'Subclass all the buttons to the same procedure...
    glpButtonProc = GetWindowLongPtr(hButton, GWL_WNDPROC)
 
    SetWindowLongPtr(hButton, GWL_WNDPROC, @ButtonProc)

    'assign new region to a window
    SetWindowRgn(hButton, m_hRgn, bTrue)

    'create this controls instance data...
    CtlDataCreate(hButton)

    'add the final updates to instance data
    &ptCD = GetProp(hButton,"ptCTLDATA")
    ptCD.hButton  = hButton
    ptCD.idbutton = ID

    return hButton  'return the handle
 end function

Arnold

  • Hero Member
  • *****
  • Posts: 977
Re: Subclassing in a WINDOW
« Reply #6 on: February 22, 2020, 02:06:09 am »
I downloaded your code of your first message. I did not look very much to it, but I replaced your wrappings with corewin.inc and modified int win to sys win. (handles and pointers must be sys).

I can run your code JIT-compiled and I  can also create a 32 bit executable which works. 64-bit exe does not work.

All this is a sign that your wrappings are not correct. You have to compare your wrapper functions with Win32 Help file or similiar SDK documentation. There is a lot of info in Internet if you want to look for differences of Win32 and Win64. The most important rule is looking for handles and pointers. You can also look in the include files and in the WinGui demos, when sys is used; sys is 4 bytes in Win32, 8 bytes in Win64. Int is always 4 bytes. Also different constants are used sometimes for Win64, also for dialog or window classes. It is a hardworking bed, but it is necessary.

Code: [Select]
$ Filename "ARichLN.exe" ' Oxygen Basic
'Include "RTL32.inc"
'uses rtl64    ' does not work

Include "awinh037.inc"
use corewin
// #lookahead
/*
'api calls for subclasing + some GDI functions(! you can put it inside include file)
! CallWindowProc Lib "user32.dll" Alias "CallWindowProcA"(lpPrevWndFunc AS INT,hWnd AS INT,Msg AS INT,wParam AS INT,lParam AS INT) as INT
'! SetWindowLong Lib "user32.dll" Alias "SetWindowLongA"(hwnd AS int, nIndex AS INT, dwNewLong AS SYS) as INT
Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hctl As Long, ByVal nIndex As Long,byval dwNewLong As int) As Long
! 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 Long, ByVal lpzFormat As String, Byval Number as Long) As long

'! editCallback (byval uWnd as int,byval uMsg as int,byval wParam as int, byval lParam as int) as int
Declare Function SaveDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Declare Function RestoreDC Lib "gdi32.dll" (ByVal hdc As Long, ByVal nSavedDC As Long) As Long
Declare Function CreateRectRgn Lib "gdi32.dll" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Declare Function SelectClipRgn Lib "gdi32.dll" (ByVal hdc As Long, ByVal hRgn As Long) As Long
'! SetWindowLongPtr Lib "user32.dll" Alias "SetWindowLongA" (ByVal hctl As sys, ByVal nIndex As Long, ByVal dwNewLong As sys) As sys
'extern lib "user32.dll"
'! SetWindowLong "SetWindowLongA"
*/
'create window
sys 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

'no more changes, but should be checked
[
/code]

Aurel

  • Guest
Re: Subclassing in a WINDOW
« Reply #7 on: February 22, 2020, 03:38:31 am »
Thanks Arnold
Quote
All this is a sign that your wrappings are not correct
.

Nothing is wrong with my wrapper as i said before but I suspect that main problem might be in types
INT to SYS , also i don't understand why i must use sys when i using 32bit.
OK i will try change this and if work i will try on win7-64bit two , because i have dual boot win7 - 32,64
 ;)
« Last Edit: February 22, 2020, 05:04:04 am by Aurel »

Arnold

  • Hero Member
  • *****
  • Posts: 977
Re: Subclassing in a WINDOW
« Reply #8 on: February 22, 2020, 03:50:00 am »
As a proof of the concept I removed corewin.inc and did the declarations (using the Win32 Helpfile) of SetWindowLong, CallWindowProc, GetDlgItem.  The declaration of wsprintf I did not change, the other functions I used unptrotyped, but can be adapted. It seems you forgot the byval approach in SetWindowLong function. Applying these modifications the app will run too (in 32-bit)

Code: [Select]
$ Filename "ARichLN.exe" ' Oxygen Basic
'Include "RTL32.inc"
'uses rtl64    ' does not work

Include "awinh037.inc"

// #lookahead
/*
'api calls for subclasing + some GDI functions(! you can put it inside include file)
! CallWindowProc Lib "user32.dll" Alias "CallWindowProcA"(lpPrevWndFunc AS INT,hWnd AS INT,Msg AS INT,wParam AS INT,lParam AS INT) as INT
'! SetWindowLong Lib "user32.dll" Alias "SetWindowLongA"(hwnd AS int, nIndex AS INT, dwNewLong AS SYS) as INT
Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hctl As Long, ByVal nIndex As Long,byval dwNewLong As int) As Long
! 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 Long, ByVal lpzFormat As String, Byval Number as Long) As long

'! editCallback (byval uWnd as int,byval uMsg as int,byval wParam as int, byval lParam as int) as int
Declare Function SaveDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Declare Function RestoreDC Lib "gdi32.dll" (ByVal hdc As Long, ByVal nSavedDC As Long) As Long
Declare Function CreateRectRgn Lib "gdi32.dll" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Declare Function SelectClipRgn Lib "gdi32.dll" (ByVal hdc As Long, ByVal hRgn As Long) As Long
'! SetWindowLongPtr Lib "user32.dll" Alias "SetWindowLongA" (ByVal hctl As sys, ByVal nIndex As Long, ByVal dwNewLong As sys) As sys
'extern lib "user32.dll"
'! SetWindowLong "SetWindowLongA"
*/

'! SetWindowLong    Lib "user32.dll" Alias "SetWindowLongA" (sys hwnd, dword nIndex, dword dwNewLong) as sys
! SetWindowLong    Lib "user32.dll" Alias "SetWindowLongA" (byval hwnd as sys, byval nIndex as dword, byval dwNewLong as dword) as sys
! CallWindowProc Lib "user32.dll" Alias "CallWindowProcA"  (byval lpPrevWndFunc AS sys,byval hWnd AS sys,byval Msg AS uint,byval wParam AS sys,byval lParam AS sys) as sys
! GetDlgItem Lib "user32.dll"  (ByVal hDlg As sys, ByVal nIDDlgItem As INT) As sys
! wsprintf Lib "user32.dll" Alias "wsprintfA" (ByVal lpzBuffer as Long, ByVal lpzFormat As String, Byval Number as Long) As long


Declare Function CreateRectRgn Lib "gdi32.dll"
Declare Function SaveDC Lib "gdi32.dll"
Declare Function RestoreDC Lib "gdi32.dll"
Declare Function SelectClipRgn Lib "gdi32.dll"

....

Aurel

  • Guest
Re: Subclassing in a WINDOW
« Reply #9 on: February 22, 2020, 05:02:58 am »
Arnold
As a proof that is not wrong with my include i checked each api function with corewin and without
Quote
forgot the byval approach in SetWindowLong function
yes you are right, i made so many changes in testing... ::)
and i get it finally what is wrong ,is not problem in sys or int ( long is problematic a little) then
in different shape of

! CallWindowProc Lib "user32.dll" Alias "CallWindowProcA"(sys pPrevWndFunc ,hWnd ,uMsg ,wParam ,lParam ) as int

and above shape work when old with byVal, byRef which i have used before not work.
This might be , just might be because i don't have tested it yet on 64bit too.
of course this is not first time, i was suspicious because awinh.inc work with other programs in new 0.2.8. veersion.
Also i don't know that #lookahead now don't have effect ??

All in all, thank you very much on testing this program Arnold   :)
Also i know what i must replace in awinh.
Of course thanks to Charles  ;)

Here is code:
Code: [Select]
$ Filename "ARichLN.exe" ' Oxygen Basic
Include "RTL32.inc"
Include "awinh037.inc"
#lookahead  ' work without #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)
'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


just add back color and set font ,it looks better
« Last Edit: February 22, 2020, 06:01:40 am by Aurel »

Aurel

  • Guest
Re: Subclassing in a WINDOW
« Reply #10 on: February 27, 2020, 09:05:21 am »
Hi
As next step i would like to add simply syntax coloring(highlite) of some keywords-
I found one example on Garry Beene site with Borje Hagsteen syntax coloring on richedit control.
It work very well well on PBwin i also tried so i don't se reason why would not work in o2.

Aurel

  • Guest
Re: Subclassing in a WINDOW
« Reply #11 on: February 27, 2020, 11:07:14 am »
But first easy thing.
I look into another Garry example with context menu and looks to me really simple and
( Garry have really big amount of great and simple exmples how to do programming  :) )
i must say that i don't see similar version in other gui programs which use ScreenToClient method.
So i add one subroutine in which i create PopUpMenu:

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

END SUB

then just under message events add this:

Code: [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

and work well, i just need to add menu id chacks to get CUT/COPY/PASTE functions
« Last Edit: February 27, 2020, 11:50:14 am by Aurel »

Aurel

  • Guest
Re: Subclassing in a WINDOW
« Reply #12 on: February 28, 2020, 02:32:44 am »
And now with bitmaps on context menu

Code: [Select]
$ Filename "ARichLN.exe" ' Oxygen Basic v0.2.8 / Aurel 27.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
'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
'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)
'print "img:" str (mImg1)
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)

'init context popup_menu and set client rect to richedit
RECT rcRE
RichEditPopUpMenu()
'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_CREATE
                 

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

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)
           
            ';fnx br = SelectObject,ebx,rv(CreateSolidBrush,bkColor)
            '% PATCOPY 0x00F00021
            BitBlt (hDC,00,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,40,pt.y,sz,len(sz))
                line++
            wend
            RestoreDC(hDC,-1)
            DeleteObject(rgn)
            ReleaseDC(hwnd,hDC)
        end if     
    end if
    return dret     
 'else
 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



Aurel

  • Guest
Re: Subclassing in a WINDOW
« Reply #13 on: February 28, 2020, 08:13:02 am »
Open button replaced with iconButton:
I just draw one in aWiconsLite, also i add resizing of richedit control.

Code: [Select]
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...

Aurel

  • Guest
Re: Subclassing in a WINDOW
« Reply #14 on: March 15, 2020, 06:24:22 am »
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?

Code: [Select]
$ 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