It is currently Wed Nov 21, 2018 2:50 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 10 posts ] 
Author Message
 Post subject: VariantHelper_Include.pb (Updates)
PostPosted: Wed Dec 02, 2009 5:40 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 1444
Location: Germany
Bugfix v2.09:
- Macro SA_WORD(...)

Bugfix v2.10:
- Compiler Options for SAFEARRAY

Bugfix v2.11:
- Import for x64
- pData structure

Update v2.12
- Change native type of pointer

Code:
;-TOP
; Kommentar     : Variant Helper
; Author        : mk-soft
; Second Author : ts-soft
; Datei         : VariantHelper_Include.pb
; Version       : 2.12
; Erstellt      : 30.04.2007
; Geändert      : 12.06.2018
;
; Compilermode  :
;
; ***************************************************************************************
;
; Informations:
;
; SafesArray functions and macros supported only array with one dims
;
;
;
;
; ***************************************************************************************

Define.l vhLastError, saLastError


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

CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
  Import "oleaut32.lib"
    SafeArrayAllocDescriptorEx(a.l,b.l,c.l) As "_SafeArrayAllocDescriptorEx@12"
    SafeArrayGetVartype(a.l,b.l) As "_SafeArrayGetVartype@8"
  EndImport
CompilerElse
  Import "oleaut32.lib"
    SafeArrayAllocDescriptorEx(a.l,b.l,c.l)
    SafeArrayGetVartype(a.l,b.l)
  EndImport
CompilerEndIf

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

;- Structure SAFEARRAY
CompilerIf Defined(SAFEARRAYBOUND, #PB_Structure) = 0
  Structure SAFEARRAYBOUND
    cElements.l
    lLbound.l
  EndStructure
CompilerEndIf

CompilerIf Defined(pData, #PB_Structure) = 0
  Structure pData
    StructureUnion
      llVal.q[0]
      lVal.l[0]
      bVal.b[0]
      iVal.w[0]
      fltVal.f[0]
      dblVal.d[0]
      boolVal.w[0]
      bool.w[0]
      scode.l[0]
      cyVal.l[0]
      date.d[0]
      bstrVal.i[0]
      varVal.VARIANT[0] ; Added ?
      Value.VARIANT[0] ; Added ?
      *punkVal.IUnknown[0]
      *pdispVal.IDispatch[0]
      *parray[0]
      *pbVal.BYTE[0]
      *piVal.WORD[0]
      *plVal.LONG[0]
      *pllVal.QUAD[0]
      *pfltVal.FLOAT[0]
      *pdblVal.DOUBLE[0]
      *pboolVal.LONG[0]
      *pbool.LONG[0]
      *pscode.LONG[0]
      *pcyVal.LONG[0]
      *pdate.DOUBLE[0]
      *pbstrVal.INTEGER[0]
      *ppunkVal.INTEGER[0]
      *ppdispVal.INTEGER[0]
      *pparray.INTEGER[0]
      *pvarVal.VARIANT[0]
      *byref[0]
      cVal.b[0]
      uiVal.w[0]
      ulVal.l[0]
      ullVal.q[0]
      intVal.l[0]
      uintVal.l[0]
      *pdecVal.LONG[0]
      *pcVal.BYTE[0]
      *puiVal.WORD[0]
      *pulVal.LONG[0]
      *pullVal.QUAD[0]
      *pintVal.LONG[0]
      *puintVal.LONG[0]
      decVal.l[0]
      brecord.VARIANT_BRECORD[0]
    EndStructureUnion
  EndStructure
CompilerEndIf

CompilerIf Defined(SAFEARRAY, #PB_Structure) = 0
  Structure SAFEARRAY
    cDims.w
    fFeatures.w
    cbElements.l
    cLocks.l
    *pvData.pData
    rgsabound.SAFEARRAYBOUND[0]
  EndStructure
CompilerEndIf

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

;- 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.SAFEARRAY)

  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

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

;- Memory Gabage

Procedure VariantClear(*Var.variant)
 
  Protected hr
 
  If *Var\vt & #VT_ARRAY = #VT_ARRAY
    hr =  SafeArrayDestroy_(*Var\parray)
    If hr = #S_OK
      *Var\parray = 0
      *var\vt = #VT_EMPTY
    EndIf
    ProcedureReturn hr
  Else
    ProcedureReturn VariantClear_(*Var)
  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

Macro V_ARRAY_VARIANT(Arg)
  VariantClear(Arg)
  Arg\vt = #VT_ARRAY | #VT_VARIANT
  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#\pvData\iVal[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

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


Good Time :wink:

_________________
My Projects OOP-BaseClass / OOP-BaseClassDispatch / Event-Designer /
PB v3.30 / v5.60 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
 Post subject: Re: VariantHelper_Include.pb (Updates)
PostPosted: Tue Jun 12, 2018 11:47 am 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 1444
Location: Germany
Update v2.12
- Change native type of pointer

_________________
My Projects OOP-BaseClass / OOP-BaseClassDispatch / Event-Designer /
PB v3.30 / v5.60 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
 Post subject: Re: VariantHelper_Include.pb (Updates)
PostPosted: Wed Jun 13, 2018 6:54 am 
Offline
Addict
Addict
User avatar

Joined: Thu Jun 24, 2004 8:51 am
Posts: 1438
Location: Germany
For what is it using?

_________________
Belive!
<Wrapper>4PB, PB<game>, =QONK=, PetriDish, Movie2Image, PictureManager,...


Top
 Profile  
Reply with quote  
 Post subject: Re: VariantHelper_Include.pb (Updates)
PostPosted: Wed Jun 13, 2018 8:10 am 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 1444
Location: Germany
It´s a part of COMatePlus.

For easy way to manage vartype variant and safearray.

_________________
My Projects OOP-BaseClass / OOP-BaseClassDispatch / Event-Designer /
PB v3.30 / v5.60 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
 Post subject: Re: VariantHelper_Include.pb (Updates)
PostPosted: Wed Jun 13, 2018 10:31 am 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4311
Location: Lyon - France
IceSoft wrote:
For what is it using?
I not dare to ask the same question :oops: :lol:
I have see it's the same name that the COMATE PBI of SROD but i say to me it's perhaps a coincidence :oops:
It's a little bit hard for understand for me, but thanks for sharing 8)

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
 Post subject: Re: VariantHelper_Include.pb (Updates)
PostPosted: Wed Jun 13, 2018 11:19 am 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 1444
Location: Germany
The Variant Helper from me has been included in the complete package of COMatePlus at some point.

Many external functions use the variable type Variant. To simplify the work with Variant I wrote myself this include at some point.

Example
Code:
;-TOP
IncludeFile "VariantHelper_Include.pb"

; Examples

Define.variant var1, var2, var3, var4, var5

; Without helper from PB
var1\vt = #VT_R4
var1\fltVal = 199.99
; With helper
V_FLOAT(var2) = 1.234

; Without helper to PB
If var1\vt = #VT_R4
  r1.f = var1\fltVal
  Debug r1
EndIf

If var2\vt = #VT_R4
  s1.s = StrF(var1\fltVal,4)
  Debug s1
EndIf

Debug "var1:"
; With helper
Debug VT_FLOAT(var1)
Debug VT_LONG(var1)
Debug VT_STR(var1)
Debug "var2:"
Debug VT_FLOAT(var2)
Debug VT_LONG(var2)
Debug VT_STR(var2)

Debug "Date"
v_date(var3) = T_DATE(Date())
Debug vt_str(var3)
Debug "String"
V_STR(var4) = T_BSTR("Hello World")
Debug VT_STR(var4)
Debug "Boolean"
V_BOOL(var5) = T_BOOL(#True)
Debug VT_BOOL(var5)
Debug VT_QUAD(var5)

_________________
My Projects OOP-BaseClass / OOP-BaseClassDispatch / Event-Designer /
PB v3.30 / v5.60 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
 Post subject: Re: VariantHelper_Include.pb (Updates)
PostPosted: Thu Jun 14, 2018 1:15 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4311
Location: Lyon - France
Thanks for your answer
Quote:
; Without helper from PB
var1\vt = #VT_R4
var1\fltVal = 199.99
; With helper
V_FLOAT(var2) = 1.234
Effectively ....now it's clear what your code do :shock: 8)
Again thanks for sharing this code and all your works about the COM and the crazy CROSOFT world 8)

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
 Post subject: Re: VariantHelper_Include.pb (Updates)
PostPosted: Thu Jun 14, 2018 4:56 pm 
Offline
Addict
Addict

Joined: Sun Jun 25, 2006 7:28 pm
Posts: 1327
Quote:
IceSoft wrote:
For what is it using?

Kwai chang caine wrote:
I not dare to ask the same question

me too !!!

thanks mk-soft
and thanks for the Brave IceSoft and the Brave Kwai chang caine


Top
 Profile  
Reply with quote  
 Post subject: Re: VariantHelper_Include.pb (Updates)
PostPosted: Thu Jun 14, 2018 6:45 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4311
Location: Lyon - France
Quote:
thanks for the Brave IceSoft and the Brave Kwai chang caine
:lol: :lol: :lol:
Image

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
 Post subject: Re: VariantHelper_Include.pb (Updates)
PostPosted: Fri Jun 15, 2018 6:00 am 
Offline
Addict
Addict
User avatar

Joined: Thu Jun 24, 2004 8:51 am
Posts: 1438
Location: Germany
True heroes often go unrecognized.
Thanks mk-soft.

_________________
Belive!
<Wrapper>4PB, PB<game>, =QONK=, PetriDish, Movie2Image, PictureManager,...


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 10 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 9 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