PureBoard

Verfasst: **11.05.2017 18:29**

Mit "QueryInterface" kann man ein neues Object über die IID anlegen. Dazu muss die IID für das Object registriert sein oder bei nicht registrieren IID dem aufrufenden Programm bekannt sein.
Im QuerInterface muss natürlich die IID ausgewertet werden welches Object gemeint ist und das Object erstellen.

P.S.
Update v1.24
- Bugfix und Erweiterung Defined Properties

Verfasst: **11.05.2017 18:52**

ich hab gerade nochmal bei QueryInterface nachgelesen.
Bei dir dürfte man es machen. Wenn man ein QueryInterface von ein IDispatch macht und ein IIrgendwas bekommt, dann muss ein Querinterface von IIrgendwas mti IDispatch das "Vorherige" QueryInterface zurückgeben. Das ist bei dir gegeben.
Bei mir leider nicht, weil ich quasi ein neues Objekt hab und das ist dann nicht erlaubt, außer es "verbinden" sich quasi zurück.

Verfasst: **14.05.2017 16:57**

Update v1.25
- Type Date hingefügt
- Code bereinigt

Im diesen Zuge habe ich den ersten Beitrag die Beschreibung überarbeitet

Verfasst: **20.05.2017 17:10**

Update v1.27
- Optimiert: Die Übernahme von Variant zu Purebasic-Variablen
- Hinzugefügt: Datentype Variant für Methoden und Properties

Neu:
- Es gibt neue Macros zum definieren von Properties mit den Datentype Variant und Variant ByRef
- DispInvoke kann jetzt auch den Datentype Variant zurückgeben und als Argument übergeben werden.

Kurzes Beispiel

Code: Alles auswählen

;-TOP

; Example 1-3

IncludeFile "Modul_BaseClassDispatch.pb"

; Create Logfile
ClassCommon::EnableClassDebug()

; *******************************************************************************

DeclareModule ClassExample
  
  UseModule ClassDispatch
  ; Properties
  Structure sClassExample Extends sClassDispatch
    name.s
    data1.variant
    *data2.variant ; It must be allocated memory
    vResult.variant ; Helpbuffer for DispInvoke result of type Variant
  EndStructure
  
  ; Methodes
  Interface iClassExample Extends iClassDispatch
    GetName()
  EndInterface
  
  UnuseModule ClassDispatch
  ; Create new Object
  Declare.i New()
  
EndDeclareModule

Module ClassExample
  
  EnableExplicit
  
  UseModule ClassCommon
  UseModule ClassDispatch
  
  ; Create Class
  NewClass(iClassExample)
  
  ; ---------------------------------------------------------------------------
  
  ; Defined Public Properties
  UseProperty(sClassExample)
  DefineProperty(Name)
  DefinePropertyVariant(data1)
  DefinePropertyVariantByRef(data2)
  
  ; ---------------------------------------------------------------------------
  
  ; Do by new object
  Procedure Init(*this.sClassExample)
    ClassDebug("Init Object ", *this)
    *this\data2 = AllocateStructure(Variant)
  EndProcedure : AsInitalizeObject(Init)
  
  ; ---------------------------------------------------------------------------
  
  ; Do by release object
  Procedure Dispose(*this.sClassExample)
    ClassDebug("Dispose Object ", *this)
    FreeStructure(*this\data2)
  EndProcedure : AsDisposeObject(Dispose)
  
  ; ---------------------------------------------------------------------------
  
  Procedure GetName(*this.sClassExample) ; Result pointer to Variant
    With *this
      SetVariantString(\vResult, \name)
      ProcedureReturn \vResult
    EndWith
  EndProcedure : AsMethodeDisp(GetName, Variant)
  
  ; ---------------------------------------------------------------------------
  
  Procedure New()
    InitObject(sClassExample) ; Do not more
  EndProcedure
  
  ; ---------------------------------------------------------------------------
  
  CheckInterface(iClassExample)
  
EndModule

; ***************************************************************************************

;- Create ClassFactory

EnableExplicit

; Always encapsulate in a procedure
Procedure InitDLL()
  Global ProgramId.s   = "PureExample.Application"
  Global ClassId.s     = ClassCommon::GetGuidString(?CLSID_App)
  Global Description.s = "Purebasic Example COM-DLL"
EndProcedure : InitDLL()

; Own CLSID
DataSection
  CLSID_App:
  Data.l $01AAD4B2
  Data.w $FFFF, $4E08
  Data.b $FF, $FF, $FF, $FF, $60, $FF, $3B, $21
EndDataSection

InitClassFactory(ProgramId, ClassId, Description, ClassExample::@New(), ?CLSID_App)

VBS

dim obj
set obj = createobject("PureExample.Application")

obj.name = now()
msgbox obj.getname()

obj.data1 = time()
obj.data2 = date()

msgbox "(" & obj.data1 & " " & obj.data2 & ")"

obj.data1 = "Purebasic Power"
msgbox obj.data1

set obj = Nothing

Hat sich einiges getan

PureBoard

Modul BaseClass ClassDispatch inklusive ClassFactory

Re: Modul BaseClass ClassDispatch inklusive ClassFactory

Re: Modul BaseClass ClassDispatch inklusive ClassFactory

Re: Modul BaseClass ClassDispatch inklusive ClassFactory

Re: Modul BaseClass ClassDispatch inklusive ClassFactory