Dare I say, once again, that PB already has everything one needs to create classes.
We use classes for every aspect of our applications. It's easy to do and creates well structured code.
The future is already here.
Here's an example. This class works with others to implement a menu structure in the form of a Tree gadget. It uses standard PB features and is cross-platform.
Code: Select all
;===============================================
;
; clsMenuItem.pbi : class methods : MenuItem Class
;
;===============================================
;
; Properties
;
Structure strMenuItem
;
; primary properties
;
FieldPointer(prpVirtualTable) ; 16393 : pointer to the class virtual table
Field(priClassReferenceNumber, typInt32) ; 16447 : the entity number for the class (module, program, package, etc)
Field(exiChildEntryNumber, typInt32) ; 16484 : entry number of the object in the parent child array (1 based)
;
; private dvsam control blocks
;
;
; private file records
;
;
; private file objects
;
;
; private properties
;
Field(priGadgetNumber, typInt32) ; 16402 : assigned by pb using #pb_any
;
; external properties: read/write
;
;
; external properties: read only
;
;
; external properties: write only
;
Field(exsCaption, typString) ; 15328 : caption text
Field(exoParent, objGeneric) ; 16086 : reference to an object's parent
Field(exiMenuLevel, typInt32) ; 16136 : menu level: 0=heading, 1=topic
Field(exoMenuHeading, objMenuItem) ; 16144 : object reference to the associated menu heading
FieldCallBack(expCBAttach) ; 16479 : callback ptr: attach a program object to a panel
FieldCallBack(expCBDetach) ; 16480 : callback ptr: detach a program object from a panel
;
EndStructure
;
;===============================================
;
; Private Declares
;
DeclarePrivateSubroutine(MenuItem, Constructor) (ByVal(Me, strMenuItem))
DeclarePrivateSubroutine(MenuItem, Destructor) (ByVal(Me, strMenuItem))
DeclarePrivateSubroutine(MenuItem, LeftClickEvent) (ByVal(Me, strMenuItem))
DeclarePrivateSubroutine(MenuItem, LeftDoubleClickEvent) (ByVal(Me, strMenuItem))
DeclarePrivateSubroutine(MenuItem, RightClickEvent) (ByVal(Me, strMenuItem))
DeclarePrivateSubroutine(MenuItem, RightDoubleClickEvent) (ByVal(Me, strMenuItem))
DeclarePrivateSubroutine(MenuItem, ChangeEvent) (ByVal(Me, strMenuItem))
DeclarePrivateSubroutine(MenuItem, DragStartEvent) (ByVal(Me, strMenuItem))
;
;===============================================
;
; Primary Methods
;
;-----------------------------------------------
;
ExternalFunction(MenuItem, Create, typObject) ()
;
; Create create a class instance
;
Local(Me, strMenuItem)
Me = AllocateMemory(SizeOf(strMenuItem))
If IsObject(Me)
InitializeStructure(Me, strMenuItem)
Me\prpVirtualTable = LabelPtr(MenuItem, VirtualTable)
ClassCall(MenuItem, Constructor) (Me)
EndIf
ProcedureReturn Me
EndFunction
;
;-----------------------------------------------
;
ExternalFunction(MenuItem, Destroy, typObject) (ByVal(Me, strMenuItem))
;
; Destroy destroy a class instance
;
If IsObject(Me)
ClassCall(MenuItem, Destructor) (Me)
ClearStructure(Me, strMenuItem)
FreeMemory(Me)
EndIf
ProcedureReturn Nothing
EndFunction
;
;-----------------------------------------------
;
ExternalFunction(MenuItem, Class, typInt32) (ByVal(Me, strMenuItem))
;
; Class return the class reference number
;
ProcedureReturn Me\priClassReferenceNumber
EndFunction
;
;-----------------------------------------------
;
; exiChildEntryNumber 16484 : entry number of the object in the parent child array (1 based)
;
ExternalGet(MenuItem, exiChildEntryNumber, typInt32) (ByVal(Me, strMenuItem))
ProcedureReturn Me\exiChildEntryNumber
EndGet
;
ExternalSet(MenuItem, exiChildEntryNumber) (ByVal(Me, strMenuItem), ByVal(bviChildEntryNumber, typInt32))
Me\exiChildEntryNumber = bviChildEntryNumber
EndSet
;
;===============================================
;
; External Methods
;
;-----------------------------------------------
;
ExternalSubroutine(MenuItem, Events) (ByVal(Me, strMenuItem))
;
; Events process gadget events
;
;
Local(iEventType, typInt32)
iEventType = EventType()
Select iEventType
Case #PB_EventType_LeftClick ; left click on an item, or a checkbox was checked/unchecked
ClassCall(MenuItem, LeftClickEvent) (Me)
Case #PB_EventType_LeftDoubleClick
ClassCall(MenuItem, LeftDoubleClickEvent) (Me)
Case #PB_EventType_RightClick
ClassCall(MenuItem, RightClickEvent) (Me)
Case #PB_EventType_RightDoubleClick
ClassCall(MenuItem, RightDoubleClickEvent) (Me)
Case #PB_EventType_Change ; the current item is selected
ClassCall(MenuItem, ChangeEvent) (Me)
Case #PB_EventType_DragStart ; the user tried to start a Drag & Drop operation.
ClassCall(MenuItem, DragStartEvent) (Me)
EndSelect
EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(MenuItem, Resize) (ByVal(Me, strMenuItem))
;
; Resize process a window resize event
;
;
EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(MenuItem, Attach) (ByVal(Me, strMenuItem))
;
; Attach attach this object to the application
;
;
Local(oGenericMenu, objMenu) ; 16108 : generic reference to a menu object
Local(iItemFlags, typInt32) ; 16477 : composite option flags used when creating a pb gadget item
Local(iItemIndex, typInt32) ; 16478 : gadget item index (zero based)
ObjectCall(Me\exoParent, AttachChild) (Me) ; link this object to its parent
iItemIndex = Me\exiChildEntryNumber - 1 ; calculate the menu item index
oGenericMenu = Me\exoParent ; point to the parent menu object
Me\priGadgetNumber = Get(oGenericMenu, exiGadgetNumber) ; get the menu gadget number
iItemFlags = Me\exiMenuLevel ; pick up menu item level
If iItemFlags = #iMENU_LEVEL_QUIT ; if quit specified then treat as topic
iItemFlags = #iMENU_LEVEL_TOPIC
EndIf
AddGadgetItem(Me\priGadgetNumber, iItemIndex, Me\exsCaption, 0, iItemFlags)
SetGadgetItemData(Me\priGadgetNumber, iItemIndex, Me) ; link this object to its gadget item
EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(MenuItem, AttachChild) (ByVal(Me, strMenuItem), ByRef(broChild, objGeneric))
;
; AttachChild attach a child object
;
; broChild 16448 : reference to a child object
;
EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(MenuItem, Detach) (ByVal(Me, strMenuItem))
;
; Detach detach this object from the application
;
;
EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(MenuItem, DetachChild) (ByVal(Me, strMenuItem), ByRef(broChild, objGeneric))
;
; DetachChild detach a child object
;
; broChild 16448 : reference to a child object
;
EndSubroutine
;
;===============================================
;
; Property Methods
;
;-----------------------------------------------
;
; external properties: read/write
;
;-----------------------------------------------
;
; external properties: read only
;
;-----------------------------------------------
;
; external properties: write only
;
;--------
;
ExternalSet(MenuItem, exsCaption) (ByVal(Me, strMenuItem), ByVal(bvsCaption, typString))
Me\exsCaption = bvsCaption
EndSet
;
;--------
;
ExternalSet(MenuItem, exoParent) (ByVal(Me, strMenuItem), ByVal(bvoParent, typObject))
Me\exoParent = bvoParent
EndSet
;
;--------
;
ExternalSet(MenuItem, exiMenuLevel) (ByVal(Me, strMenuItem), ByVal(bviMenuLevel, typInt32))
Me\exiMenuLevel = bviMenuLevel
EndSet
;
;--------
;
ExternalSet(MenuItem, exoMenuHeading) (ByVal(Me, strMenuItem), ByVal(bvoMenuHeading, typObject))
Me\exoMenuHeading = bvoMenuHeading
EndSet
;
;--------
;
ExternalSet(MenuItem, expCBAttach) (ByVal(Me, strMenuItem), ByVal(bviIndex, typInt32), ByVal(bvpCBAttach, typPointer))
Me\expCBAttach(bviIndex) = bvpCBAttach
EndSet
;
;--------
;
ExternalSet(MenuItem, expCBDetach) (ByVal(Me, strMenuItem), ByVal(bviIndex, typInt32), ByVal(bvpCBDetach, typPointer))
Me\expCBDetach(bviIndex) = bvpCBDetach
EndSet
;
;===============================================
;
; Private Methods
;
;-----------------------------------------------
;
PrivateSubroutine(MenuItem, Constructor) (ByVal(Me, strMenuItem))
;
; Constructor class constructor
;
;
;
; auto generated code
;
Me\priClassReferenceNumber = #iCLASS_MOD_MENUITEM ; MenuItem Class
;
; manual code
;
EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(MenuItem, Destructor) (ByVal(Me, strMenuItem))
;
; Destructor class destructor
;
;
;
; manual code
;
;
; auto generated code
;
EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(MenuItem, LeftClickEvent) (ByVal(Me, strMenuItem))
;
; LeftClickEvent an item or checkbox has been left clicked
;
;
Local(iItemIndex, typInt32) ; 16478 : gadget item index (zero based)
Local(iItemState, typInt32) ; 16482 : gadget item state
iItemIndex = Me\exiChildEntryNumber - 1 ; calculate the menu item index
Select Me\exiMenuLevel
Case #iMENU_LEVEL_HEADING
iItemState = GetGadgetItemState(Me\priGadgetNumber, iItemIndex)
If iItemState & #PB_Tree_Expanded
SetGadgetItemState(Me\priGadgetNumber, iItemIndex, #PB_Tree_Collapsed)
Else
SetGadgetItemState(Me\priGadgetNumber, iItemIndex, #PB_Tree_Expanded)
EndIf
Case #iMENU_LEVEL_TOPIC
SetGadgetItemColor(Me\priGadgetNumber, iItemIndex, #PB_Gadget_FrontColor, RGB(255, 0, 0)) ; set caption to red
CallBack(Me\expCBAttach) ; attach the program task
Case #iMENU_LEVEL_QUIT
Set(gloApp, exlQuitApplication, True) ; terminate the application
EndSelect
SetGadgetState(Me\priGadgetNumber, -1) ; remove select state from all menu items
EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(MenuItem, LeftDoubleClickEvent) (ByVal(Me, strMenuItem))
;
; LeftDoubleClickEvent an item has been left double clicked
;
;
SetGadgetState(Me\priGadgetNumber, -1) ; remove select state from all menu items
EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(MenuItem, RightClickEvent) (ByVal(Me, strMenuItem))
;
; RightClickEvent an item has been right clicked
;
;
Local(iItemIndex, typInt32) ; 16478 : gadget item index (zero based)
iItemIndex = Me\exiChildEntryNumber - 1 ; calculate the menu item index
Select Me\exiMenuLevel
Case #iMENU_LEVEL_HEADING
Case #iMENU_LEVEL_TOPIC
SetGadgetItemColor(Me\priGadgetNumber, iItemIndex, #PB_Gadget_FrontColor, RGB(0, 0, 0)) ; set caption to black
CallBack(Me\expCBDetach) ; detach the program task
Case #iMENU_LEVEL_QUIT
EndSelect
SetGadgetState(Me\priGadgetNumber, -1) ; remove select state from all menu items
EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(MenuItem, RightDoubleClickEvent) (ByVal(Me, strMenuItem))
;
; RightDoubleClickEvent an item has been right double clicked
;
;
SetGadgetState(Me\priGadgetNumber, -1) ; remove select state from all menu items
EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(MenuItem, ChangeEvent) (ByVal(Me, strMenuItem))
;
; ChangeEvent an item has been selected
;
;
EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(MenuItem, DragStartEvent) (ByVal(Me, strMenuItem))
;
; DragStartEvent a user drag operation has started
;
;
EndSubroutine
;
;===============================================
;
; Virtual Table
;
DataSection
Label(MenuItem, VirtualTable)
;
; primary methods
;
InterfaceFunc(MenuItem, Destroy)
InterfaceFunc(MenuItem, Class)
InterfaceGetx(MenuItem, exiChildEntryNumber)
InterfaceSetx(MenuItem, exiChildEntryNumber)
;
; external methods
;
InterfaceSubr(MenuItem, Events)
InterfaceSubr(MenuItem, Resize)
InterfaceSubr(MenuItem, Attach)
InterfaceSubr(MenuItem, AttachChild)
InterfaceSubr(MenuItem, Detach)
InterfaceSubr(MenuItem, DetachChild)
;
; external properties: read/write
;
;
; external properties: read only
;
;
; external properties: write only
;
InterfaceSetx(MenuItem, exsCaption)
InterfaceSetx(MenuItem, exoParent)
InterfaceSetx(MenuItem, exiMenuLevel)
InterfaceSetx(MenuItem, exoMenuHeading)
InterfaceSetx(MenuItem, expCBAttach)
InterfaceSetx(MenuItem, expCBDetach)
;
EndDataSection
;
;===============================================
; end of : clsMenuItem.pbi
;===============================================