It is currently Fri Oct 23, 2020 10:42 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 336 posts ]  Go to page Previous  1 ... 19, 20, 21, 22, 23  Next
Author Message
 Post subject: Re: COMatePLUS version 1.2
PostPosted: Tue Feb 16, 2016 4:49 pm 
Offline
PureBasic Expert
PureBasic Expert

Joined: Wed Oct 29, 2003 4:35 pm
Posts: 10589
Location: Beyond the pale...
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.


Top
 Profile  
Reply with quote  
 Post subject: Re: COMatePLUS version 1.2
PostPosted: Tue Feb 16, 2016 5:12 pm 
Offline
Enthusiast
Enthusiast

Joined: Fri Feb 19, 2010 3:42 am
Posts: 544
Hello srod,
hello RSBasic,

thanks a lot for the quick help!!!

Now I can test the latest beta with my app.


THANKS!!


Top
 Profile  
Reply with quote  
 Post subject: Re: COMatePLUS version 1.2
PostPosted: Tue Feb 16, 2016 6:49 pm 
Offline
Moderator
Moderator

Joined: Thu Dec 31, 2009 11:05 pm
Posts: 1112
Location: Gernsbach (Germany)
New version by srod: http://www.rsbasic.de/backupprogramme/COMatePLUS.zip

@IdeasVacuum
:D

_________________
ImageImageImageImage Image


Top
 Profile  
Reply with quote  
 Post subject: Re: COMatePLUS version 1.2
PostPosted: Tue Feb 16, 2016 7:41 pm 
Offline
PureBasic Expert
PureBasic Expert

Joined: Wed Oct 29, 2003 4:35 pm
Posts: 10589
Location: Beyond the pale...
Thank you Ray. Much appreciated.

_________________
I may look like a mule, but I'm not a complete ass.


Top
 Profile  
Reply with quote  
 Post subject: Re: COMatePLUS version 1.2
PostPosted: Tue Feb 16, 2016 9:22 pm 
Offline
Addict
Addict

Joined: Fri Nov 09, 2012 11:04 pm
Posts: 1785
Location: Uttoxeter, UK
@RSBasic,
Thanks for hosting the Comate Plus.
You've made it nice and easy to download, too. :D

_________________
DE AA EB


Top
 Profile  
Reply with quote  
 Post subject: Re: COMatePLUS version 1.2
PostPosted: Thu Feb 18, 2016 3:19 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4743
Location: Lyon - France
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


Top
 Profile  
Reply with quote  
 Post subject: Re: COMatePLUS version 1.2
PostPosted: Tue Aug 02, 2016 4:49 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Fri Mar 27, 2009 9:41 am
Posts: 754
Location: Athens, Greece
Is it possible to retrieve a running IAccessible object with Comate Plus?


Top
 Profile  
Reply with quote  
 Post subject: Re: COMatePLUS version 1.2
PostPosted: Tue Aug 02, 2016 7:23 pm 
Offline
Enthusiast
Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 573
Location: Almaty (Kazakhstan)
doctorized, did you read this topic viewtopic.php?f=17&t=51303 probably it is same case :)


Top
 Profile  
Reply with quote  
 Post subject: Re: COMatePLUS version 1.2
PostPosted: Tue Aug 02, 2016 7:43 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Fri Mar 27, 2009 9:41 am
Posts: 754
Location: Athens, Greece
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?


Top
 Profile  
Reply with quote  
 Post subject: Re: COMatePLUS version 1.2
PostPosted: Fri May 05, 2017 3:32 am 
Offline
Enthusiast
Enthusiast

Joined: Sun Nov 06, 2005 6:07 am
Posts: 162
Location: Perth Western Australia
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


Top
 Profile  
Reply with quote  
 Post subject: Re: COMatePLUS version 1.2
PostPosted: Fri May 05, 2017 10:43 am 
Offline
PureBasic Expert
PureBasic Expert

Joined: Wed Oct 29, 2003 4:35 pm
Posts: 10589
Location: Beyond the pale...
You can print workbooks or individual sheets/ranges etc.

For a workbook :

Code:
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.


Top
 Profile  
Reply with quote  
 Post subject: Re: COMatePLUS version 1.2
PostPosted: Tue May 19, 2020 2:51 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat Jul 23, 2011 1:13 am
Posts: 304
Location: Germany
Hi srod, RSBasic.
Is Commate+ still available somewhere? The deep-link is dead and I can't find it on RSBasic's webpage

Thanks :)


Top
 Profile  
Reply with quote  
 Post subject: Re: COMatePLUS version 1.2
PostPosted: Wed May 20, 2020 11:41 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Wed Dec 23, 2009 3:26 pm
Posts: 214
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 https://www.purebasic.fr/english/viewtopic.php?f=13&t=74919&hilit=comateplusout,ComatePlus module,it does the same work.
ComatePlus_Residents.pbi
Code:
;/////////////////////////////////////////////////////////////////////////////////
;***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


Top
 Profile  
Reply with quote  
 Post subject: Re: COMatePLUS version 1.2
PostPosted: Wed May 20, 2020 11:43 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Wed Dec 23, 2009 3:26 pm
Posts: 214
Variant_helper.pb
Code:
;-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


Top
 Profile  
Reply with quote  
 Post subject: Re: COMatePLUS version 1.2
PostPosted: Wed May 20, 2020 1:41 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat Jul 23, 2011 1:13 am
Posts: 304
Location: Germany
Thanks, but I'm missing something.

I'm trying this code snippet here and get this error.

Quote:
---------------------------
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:
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.


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 336 posts ]  Go to page Previous  1 ... 19, 20, 21, 22, 23  Next

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 26 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye