http://www.purebasic.com
https://www.purebasic.fr/english/
Code: Select all
Class MyClass
Const = 5
Procedure Plus (var1, var2)
ProcedureReturn var1+var2
EndProcedure
EndClass
Debug MyClass.Const
Debug MyClass.Plus (5, 2)from -> http://www.purearea.net/pb/english/inte ... d_2012.htm14.PureBasic is a procedural language with several extensions. Will you ever support "real" OOP, or a more improved / easier method to (optionally) use it?
No. The command set is not OOP and it won't mix well. Either do a procedural or OOP language, but don't try to do both. It will end up like C++ where clean C++ sources are rare. Most are patches of C and C++.
Modules are coming ! -> http://www.purebasic.fr/english/viewtop ... 486#p98486User_Russian wrote:This is important because in PureBasic, no NameSpace.
Code: Select all
;===============================================
;
; objMenuItem.pbi : class interface : MenuItem Class
;
;-----------------------------------------------
;
DeclareExternalFunction(MenuItem, Create, typObject) ()
;
Interface objMenuItem
;
; primary methods
;
Func(Destroy, typObject) ()
Func(Class, typInt32) ()
Getx(exiChildEntryNumber, typInt32) ()
Setx(exiChildEntryNumber) (ByVal(bviChildEntryNumber, typInt32))
;
; external methods
;
Subr(Events) ()
Subr(Resize) ()
Subr(Attach) ()
Subr(AttachChild) (ByVal(bvoChild, typObject))
Subr(Detach) ()
Subr(DetachChild) (ByVal(bvoChild, typObject))
;
; external properties: read/write
;
;
; external properties: read only
;
;
; external properties: write only
;
Setx(exsCaption) (ByVal(bvsCaption, typString))
Setx(exoParent) (ByVal(bvoParent, typObject))
Setx(exiMenuLevel) (ByVal(bviMenuLevel, typInt32))
Setx(exoMenuHeading) (ByVal(bvoMenuHeading, typObject))
Setx(expCBAttach) (ByVal(bviIndex, typInt32), ByVal(bvpCBAttach, typPointer))
Setx(expCBDetach) (ByVal(bviIndex, typInt32), ByVal(bvpCBDetach, typPointer))
;
EndInterface
;
;===============================================
; end of : objMenuItem.pbi
;===============================================
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
;===============================================
Code: Select all
EnableExplicit
Structure Foo
*vt ;pointer to virtual table as first entry
intFoo.i
EndStructure
;public menthods
Procedure Foo_SetFoo(*this.foo,value.i) ;first parameter is the *this pointer
*this\intFoo = value
EndProcedure
Procedure Foo_GetFoo(*this.foo)
ProcedureReturn *this\intFoo
EndProcedure
;destructor
Procedure Foo_Free(*this.foo)
FreeMemory(*this)
EndProcedure
Interface IFoo ;create interface hides the *this pointer
Get()
Set(value.i)
Free()
EndInterface
DataSection : vtFoo : ;create virtual table
Data.i @Foo_GetFoo()
Data.i @Foo_SetFoo()
Data.i @Foo_Free()
EndDataSection
;contructor
Procedure New_Foo()
Protected *this.foo
*this = AllocateMemory(SizeOf(foo))
If *this
*this\vt = ?vtFoo
ProcedureReturn *this
EndIf
EndProcedure
;user declares inteface
Global *myfoo.ifoo = New_Foo()
If *myfoo
*myfoo\Set(123)
Debug *myfoo\Get()
*myfoo\Free()
EndIf
Even C++ is simpler and cleaner. :lol:idle wrote:There are numerous ways to make classes the stand method is to use interface and a datasection
while it adds a little overhead to your coding it's not really a big deal to implement
Code: Select all
EnableExplicit Structure Foo *vt ;pointer to virtual table as first entry intFoo.i EndStructure ;public menthods Procedure Foo_SetFoo(*this.foo,value.i) ;first parameter is the *this pointer *this\intFoo = value EndProcedure Procedure Foo_GetFoo(*this.foo) ProcedureReturn *this\intFoo EndProcedure ;destructor Procedure Foo_Free(*this.foo) FreeMemory(*this) EndProcedure Interface IFoo ;create interface hides the *this pointer Get() Set(value.i) Free() EndInterface DataSection : vtFoo : ;create virtual table Data.i @Foo_GetFoo() Data.i @Foo_SetFoo() Data.i @Foo_Free() EndDataSection ;contructor Procedure New_Foo() Protected *this.foo *this = AllocateMemory(SizeOf(foo)) If *this *this\vt = ?vtFoo ProcedureReturn *this EndIf EndProcedure ;user declares inteface Global *myfoo.ifoo = New_Foo() If *myfoo *myfoo\Set(123) Debug *myfoo\Get() *myfoo\Free() EndIf
Code: Select all
#include <iostream>
class Foo {
int intFoo;
public:
int Get() {
return intFoo;
}
void Set(int value) {
intFoo = value;
}
};
int main(int argc, char *argv[]) {
Foo myfoo;
myfoo.Set(123);
std::cout << myfoo.Get();
return 0;
}A language supporting OOP natively can boast a simpler and cleaner syntax then using interfaces and explicit virtual tables in PB ?Danilo wrote: Even C++ is simpler and cleaner. :lol:
Hi Boris,BorisTheOld wrote: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.
It is more interesting how many years we still haveFred wrote:PureBasic won't be object oriented, period.