VariantHelper_Include.pb (Updates)

Developed or developing a new product in PureBasic? Tell the world about it.
Post Reply
User avatar
mk-soft
Always Here
Always Here
Posts: 6337
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

VariantHelper_Include.pb (Updates)

Post by mk-soft »

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

Update v2.13
- Chance import param type to integer

Code: Select all

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

Global.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.i,b.i,c.i)
    SafeArrayGetVartype(a.i,b.i)
  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:
Last edited by mk-soft on Thu Apr 27, 2023 11:35 am, edited 1 time in total.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Top
User avatar
mk-soft
Always Here
Always Here
Posts: 6337
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: VariantHelper_Include.pb (Updates)

Post by mk-soft »

Update v2.12
- Change native type of pointer
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Top
User avatar
IceSoft
Addict
Addict
Posts: 1699
Joined: Thu Jun 24, 2004 8:51 am
Location: Germany

Re: VariantHelper_Include.pb (Updates)

Post by IceSoft »

For what is it using?
Belive! C++ version of Puzzle of Mystralia
Bug Planet
<Wrapper>4PB, PB<game>, =QONK=, PetriDish, Movie2Image, PictureManager,...
Top
User avatar
mk-soft
Always Here
Always Here
Posts: 6337
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: VariantHelper_Include.pb (Updates)

Post by mk-soft »

It´s a part of COMatePlus.

For easy way to manage vartype variant and safearray.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Top
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5502
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: VariantHelper_Include.pb (Updates)

Post by Kwai chang caine »

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
User avatar
mk-soft
Always Here
Always Here
Posts: 6337
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: VariantHelper_Include.pb (Updates)

Post by mk-soft »

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: Select all

;-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 ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Top
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5502
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: VariantHelper_Include.pb (Updates)

Post by Kwai chang caine »

Thanks for your answer
; 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
applePi
Addict
Addict
Posts: 1404
Joined: Sun Jun 25, 2006 7:28 pm

Re: VariantHelper_Include.pb (Updates)

Post by applePi »

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
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5502
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: VariantHelper_Include.pb (Updates)

Post by Kwai chang caine »

thanks for the Brave IceSoft and the Brave Kwai chang caine
:lol: :lol: :lol:
Image
ImageThe happiness is a road...
Not a destination
Top
User avatar
IceSoft
Addict
Addict
Posts: 1699
Joined: Thu Jun 24, 2004 8:51 am
Location: Germany

Re: VariantHelper_Include.pb (Updates)

Post by IceSoft »

True heroes often go unrecognized.
Thanks mk-soft.
Belive! C++ version of Puzzle of Mystralia
Bug Planet
<Wrapper>4PB, PB<game>, =QONK=, PetriDish, Movie2Image, PictureManager,...
Top
Post Reply

Return to “Announcement”