COMatePLUS version 1.2

Developed or developing a new product in PureBasic? Tell the world about it.
srod
PureBasic Expert
PureBasic Expert
Posts: 10589
Joined: Wed Oct 29, 2003 4:35 pm
Location: Beyond the pale...

Re: COMatePLUS version 1.2

Post by srod »

It will work with all versions of PB. Well all Windows versions that is. :)
I may look like a mule, but I'm not a complete ass.
HanPBF
Enthusiast
Enthusiast
Posts: 563
Joined: Fri Feb 19, 2010 3:42 am

Re: COMatePLUS version 1.2

Post by HanPBF »

Hello srod,
hello RSBasic,

thanks a lot for the quick help!!!

Now I can test the latest beta with my app.


THANKS!!
User avatar
RSBasic
Moderator
Moderator
Posts: 1218
Joined: Thu Dec 31, 2009 11:05 pm
Location: Gernsbach (Germany)
Contact:

Re: COMatePLUS version 1.2

Post by RSBasic »

New version by srod: http://www.rsbasic.de/backupprogramme/COMatePLUS.zip

@IdeasVacuum
:D
Image
Image
srod
PureBasic Expert
PureBasic Expert
Posts: 10589
Joined: Wed Oct 29, 2003 4:35 pm
Location: Beyond the pale...

Re: COMatePLUS version 1.2

Post by srod »

Thank you Ray. Much appreciated.
I may look like a mule, but I'm not a complete ass.
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: COMatePLUS version 1.2

Post by davido »

@RSBasic,
Thanks for hosting the Comate Plus.
You've made it nice and easy to download, too. :D
DE AA EB
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: COMatePLUS version 1.2

Post by Kwai chang caine »

Yes thanks RSBASIC for your precious big memory site 8)
And obviously for SROD and his MAGICAL COMATE that i use nearly all the days since numerous years 8)
ImageThe happiness is a road...
Not a destination
User avatar
doctorized
Addict
Addict
Posts: 854
Joined: Fri Mar 27, 2009 9:41 am
Location: Athens, Greece

Re: COMatePLUS version 1.2

Post by doctorized »

Is it possible to retrieve a running IAccessible object with Comate Plus?
SeregaZ
Enthusiast
Enthusiast
Posts: 617
Joined: Fri Feb 20, 2009 9:24 am
Location: Almaty (Kazakhstan. not Borat, but Triple G)
Contact:

Re: COMatePLUS version 1.2

Post by SeregaZ »

doctorized, did you read this topic http://www.purebasic.fr/english/viewtop ... 17&t=51303 probably it is same case :)
User avatar
doctorized
Addict
Addict
Posts: 854
Joined: Fri Mar 27, 2009 9:41 am
Location: Athens, Greece

Re: COMatePLUS version 1.2

Post by doctorized »

SeregaZ wrote:doctorized, did you read this topic http://www.purebasic.fr/english/viewtop ... 17&t=51303 probably it is same case :)
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?
leodh
Enthusiast
Enthusiast
Posts: 164
Joined: Sun Nov 06, 2005 6:07 am
Location: Perth Western Australia

Re: COMatePLUS version 1.2

Post by leodh »

Printing Excel worksheet,

I have not used Comate (programmed) for a while.

I can not seem to print an Excel spreadsheet

I thought it was ExcelObject\Invoke("Print()")

but that does work, can someone refresh my memery on how to do it.

Thanks

Leo
Regards
Leo
srod
PureBasic Expert
PureBasic Expert
Posts: 10589
Joined: Wed Oct 29, 2003 4:35 pm
Location: Beyond the pale...

Re: COMatePLUS version 1.2

Post by srod »

You can print workbooks or individual sheets/ranges etc.

For a workbook :

Code: Select all

Workbook\Invoke("PrintOut(1, 1, 1, #True)")
The parameters are : (from, to, copies, showPrintPreview). There are additional optional parameters for printing to files etc.
I may look like a mule, but I'm not a complete ass.
User avatar
Derren
Enthusiast
Enthusiast
Posts: 313
Joined: Sat Jul 23, 2011 1:13 am
Location: Germany

Re: COMatePLUS version 1.2

Post by Derren »

Hi srod, RSBasic.
Is Commate+ still available somewhere? The deep-link is dead and I can't find it on RSBasic's webpage

Thanks :)
User avatar
leonhardt
Enthusiast
Enthusiast
Posts: 220
Joined: Wed Dec 23, 2009 3:26 pm

Re: COMatePLUS version 1.2

Post by leonhardt »

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 :)
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.
ComatePlus_Residents.pbi

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
;/////////////////////////////////////////////////////////////////////////////////
poor English...

PureBasic & Delphi & VBA
User avatar
leonhardt
Enthusiast
Enthusiast
Posts: 220
Joined: Wed Dec 23, 2009 3:26 pm

Re: COMatePLUS version 1.2

Post by leonhardt »

Variant_helper.pb

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 

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

poor English...

PureBasic & Delphi & VBA
User avatar
Derren
Enthusiast
Enthusiast
Posts: 313
Joined: Sat Jul 23, 2011 1:13 am
Location: Germany

Re: COMatePLUS version 1.2

Post by Derren »

Thanks, but I'm missing something.

I'm trying this code snippet here and get this error.
---------------------------
PureBasic
---------------------------
The procedure 'COMate_CreateObject()' has been declared but not defined.
---------------------------
OK
---------------------------

Taken from: http://www.jose.it-berater.org/smfforum ... pic=5107.0

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



Sorry, I'm new to the world of COM, just looking for an easy way to replace my "write VB code to a *.vbs file and run in" code-parts.
Post Reply