- test custom events : OK
- test custom callback : OK
- test default commands : OK
- test default font : OK
- test FreeGadget : OK
- test IsGadget : OK
- test setgadgetdata : OK
- test unicode : OK
- test PB x64 : OK
Code: Select all
;EnableExplicit
CompilerIf Defined(CreateGadget, #PB_Procedure)=0
;{/// STRUCTURES
CompilerIf Defined(GADGET_VT, #PB_Structure)=#False
Structure GADGET_VT ; PB_GadgetVT
GadgetType.i ; gadget type (used by GadgetType command)
SizeOf.i ; Size of structure
*GadgetCallback
*FreeGadget
*GetGadgetState
*SetGadgetState
*GetGadgetText
*SetGadgetText
*AddGadgetItem2
*AddGadgetItem3
*RemoveGadgetItem
*ClearGadgetItemList
*ResizeGadget
*CountGadgetItems
*GetGadgetItemState
*SetGadgetItemState
*GetGadgetItemText
*SetGadgetItemText
*OpenGadgetList2
*GadgetX
*GadgetY
*GadgetWidth
*GadgetHeight
*HideGadget
*AddGadgetColumn
*RemoveGadgetColumn
*GetGadgetAttribute
*SetGadgetAttribute
*GetGadgetItemAttribute2
*SetGadgetItemAttribute2
*SetGadgetColor
*GetGadgetColor
*SetGadgetItemColor2
*GetGadgetItemColor2
*SetGadgetItemData
*GetGadgetItemData
EndStructure
CompilerEndIf
CompilerIf Defined(GADGET, #PB_Structure)=#False
Structure GADGET ; PB_Gadget
hwnd.i ; gadget window handle
*VT.GADGET_VT ; gadget commands
*GadgetData ; gadget data (used by SetGadgetData command)
*OldCallback ; window CALLBACK (used by purebasic CALLBACK)
Dates.i[4] ; .....
EndStructure
CompilerEndIf
CompilerIf Defined(GADGET_PARAMS, #PB_Structure)=#False
Structure GADGET_PARAMS
ID.i ; gadget ID
NewType.i ; gadget custom type
*cmds.GADGET_VT ; gadget custom commands
*NewCallback ; gadget custom CALLBACK
*OldCallback ; gadget purebasic CALLBACK (used by custom CALLBACK)
*customFree ; gadget custom FreeGadget (used by CleanupGadget procedure)
Window_Style.i ; For window creation
Window_ExStyle.i ; For window creation
Window_ClassName.s; For window creation
Window_Text.s ; For window creation
EndStructure
CompilerEndIf
;}
;{/// IMPORTS
Import ""
CompilerIf Defined(*PB_GADGET_OBJECTS, #PB_Variable)=#False
CompilerIf #PB_Compiler_Processor=#PB_Processor_x64
*PB_GADGET_OBJECTS As "PB_Gadget_Objects"
CompilerElse
*PB_GADGET_OBJECTS As "_PB_Gadget_Objects"
CompilerEndIf
CompilerEndIf
CompilerIf Defined(*PB_GADGET_GLOBALS, #PB_Variable)=#False
CompilerIf #PB_Compiler_Processor=#PB_Processor_x64
*PB_GADGET_GLOBALS As "PB_Gadget_Globals"
CompilerElse
*PB_GADGET_GLOBALS As "_PB_Gadget_Globals"
CompilerEndIf
CompilerEndIf
CompilerIf Defined(PB_Object_GetThreadMemory, #PB_Procedure)=#False
PB_Object_GetThreadMemory(*PB_Object)
CompilerEndIf
CompilerIf Defined(PB_Object_GetOrAllocateID, #PB_Procedure)=#False
PB_Object_GetOrAllocateID(*PB_Object, ID)
CompilerEndIf
CompilerIf Defined(CreateGadgetWindow, #PB_Procedure)=#False
CompilerIf #PB_Compiler_Unicode
CompilerIf #PB_Compiler_Processor=#PB_Processor_x64
PB_Gadget_RegisterGadget(ID, *Gadget.GADGET_PARAMS, hwnd, *vt.GADGET_VT) As "PB_Gadget_RegisterGadget_UNICODE@16"
CompilerElse
PB_Gadget_RegisterGadget(ID, *Gadget.GADGET_PARAMS, hwnd, *vt.GADGET_VT) As "_PB_Gadget_RegisterGadget_UNICODE@16"
CompilerEndIf
CompilerElse
PB_Gadget_RegisterGadget(ID, *Gadget.GADGET_PARAMS, hwnd, *vt.GADGET_VT)
CompilerEndIf
CompilerEndIf
CompilerIf Defined(PB_Gadget_SendGadgetCommand, #PB_Procedure)=#False
PB_Gadget_SendGadgetCommand(hwnd, EventType)
CompilerEndIf
EndImport
;}
;{/// MACROS
Macro NewGadgetParams(params, GADGET_PARAMS_TYPE)
Protected params.GADGET_PARAMS_TYPE=AllocateMemory(SizeOf(GADGET_PARAMS_TYPE))
params\cmds=AllocateMemory(SizeOf(GADGET_VT))
EndMacro
Macro GetGadgetParams(params, GADGET_PARAMS_TYPE, hwnd)
Protected params.GADGET_PARAMS_TYPE=GetProp_(hwnd, "GadgetInfo")
EndMacro
;}
;{/// FUNCTIONS
Procedure CleanupGadget(*gadget.GADGET)
Protected *params.GADGET_PARAMS=GetProp_(*gadget\hwnd, "GadgetInfo")
;call custom command for FreeGadget
If *params\customFree
CallFunctionFast(*params\customFree, *gadget)
EndIf
;cleanup memory
RemoveProp_(*gadget\hwnd, "GadgetInfo")
FreeMemory(*params\cmds)
FreeMemory(*params)
EndProcedure
Procedure RegisterGadget(ID, hwnd, *params.GADGET_PARAMS)
Protected *Gadget.GADGET
Protected result
With *params
If hwnd=0 Or ID<#PB_Any : ProcedureReturn #False : EndIf
If *params=0 Or \cmds=0 : ProcedureReturn #False : EndIf
;set custom command for FreeGadget
\customFree=\cmds\FreeGadget
\cmds\FreeGadget=@CleanupGadget()
;set gadget type
\cmds\GadgetType=\NewType
;register gadget ID
*Gadget=PB_Object_GetOrAllocateID(*PB_GADGET_OBJECTS, ID)
result=PB_Gadget_RegisterGadget(ID, *Gadget, hwnd, \cmds)
If Not result : ProcedureReturn #False : EndIf
;register gadget parameters
If ID=#PB_Any
\ID=result
Else
\ID=ID
EndIf
If \NewCallback
\OldCallback=SetWindowLongPtr_(hwnd, #GWL_WNDPROC, \NewCallback)
EndIf
SetProp_(hwnd, "GadgetInfo", *params)
EndWith
ProcedureReturn result
EndProcedure
Procedure CreateGadget(ID, x, y, Width, Height, *params.GADGET_PARAMS)
Protected hInstance=GetModuleHandle_(0)
Protected hwnd
Protected hwndParent
Protected result
;get gadget parent
CompilerIf #PB_Compiler_Version<430
If 0 : CreateGadgetList(0) : EndIf
hwndParent=PeekI(PB_Object_GetThreadMemory(*PB_GADGET_GLOBALS))
CompilerElse
DisableDebugger
hwndParent=UseGadgetList(0)
EnableDebugger
CompilerEndIf
;create gadget window
With *params
hwnd=CreateWindowEx_(\Window_ExStyle, \Window_ClassName, \Window_Text, \Window_Style, x, y, Width, Height, hwndParent, 0, hInstance, 0)
If Not hwnd : ProcedureReturn #False : EndIf
EndWith
;set gadget ID and params
result=RegisterGadget(ID, hwnd, *params)
If Not result : ProcedureReturn #False : EndIf
;set gadget Font
SendMessage_(hwnd, #WM_SETFONT, GetGadgetFont(#PB_Default), #True)
ProcedureReturn result
EndProcedure
;}
CompilerEndIf