Verfasst: 30.04.2007 16:36
UPDATE Variant Helper
Der DispHelper funktioniert soweit sehr Gut.
Es gibt aber Probleme Werte zu übergeben die nicht von Type LONG sind.
Der PB-Compiler für eine Formatumwandlung durch.
Es gibt leider keinen Type VOID oder ANY bei PB
Man kann aber die Parameter als Type Variant "%v" übergeben.
Hier die Hilfsfunktionen um mit Variant einfach arbeiten zu können
und ein Beispiel mit Excel.
Code: VariantHelper2.pb
Code: Excel.pb
FF 
Der DispHelper funktioniert soweit sehr Gut.
Es gibt aber Probleme Werte zu übergeben die nicht von Type LONG sind.
Der PB-Compiler für eine Formatumwandlung durch.
Es gibt leider keinen Type VOID oder ANY bei PB
Man kann aber die Parameter als Type Variant "%v" übergeben.
Hier die Hilfsfunktionen um mit Variant einfach arbeiten zu können
und ein Beispiel mit Excel.
Code: VariantHelper2.pb
Code: Alles auswählen
;-TOP
; Kommentar : Variant Helper
; Author : mk-soft
; Second Author :
; Datei : VariantHelper_Include.pb
; Version : 2.03
; Erstellt : 30.04.2007
; Geändert :
;
; Compilermode :
;
; ***************************************************************************************
Define.l vhLastError
; ***************************************************************************************
;- 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
; ***************************************************************************************
; UNICODE / ASCII Helper for SysAllocString
Procedure helpSysAllocString(*Value)
ProcedureReturn SysAllocString_(*Value)
EndProcedure
Prototype.l ProtoSysAllocString(Value.p-unicode)
;-T_BSTR
Global T_BSTR.ProtoSysAllocString = @helpSysAllocString()
; ***************************************************************************************
Procedure.d T_DATE(pbDate)
Protected date.d
date = pbDate / 86400.0 + 25569.0
ProcedureReturn date
EndProcedure
; ***************************************************************************************
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, len - 2)
LocalFree_(*Buffer)
ProcedureReturn result
Else
ProcedureReturn "Errorcode: " + Hex(vhLastError)
EndIf
EndProcedure
; ***************************************************************************************
Procedure.s VT_STR(*Var.Variant)
Shared vhLastError.l
Protected vargDest.variant, hr, result.s
If *Var
hr = VariantChangeType_(vargDest, *Var, #LOCALE_NOUSEROVERRIDE, #VT_BSTR)
If hr = #S_OK
result = PeekS(vargDest\bstrVal, #PB_Any, #PB_Unicode)
VariantClear_(vargDest)
ProcedureReturn result
Else
vhLastError = hr
ProcedureReturn ""
EndIf
EndIf
EndProcedure
; ***************************************************************************************
Procedure.l VT_BOOL(*Var.Variant)
Shared vhLastError.l
Protected result.l
If *Var
Select *Var\vt
Case #VT_BOOL
result = *Var\boolVal
Case #VT_I1, #VT_UI1
result = *Var\bVal
Case #VT_I2, #VT_UI2
result = *Var\iVal
Case #VT_I4, #VT_UI4
result = *Var\lVal
Case #VT_I8, #VT_UI8
result = *Var\llVal
Case #VT_R4
result = *Var\fltVal
Case #VT_R8
*Var\dblVal
Default
vhLastError = $80020008
result = 0
EndSelect
If result
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndIf
EndProcedure
; ***************************************************************************************
Procedure.b VT_BYTE(*Var.Variant)
Shared vhLastError.l
If *Var
Select *Var\vt
Case #VT_BOOL
ProcedureReturn *Var\boolVal
Case #VT_I1, #VT_UI1
ProcedureReturn *Var\bVal
Case #VT_I2, #VT_UI2
ProcedureReturn *Var\iVal
Case #VT_I4, #VT_UI4
ProcedureReturn *Var\lVal
Case #VT_I8, #VT_UI8
ProcedureReturn *Var\llVal
Case #VT_R4
ProcedureReturn *Var\fltVal
Case #VT_R8
ProcedureReturn *Var\dblVal
Case #VT_BSTR
ProcedureReturn Val(PeekS(*Var\bstrVal, #PB_Any, #PB_Unicode))
Default
vhLastError = $80020008
ProcedureReturn 0
EndSelect
EndIf
EndProcedure
; ***************************************************************************************
Procedure.w VT_WORD(*Var.Variant)
Shared vhLastError.l
If *Var
Select *Var\vt
Case #VT_BOOL
ProcedureReturn *Var\boolVal
Case #VT_I1, #VT_UI1
ProcedureReturn *Var\bVal
Case #VT_I2, #VT_UI2
ProcedureReturn *Var\iVal
Case #VT_I4, #VT_UI4
ProcedureReturn *Var\lVal
Case #VT_I8, #VT_UI8
ProcedureReturn *Var\llVal
Case #VT_R4
ProcedureReturn *Var\fltVal
Case #VT_R8
ProcedureReturn *Var\dblVal
Case #VT_BSTR
ProcedureReturn Val(PeekS(*Var\bstrVal, #PB_Any, #PB_Unicode))
Default
vhLastError = $80020008
ProcedureReturn 0
EndSelect
EndIf
EndProcedure
; ***************************************************************************************
Procedure.l VT_LONG(*Var.Variant)
Shared vhLastError.l
If *Var
Select *Var\vt
Case #VT_BOOL
ProcedureReturn *Var\boolVal
Case #VT_I1, #VT_UI1
ProcedureReturn *Var\bVal
Case #VT_I2, #VT_UI2
ProcedureReturn *Var\iVal
Case #VT_I4, #VT_UI4
ProcedureReturn *Var\lVal
Case #VT_I8, #VT_UI8
ProcedureReturn *Var\llVal
Case #VT_R4
ProcedureReturn *Var\fltVal
Case #VT_R8
ProcedureReturn *Var\dblVal
Case #VT_BSTR
ProcedureReturn Val(PeekS(*Var\bstrVal, #PB_Any, #PB_Unicode))
Default
vhLastError = $80020008
ProcedureReturn 0
EndSelect
EndIf
EndProcedure
; ***************************************************************************************
Procedure.q VT_QUAD(*Var.Variant)
Shared vhLastError.l
If *Var
Select *Var\vt
Case #VT_BOOL
ProcedureReturn *Var\boolVal
Case #VT_I1, #VT_UI1
ProcedureReturn *Var\bVal
Case #VT_I2, #VT_UI2
ProcedureReturn *Var\iVal
Case #VT_I4, #VT_UI4
ProcedureReturn *Var\lVal
Case #VT_I8, #VT_UI8
ProcedureReturn *Var\llVal
Case #VT_R4
ProcedureReturn *Var\fltVal
Case #VT_R8
ProcedureReturn *Var\dblVal
Case #VT_BSTR
ProcedureReturn ValQ(PeekS(*Var\bstrVal, #PB_Any, #PB_Unicode))
Default
vhLastError = $80020008
ProcedureReturn 0
EndSelect
EndIf
EndProcedure
; ***************************************************************************************
Procedure.f VT_FLOAT(*Var.Variant)
Shared vhLastError.l
If *Var
Select *Var\vt
Case #VT_BOOL
ProcedureReturn *Var\boolVal
Case #VT_I1, #VT_UI1
ProcedureReturn *Var\bVal
Case #VT_I2, #VT_UI2
ProcedureReturn *Var\iVal
Case #VT_I4, #VT_UI4
ProcedureReturn *Var\lVal
Case #VT_I8, #VT_UI8
ProcedureReturn *Var\llVal
Case #VT_R4
ProcedureReturn *Var\fltVal
Case #VT_R8
ProcedureReturn *Var\dblVal
Case #VT_BSTR
ProcedureReturn ValF(PeekS(*Var\bstrVal, #PB_Any, #PB_Unicode))
Default
vhLastError = $80020008
ProcedureReturn 0
EndSelect
EndIf
EndProcedure
; ***************************************************************************************
Procedure.d VT_DOUBLE(*Var.Variant)
Shared vhLastError.l
If *Var
Select *Var\vt
Case #VT_BOOL
ProcedureReturn *Var\boolVal
Case #VT_I1, #VT_UI1
ProcedureReturn *Var\bVal
Case #VT_I2, #VT_UI2
ProcedureReturn *Var\iVal
Case #VT_I4, #VT_UI4
ProcedureReturn *Var\lVal
Case #VT_I8, #VT_UI8
ProcedureReturn *Var\llVal
Case #VT_R4
ProcedureReturn *Var\fltVal
Case #VT_R8
ProcedureReturn *Var\dblVal
Case #VT_BSTR
ProcedureReturn ValD(PeekS(*Var\bstrVal, #PB_Any, #PB_Unicode))
Default
vhLastError = $80020008
ProcedureReturn 0
EndSelect
EndIf
EndProcedure
; ***************************************************************************************
Procedure.l VT_DATE(*Var.Variant) ; PB-Datum
Shared vhLastError.l
Protected pbDate
If *Var
Select *Var\vt
Case #VT_DATE
pbDate = (*Var\dblVal - 25569.0) * 86400.0
ProcedureReturn pbDate
Default
vhLastError = $80020008
ProcedureReturn 0
EndSelect
EndIf
EndProcedure
; ***************************************************************************************
Procedure.l GetVariantSafeArrayCount(*Var.Variant)
Protected result.l, *array.safearray
If *Var
If (*Var\vt & #VT_ARRAY) = #VT_ARRAY
*array = *Var\parray
result = *array\rgsabound\cElements
Else
result = 0
EndIf
Else
result = 0
EndIf
ProcedureReturn result
EndProcedure
; ***************************************************************************************
Procedure.l GetVariantSafeArrayVarType(*Var.Variant)
Protected result.l, *array.safearray
If *Var
result = *Var\vt & $1FFF
Else
result = 0
EndIf
ProcedureReturn result
EndProcedure
; ***************************************************************************************
Procedure.l GetVariantSafeArray(*Var.Variant)
Protected result.l, *array.safearray
If *Var
If (*Var\vt & #VT_ARRAY) = #VT_ARRAY
*array = *Var\parray
result = *array\pvdata
Else
result = 0
EndIf
Else
result = 0
EndIf
ProcedureReturn result
EndProcedure
; ***************************************************************************************
Macro V_EMPTY(Arg)
VariantClear_(Arg)
Arg\vt = #VT_EMPTY
arg\llVal = 0
EndMacro
; ***************************************************************************************
Macro V_NULL(Arg)
VariantClear_(Arg)
Arg\vt = #VT_NULL
arg\bstrVal
EndMacro
; ***************************************************************************************
Macro V_DISP(Arg)
VariantClear_(Arg)
Arg\vt = #VT_DISPATCH
arg\pdispVal
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
; ***************************************************************************************
Code: Alles auswählen
; example by Kiffi
EnableExplicit
IncludeFile "Varianthelper2.pb"
Define.l ExcelApp, Workbook
dhToggleExceptions(#True)
ExcelApp = dhCreateObject("Excel.Application")
Define.variant wert1, wert2, wert3, result, text
V_DOUBLE(wert1) = 3.33333333333333
V_DOUBLE(wert2) = 4.44444444444444
V_DOUBLE(wert3) = 5.55555555555555
V_STR(text) = T_BSTR("Hallo Welt")
If ExcelApp
dhPutValue(ExcelApp, ".Visible = %b", #True)
dhGetValue("%o", @Workbook, ExcelApp, ".Workbooks.Add")
dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 1, 1, @"Feel")
dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 2, 1, @"the")
dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 3, 1, @"pure")
dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 4, 1, @"Power")
dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 1, 2, @"the")
dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 1, 3, @"pure")
dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 1, 4, @"Power")
dhPutValue(ExcelApp, "Cells(%d, %d).Value = %v", 2, 2, wert1)
dhPutValue(ExcelApp, "Cells(%d, %d).Value = %v", 2, 3, wert2)
dhPutValue(ExcelApp, "Cells(%d, %d).Value = %v", 2, 4, wert3)
dhPutValue(ExcelApp, "Cells(%d, %d).Value = %v", 3, 2, text)
dhGetValue("%v", @result, ExcelApp, "Cells(%d, %d).Value", 2, 2)
MessageRequester("PureDispHelper-ExcelDemo", "Result Cells(2,2): " + VT_STR(result))
MessageRequester("PureDispHelper-ExcelDemo", "Click OK to close Excel")
dhCallMethod(ExcelApp, ".Quit")
dhReleaseObject(Workbook) : Workbook = 0
dhReleaseObject(ExcelApp) : ExcelApp = 0
Else
MessageRequester("PureDispHelper-ExcelDemo", "Couldn't create Excel-Object")
EndIf
