'
' ----------------------------------------------------------------------------
' MULTIPLE CALLBACK UNDER RAPIDQ         Example                    by Jacques
'
' September 25th, 2005
' August 13th, 2006
' ----------------------------------------------------------------------------
$ESCAPECHARS ON
$TYPECHECK ON
$INCLUDE "RAPIDQ.INC"
'
$Include "CallBack_4.Inc"  ' or   $Include "CallBackAll.Inc"
'
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
                      (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function CallWindowProc LIB "user32" ALIAS "CallWindowProcA" _
                           (Proc AS Long, A1 AS Long, A2 AS Long, A3 AS Long, A4 AS Long) AS Long
'
Declare Sub OnClose_frmCallBackTest
Declare Function MouseOffCallBackTop (hWnd As Long, uMsg As Long, wParam As Long, lParam As Long) As Long
Declare Function MouseOffCallBackBottom (hWnd As Long, uMsg As Long, wParam As Long, lParam As Long) As Long
'
Declare Sub OnClic_AnyMenu (Sender As QMenuItem)
'
Create frmCallBackTest As QForm
    Center
    Width  = 800
    height = 800
    Caption = "Multiple CallBack Test"
    AutoScroll = False
    OnClose = OnClose_frmCallBackTest
    Create rchWinTop AS QRichEdit
        Align = alTop
        Color = &HBEFCCF
        Height = 400
        Font.Name = "courier"
        ReadOnly = False
        WordWrap = False
        ScrollBars = ssBoth
        HideSelection = False
        PlainText = True
        Text = "NoMouse"
    End Create
    Create rchWinBottom AS QRichEdit
        Align = 5
        Font.Name = "courier"
        ReadOnly = False
        WordWrap = False
        ScrollBars = ssBoth
        HideSelection = False
        PlainText = True
    End Create
    Create mnuMain AS QMAINMENU
        Create mnuMouseTopOnOff AS QMENUITEM
            Caption = "&MouseTop_Off"
            OnClick = OnClic_AnyMenu
        End Create
        Create mnuMouseBottomOnOff AS QMENUITEM
            Caption = "&MouseBottom_Off"
            OnClick = OnClic_AnyMenu
        End Create
    End Create
End Create
' *************************************
frmCallBackTest.Show
' *************************************
rchWinTop.LoadFromFile ("TestNoMouse.Bas")
rchWinBottom.LoadFromFile ("TestNoMouse.Bas")
' ---- CREATES AND ACTIVATES THE NEW CALLBACK ----
DefInt iBind_1
Bind iBind_1 To MouseOffCallBackTop
' Create a CallBackForwarder forwarding to iBind_1
DefInt ptrCallBackTop = SetNewCallBack_4 (iBind_1)  ' _4  for 4 Arguments callback, _1, ... _7 available
' Usual line to SubClass the RichEdit Window (Switch to another Window Procedure)
DefInt ptrOldRchWndProcTop = SetWindowLong (rchWinTop.Handle, (-4), ptrCallBackTop)
' no maximum number of callback anymore
'
' Sets the second 4 arguments CallBack for the Bottom RichEdit
DefInt iBind_2
Bind iBind_2 To MouseOffCallBackBottom
DefInt ptrCallBackBottom = SetNewCallBack_4 (iBind_2)
DefInt ptrOldRchWndProcBottom = SetWindowLong (rchWinBottom.Handle, (-4), ptrCallBackBottom)
'
ShowMessage ("THE EFFECT OF THIS RICHEDIT SUBCLASSINGS IS THAT\n\nMOUSE HAS NO EFFECT IN RICHEDIT\n\nCLIC MENU \"MOUSE OFF\" TO RESTABLISH MOUSE IN UPPER/LOWER WINDOW ")
' ------------------------------------------------
' *************************************
frmCallBackTest.Visible = False
frmCallBackTest.ShowModal
' *************************************
' Mouse On/Off in Upper/Lower RichEdit Window
Sub OnClic_AnyMenu (Sender As QMenuItem)
    ' Mouse On/Off in Upper RichEdit Window
    Select Case Sender.Handle
        Case mnuMouseTopOnOff.Handle
            If mnuMouseTopOnOff.Caption = "&MouseTop_Off" Then
                SetWindowLong (rchWinTop.Handle, (-4), ptrOldRchWndProcTop)
                mnuMouseTopOnOff.Caption = "&MouseTop_On"
            Else
                SetWindowLong (rchWinTop.Handle, (-4), ptrCallBackTop)
                mnuMouseTopOnOff.Caption = "&MouseTop_Off"
            End If
        ' Mouse On/Off in Lower RichEdit Window
        Case mnuMouseBottomOnOff.Handle
            If mnuMouseBottomOnOff.Caption = "&MouseBottom_Off" Then
                SetWindowLong (rchWinBottom.Handle, (-4), ptrOldRchWndProcBottom)
                mnuMouseBottomOnOff.Caption = "&MouseBottom_On"
            Else
                SetWindowLong (rchWinBottom.Handle, (-4), ptrCallBackBottom)
                mnuMouseBottomOnOff.Caption = "&MouseBottom_Off"
            End If
    End Select
End Sub
'
Sub OnClose_frmCallBackTest
    Application.Terminate
    End
End Sub
'
' FIRST CALLBACK FUNCTION
Function MouseOffCallBackTop (hWnd As Long, uMsg As Long, wParam As Long, lParam As Long) As Long
    If (uMsg < &H200 Or uMsg > &H20A) Then  ' Message &200 to &H20A are all the Mouse Messages
        ' All messages are processed -passed to the old window proc- except mouse messages
        CallWindowProc (ptrOldRchWndProcTop, hWnd, uMsg, wParam, lParam)
    End  If
End Function
' SECOND CALLBACK FINCTION
Function MouseOffCallBackBottom (hWnd As Long, uMsg As Long, wParam As Long, lParam As Long) As Long
    If (uMsg < &H200 Or uMsg > &H20A) Then  ' Message &200 to &H20A are all the Mouse Messages
        ' All messages are processed -passed to the old window proc- except mouse messages
        CallWindowProc (ptrOldRchWndProcBottom, hWnd, uMsg, wParam, lParam)
    End  If
End Function
' ----------------------------------------------------------------------------
'