Code: Select all
;-TOP
; Comment : Module SetGadgetCallback (Windows Only)
; Author : mk-soft
; Version : v0.03
; Created : 10.06.2018
; Updated : 16.02.2020
; Link : https://www.purebasic.fr/english/viewtopic.php?f=12&t=70842
;
; Syntax Callback:
; Procedure GadgetCB(hWnd,uMsg,wParam,lParam)
; Select uMsg
; ;TODO
; EndSelect
; ; Call previous gadget procedure
; ProcedureReturn CallGadgetProc(hWnd,uMsg,wParam,lParam)
; EndProcedure
;
; *****************************************************************************
DeclareModule GadgetCallback
Declare SetGadgetCallback(Gadget, *lpNewFunc)
Declare CallGadgetProc(hWnd, uMsg, wParam, lParam)
EndDeclareModule
Module GadgetCallback
EnableExplicit
; ---------------------------------------------------------------------------
Procedure SetGadgetCallback(Gadget, *lpNewFunc)
Protected hWnd, *lpPrevFunc
hWnd = GadgetID(Gadget)
*lpPrevFunc = GetProp_(hWnd, "PB_PrevFunc")
; Remove exists Callback
If *lpPrevFunc
SetWindowLongPtr_(hWnd, #GWL_WNDPROC, *lpPrevFunc)
RemoveProp_(hWnd, "PB_PrevFunc")
EndIf
; Set new Callback
If *lpNewFunc
*lpPrevFunc = SetWindowLongPtr_(hWnd, #GWL_WNDPROC, *lpNewFunc)
SetProp_(hWnd, "PB_PrevFunc", *lpPrevFunc)
ProcedureReturn *lpPrevFunc
EndIf
ProcedureReturn 0
EndProcedure
; ---------------------------------------------------------------------------
Procedure CallGadgetProc(hWnd, uMsg, wParam, lParam)
Protected result, *lpPrevFunc
*lpPrevFunc = GetProp_(hWnd, "PB_PrevFunc")
If *lpPrevFunc
result = CallWindowProc_(*lpPrevFunc, hWnd, uMsg, wParam, lParam)
EndIf
ProcedureReturn result
EndProcedure
EndModule
; *****************************************************************************
; Example
CompilerIf #PB_Compiler_IsMainFile
EnableExplicit
UseModule GadgetCallback
;- Constant
Enumeration Windows
#Main
EndEnumeration
Enumeration Menus
#Menu
EndEnumeration
Enumeration MenuItems
#MenuExitApplication
EndEnumeration
Enumeration Gadgets
#Splitter
#List
#Edit
EndEnumeration
Enumeration Statusbar
#Status
EndEnumeration
;- Global Variable
Global ExitApplication
;- Functions
Procedure UpdateWindow()
Protected x, y, dx, dy, menu, status
menu = MenuHeight()
If IsStatusBar(#Status)
status = StatusBarHeight(#Status)
Else
status = 0
EndIf
x = 0
y = 0
dx = WindowWidth(#Main)
dy = WindowHeight(#Main) - menu - status
ResizeGadget(#Splitter, x, y, dx, dy)
EndProcedure
; ----
Procedure ListGadgetProc(hWnd,uMsg,wParam,lParam)
Select uMsg
Case #WM_LBUTTONDBLCLK
PostEvent(#PB_Event_Gadget, GetActiveWindow(), GetProp_(hWnd, "pb_id"), #PB_EventType_LeftDoubleClick)
ProcedureReturn 1
EndSelect
ProcedureReturn CallGadgetProc(hWnd,uMsg,wParam,lParam)
EndProcedure
Procedure EditGadgetProc(hWnd,uMsg,wParam,lParam)
Select uMsg
Case #WM_LBUTTONDBLCLK
PostEvent(#PB_Event_Gadget, GetActiveWindow(), GetProp_(hWnd, "pb_id"), #PB_EventType_LeftDoubleClick)
ProcedureReturn 1
Case #WM_RBUTTONDOWN
PostEvent(#PB_Event_Gadget, GetActiveWindow(), GetProp_(hWnd, "pb_id"), #PB_EventType_RightClick)
ProcedureReturn 1
EndSelect
ProcedureReturn CallGadgetProc(hWnd,uMsg,wParam,lParam)
EndProcedure
;- Main
Procedure Main()
Protected event, dx, dy
#WinStyle = #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget
dx = 800
dy = 600
If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, dx, dy, "Main Window", #WinStyle)
; Menu
CreateMenu(#Menu, WindowID(#Main))
MenuTitle("Ablage")
MenuItem(#MenuExitApplication, "Be&enden")
; Gadgets
ListViewGadget(#List, 0, 0, 0, 0)
EditorGadget(#Edit, 0, 0, 0, 0)
SplitterGadget(#Splitter, 0, 0, dx ,dy, #List, #Edit)
SetGadgetState(#Splitter, dy * 2 / 3)
; Statusbar
CreateStatusBar(#Status, WindowID(#Main))
AddStatusBarField(#PB_Ignore)
; For Mac
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
If Not IsMenu(#Menu)
CreateMenu(#Menu, WindowID(#Main))
EndIf
MenuItem(#PB_Menu_About, "")
MenuItem(#PB_Menu_Preferences, "")
CompilerEndIf
; Init
UpdateWindow()
BindEvent(#PB_Event_SizeWindow, @UpdateWindow(), #Main)
; Callback
SetGadgetCallback(#List, @ListGadgetProc()) ; <- Not used
SetGadgetCallback(#Edit, @EditGadgetProc())
; Main Loop
Repeat
event = WaitWindowEvent()
Select event
Case #PB_Event_Menu
Select EventMenu()
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
Case #PB_Menu_About
MessageRequester("Info", "Main Window v1.01")
Case #PB_Menu_Preferences
Case #PB_Menu_Quit
ExitApplication = #True
CompilerEndIf
Case #MenuExitApplication
ExitApplication = #True
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
Case #List
Select EventType()
Case #PB_EventType_LeftDoubleClick
Debug "Left Double Click on ListViewGadget"
EndSelect
Case #Edit
Select EventType()
Case #PB_EventType_LeftDoubleClick
Debug "Left Double Click on EditorGadget"
Case #PB_EventType_RightClick
Debug "Right Click on EditorGadget"
EndSelect
EndSelect
Case #PB_Event_CloseWindow
Select EventWindow()
Case #Main
ExitApplication = #True
EndSelect
EndSelect
Until ExitApplication
EndIf
EndProcedure : Main()
End
CompilerEndIf
;- BOTTOM