Problem with OnClick event

[Tolo68]

Hello everyone, I have looked at several examples and have done several tests, but I can't get this done...
Note, the code has 2 message processing systems.......

Function ApiWindow.CtrlMsgFunc
Function wndproc

....I test with one or the other.

////////////////////////////////////////////

Form.bi

Code: Select all

#Include Once "windows.bi"
#include "win\commctrl.bi"

Dim As WNDCLASSEX wc
Dim Shared As String NameClass
NameClass="WinClass"
Dim As HINSTANCE Hinst=GetModuleHandle(0)
Dim Shared msg As MSG

Type ApiWindow

  As short _Left = 100 ' valor por defecto
  As short _Top = 100
  As short _Width = 320
  As short _Height = 240
  
  Declare Sub Create(WinName As string, Title As string)
  Declare Sub onClick()    ' <--------------------------------------------
  Declare Static Function CtrlMsgFunc(WinHwnd As handle,uMsg as UInteger,wParam as wParam,lParam as lParam) as LRESULT
  
End Type

Sub ApiWindow.onClick()
 Print "-- ApiWindow.Click() --"
End Sub

Function ApiWindow.CtrlMsgFunc(WinHwnd As handle,Msg as UInteger,wParam as wParam,lParam as lParam) as LRESULT

  Select Case Msg
  
        Case WM_CREATE
            
        Case WM_DESTROY
            PostQuitMessage(0)
            
        Case WM_LBUTTONDOWN
          ' < ------------  Here I want to fire the Onclick event
          'ApiWindow.onClick()  ' < ------------ Not Work
          
    End Select
    return DefWindowProc(WinHwnd,Msg,wparam,lparam)

End function

Function wndproc(hwnd As HWND, msg As UInteger,_
    wparam As WPARAM, lparam As LPARAM) As Integer
    
    Select Case msg
    
        Case WM_CREATE
            
        Case WM_DESTROY
            PostQuitMessage(0)
            
        Case WM_LBUTTONDOWN
          ' < ------------  Here I want to fire the Onclick event
          'ApiWindow.onClick()  ' < ------------ Not Work
          
    End Select
    Return DefWindowProc(hwnd,msg,wparam,lparam)
End Function

With wc
    .cbSize=SizeOf(WNDCLASSEX)
    .style=CS_HREDRAW Or CS_VREDRAW
    
    .lpfnWndProc=@wndproc   ' < ------------ i can use this ......
    ''' .lpfnWndProc = @ApiWindow.CtrlMsgFunc   ' < ------------ or this ......
    
    .hInstance=Hinst
    .hIcon=LoadIcon(0,IDI_QUESTION)
    .hCursor=LoadCursor(0,IDC_ARROW)
    .hbrBackground=Cast(HBRUSH,COLOR_WINDOW)
    .lpszClassName=StrPtr(NameClass)
    .hIconSm=.hIcon
End With

If RegisterClassEx(@wc)=0 Then
    Print "Register error, press any key"
    Sleep
    End
Endif

Sub AppRun
  While GetMessage(@msg,0,0,0)
      TranslateMessage(@msg)
      DispatchMessage(@msg)
  Wend  
End sub

Sub ApiWindow.Create(WinName As string, Title As string)

    CreateWindowEx(0,WinName,Title,WS_VISIBLE Or WS_OVERLAPPEDWINDOW, _
      _left, _top, _Width, _Height, 0, 0, getmodulehandle(0),0)
    
End Sub

Test.bas

Code: Select all

#include "windows.bi"
#include "win\commctrl.bi"

InitCommonControls

#Include "Form.bi"

Dim Shared Form1 As ApiWindow

Sub MiFormSub()
  Print "MiFormSub"
End sub

Form1.Create(NameClass, "Window 1")
'Form1.onClick = @MiFormSub  ' < --------------    Error 3 - Expected End of Line....
AppRun

[adeyblue]

The way to do it is to pass the ApiWindow ptr to WndProc, then store it somewhere you can get it back from (some 'extra window data' from the WNDCLASSEX is a usual place), then get it out again for every message and use that to call the real handler.

You can also uncomment the Form1.OnClick line in test.bi now. If you want to change functions like onClick, they too need to be variables.

Code: Select all

#Include Once "windows.bi"
#include "win\commctrl.bi"

Dim As WNDCLASSEX wc
Dim Shared As String NameClass
NameClass="WinClass"
Dim As HINSTANCE Hinst=GetModuleHandle(0)
Dim Shared msg As MSG

Type ApiWindow

  As short _Left = 100 ' valor por defecto
  As short _Top = 100
  As short _Width = 320
  As short _Height = 240
  
  Dim onClick As Sub() '' variable so it can be changed

  Declare Sub Create(WinName As string, Title As string)
  Declare Function CtrlMsgFunc(WinHwnd As HWND,uMsg as UINT,wParam as wParam,lParam as lParam) as LRESULT
  Declare Static Function WndProc(WinHwnd As HWND,uMsg as UINT, wParam as wParam,lParam as lParam) as LRESULT
  
End Type

Function ApiWindow.CtrlMsgFunc(WinHwnd As HWND,Msg as UINT,wParam as wParam,lParam as lParam) as LRESULT

  Select Case Msg
  
        Case WM_CREATE
            
        Case WM_DESTROY
            PostQuitMessage(0)
            
        Case WM_LBUTTONDOWN
          If onClick Then onClick() '' if you call these when they are not set, the app will crash
          
    End Select
    return DefWindowProc(WinHwnd,Msg,wparam,lparam)

End function

Function ApiWindow.WndProc(WinHwnd As HWND,Msg as UINT,wParam as wParam,lParam as lParam) as LRESULT
  dim as ApiWindow ptr pApiWindow

  '' if this is the first message
  if(Msg = WM_NCCREATE) Then

       '' store the ApiWindow ptr we sent in CreateWindowEx in the Window data allocated by WndClassEx.cbWndExtra
       dim as CREATESTRUCT ptr pCreateWindowData = cast(CREATESTRUCT ptr, lParam)
       pApiWindow = pCreateWindowData->lpCreateParams '' this is the last argument to CreateWindowEx, where we put the 'this' pointer
       SetWindowLongPtr(WinHwnd, 0, cast(LONG_PTR, pApiWindow)) '' store it in the window data

  Else

      '' for every other message, get it out of the window data
       pApiWindow = cast(ApiWindow Ptr, GetWindowLongPtr(winHwnd, 0))

  End If
  '' call the real handler
  Return pApiWindow->CtrlMsgFunc(WinHwnd, Msg, wParam, lParam)
End Function

With wc
    .cbSize=SizeOf(WNDCLASSEX)
    .style=CS_HREDRAW Or CS_VREDRAW    
    .lpfnWndProc = @ApiWindow.WndProc
    .hInstance=Hinst
    .hIcon=LoadIcon(0,IDI_QUESTION)
    .hCursor=LoadCursor(0,IDC_ARROW)
    .hbrBackground=Cast(HBRUSH,COLOR_WINDOW)
    .lpszClassName=StrPtr(NameClass)
    .hIconSm=.hIcon
    .cbWndExtra = SizeOf(ApiWindow Ptr) '' <-- Add this so we have somewhere to store the ApiWindow pointer
End With

If RegisterClassEx(@wc)=0 Then
    Print "Register error, press any key"
    Sleep
    End
Endif

Sub AppRun
  While GetMessage(@msg,0,0,0)
      TranslateMessage(@msg)
      DispatchMessage(@msg)
  Wend  
End sub

Sub ApiWindow.Create(WinName As string, Title As string)

    CreateWindowEx(0,WinName,Title,WS_VISIBLE Or WS_OVERLAPPEDWINDOW, _
      _left, _top, _Width, _Height, 0, 0, getmodulehandle(0), @This) '' pass in the This pointer, that references this ApiWindow
    
End Sub

[Tolo68]

Thank you so much adeyblue !!
Your example was great!
I already tried the OnPaint event in WM_PAINT and it went well too.
Then create 2 Forms and everything is perfect !!!!

Code: Select all

Sub MiFormSub()
  Print "MiFormSub"
End Sub

Sub MiFormPaint()
  Print "MiFormPaint"
End Sub

Sub MiFormSub2()
  Print "MiFormSub2"
End Sub

Sub MiFormPaint2()
  Print "MiFormPaint2"
End sub

Form1.Create(NameClass, "Window 1")
Form1.onClick = @MiFormSub
Form1.onPaint = @MiFormPaint

Form2.Create(NameClass, "Window 2")
Form2.onClick = @MiFormSub2
Form2.onPaint = @MiFormPaint2

Thank you very much again, you are a crack !!!!

[Tolo68]

Well, first of all thank you all.
Now I need the OnClick event, for a Button or another control, since I have tried it but I can't get it.
The code I have is this...

''''' Button.bi

Code: Select all

Type ApiButton

  As Integer _hwnd
  Dim onClick As Sub()
  
  Declare Sub Create(parent As handle, WinName As string, Title As string, X As integer, Y As Integer, W As integer, H As integer)
  Declare Function CtrlMsgFunc(WinHwnd As handle,uMsg as UINT,wParam as wParam,lParam as lParam) as LRESULT
  
  Declare Property Hwnd() As handle   ' <----------- I can't put "As Hwnd" because it gives me an error
  Declare Property Hwnd(Byval NewValue As handle)
  
End Type

Function ApiButton.CtrlMsgFunc(WinHwnd As handle,Msg as UINT,wParam as wParam,lParam as lParam) as LRESULT

  Select Case Msg
  
        Case WM_CREATE
            
        Case WM_DESTROY
            
        Case WM_LBUTTONDOWN
        
          Print "WM_LBUTTONDOWN"    ' < ------------------does not print anything
          If onClick Then onClick()
        
  End Select
  
  return DefWindowProc(WinHwnd,Msg,wparam,lparam)

End function

Property ApiButton.Hwnd() As handle
  Hwnd = _hwnd
End Property

Property ApiButton.Hwnd( ByVal NewValue As handle )
  _hwnd = NewValue
End Property

Sub ApiButton.Create(Parent As handle, ButName As string, Title As string, X As integer, Y As Integer, W As integer, H As integer)
    this.hwnd = CreateWindowEx(0,"button",Title ,WS_VISIBLE  Or WS_CHILD,X,Y,W,H,Parent,0,getmodulehandle(0),@This)
End sub

Code added to the previous one "Test.bas"
The button creates it, but does not fire the onClick event

Code: Select all

Dim Shared But1 As ApiButton

Sub ButtonClick()
  Print "boton pulsado"
End sub

but1.Create(form1.Hwnd,"miboton","Command 1", 30,100,100,20)
but1.onClick = @ButtonClick