Update v1.22
- Entfernt: Macro AsNewMethod. Nicht erforderlich das Macro AsMethod dasselbe macht.
- Hinzugefügt: Macro AsMethodeDisp. Erstellt zusätzlich die erforderliche Funktion Disp[MethodeName](...)*
* Für das automatische erstellen der DispInvoke Methode benötigt das Macro die Type information des Rückgabewerte und der zu übergebenen Argumente. Es können bis zu 8 Standard Variablen übergeben werde.
Schlüsselnamen für den Type des Rückgabewertes (tResult)
- Void, Object, Bool, Integer, Long, Float, Double, String
Schlüsselnamen für die Typen der Argumente (tArgX)
- Bool, Integer, Long, Float, Double, String
Beispiel 4
Code: Alles auswählen
;-TOP
IncludeFile "Modul_BaseClassDispatch.pb"
; Create Logfile
ClassCommon::EnableClassDebug()
; *******************************************************************************
DeclareModule ClassTextObject
UseModule ClassDispatch
Structure sClassTextObject Extends sClassDispatch
text.s
EndStructure
Interface iClassTextObject Extends iClassDispatch
Upper.s()
Lower.s()
Reverse.s()
EndInterface
UnuseModule ClassDispatch
Declare.i New(Text.s)
EndDeclareModule
Module ClassTextObject
EnableExplicit
UseModule ClassCommon
UseModule ClassDispatch
NewClass(iClassTextObject)
; ---------------------------------------------------------------------------
; Format: Text = Object.Upper
Procedure.s Upper(*this.sClassTextObject) ; Result String
ProcedureReturn UCase(*this\text)
EndProcedure : AsMethodeDisp(Upper, String)
; ---------------------------------------------------------------------------
; Format: Text = Object.Lower
Procedure.s Lower(*this.sClassTextObject) ; Result String
ProcedureReturn LCase(*this\text)
EndProcedure : AsMethodeDisp(Lower, String)
; ---------------------------------------------------------------------------
; Format : Text = Object.Reverse
Procedure.s Reverse(*this.sClassTextObject) ; Result String
ProcedureReturn ReverseString(*this\text)
EndProcedure : AsMethodeDisp(Reverse, String)
; ---------------------------------------------------------------------------
Procedure Init(*this.sClassTextObject)
ClassDebug("Init TextObject", *this)
EndProcedure : AsInitalizeObject(Init)
Procedure Dispose(*this.sClassTextObject)
ClassDebug("Dispose TextObject", *this)
EndProcedure : AsDisposeObject(Dispose)
; ---------------------------------------------------------------------------
Procedure New(text.s)
Protected *obj.sClassTextObject
AllocateObject(*obj, sClassTextObject)
If *obj
*obj\text = text
InitalizeObject(*obj)
EndIf
ProcedureReturn *obj
EndProcedure
; ---------------------------------------------------------------------------
CheckInterface(iClassTextObject)
EndModule
; ***************************************************************************************
DeclareModule ClassText
UseModule ClassDispatch
Structure sClassText Extends sClassDispatch
EndStructure
Interface iClassText Extends iClassDispatch
Text(String.s)
EndInterface
UnuseModule ClassDispatch
Declare.i New()
EndDeclareModule
Module ClassText
EnableExplicit
UseModule ClassCommon
UseModule ClassDispatch
NewClass(iClassText)
; ---------------------------------------------------------------------------
; Object = obj.Text("String")
Procedure Text(*this.iClassText, String.s) ; Result: Object of iClassTextObject
ProcedureReturn ClassTextObject::New(String)
EndProcedure : AsMethodeDisp(Text, Object, String)
; ---------------------------------------------------------------------------
Procedure New()
InitObject(sClassText)
EndProcedure
; ---------------------------------------------------------------------------
CheckInterface(iClassText)
EndModule
; ***************************************************************************************
;- Test as DLL
CompilerIf #PB_Compiler_Debugger
Debug "Test with Purebasic code"
ClassDispatch::ShowClasses()
*obj.ClassText::iClassText = ClassText::New()
*obj2.ClassTextObject::iClassTextObject = *obj\Text("Hello World")
Debug *obj2\Upper()
Debug *obj2\Lower()
Debug *obj2\Reverse()
*obj2\Release()
*obj\Release()
CompilerElse
; Create DLL
EnableExplicit
Procedure InitDLL()
Global ProgramId.s = "PureExample4.Application"
Global ClassId.s = ClassCommon::GetGuidString(?CLSID_App); "{01AAD4B2-FFFF-4E08-FFFF-FFFF60FF3B24}"
Global Description.s = "Purebasic Example 4 with simple object"
EndProcedure : InitDLL()
DataSection
CLSID_App:
Data.l $01AAD4B2
Data.w $FFFF, $4E08
Data.b $FF, $FF, $FF, $FF, $60, $FF, $3B, $24
EndDataSection
InitClassFactory(ProgramId, ClassId, Description, ClassText::@New(), ?CLSID_App)
CompilerEndIf
VBS:
dim obj, obj2
set obj = createobject("PureExample4.Application")
set obj2 = obj.text("Hello World")
msgbox obj2.Upper
msgbox obj2.Lower
msgbox obj2.Reverse
msgbox obj.text("purebasic ").Upper & obj.text("rewoP").Reverse
set obj = Nothing
