I'll take the opportunity to share with the community the code I have been actively sharing with you, Idle... It's slightly more of a heavy-built concept of doing it, and still heavily under development, but it adds another way of doing things:
*Note - The following code is an amalgamation demonstrating a small part of the project I'm working on. It contains only support for Windows operating system at the moment (the GTK/Linux support will be released with the first RC). Scroll to bottom to see how the construction of 'classes' and 'methods' are implemented.
Code: Select all
;------------------------------------------------------------------------------------------
; Title: Utility Code
; Description: Utilities.
; Author(s): Michael R. King (mrking2910@gmail.com)
; Revision: 11 March 2012
; Notes: Part of the Mastiff Framework
;------------------------------------------------------------------------------------------
; - __mfwDQuote -
Macro __mfwDQuot
"
EndMacro
; - Encapsulate in Double Quotes -
Macro __mfwStr(Content)
__mfwDQuot#Content#__mfwDQuot
EndMacro
; - Integer Type -
CompilerIf Defined(Integer, #PB_Structure) = #False
Structure Integer
i.i
EndStructure
CompilerEndIf
; - Platform-Specific Include -
Macro __mfwPlatformInclude(File)
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
XIncludeFile "mfw/msw/" + File
CompilerCase #PB_OS_Linux
XIncludeFile "mfw/gtk/" + File
CompilerEndSelect
EndMacro
; - Common Constants -
Enumeration ;MFW_MOUSEBUTTON
#MFW_MOUSEBUTTON_LEFT
#MFW_MOUSEBUTTON_MIDDLE
#MFW_MOUSEBUTTON_RIGHT
EndEnumeration
Enumeration ;MFW_SCROLL
#MFW_SCROLL_UP
#MFW_SCROLL_DOWN
EndEnumeration
;------------------------------------------------------------------------------------------
; Title: Allocator Library
; Description: Macro to generate memory allocators for structured data object.
; Author(s): Michael R. King (mrking2910@gmail.com)
; Revision: 12 March 2012
; Notes: Part of the Mastiff Framework
;------------------------------------------------------------------------------------------
;XIncludeFile "mfw/utility.pbi"
; - Allocation Mode -
CompilerIf Defined(MFW_ALLOC_USELIST, #PB_Constant) = #False
#MFW_ALLOC_USELIST = #True ; Set as #True to enable allocations to be done using a LinkedList. (Prevent Memory Leaks)
CompilerEndIf
; - Allocator Macro -
Macro mfwCreateAllocator(Struct)
CompilerIf #MFW_ALLOC_USELIST = #True
Global NewList __mfwAllocator_#Struct.Struct()
CompilerEndIf
Procedure.i Struct#_Alloc()
Protected *obj.Struct
CompilerIf #MFW_ALLOC_USELIST = #True
*obj = AddElement(__mfwAllocator_#Struct())
CompilerElse
*obj = AllocateMemory(SizeOf(Struct))
InitializeStructure(*obj, Struct)
CompilerEndIf
CompilerIf Defined(Struct#_Constructor, #PB_Procedure)
Struct#_Constructor(*obj)
CompilerEndIf
ProcedureReturn *obj
EndProcedure
Procedure.a Struct#_Destroy(*obj)
If *obj
CompilerIf Defined(Struct#_Destructor, #PB_Procedure)
Struct#_Destructor(*obj)
CompilerEndIf
CompilerIf #MFW_ALLOC_USELIST = #True
ForEach __mfwAllocator_#Struct()
If @__mfwAllocator_#Struct() = *obj
DeleteElement(__mfwAllocator_#Struct())
ProcedureReturn #True
EndIf
Next
CompilerElse
FreeMemory(*obj)
ProcedureReturn #True
CompilerEndIf
EndIf
ProcedureReturn #False
EndProcedure
Procedure Struct#_DestroyAll()
CompilerIf #MFW_ALLOC_USELIST = #True
ForEach __mfwAllocator_#Struct()
CompilerIf Defined(Struct#_Destructor, #PB_Procedure)
Struct#_Destructor(@__mfwAllocator_#Struct())
CompilerEndIf
Next
ClearList(__mfwAllocator_#Struct())
CompilerElse
mfwDebug(__mfwDQuot#Struct#__mfwDQuot + "_DeleteAll() has no effect when #MFW_ALLOC_USELIST = #False")
CompilerEndIf
EndProcedure
EndMacro
;------------------------------------------------------------------------------------------
; Title: Mastiff Core Library
; Description: Core procedures for use by the rest of the framework.
; Author(s): Michael R. King (mrking2910@gmail.com)
; Revision: 16 March 2012
; Notes: Part of the Mastiff Framework
;------------------------------------------------------------------------------------------
; - Prototypes -
Prototype __mfwCore_Destructor()
; - Global Data -
Structure __mfwGlobData
List *destructor()
EndStructure
Global __mfwGlobal.__mfwGlobData
; - Register Global Destructor -
Procedure mfwAddGlobalDestructor(*Destructor)
With __mfwGlobal
ForEach \destructor()
If \destructor() = *Destructor
ProcedureReturn
EndIf
Next
AddElement(\destructor())
\destructor() = *Destructor
EndWith
EndProcedure
; - Remove Global Destructor -
Procedure mfwRemoveGlobalDestructor(*Destructor)
With __mfwGlobal
ForEach \destructor()
If \destructor() = *Destructor
DeleteElement(\destructor())
ProcedureReturn
EndIf
Next
AddElement(\destructor())
\destructor() = *Destructor
EndWith
EndProcedure
; - Call Global Destructors -
Procedure mfwRelease()
Protected *pDestructor.__mfwCore_Destructor
With __mfwGlobal
ForEach \destructor()
*pDestructor = \destructor()
*pDestructor()
Next
EndWith
EndProcedure
; - End Program -
Macro mfwEnd
mfwRelease()
End
EndMacro
;------------------------------------------------------------------------------------------
; Title: Object Creation Library
; Description: Macros to ease the process of designing interface-based objects.
; Author(s): Michael R. King (mrking2910@gmail.com)
; Revision: 15 March 2012
; Notes: Part of the Mastiff Framework
;------------------------------------------------------------------------------------------
;XIncludeFile "mfw/alloc.pbi"
;XIncludeFile "mfw/core.pbi"
; - Prototypes -
Prototype __mfwObjConstructor(*instance)
Prototype __mfwObjDestructor(*instance)
; - Object Method Info -
Structure __mfwObjMethodInfo
*pFunction
name.s
EndStructure
; - Object Info Structure -
Structure __mfwObjInfo
*pMethodTable
*pParentObjectInfo
*pConstructor.__mfwObjConstructor
*pDestructor.__mfwObjDestructor
List methodList.__mfwObjMethodInfo()
Map *methodMap()
EndStructure
; - Method -
Macro mfwMethod(Object, Method)
__#Object#_#Method
EndMacro
; - Method Pointer -
Macro mfwMethodPtr(Object, Method)
@__#Object#_#Method#()
EndMacro
; - Base Object -
Structure __mfwObjInstance_Base
*pMethodTable
m_isDead.a
*pObjInfo
*m_pRelease
m_objType.s
EndStructure
Interface mfwObject
Release()
TypeOf.s()
EndInterface
; - Base Methods -
Procedure.s mfwMethod(mfwObject, TypeOf)(*this.__mfwObjInstance_Base)
ProcedureReturn *this\m_objType
EndProcedure
Procedure mfwMethod(mfwObject, Release)(*this.__mfwObjInstance_Base)
CallFunctionFast(*this\m_pRelease)
EndProcedure
; - Implement Base Object -
Global __mfwObjInfo_mfwObject.__mfwObjInfo
With __mfwObjInfo_mfwObject
AddElement(\methodList())
\methodList()\name = "Release"
\methodList()\pFunction = @mfwMethod(mfwObject, Release)()
AddElement(\methodList())
\methodList()\name = "TypeOf"
\methodList()\pFunction = @mfwMethod(mfwObject, TypeOf)()
EndWith
; - Object Data Type -
Macro mfwThisType(ObjectName)
__mfwObjInstance_#ObjectName
EndMacro
; - Destruct Object -
Procedure mfwDestructObject(*Object, *Info.__mfwObjInfo)
If *Info\pParentObjectInfo
mfwDestructObject(*Object, *Info\pParentObjectInfo)
EndIf
If *Info\pDestructor
*Info\pDestructor(*Object)
EndIf
EndProcedure
; - Construct Object -
Procedure mfwConstructObject(*Object, *Info.__mfwObjInfo)
If *Info\pParentObjectInfo
mfwConstructObject(*Object, *Info\pParentObjectInfo)
EndIf
If *Info\pConstructor
*Info\pConstructor(*Object)
EndIf
EndProcedure
; - Define Object -
Macro mfwDefineObject(ObjectName)
CompilerIf Defined(__mfwObjInfo_#ObjectName, #PB_Variable) = #False
mfwCreateAllocator(__mfwObjInstance_#ObjectName)
Global __mfwObjInfo_#ObjectName#.__mfwObjInfo
Procedure __mfwObjInfo_#ObjectName#_Destructor()
FreeMemory(__mfwObjInfo_#ObjectName#\pMethodTable)
EndProcedure
mfwAddGlobalDestructor(@__mfwObjInfo_#ObjectName#_Destructor())
__mfwObjInfo_#ObjectName#\pParentObjectInfo = @__mfwObjInfo_mfwObject
ForEach __mfwObjInfo_mfwObject\methodList()
AddElement(__mfwObjInfo_#ObjectName#\methodList())
__mfwObjInfo_#ObjectName#\methodList()\pFunction = __mfwObjInfo_mfwObject\methodList()\pFunction
__mfwObjInfo_#ObjectName#\methodList()\name = __mfwObjInfo_mfwObject\methodList()\name
AddMapElement(__mfwObjInfo_#ObjectName#\methodMap(), __mfwObjInfo_mfwObject\methodList()\name)
__mfwObjInfo_#ObjectName#\methodMap() = @__mfwObjInfo_#ObjectName#\methodList()
Next
Procedure ObjectName#_Release(*object.mfwThisType(ObjectName))
mfwDestructObject(*object, @__mfwObjInfo_#ObjectName)
mfwDestroyObject(ObjectName, *object)
EndProcedure
CompilerElse
CompilerError "Error: Object '" + __mfwStr(ObjectName) + "' already defined"
CompilerEndIf
EndMacro
; - Define Extended Object -
Macro mfwDefineObjectEx(ObjectName, ParentObject)
CompilerIf Defined(__mfwObjInfo_#ObjectName, #PB_Variable) = #False
mfwCreateAllocator(__mfwObjInstance_#ObjectName)
Global __mfwObjInfo_#ObjectName#.__mfwObjInfo
__mfwObjInfo_#ObjectName#\pParentObjectInfo = @__mfwObjInfo_#ParentObject
ForEach __mfwObjInfo_#ParentObject#\methodList()
AddElement(__mfwObjInfo_#ObjectName#\methodList())
__mfwObjInfo_#ObjectName#\methodList()\pFunction = __mfwObjInfo_#ParentObject#\methodList()\pFunction
__mfwObjInfo_#ObjectName#\methodList()\name = __mfwObjInfo_#ParentObject#\methodList()\name
AddMapElement(__mfwObjInfo_#ObjectName#\methodMap(), __mfwObjInfo_#ParentObject#\methodList()\name)
__mfwObjInfo_#ObjectName#\methodMap() = @__mfwObjInfo_#ObjectName#\methodList()
Next
Procedure ObjectName#_Release(*object.mfwThisType(ObjectName))
mfwDestructObject(*object, @__mfwObjInfo_#ObjectName)
mfwDestroyObject(ObjectName, *object)
EndProcedure
CompilerElse
CompilerError "Error: Object '" + __mfwStr(ObjectName) + "' already defined"
CompilerEndIf
EndMacro
; - Implement Method -
Global *__mfwObjInfo_MethodScope.__mfwObjMethodInfo
Macro mfwImplementMethod(ObjectName, Method)
If FindMapElement(__mfwObjInfo_#ObjectName#\methodMap(), __mfwStr(Method)) = #False
LastElement(__mfwObjInfo_#ObjectName#\methodList())
AddElement(__mfwObjInfo_#ObjectName#\methodList())
__mfwObjInfo_#ObjectName#\methodList()\pFunction = @__#ObjectName#_#Method#()
__mfwObjInfo_#ObjectName#\methodList()\name = __mfwStr(Method)
AddMapElement(__mfwObjInfo_#ObjectName#\methodMap(), __mfwStr(Method))
__mfwObjInfo_#ObjectName#\methodMap() = @__mfwObjInfo_#ObjectName#\methodList()
Else
*__mfwObjInfo_MethodScope = __mfwObjInfo_#ObjectName#\methodMap(__mfwStr(Method))
*__mfwObjInfo_MethodScope\pFunction = @__#ObjectName#_#Method#()
EndIf
EndMacro
; - Attribute List Name -
Macro mfwBeginAttributesTable(ObjectName)
Structure __mfwObjInstance_#ObjectName Extends __mfwObjInstance_Base
EndMacro
; - Begin Attributes List (Extended) -
Macro mfwBeginAttributesTableEx(ObjectName, ParentObject)
Structure __mfwObjInstance_#ObjectName Extends __mfwObjInstance_#ParentObject
EndMacro
; - End Attributes List -
Macro mfwEndAttributesTable()
EndStructure
EndMacro
; - Allocate Object Instance -
Macro mfwAllocObject(ObjectName)
__mfwObjInstance_#ObjectName#_Alloc()
EndMacro
Macro mfwDestroyObject(ObjectName, Pointer)
__mfwObjInstance_#ObjectName#_Destroy(Pointer)
EndMacro
; - Initialise Object -
Macro mfwInitialiseObject(ObjectName, Pointer)
Pointer\m_objType = __mfwStr(ObjectName)
Pointer\pMethodTable = __mfwObjInfo_#ObjectName#\pMethodTable
Pointer\m_pRelease = @ObjectName#_Release()
Pointer\pObjInfo = @__mfwObjInfo_#ObjectName
mfwConstructObject(Pointer, @__mfwObjInfo_#ObjectName)
EndMacro
; - Implement Object -
Macro mfwImplementObject(ObjectName, Abstract = #False)
CompilerIf Defined(ObjectName#_New, #PB_Procedure) = #False
CompilerIf Abstract = #False
Procedure.i ObjectName#_New()
Protected.mfwThisType(ObjectName) *obj = mfwAllocObject(ObjectName)
mfwInitialiseObject(ObjectName, *obj)
ProcedureReturn *obj
EndProcedure
CompilerEndIf
CompilerEndIf
__mfwObjInfo_#ObjectName#\pMethodTable = AllocateMemory(ListSize(__mfwObjInfo_#ObjectName#\methodList()) * SizeOf(Integer))
FirstElement(__mfwObjInfo_#ObjectName#\methodList())
ForEach __mfwObjInfo_#ObjectName#\methodList()
PokeI(__mfwObjInfo_#ObjectName#\pMethodTable + (ListIndex(__mfwObjInfo_#ObjectName#\methodList()) * SizeOf(Integer)), __mfwObjInfo_#ObjectName#\methodList()\pFunction)
Next
CompilerIf Defined(ObjectName#_Constructor, #PB_Procedure)
__mfwObjInfo_#ObjectName#\pConstructor = @ObjectName#_Constructor()
CompilerEndIf
CompilerIf Defined(ObjectName#_Destructor, #PB_Procedure)
__mfwObjInfo_#ObjectName#\pDestructor = @ObjectName#_Destructor()
CompilerEndIf
EndMacro
; - TypeOf Function -
Procedure.s mfwTypeOf(*Object)
If *Object
Protected *obj.__mfwObjInstance_Base = *Object
ProcedureReturn *obj\m_objType
EndIf
EndProcedure
;------------------------------------------------------------------------------------------
; Title: Windows Platform UI Code
; Description: Library providing UI routines for Windows based platforms.
; Author(s): Michael R. King (mrking2910@gmail.com)
; Revision: 15 March 2012
; Notes: Part of the Mastiff Framework
; Internal functions.
;------------------------------------------------------------------------------------------
; - Window Handling Procedures -
Procedure __mfwPlatform_UI_Freeze(*hwnd, state)
If *hwnd
If state
ProcedureReturn SendMessage_(*hwnd, #WM_SETREDRAW, #False, 0)
Else
ProcedureReturn SendMessage_(*hwnd, #WM_SETREDRAW, #True, 0)
RedrawWindow_(*hwnd, 0, 0, #RDW_INTERNALPAINT | #RDW_INVALIDATE)
EndIf
EndIf
EndProcedure
Procedure __mfwPlatform_UI_SetProperty(*hwnd, propkey$, *property)
If *hwnd
ProcedureReturn SetProp_(*hwnd, propkey$, *property)
EndIf
EndProcedure
Procedure.i __mfwPlatform_UI_GetProperty(*hwnd, propkey$)
If *hwnd
ProcedureReturn GetProp_(*hwnd, propkey$)
EndIf
ProcedureReturn #Null
EndProcedure
Procedure __mfwPlatform_UI_RemoveProperty(*hwnd, propkey$)
If *hwnd
ProcedureReturn RemoveProp_(*hwnd, propkey$)
EndIf
EndProcedure
Procedure __mfwPlatform_UI_SetOpacity(*hwnd, opacity.f)
If *hwnd
SetWindowLongPtr_(*hwnd, #GWL_EXSTYLE, GetWindowLongPtr_(*hwnd, #GWL_EXSTYLE) | #WS_EX_LAYERED)
SetLayeredWindowAttributes_(*hwnd, 0, 255 * opacity / 1.0, 2)
EndIf
EndProcedure
;------------------------------------------------------------------------------------------
; Title: UI Base Object (Abstract)
; Description: The base object for all UI elements. (Gadgets, Windows)
; Author(s): Michael R. King (mrking2910@gmail.com)
; Revision: 15 March 2012
; Notes: Part of the Mastiff Framework
;------------------------------------------------------------------------------------------
; - Includes -
;XIncludeFile "mfw/object.pbi"
;__mfwPlatformInclude("ui.pbi")
; - UI Object Family -
Enumeration ;MFW_UIFAMILY
#MFW_UIFAMILY_WINDOW
#MFW_UIFAMILY_GADGET
EndEnumeration
; - Standard Event Types -
Enumeration ;MFW_UIEVENT
#MFW_UIEVENT_CLOSE
#MFW_UIEVENT_REDRAW
#MFW_UIEVENT_RESIZE
#MFW_UIEVENT_TAKEFOCUS
#MFW_UIEVENT_LOSEFOCUS
#MFW_UIEVENT_MOUSEENTER
#MFW_UIEVENT_MOUSEMOVE
#MFW_UIEVENT_MOUSELEAVE
#MFW_UIEVENT_MOUSESCROLL
#MFW_UIEVENT_MOUSEDOUBLECLICK
#MFW_UIEVENT_MOUSEDOWN
#MFW_UIEVENT_MOUSEUP
#MFW_UIEVENT_MAXIMISE
#MFW_UIEVENT_MINIMISE ; May not work on Linux.
#MFW_UIEVENT_RESTORE
#MFW_UIEVENT_CLICKED ; (Windows) Requires parent mfwWindow to be specified.
#MFW_UIEVENT_CUSTOM
#MFW_UIEVENT_COUNT ; Do Not Remove.
EndEnumeration
; - Event Handler Prototype -
Prototype p_mfwUIEventHandler(*This, *Event)
; - Event Handler List -
Structure __mfwUI_EvtHandler
List *pHandler()
EndStructure
; - Interface -
Interface mfwUI Extends mfwObject
GetHandle.i()
GetID.i()
GetFamily.a()
SetProperty(Key$, *Property)
GetProperty.i(Key$)
RemoveProperty(Key$)
Freeze(State = #True)
Thaw()
ConnectEvent(Event, *Handler)
DisconnectEvent(Event, *Handler)
PostEvent(*EventData)
EnableEventHandling(State = #True)
SetState(State)
GetState.l()
EndInterface
; - Attributes Table -
mfwBeginAttributesTable(mfwUI)
*m_pHwnd
m_family.w
m_pbID.i
m_mouseIn.a
*m_pOldCB
m_lkwidth.l
m_lkheight.l
m_lkstate.l
Array m_evtHandler.__mfwUI_EvtHandler(#MFW_UIEVENT_COUNT)
mfwEndAttributesTable()
; - Define Object -
mfwDefineObject(mfwUI)
; - Event Structure -
Structure mfwUIEvent
*Control.mfwUI
EventType.l
MouseButton.l
MouseX.l
MouseY.l
MouseScroll.b
Family.l
Width.l
Height.l
EndStructure
; - Event Handling Callback -
;------------------------------------------------------------------------------------------
; Title: Windows Platform UI Callback Code
; Description: Callback function for event handling.
; Author(s): Michael R. King (mrking2910@gmail.com)
; Revision: 15 March 2012
; Notes: Part of the Mastiff Framework
; Internal functions.
;------------------------------------------------------------------------------------------
Procedure __mfwPlatform_UI_Callback(*hWnd, msg, wParam, lParam)
Protected evt.mfwUIEvent
Protected *ctrl.mfwUI = __mfwPlatform_UI_GetProperty(*hWnd, "__mfwUI")
Protected *ctrlChild.mfwUI = #Null
Protected *ctrlData.mfwThisType(mfwUI) = *ctrl
If *ctrl
With evt
\EventType = -1
Select msg
Case #WM_PAINT
\EventType = #MFW_UIEVENT_REDRAW
Case #WM_MOUSEMOVE
If *ctrlData\m_mouseIn = #False
\EventType = #MFW_UIEVENT_MOUSEENTER
*ctrlData\m_mouseIn = #True
Else
\EventType = #MFW_UIEVENT_MOUSEMOVE
EndIf
\MouseX = (lParam & $FFFF)
\MouseY = (lParam >> 16)
Case #WM_MOUSELEAVE
\EventType = #MFW_UIEVENT_MOUSELEAVE
\MouseX = (lParam & $FFFF)
\MouseY = (lParam >> 16)
*ctrlData\m_mouseIn = #False
Case #WM_MOUSEWHEEL
\EventType = #MFW_UIEVENT_MOUSESCROLL
\MouseX = (lParam & $FFFF)
\MouseY = (lParam >> 16)
If wParam > 0
\MouseScroll = #MFW_SCROLL_UP
Else
\MouseScroll = #MFW_SCROLL_DOWN
EndIf
Case #WM_LBUTTONDOWN
\EventType = #MFW_UIEVENT_MOUSEDOWN
\MouseButton = #MFW_MOUSEBUTTON_LEFT
Case #WM_LBUTTONUP
\EventType = #MFW_UIEVENT_MOUSEUP
\MouseButton = #MFW_MOUSEBUTTON_LEFT
Case #WM_LBUTTONDBLCLK
\EventType = #MFW_UIEVENT_MOUSEDOUBLECLICK
\MouseButton = #MFW_MOUSEBUTTON_LEFT
Case #WM_RBUTTONDOWN
\EventType = #MFW_UIEVENT_MOUSEDOWN
\MouseButton = #MFW_MOUSEBUTTON_RIGHT
Case #WM_RBUTTONUP
\EventType = #MFW_UIEVENT_MOUSEUP
\MouseButton = #MFW_MOUSEBUTTON_RIGHT
Case #WM_RBUTTONDBLCLK
\EventType = #MFW_UIEVENT_MOUSEDOUBLECLICK
\MouseButton = #MFW_MOUSEBUTTON_RIGHT
Case #WM_MBUTTONDOWN
\EventType = #MFW_UIEVENT_MOUSEDOWN
\MouseButton = #MFW_MOUSEBUTTON_MIDDLE
Case #WM_MBUTTONUP
\EventType = #MFW_UIEVENT_MOUSEUP
\MouseButton = #MFW_MOUSEBUTTON_MIDDLE
Case #WM_MBUTTONDBLCLK
\EventType = #MFW_UIEVENT_MOUSEDOUBLECLICK
\MouseButton = #MFW_MOUSEBUTTON_MIDDLE
Case #WM_SETFOCUS
\EventType = #MFW_UIEVENT_TAKEFOCUS
Case #WM_KILLFOCUS
\EventType = #MFW_UIEVENT_LOSEFOCUS
Case #WM_NCDESTROY
ProcedureReturn
Case #WM_COMMAND
*ctrlChild = __mfwPlatform_UI_GetProperty(lParam & $FFFF, "__mfwUI")
If *ctrlChild
\EventType = #MFW_UIEVENT_CLICKED
\Control = *ctrlChild
\Family = *ctrlChild\GetFamily()
*ctrlChild\PostEvent(@evt)
EndIf
Case #WM_CLOSE
\EventType = #MFW_UIEVENT_CLOSE
EndSelect
If *ctrl\GetFamily() = #MFW_UIFAMILY_WINDOW
If IsWindow(*ctrlData\m_pbID)
If *ctrlData\m_lkstate <> *ctrl\GetState()
Select *ctrl\GetState()
Case #PB_Window_Maximize
\EventType = #MFW_UIEVENT_MAXIMISE
Case #PB_Window_Minimize
\EventType = #MFW_UIEVENT_MINIMISE
Case #PB_Window_Normal
\EventType = #MFW_UIEVENT_RESTORE
EndSelect
*ctrlData\m_lkstate = *ctrl\GetState()
EndIf
If *ctrlData\m_lkwidth <> WindowWidth(*ctrlData\m_pbID) Or *ctrlData\m_lkheight <> WindowHeight(*ctrlData\m_pbID)
\EventType = #MFW_UIEVENT_RESIZE
*ctrlData\m_lkwidth = WindowWidth(*ctrlData\m_pbID)
*ctrlData\m_lkheight = WindowHeight(*ctrlData\m_pbID)
\Width = *ctrlData\m_lkwidth
\Height = *ctrlData\m_lkheight
EndIf
EndIf
EndIf
If *ctrl\GetFamily() = #MFW_UIFAMILY_GADGET
If IsGadget(*ctrlData\m_pbID)
If *ctrlData\m_lkwidth <> GadgetWidth(*ctrlData\m_pbID) Or *ctrlData\m_lkheight <> GadgetHeight(*ctrlData\m_pbID)
\EventType = #MFW_UIEVENT_RESIZE
*ctrlData\m_lkwidth = GadgetWidth(*ctrlData\m_pbID)
*ctrlData\m_lkheight = GadgetHeight(*ctrlData\m_pbID)
\Width = *ctrlData\m_lkwidth
\Height = *ctrlData\m_lkheight
EndIf
EndIf
EndIf
If \EventType > -1
*ctrl\PostEvent(@evt)
EndIf
EndWith
If *ctrlData\m_pOldCB
ProcedureReturn CallWindowProc_(*ctrlData\m_pOldCB, *hWnd, msg, wParam, lParam)
EndIf
EndIf
EndProcedure
; - Define Methods -
Procedure.i mfwMethod(mfwUI, GetHandle)(*this.mfwThisType(mfwUI))
ProcedureReturn *this\m_pHwnd
EndProcedure
Procedure.i mfwMethod(mfwUI, GetID)(*this.mfwThisType(mfwUI))
ProcedureReturn *this\m_pbID
EndProcedure
Procedure.w mfwMethod(mfwUI, GetFamily)(*this.mfwThisType(mfwUI))
ProcedureReturn *this\m_family
EndProcedure
Procedure mfwMethod(mfwUI, SetProperty)(*this.mfwThisType(mfwUI), Key$, *Property)
ProcedureReturn __mfwPlatform_UI_SetProperty(*this\m_pHwnd, Key$, *Property)
EndProcedure
Procedure mfwMethod(mfwUI, GetProperty)(*this.mfwThisType(mfwUI), Key$)
ProcedureReturn __mfwPlatform_UI_GetProperty(*this\m_pHwnd, Key$)
EndProcedure
Procedure mfwMethod(mfwUI, RemoveProperty)(*this.mfwThisType(mfwUI), Key$)
ProcedureReturn __mfwPlatform_UI_RemoveProperty(*this\m_pHwnd, Key$)
EndProcedure
Procedure mfwMethod(mfwUI, Freeze)(*this.mfwThisType(mfwUI), State = #True)
__mfwPlatform_UI_Freeze(*this\m_pHwnd, State)
EndProcedure
Procedure mfwMethod(mfwUI, Thaw)(*this.mfwThisType(mfwUI))
__mfwPlatform_UI_Freeze(*this\m_pHwnd, #False)
EndProcedure
Procedure mfwMethod(mfwUI, ConnectEvent)(*this.mfwThisType(mfwUI), Event, *Handler)
Protected *inst.mfwUI = *this
If Event > -1 And Event < #MFW_UIEVENT_COUNT And *Handler
*inst\DisconnectEvent(Event, *Handler)
AddElement(*this\m_evtHandler(Event)\pHandler())
*this\m_evtHandler(Event)\pHandler() = *Handler
EndIf
EndProcedure
Procedure mfwMethod(mfwUI, DisconnectEvent)(*this.mfwThisType(mfwUI), Event, *Handler)
If Event > -1 And Event < #MFW_UIEVENT_COUNT And *Handler
ForEach *this\m_evtHandler(Event)\pHandler()
If *this\m_evtHandler(Event)\pHandler() = *Handler
DeleteElement(*this\m_evtHandler(Event)\pHandler())
EndIf
Next
EndIf
EndProcedure
Procedure mfwMethod(mfwUI, PostEvent)(*this.mfwThisType(mfwUI), *EventData)
Protected *evt.mfwUIEvent
Protected *proc.p_mfwUIEventHandler
If *EventData
*evt = *EventData
With *evt
If \EventType > -1 And \EventType < #MFW_UIEVENT_COUNT
\Control = *this
ForEach *this\m_evtHandler(\EventType)\pHandler()
*proc = *this\m_evtHandler(\EventType)\pHandler()
If *proc(*this, *EventData) = #False
ProcedureReturn
EndIf
Next
EndIf
EndWith
EndIf
EndProcedure
Procedure mfwMethod(mfwUI, EnableEventHandling)(*this.mfwThisType(mfwUI), State = #True)
With *this
If State
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
__mfwPlatform_UI_SetProperty(*this\m_pHwnd, "__mfwUI", *this)
\m_pOldCB = SetWindowLongPtr_(\m_pHwnd, #GWL_WNDPROC, @__mfwPlatform_UI_Callback())
CompilerEndSelect
Else
If \m_pOldCB
SetWindowLongPtr_(\m_pHwnd, #GWL_WNDPROC, \m_pOldCB)
\m_pOldCB = #Null
EndIf
EndIf
EndWith
EndProcedure
Procedure mfwMethod(mfwUI, SetState)(*this.mfwThisType(mfwUI), State)
Select *this\m_family
Case #MFW_UIFAMILY_WINDOW
SetWindowState(*this\m_pbID, State)
Case #MFW_UIFAMILY_GADGET
SetGadgetState(*this\m_pbID, State)
EndSelect
EndProcedure
Procedure.l mfwMethod(mfwUI, GetState)(*this.mfwThisType(mfwUI))
Select *this\m_family
Case #MFW_UIFAMILY_WINDOW
ProcedureReturn GetWindowState(*this\m_pbID)
Case #MFW_UIFAMILY_GADGET
ProcedureReturn GetGadgetState(*this\m_pbID)
EndSelect
EndProcedure
; - Implement Methods -
mfwImplementMethod(mfwUI, GetHandle)
mfwImplementMethod(mfwUI, GetID)
mfwImplementMethod(mfwUI, GetFamily)
mfwImplementMethod(mfwUI, SetProperty)
mfwImplementMethod(mfwUI, GetProperty)
mfwImplementMethod(mfwUI, RemoveProperty)
mfwImplementMethod(mfwUI, Freeze)
mfwImplementMethod(mfwUI, Thaw)
mfwImplementMethod(mfwUI, ConnectEvent)
mfwImplementMethod(mfwUI, DisconnectEvent)
mfwImplementMethod(mfwUI, PostEvent)
mfwImplementMethod(mfwUI, EnableEventHandling)
mfwImplementMethod(mfwUI, SetState)
mfwImplementMethod(mfwUI, GetState)
; - Constructor -
Procedure mfwUI_Constructor(*this.mfwThisType(mfwUI))
Protected.mfwUI *instance = *this
With *this
\m_pHwnd = #Null
\m_family = -1
\m_pbID = -1
*instance\SetProperty("__mfwUI", *instance)
EndWith
EndProcedure
; - Implement Object -
mfwImplementObject(mfwUI, #True)
;------------------------------------------------------------------------------------------
; Title: Window Object
; Description: Create a Object/Class supporting a Window.
; Author(s): Michael R. King (mrking2910@gmail.com)
; Revision: 15 March 2012
; Notes: Part of the Mastiff Framework
;------------------------------------------------------------------------------------------
; - Includes -
;XIncludeFile "mfw/ui.pbi"
; - Constants -
#MFW_WINDOW_DEFAULTWIDTH = 400
#MFW_WINDOW_DEFAULTHEIGHT = 300
#MFW_WINDOW_DEFAULTTITLE = "New Window"
#MFW_WINDOW_DEFAULTFLAGS = #PB_Window_ScreenCentered | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget | #PB_Window_SizeGadget | #PB_Window_SystemMenu
#MFW_WINDOW_DEFAULTCOLOUR = -1
; - Object Interface -
Interface mfwWindow Extends mfwUI
Close()
Show()
Hide(State = #True)
Enable()
Disable(State = #True)
AddKeyboardShortcut(Key, MenuItemID)
RemoveKeyboardShortcut(Key)
AddTimer(Timer, Timeout)
RemoveTimer(Timer)
SetTitle(Title$)
GetTitle.s()
SetSmartRefresh(State = #True)
SetBounds(MinimalWidth, MinimalHeight, MaximalWidth, MaximalHeight)
SetActive()
SetOnTop(State = #True)
SetPosition(X, Y)
GetX.l()
GetY.l()
SetSize(Width, Height)
GetWidth.l()
GetHeight.l()
SetOpacity(Opacity.f = 1.0)
SetColour(Color = #MFW_WINDOW_DEFAULTCOLOUR)
GetColour.l()
Minimise()
Maximise()
Restore()
IsActive.a()
EndInterface
; - Attributes Table -
mfwBeginAttributesTableEx(mfwWindow, mfwUI)
m_wndX.l
m_wndY.l
m_wndWidth.l
m_wndHeight.l
m_wndTitle.s
m_wndFlags.l
mfwEndAttributesTable()
; - Global Window List -
Global NewList *__mfwWindow_List.mfwWindow()
; - Process Window Events -
Procedure mfwWindowEvent()
If ListSize(*__mfwWindow_List()) > 0
WindowEvent()
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
; - Global Destructor -
Procedure mfwWindow_ReleaseAll()
Protected *inst.mfwWindow
ForEach *__mfwWindow_List()
*inst = *__mfwWindow_List()
*inst\Close()
*inst\Release()
Next
ClearList(*__mfwWindow_List())
EndProcedure
mfwAddGlobalDestructor(@mfwWindow_ReleaseAll())
; - Set Creation Parameters -
Procedure mfwWindowCreationParams(*Window.mfwWindow, *Parent.mfwWindow = #Null, X = #PB_Ignore, Y = #PB_Ignore, Width = #MFW_WINDOW_DEFAULTWIDTH, Height = #MFW_WINDOW_DEFAULTHEIGHT, Title$ = #MFW_WINDOW_DEFAULTTITLE, Flags = #MFW_WINDOW_DEFAULTFLAGS)
Protected *this.mfwThisType(mfwWindow) = *Window
With *this
\m_wndX = X
\m_wndY = Y
\m_wndWidth = Width
\m_wndHeight = Height
\m_wndTitle = Title$
\m_wndFlags = Flags
EndWith
EndProcedure
; - Define Object -
mfwDefineObjectEx(mfwWindow, mfwUI)
; - Define Methods -
Procedure mfwMethod(mfwWindow, Close)(*this.mfwThisType(mfwWindow))
If IsWindow(*this\m_pbID)
CloseWindow(*this\m_pbID)
ForEach *__mfwWindow_List()
If *__mfwWindow_List() = *this
DeleteElement(*__mfwWindow_List())
Break
EndIf
Next
EndIf
EndProcedure
Procedure mfwMethod(mfwWindow, Show)(*this.mfwThisType(mfwWindow))
If IsWindow(*this\m_pbID)
HideWindow(*this\m_pbID, #False)
EndIf
EndProcedure
Procedure mfwMethod(mfwWindow, Hide)(*this.mfwThisType(mfwWindow), State = #True)
If IsWindow(*this\m_pbID)
HideWindow(*this\m_pbID, State)
EndIf
EndProcedure
Procedure mfwMethod(mfwWindow, Enable)(*this.mfwThisType(mfwWindow))
If IsWindow(*this\m_pbID)
DisableWindow(*this\m_pbID, #False)
EndIf
EndProcedure
Procedure mfwMethod(mfwWindow, Disable)(*this.mfwThisType(mfwWindow), State = #True)
If IsWindow(*this\m_pbID)
DisableWindow(*this\m_pbID, #True)
EndIf
EndProcedure
Procedure mfwMethod(mfwWindow, AddKeyboardShortcut)(*this.mfwThisType(mfwWindow), Key, MenuID)
If IsWindow(*this\m_pbID)
ProcedureReturn AddKeyboardShortcut(*this\m_pHwnd, Key, MenuID)
EndIf
EndProcedure
Procedure mfwMethod(mfwWindow, RemoveKeyboardShortcut)(*this.mfwThisType(mfwWindow), Key)
If IsWindow(*this\m_pbID)
ProcedureReturn RemoveKeyboardShortcut(*this\m_pHwnd, Key)
EndIf
EndProcedure
Procedure mfwMethod(mfwWindow, AddTimer)(*this.mfwThisType(mfwWindow), Timer, Timeout)
If IsWindow(*this\m_pbID)
ProcedureReturn AddWindowTimer(*this\m_pHwnd, Timer, Timeout)
EndIf
EndProcedure
Procedure mfwMethod(mfwWindow, RemoveTimer)(*this.mfwThisType(mfwWindow), Timer)
If IsWindow(*this\m_pbID)
ProcedureReturn RemoveWindowTimer(*this\m_pHwnd, Timer)
EndIf
EndProcedure
Procedure mfwMethod(mfwWindow, SetTitle)(*this.mfwThisType(mfwWindow), Title$)
If IsWindow(*this\m_pbID)
SetWindowTitle(*this\m_pbID, Title$)
EndIf
EndProcedure
Procedure.s mfwMethod(mfwWindow, GetTitle)(*this.mfwThisType(mfwWindow))
If IsWindow(*this\m_pbID)
ProcedureReturn GetWindowTitle(*this\m_pbID)
EndIf
EndProcedure
Procedure mfwMethod(mfwWindow, SetSmartRefresh)(*this.mfwThisType(mfwWindow), State = #True)
If IsWindow(*this\m_pbID)
SmartWindowRefresh(*this\m_pbID, State)
EndIf
EndProcedure
Procedure mfwMethod(mfwWindow, SetBounds)(*this.mfwThisType(mfwWindow), MinimalWidth, MinimalHeight, MaximalWidth, MaximalHeight)
If IsWindow(*this\m_pbID)
WindowBounds(*this\m_pbID, MinimalWidth, MinimalHeight, MaximalWidth, MaximalHeight)
EndIf
EndProcedure
Procedure mfwMethod(mfwWindow, SetActive)(*this.mfwThisType(mfwWindow))
If IsWindow(*this\m_pbID)
SetActiveWindow(*this\m_pbID)
EndIf
EndProcedure
Procedure mfwMethod(mfwWindow, SetOnTop)(*this.mfwThisType(mfwWindow), State = #True)
If IsWindow(*this\m_pbID)
StickyWindow(*this\m_pbID, State)
EndIf
EndProcedure
Procedure mfwMethod(mfwWindow, SetPosition)(*this.mfwThisType(mfwWindow), X, Y)
If IsWindow(*this\m_pbID)
ResizeWindow(*this\m_pbID, X, Y, #PB_Ignore, #PB_Ignore)
EndIf
EndProcedure
Procedure.l mfwMethod(mfwWindow, GetX)(*this.mfwThisType(mfwWindow))
If IsWindow(*this\m_pbID)
ProcedureReturn WindowX(*this\m_pbID)
EndIf
EndProcedure
Procedure.l mfwMethod(mfwWindow, GetY)(*this.mfwThisType(mfwWindow))
If IsWindow(*this\m_pbID)
ProcedureReturn WindowY(*this\m_pbID)
EndIf
EndProcedure
Procedure mfwMethod(mfwWindow, SetSize)(*this.mfwThisType(mfwWindow), Width, Height)
If IsWindow(*this\m_pbID)
ResizeWindow(*this\m_pbID, #PB_Ignore, #PB_Ignore, Width, Height)
EndIf
EndProcedure
Procedure.l mfwMethod(mfwWindow, GetWidth)(*this.mfwThisType(mfwWindow))
If IsWindow(*this\m_pbID)
ProcedureReturn WindowWidth(*this\m_pbID)
EndIf
EndProcedure
Procedure.l mfwMethod(mfwWindow, GetHeight)(*this.mfwThisType(mfwWindow))
If IsWindow(*this\m_pbID)
ProcedureReturn WindowHeight(*this\m_pbID)
EndIf
EndProcedure
Procedure mfwMethod(mfwWindow, SetOpacity)(*this.mfwThisType(mfwWindow), Opacity.f = 1.0)
If IsWindow(*this\m_pbID)
If Opacity < 0.0 : Opacity = 0.0 : EndIf
If Opacity > 1.0 : Opacity = 1.0 : EndIf
__mfwPlatform_UI_SetOpacity(*this\m_pHwnd, Opacity)
EndIf
EndProcedure
Procedure mfwMethod(mfwWindow, SetColour)(*this.mfwThisType(mfwWindow), Colour = #MFW_WINDOW_DEFAULTCOLOUR)
If IsWindow(*this\m_pbID)
SetWindowColor(*this\m_pbID, Colour)
EndIf
EndProcedure
Procedure.l mfwMethod(mfwWindow, GetColour)(*this.mfwThisType(mfwWindow))
If IsWindow(*this\m_pbID)
ProcedureReturn GetWindowColor(*this\m_pbID)
EndIf
EndProcedure
Procedure mfwMethod(mfwWindow, Minimise)(*this.mfwThisType(mfwWindow))
If IsWindow(*this\m_pbID)
SetWindowState(*this\m_pbID, #PB_Window_Minimize)
EndIf
EndProcedure
Procedure mfwMethod(mfwWindow, Maximise)(*this.mfwThisType(mfwWindow))
If IsWindow(*this\m_pbID)
SetWindowState(*this\m_pbID, #PB_Window_Maximize)
EndIf
EndProcedure
Procedure mfwMethod(mfwWindow, Restore)(*this.mfwThisType(mfwWindow))
If IsWindow(*this\m_pbID)
SetWindowState(*this\m_pbID, #PB_Window_Normal)
EndIf
EndProcedure
Procedure.a mfwMethod(mfwWindow, IsActive)(*this.mfwThisType(mfwWindow))
If GetActiveWindow() = *this\m_pbID
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
; - Implement Methods -
mfwImplementMethod(mfwWindow, Close)
mfwImplementMethod(mfwWindow, Show)
mfwImplementMethod(mfwWindow, Hide)
mfwImplementMethod(mfwWindow, Enable)
mfwImplementMethod(mfwWindow, Disable)
mfwImplementMethod(mfwWindow, AddKeyboardShortcut)
mfwImplementMethod(mfwWindow, RemoveKeyboardShortcut)
mfwImplementMethod(mfwWindow, AddTimer)
mfwImplementMethod(mfwWindow, RemoveTimer)
mfwImplementMethod(mfwWindow, SetTitle)
mfwImplementMethod(mfwWindow, GetTitle)
mfwImplementMethod(mfwWindow, SetSmartRefresh)
mfwImplementMethod(mfwWindow, SetBounds)
mfwImplementMethod(mfwWindow, SetActive)
mfwImplementMethod(mfwWindow, SetOnTop)
mfwImplementMethod(mfwWindow, SetPosition)
mfwImplementMethod(mfwWindow, GetX)
mfwImplementMethod(mfwWindow, GetY)
mfwImplementMethod(mfwWindow, SetSize)
mfwImplementMethod(mfwWindow, GetWidth)
mfwImplementMethod(mfwWindow, GetHeight)
mfwImplementMethod(mfwWindow, SetOpacity)
mfwImplementMethod(mfwWindow, SetColour)
mfwImplementMethod(mfwWindow, GetColour)
mfwImplementMethod(mfwWindow, Minimise)
mfwImplementMethod(mfwWindow, Maximise)
mfwImplementMethod(mfwWindow, Restore)
mfwImplementMethod(mfwWindow, IsActive)
; - Constructor -
Procedure mfwWindow_Constructor(*this.mfwThisType(mfwWindow))
With *this
\m_pbID = OpenWindow(#PB_Any, \m_wndX, \m_wndY, \m_wndWidth, \m_wndHeight, \m_wndTitle, \m_wndFlags | #PB_Window_Invisible)
\m_pHwnd = WindowID(\m_pbID)
\m_family = #MFW_UIFAMILY_WINDOW
AddElement(*__mfwWindow_List()) : *__mfwWindow_List() = *this
EndWith
EndProcedure
; - Destructor -
Procedure mfwWindow_Destructor(*this.mfwThisType(mfwWindow))
If IsWindow(*this\m_pbID)
CloseWindow(*this\m_pbID)
EndIf
EndProcedure
; - Allocator -
Procedure mfwWindow_New(*Parent.mfwWindow = #Null, X = #PB_Ignore, Y = #PB_Ignore, Width = #MFW_WINDOW_DEFAULTWIDTH, Height = #MFW_WINDOW_DEFAULTHEIGHT, Title$ = #MFW_WINDOW_DEFAULTTITLE, Flags = #MFW_WINDOW_DEFAULTFLAGS)
Protected.mfwThisType(mfwWindow) *this = mfwAllocObject(mfwWindow)
With *this
\m_wndX = X
\m_wndY = Y
\m_wndWidth = Width
\m_wndHeight = Height
\m_wndTitle = Title$
\m_wndFlags = Flags
EndWith
mfwInitialiseObject(mfwWindow, *this)
ProcedureReturn *this
EndProcedure
; - Implement Object -
mfwImplementObject(mfwWindow)
;------------------------------------------------------------------------------------------
; Title: Form Test
; Description: A demonstration of creating a form object.
; Author(s): Michael R. King (mrking2910@gmail.com)
; Revision: 19 March 2012
;------------------------------------------------------------------------------------------
EnableExplicit
;IncludePath "../include"
; - Include Mastiff Framework -
;XIncludeFile "mfw/window.pbi"
; - Form Object -
Interface MyForm Extends mfwWindow
MyMethod()
OnClose(*Event.mfwUIEvent)
EndInterface
mfwBeginAttributesTableEx(MyForm, mfwWindow)
mfwEndAttributesTable()
mfwDefineObjectEx(MyForm, mfwWindow)
Procedure mfwMethod(MyForm, MyMethod)(*this.mfwThisType(MyForm))
Debug "My Method has been Called!"
EndProcedure
Procedure mfwMethod(MyForm, OnClose)(*this.mfwThisType(MyForm), *Event.mfwUIEvent)
Protected.MyForm *instance = *this
Debug "Window has been Closed!"
*instance\Close()
*instance\Release()
ProcedureReturn #False
EndProcedure
mfwImplementMethod(MyForm, MyMethod)
mfwImplementMethod(MyForm, OnClose)
; - Allocator -
Procedure.i MyForm_New()
Protected.mfwThisType(MyForm) *this = mfwAllocObject(MyForm)
Protected.MyForm *instance = *this
mfwWindowCreationParams(*this, #Null, #PB_Ignore, #PB_Ignore, 800, 600, "Test Form")
mfwInitialiseObject(MyForm, *this)
*instance\SetColour(RGB(128, 64, 64))
*instance\SetSmartRefresh(#True)
*instance\EnableEventHandling(#True)
*instance\ConnectEvent(#MFW_UIEVENT_CLOSE, mfwMethodPtr(MyForm, OnClose))
ProcedureReturn *this
EndProcedure
mfwImplementObject(MyForm)
; - Sample -
Define.MyForm *Form = MyForm_New()
*Form\Show()
*Form\MyMethod()
While mfwWindowEvent()
Wend
mfwRelease()
This 'OOP Layer' supports inheritance, overriding, constructors/destructors, 'typeof', and is hopefully pretty straight forward. The example demonstrates a Window class with built in event handling so all events can be contained within the single window or form class.