Re: COMatePLUS version 1.2
Posted: Tue Feb 16, 2016 4:49 pm
It will work with all versions of PB. Well all Windows versions that is.
http://www.purebasic.com
https://www.purebasic.fr/english/
Yes, I have seen it and you can see posts of mine there, a few days ago. It didn't help. I think that in my case something more is needed but what?SeregaZ wrote:doctorized, did you read this topic http://www.purebasic.fr/english/viewtop ... 17&t=51303 probably it is same case
Code: Select all
Workbook\Invoke("PrintOut(1, 1, 1, #True)")
the ComatePlus.pbi is too large to post here,you can check this viewtopic.php?f=13&t=74919&hilit=comateplusout,ComatePlus module,it does the same work.Derren wrote:Hi srod, RSBasic.
Is Commate+ still available somewhere? The deep-link is dead and I can't find it on RSBasic's webpage
Thanks
Code: Select all
;/////////////////////////////////////////////////////////////////////////////////
;***COMatePLUS*** COM OLE automation through iDispatch.
;*===========
;*
;*©nxSoftWare (www.nxSoftware.com) 2009.
;*======================================
;*
;*Header file.
;/////////////////////////////////////////////////////////////////////////////////
#COMate_UnknownObjectType = 1 ;Use this with the GetObjectProperty() method when the object type does not inherit from iDispatch.
;In such cases, the method will return the interface pointer directly (as opposed to a COMate object!)
;The following constant is used with the SetEventHandler() method of the COMateObject class in order to set an optional
;'global' handler for all events (useful for examining which events are being sent etc.)
;This is in addition to any individual handlers which are called after this global one.
#COMate_CatchAllEvents = ""
;The following enumeration is used with the SetEventHandler() method of the COMateObject class to specify the return type
;(if any) of an individual event.
Enumeration
#COMate_NoReturn
#COMate_IntegerReturn
#COMate_RealReturn
#COMate_StringReturn
#COMate_OtherReturn ;This is a special case; please see the COMate manual for details (SetEventHandler()).
#COMate_VariantReturn = #COMate_OtherReturn ;Alias!
#COMate_UnknownReturn = #COMate_OtherReturn ;Alias!
EndEnumeration
;/////////////////////////////////////////////////////////////////////////////////
;-Declaration of 'Public' functions.
Declare.i COMate_CreateObject(progID$, hWnd = 0, blnInitCOM = #True)
Declare.i COMate_GetObject(file$, progID$="", blnInitCOM = #True)
Declare.i COMate_WrapCOMObject(object.iUnknown)
;Statement functions.
Declare.i COMate_PrepareStatement(command$) ;Returns a statement handle or zero if an error.
Declare.i COMate_GetStatementParameter(hStatement, index) ;Returns, if successful, a direct pointer to the appropriate variant structure.
;Index is 1-based.
Declare COMate_FreeStatementHandle(hStatement)
;The two error retrieval functions are completely threadsafe in that, for example, 2 threads could be working with the same COMate object
;and any resuting errors will be stored separately so that one thread's errors will not conflict with another's etc.
Declare.i COMate_GetLastErrorCode()
Declare.s COMate_GetLastErrorDescription()
;OCX (ActiveX) functions.
Declare.i COMate_RegisterCOMServer(dllName$, blnInitCOM = #True)
Declare.i COMate_UnRegisterCOMServer(dllName$, blnInitCOM = #True)
Declare.i COMate_CreateActiveXControl(x, y, width, height, progID$, blnInitCOM = #True)
;Miscellaneous.
Declare.i COMate_GetIIDFromName(name$, *iid.IID)
;/////////////////////////////////////////////////////////////////////////////////
;/////////////////////////////////////////////////////////////////////////////////
;-Class interfaces.
;The following interface details the class methods for COMateObject type objects; the main object type for COMate.
Interface COMateObject
;General methods.
;=================================
Invoke.i(command$, *hStatement=0)
;Returns a HRESULT value. #S_OK for no errors.
Release() ;DO NOT use this until all enumeration objects attached to this object have been freed.
CreateEnumeration.i(command$, *hStatement=0)
;Returns an object of type COMateEnumObject (see below) or zero if an error.
GetCOMObject.i() ;Returns the COMate object's underlying iDispatch object pointer. AddRef() is called on this object
;so the developer must call Release() at some point.
GetContainerhWnd.i(returnCtrlID=0)
;In the case of an ActiveX control, this methods returns either the handle of the container used
;to house the control or the Purebasic gadget#. Returning the gadget# is only viable if using COMate
;as a source code include (or a Tailbitten library!)
SetDesignTimeMode.i(state=#True);In the case of an ActiveX control, this methods attempts to set a design time mode.
;Returns a HRESULT value. #S_OK for no errors.
;Get property methods.
;=================================
GetDateProperty.i(command$, *hStatement=0)
;Returns a PB date value. Of course you can always retrieve a data in string form using GetStringProperty() etc.
GetIntegerProperty.q(command$, *hStatement=0)
;Returns a signed quad which can of course be placed into any integer variable; byte, word etc.
GetObjectProperty.i(command$, *hStatement=0, objectType = #VT_DISPATCH)
;Returns a COMate object or an iUnknown interface pointer depending on the value of the 'objectType' parameter.
;For 'regular' objects based upon iDispatch, leave the optional parameter 'objectType' as it is.
;Otherwise, for unknown object types set objectType to equal #COMate_UnknownObjectType. In these cases,
;this method will return the interface pointer directly (as opposed to a COMate object).
;In either case the object should be released as soon as it is no longer required.
GetRealProperty.d(command$, *hStatement=0)
;Returns a double value which can of course be placed into any floating point variable; float or double.
GetStringProperty.s(command$, *hStatement=0)
GetVariantProperty.i(command$, *hStatement=0)
;For those returns which are not directly supported by the COMate functions.
;The user must use VariantClear_() and FreeMemory() when finished with the variant returned by this method.
;Set property methods.
;=================================
SetProperty.i(command$, *hStatement=0)
;Returns a HRESULT value. #S_OK for no errors.
SetPropertyRef.i(command$, *hStatement=0)
;Returns a HRESULT value. #S_OK for no errors.
CompilerIf Defined(COMATE_NOINCLUDEATL, #PB_Constant)=0
;Event handler methods.
;=================================
SetEventHandler.i(eventName$, callback, returnType = #COMate_NORETURN, *riid.IID=0)
;eventName$ = "" to set an optional handler which will receive all events (useful for examining which events are sent).
;This is in addition to any individual handlers which are called after this 'global' one.
;Returns a HRESULT value. #S_OK for no errors. Set callback = 0 to remove an existing event handler.
GetIntegerEventParam.q(index) ;Only valid to call this during an event handler. Index is a 1-based index.
GetObjectEventParam.i(index, objectType = #VT_DISPATCH)
;Only valid to call this during an event handler. Index is a 1-based index.
;The object returned is NOT in the form of a COMate object. Use COMate_WrapCOMObject() to convert to
;a COMate object if required.
;User must call Release() on this object when done.
GetRealEventParam.d(index) ;Only valid to call this during an event handler. Index is a 1-based index.
GetStringEventParam.s(index) ;Only valid to call this during an event handler. Index is a 1-based index.
IsEventParamPassedByRef.i(index, *ptrParameter.INTEGER=0, *ptrVariant.INTEGER=0)
;Returns zero or a variant #VT_... type constant (minus the #VT_BYREF modifier).
;In the latter case, and if *ptrParameter is non-zero, then the address of the underlying parameter
;is placed into this buffer, enabling the client application to modify the parameter etc.
CompilerEndIf
EndInterface
;The following interface details the class methods for COMateEnumObject type objects.
;Instances of these objects are used to enumerate collections of objects (or variants) exposed by a COM object.
;These objects are created through the CreateEnumeration() method of the COMateObject class (see above).
Interface COMateEnumObject
GetNextObject.i() ;Returns a 'COMateObject' object (or zero if the enumeration is complete).
;The user must use the Release() method on this object when it is no longer required.
GetNextVariant.i() ;Returns a pointer to a variant (or zero if there are no more).
;The user must use VariantClear_() and FreeMemory() when finished with the variant returned by this method.
Reset.i() ;Resets the enumeration back to the beginning. NOTE that there is no guarantee that a second run
;through the underlying collection will produce the same results. Imagine a collection of files in a
;folder for example in which some can be deleted between enumerations etc.
;Returns a HRESULT value. #S_OK for no errors.
Release()
EndInterface
;/////////////////////////////////////////////////////////////////////////////////
Code: Select all
;-TOP
; Kommentar : Variant Helper
; Author : mk-soft
; Second Author : ts-soft
; Third Author : srod
; Datei : VariantHelper_Include.pb
; Version : 2.08
; Erstellt : 30.04.2007
; Ge鋘dert : 23.10.2008
;
; Compilermode :
;
; ***************************************************************************************
;
; Informations:
;
; SafesArray functions and macros supported only array with one dims
;
;
;
;
; ***************************************************************************************
Define.l vhLastError, saLastError
; ***************************************************************************************
Import "oleaut32.lib"
SafeArrayAllocDescriptorEx(a.l,b.l,c.l) As "_SafeArrayAllocDescriptorEx@12"
SafeArrayGetVartype(a.l,b.l) As "_SafeArrayGetVartype@8"
EndImport
; ***************************************************************************************
;- Structure SAFEARRAY
;Structure SAFEARRAYBOUND
; cElements.l
; lLbound.l
;EndStructure
Structure pData
StructureUnion
bVal.b[0]; AS BYTE ' VT_UI1
iVal.w[0]; AS INTEGER ' VT_I2
lVal.l[0]; AS LONG ' VT_I4
llVal.q[0]; AS QUAD ' VT_I8
fltVal.f[0]; AS SINGLE ' VT_R4
dblVal.d[0]; AS DOUBLE ' VT_R8
boolVal.w[0]; AS INTEGER ' VT_BOOL
scode.l[0]; AS LONG ' VT_ERROR
cyVal.l[0]; AS LONG ' VT_CY
date.d[0]; AS DOUBLE ' VT_DATE
bstrVal.l[0]; AS LONG ' VT_BSTR
punkVal.l[0]; AS DWORD ' VT_UNKNOWN
pdispVal.l[0]; AS DWORD ' VT_DISPATCH
parray.l[0]; AS DWORD ' VT_ARRAY|*
Value.Variant[0];
EndStructureUnion
EndStructure
;Structure SAFEARRAY
; cDims.w
; fFeatures.w
; cbElements.l
; cLocks.l
; *pvData.pData
; rgsabound.SAFEARRAYBOUND[0]
;EndStructure
; ***************************************************************************************
;- Type Constants helps for Variant and SafeArray
#TLong = #VT_I4
#TQuad = #VT_I8
#TWord = #VT_I2
#TFloat = #VT_R4
#TDouble = #VT_R8
#TString = #VT_BSTR
#TDate = #VT_DATE
; ***************************************************************************************
;- Errorhandling
; ***************************************************************************************
Procedure.l vhGetLastError()
Shared vhLastError
ProcedureReturn vhLastError
EndProcedure
; ***************************************************************************************
Procedure.s vhGetLastMessage()
Shared vhLastError
Protected *Buffer, len, result.s
len = FormatMessage_(#FORMAT_MESSAGE_ALLOCATE_BUFFER|#FORMAT_MESSAGE_FROM_SYSTEM,0,vhLastError,0,@*Buffer,0,0)
If len
result = PeekS(*Buffer)
LocalFree_(*Buffer)
ProcedureReturn result
Else
ProcedureReturn "Errorcode: " + Hex(vhLastError)
EndIf
EndProcedure
; ***************************************************************************************
Procedure.l saGetLastError()
Shared saLastError
ProcedureReturn saLastError
EndProcedure
; ***************************************************************************************
Procedure.s saGetLastMessage()
Shared saLastError
Protected *Buffer, len, result.s
len = FormatMessage_(#FORMAT_MESSAGE_ALLOCATE_BUFFER|#FORMAT_MESSAGE_FROM_SYSTEM,0,saLastError,0,@*Buffer,0,0)
If len
result = PeekS(*Buffer)
LocalFree_(*Buffer)
ProcedureReturn result
Else
ProcedureReturn "Errorcode: " + Hex(saLastError)
EndIf
EndProcedure
; ***************************************************************************************
;- SafeArray Functions
; ***************************************************************************************
Procedure saCreateSafeArray(vartype, Lbound, Elements)
Shared saLastError
Protected rgsabound.SAFEARRAYBOUND, *psa
rgsabound\lLbound = Lbound
rgsabound\cElements = Elements
saLastError = 0
*psa = SafeArrayCreate_(vartype, 1, rgsabound)
If *psa
ProcedureReturn *psa
Else
saLastError = #E_OUTOFMEMORY
ProcedureReturn 0
EndIf
EndProcedure
; ***************************************************************************************
Procedure saFreeSafeArray(*psa)
Shared saLastError
Protected hr
saLastError = 0
hr = SafeArrayDestroy_(*psa)
If hr = #S_OK
ProcedureReturn #True
Else
saLastError = hr
ProcedureReturn #False
EndIf
EndProcedure
; ***************************************************************************************
Procedure saGetVartype(*psa)
Shared saLastError
Protected hr, vartype
saLastError = 0
hr = SafeArrayGetVartype(*psa, @vartype)
If hr = #S_OK
ProcedureReturn vartype
Else
saLastError = hr
ProcedureReturn 0
EndIf
EndProcedure
; ***************************************************************************************
Procedure.l saCount(*psa.safearray) ; Result Count of Elements
Protected result.l
If *psa
result = *psa\rgsabound\cElements
Else
result = 0
EndIf
ProcedureReturn result
EndProcedure
; ***************************************************************************************
Procedure.l saLBound(*psa.safearray) ; Result first number of Array
Shared saLastError
Protected hr, result
saLastError = 0
hr = SafeArrayGetLBound_(*psa, 1, @result)
If hr = #S_OK
ProcedureReturn result
Else
saLastError = hr
ProcedureReturn 0
EndIf
EndProcedure
; ***************************************************************************************
Procedure.l saUBound(*psa.safearray) ; Result last number of Array
Shared saLastError
Protected hr, result
saLastError = 0
hr = SafeArrayGetUBound_(*psa, 1, @result)
If hr = #S_OK
ProcedureReturn result
Else
saLastError = hr
ProcedureReturn 0
EndIf
EndProcedure
; ***************************************************************************************
;- Type Conversion Helper
; ***************************************************************************************
;-T_BSTR
Procedure helpSysAllocString(*Value)
ProcedureReturn SysAllocString_(*Value)
EndProcedure
Prototype.l ProtoSysAllocString(Value.p-unicode)
Global T_BSTR.ProtoSysAllocString = @helpSysAllocString()
; ***************************************************************************************
Procedure.d T_DATE(pbDate) ; Result Date from PB-Date
Protected date.d
date = pbDate / 86400.0 + 25569.0
ProcedureReturn date
EndProcedure
; ***************************************************************************************
Procedure T_BOOL(Assert) ; Result Variant Type Boolean
If Assert
ProcedureReturn #VARIANT_TRUE
Else
ProcedureReturn #VARIANT_FALSE
EndIf
EndProcedure
; ***************************************************************************************
;- Conversion Variant to PB Values
; ***************************************************************************************
Procedure.s VT_STR(*Var.Variant)
Shared vhLastError.l
Protected hr.l, result.s, VarDest.Variant
vhLastError = 0
If *Var
hr = VariantChangeType_(VarDest, *Var, 0, #VT_BSTR)
If hr = #S_OK
result = PeekS(VarDest\bstrVal, #PB_Any, #PB_Unicode)
VariantClear_(VarDest)
ProcedureReturn result
Else
vhLastError = hr
ProcedureReturn ""
EndIf
EndIf
EndProcedure
; ***************************************************************************************
Procedure.l VT_BOOL(*Var.Variant)
Shared vhLastError.l
Protected hr.l, result.l, VarDest.Variant
vhLastError = 0
If *Var
hr = VariantChangeType_(VarDest, *Var, 0, #VT_BOOL)
If hr = #S_OK
result = VarDest\boolVal
VariantClear_(VarDest)
If result
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
Else
vhLastError = hr
ProcedureReturn 0
EndIf
EndIf
EndProcedure
; ***************************************************************************************
Procedure.b VT_BYTE(*Var.Variant)
Shared vhLastError.l
Protected hr.l, result.b, VarDest.Variant
vhLastError = 0
If *Var
hr = VariantChangeType_(VarDest, *Var, 0, #VT_I1)
If hr = #S_OK
result = VarDest\bVal
VariantClear_(VarDest)
ProcedureReturn result
Else
vhLastError = hr
ProcedureReturn 0
EndIf
EndIf
EndProcedure
; ***************************************************************************************
Procedure.w VT_WORD(*Var.Variant)
Shared vhLastError.l
Protected hr.l, result.w, VarDest.Variant
vhLastError = 0
If *Var
hr = VariantChangeType_(VarDest, *Var, 0, #VT_I2)
If hr = #S_OK
result = VarDest\iVal
VariantClear_(VarDest)
ProcedureReturn result
Else
vhLastError = hr
ProcedureReturn 0
EndIf
EndIf
EndProcedure
; ***************************************************************************************
Procedure.l VT_LONG(*Var.Variant)
Shared vhLastError.l
Protected hr.l, result.l, VarDest.Variant
vhLastError = 0
If *Var
hr = VariantChangeType_(VarDest, *Var, 0, #VT_I4)
If hr = #S_OK
result = VarDest\lVal
VariantClear_(VarDest)
ProcedureReturn result
Else
vhLastError = hr
ProcedureReturn 0
EndIf
EndIf
EndProcedure
; ***************************************************************************************
Procedure.q VT_QUAD(*Var.Variant)
Shared vhLastError.l
Protected hr.l, result.q, VarDest.Variant
vhLastError = 0
If *Var
hr = VariantChangeType_(VarDest, *Var, 0, #VT_I8)
If hr = #S_OK
result = VarDest\llVal
VariantClear_(VarDest)
ProcedureReturn result
Else
vhLastError = hr
ProcedureReturn 0
EndIf
EndIf
EndProcedure
; ***************************************************************************************
Procedure.f VT_FLOAT(*Var.Variant)
Shared vhLastError.l
Protected hr.l, result.f, VarDest.Variant
vhLastError = 0
If *Var
hr = VariantChangeType_(VarDest, *Var, 0, #VT_R4)
If hr = #S_OK
result = VarDest\fltVal
VariantClear_(VarDest)
ProcedureReturn result
Else
vhLastError = hr
ProcedureReturn 0
EndIf
EndIf
EndProcedure
; ***************************************************************************************
Procedure.d VT_DOUBLE(*Var.Variant)
Shared vhLastError.l
Protected hr.l, result.d, VarDest.Variant
vhLastError = 0
If *Var
hr = VariantChangeType_(VarDest, *Var, 0, #VT_R8)
If hr = #S_OK
result = VarDest\dblVal
VariantClear_(VarDest)
ProcedureReturn result
Else
vhLastError = hr
ProcedureReturn 0
EndIf
EndIf
EndProcedure
; ***************************************************************************************
Procedure.l VT_DATE(*Var.Variant) ; Result PB-Date from Variant Date
Shared vhLastError.l
Protected pbDate
Protected hr.l, result.d, VarDest.Variant
vhLastError = 0
If *Var
hr = VariantChangeType_(VarDest, *Var, 0, #VT_DATE)
If hr = #S_OK
pbDate = (VarDest\dblVal - 25569.0) * 86400.0
VariantClear_(VarDest)
ProcedureReturn pbDate
Else
vhLastError = hr
ProcedureReturn 0
EndIf
EndIf
EndProcedure
; ***************************************************************************************
Procedure.l VT_ARRAY(*Var.Variant) ; Result a Pointer to SafeArray
Protected result.l
vhLastError = 0
If *Var
If (*Var\vt & #VT_ARRAY) = #VT_ARRAY
result = *Var\parray
Else
result = 0
EndIf
Else
result = 0
EndIf
ProcedureReturn result
EndProcedure
; ***************************************************************************************
;- Converions PB Values to Variant
; ***************************************************************************************
Macro V_EMPTY(Arg)
VariantClear_(Arg)
EndMacro
; ***************************************************************************************
Macro V_NULL(Arg)
VariantClear_(Arg)
Arg\vt = #VT_NULL
Arg\llVal
EndMacro
; ***************************************************************************************
Macro V_DISP(Arg)
VariantClear_(Arg)
Arg\vt = #VT_DISPATCH
Arg\ppdispVal
EndMacro
; ***************************************************************************************
Macro V_UNKNOWN(Arg)
VariantClear_(Arg)
Arg\vt = #VT_UNKNOWN
Arg\punkVal
EndMacro
; ***************************************************************************************
Macro V_STR(Arg)
VariantClear_(Arg)
Arg\vt = #VT_BSTR
Arg\bstrVal
EndMacro
; ***************************************************************************************
Macro V_BOOL(Arg)
VariantClear_(Arg)
Arg\vt = #VT_BOOL
Arg\boolVal
EndMacro
; ***************************************************************************************
Macro V_BYTE(Arg)
VariantClear_(Arg)
Arg\vt = #VT_I1
Arg\bVal
EndMacro
; ***************************************************************************************
Macro V_UBYTE(Arg)
VariantClear_(Arg)
Arg\vt = #VT_UI1
Arg\bVal
EndMacro
; ***************************************************************************************
Macro V_WORD(Arg)
VariantClear_(Arg)
Arg\vt = #VT_I2
Arg\iVal
EndMacro
; ***************************************************************************************
Macro V_UWORD(Arg)
VariantClear_(Arg)
Arg\vt = #VT_UI2
Arg\iVal
EndMacro
; ***************************************************************************************
Macro V_LONG(Arg)
VariantClear_(Arg)
Arg\vt = #VT_I4
Arg\lVal
EndMacro
; ***************************************************************************************
Macro V_ULONG(Arg)
VariantClear_(Arg)
Arg\vt = #VT_UI4
Arg\lVal
EndMacro
; ***************************************************************************************
Macro V_QUAD(Arg)
VariantClear_(Arg)
Arg\vt = #VT_I8
Arg\llVal
EndMacro
; ***************************************************************************************
Macro V_FLOAT(Arg)
VariantClear_(Arg)
Arg\vt = #VT_R4
Arg\fltVal
EndMacro
; ***************************************************************************************
Macro V_DOUBLE(Arg)
VariantClear_(Arg)
Arg\vt = #VT_R8
Arg\dblVal
EndMacro
; ***************************************************************************************
Macro V_DATE(Arg)
VariantClear_(Arg)
Arg\vt = #VT_DATE
Arg\dblVal
EndMacro
; ***************************************************************************************
Macro V_VARIANT(Arg)
VariantClear_(Arg)
Arg\vt = #VT_VARIANT
Arg\pvarVal
EndMacro
; ***************************************************************************************
Macro V_NULL_BYREF(Arg)
VariantClear_(Arg)
Arg\vt = #VT_BYREF | #VT_NULL
Arg\pllVal
EndMacro
; ***************************************************************************************
Macro V_DISP_BYREF(Arg)
VariantClear_(Arg)
Arg\vt = #VT_BYREF | #VT_DISPATCH
Arg\ppdispVal
EndMacro
; ***************************************************************************************
Macro V_UNKNOWN_BYREF(Arg)
VariantClear_(Arg)
Arg\vt = #VT_BYREF | #VT_UNKNOWN
Arg\ppunkVal
EndMacro
; ***************************************************************************************
Macro V_STR_BYREF(Arg)
VariantClear_(Arg)
Arg\vt = #VT_BYREF | #VT_BSTR
Arg\pbstrVal
EndMacro
; ***************************************************************************************
Macro V_BOOL_BYREF(Arg)
VariantClear_(Arg)
Arg\vt = #VT_BYREF | #VT_BOOL
Arg\pboolVal
EndMacro
; ***************************************************************************************
Macro V_BYTE_BYREF(Arg)
VariantClear_(Arg)
Arg\vt = #VT_BYREF | #VT_I1
Arg\pbVal
EndMacro
; ***************************************************************************************
Macro V_UBYTE_BYREF(Arg)
VariantClear_(Arg)
Arg\vt = #VT_BYREF | #VT_UI1
Arg\pbVal
EndMacro
; ***************************************************************************************
Macro V_WORD_BYREF(Arg)
VariantClear_(Arg)
Arg\vt = #VT_BYREF | #VT_I2
Arg\piVal
EndMacro
; ***************************************************************************************
Macro V_UWORD_BYREF(Arg)
VariantClear_(Arg)
Arg\vt = #VT_BYREF | #VT_UI2
Arg\piVal
EndMacro
; ***************************************************************************************
Macro V_LONG_BYREF(Arg)
VariantClear_(Arg)
Arg\vt = #VT_BYREF | #VT_I4
Arg\plVal
EndMacro
; ***************************************************************************************
Macro V_ULONG_BYREF(Arg)
VariantClear_(Arg)
Arg\vt = #VT_BYREF | #VT_UI4
Arg\plVal
EndMacro
; ***************************************************************************************
Macro V_QUAD_BYREF(Arg)
VariantClear_(Arg)
Arg\vt = #VT_BYREF | #VT_I8
Arg\pllVal
EndMacro
; ***************************************************************************************
Macro V_FLOAT_BYREF(Arg)
VariantClear_(Arg)
Arg\vt = #VT_BYREF | #VT_R4
Arg\pfltVal
EndMacro
; ***************************************************************************************
Macro V_DOUBLE_BYREF(Arg)
VariantClear_(Arg)
Arg\vt = #VT_BYREF | #VT_R8
Arg\pdblVal
EndMacro
; ***************************************************************************************
Macro V_DATE_BYREF(Arg)
VariantClear_(Arg)
Arg\vt = #VT_BYREF | #VT_DATE
Arg\pdblVal
EndMacro
; ***************************************************************************************
;- Conversion SafeArray
; ***************************************************************************************
Macro V_ARRAY_DISP(Arg)
VariantClear_(Arg)
Arg\vt = #VT_ARRAY |#VT_DISPATCH
Arg\ppdispVal
EndMacro
; ***************************************************************************************
Macro V_ARRAY_STR(Arg)
VariantClear_(Arg)
Arg\vt = #VT_ARRAY | #VT_BSTR
Arg\parray
EndMacro
; ***************************************************************************************
Macro V_ARRAY_BOOL(Arg)
VariantClear_(Arg)
Arg\vt = #VT_ARRAY | #VT_BOOL
Arg\parray
EndMacro
; ***************************************************************************************
Macro V_ARRAY_BYTE(Arg)
VariantClear_(Arg)
Arg\vt = #VT_ARRAY | #VT_I1
Arg\parray
EndMacro
; ***************************************************************************************
Macro V_ARRAY_UBYTE(Arg)
VariantClear_(Arg)
Arg\vt = #VT_ARRAY | #VT_UI1
Arg\parray
EndMacro
; ***************************************************************************************
Macro V_ARRAY_WORD(Arg)
VariantClear_(Arg)
Arg\vt = #VT_ARRAY | #VT_I2
Arg\parray
EndMacro
; ***************************************************************************************
Macro V_ARRAY_UWORD(Arg)
VariantClear_(Arg)
Arg\vt = #VT_ARRAY | #VT_UI2
Arg\parray
EndMacro
; ***************************************************************************************
Macro V_ARRAY_LONG(Arg)
VariantClear_(Arg)
Arg\vt = #VT_ARRAY | #VT_I4
Arg\parray
EndMacro
; ***************************************************************************************
Macro V_ARRAY_ULONG(Arg)
VariantClear_(Arg)
Arg\vt = #VT_ARRAY | #VT_UI4
Arg\parray
EndMacro
; ***************************************************************************************
Macro V_ARRAY_QUAD(Arg)
VariantClear_(Arg)
Arg\vt = #VT_ARRAY | #VT_I8
Arg\parray
EndMacro
; ***************************************************************************************
Macro V_ARRAY_FLOAT(Arg)
VariantClear_(Arg)
Arg\vt = #VT_ARRAY | #VT_R4
Arg\parray
EndMacro
; ***************************************************************************************
Macro V_ARRAY_DOUBLE(Arg)
VariantClear_(Arg)
Arg\vt = #VT_ARRAY | #VT_R8
Arg\parray
EndMacro
; ***************************************************************************************
Macro V_ARRAY_DATE(Arg)
VariantClear_(Arg)
Arg\vt = #VT_ARRAY | #VT_DATE
Arg\parray
EndMacro
; ***************************************************************************************
;- Macros for Safearray to get and put values
; ***************************************************************************************
Macro SA_BYTE(psa, index)
psa#\pvData\bVal[index-psa#\rgsabound\lLbound]
EndMacro
; ***************************************************************************************
Macro SA_WORD(psa, index)
psa#\pvDataiVal[index-psa#\rgsabound\lLbound]
EndMacro
; ***************************************************************************************
Macro SA_LONG(psa, index)
psa#\pvData\lVal[index-psa#\rgsabound\lLbound]
EndMacro
; ***************************************************************************************
Macro SA_FLOAT(psa, index)
psa#\pvData\fltVal[index-psa#\rgsabound\lLbound]
EndMacro
; ***************************************************************************************
Macro SA_DOUBLE(psa, index)
psa#\pvData\dblVal[index-psa#\rgsabound\lLbound]
EndMacro
; ***************************************************************************************
Macro SA_DATE(psa, index)
psa#\pvData\dblVal[index-psa#\rgsabound\lLbound]
EndMacro
; ***************************************************************************************
Macro SA_BSTR(psa, index)
psa#\pvData\bStrVal[index-psa#\rgsabound\lLbound]
EndMacro
; ***************************************************************************************
Procedure.s SA_STR(*psa.safearray, index) ; Result PB-String from SafeArray BSTR
Protected *BSTR
*BSTR = *psa\pvData\bStrVal[index-*psa\rgsabound\lLbound]
ProcedureReturn PeekS(*BSTR, #PB_Any, #PB_Unicode)
EndProcedure
; ***************************************************************************************
Macro SA_VARIANT(psa, index)
psa#\pvData\Value[index-psa#\rgsabound\lLbound]
EndMacro
; ***************************************************************************************
Macro SA_DISPATCH(psa, index)
psa#\pvData\pdispVal[index-psa#\rgsabound\lLbound]
EndMacro
; ***************************************************************************************
---------------------------
PureBasic
---------------------------
The procedure 'COMate_CreateObject()' has been declared but not defined.
---------------------------
OK
---------------------------
Code: Select all
Define.COMateObject ExcelObject, WorkBook
ExcelObject = COMate_CreateObject("Excel.Application")
If ExcelObject
If ExcelObject\SetProperty("Visible = #True") = #S_OK
WorkBook = ExcelObject\GetObjectProperty("Workbooks\Add")
If WorkBook
ExcelObject\SetProperty("Cells(1,1) = 'Hello'")
ExcelObject\SetProperty("Cells(1,2) = 'from'")
ExcelObject\SetProperty("Cells(1,3) = 'COMate!'")
ExcelObject\Invoke("Quit()")
WorkBook\Release()
EndIf
EndIf
ExcelObject\Release()
Else
MessageRequester("COMate -Excel demo", "Couldn't create the application object!")
EndIf