PureDispHelper Userlib - Update Include für Unicode Support

[ts-soft]

@Falko

Code: Alles auswählen

 dhGetValue("%d",@MyVar,obj,"Scan(%b)",1) 

Der ist schon mal laut Hilfe verkehrt!
Wenn das wirklich eine Getter-Methode ist, steht nicht in der Hilfe, dann so:

Code: Alles auswählen

dhGetValue("%b",@MyVar,obj,"Scan(%d)", DeviceNr.l)

weil ReturnType ist ein Boolean, kein Long (Integer)
Ich denke aber, das ist eher eine Setter-Methode?
Aber ohne OCX kann ich das nicht testen, falls das ohne Gerät geht?

[ts-soft]

Code: Alles auswählen

Procedure.l Scan(*Obj.IDispatch, DeviceNr.w)

  Dim Value.Variant(1)
 
  Result.Variant\vt = #VT_EMPTY
  Value(0)\vt = #VT_I2
  Value(0)\iVal = DeviceNr
 
  parms.DISPPARAMS
  With parms
    \rgvarg = @Value(0)
    \rgdispidNamedArgs = 0
    \cArgs = 1
    \cNamedArgs = 0
  EndWith
 
  r1 = *Obj\Invoke($01, ?IID_NULL, 0, #DISPATCH_METHOD, @parms, @Result, 0, 0)
  If r1 <> #S_OK
    LastMessage = "Fehler Scan"
    LastError = $80080101
    ProcedureReturn 0
  Else
    ProcedureReturn Result\bool ; <---- 
  EndIf

EndProcedure      

Ich hatte recht

[Falko]

Ob Get.. oder Set.., das hatte ich nun nicht beachtet.
Ich dachte ein Getter wäre für Funktionen, die was zurück gibt.

Es müsste gleich bei dir große E-Mail auf deinen Webmaster angekommen
sein. Kannst Kiffi bitte auch zukommen lassen.

Gruß ..Falko

[ts-soft]

@Falko

Die ersten 3 Funktionen sehen nach der Änderung wie folgt aus: (alles ungetested)

Code: Alles auswählen

; Scan -------------------------------------------------------------------------------------

Procedure.l Scan(Obj, DeviceNr.l)
  Protected Result.l
  dhGetValue("%b",@Result,obj,"Scan(%d)", DeviceNr)
  If Result <> 0 ; True = -1 achtung
    ProcedureReturn #True
  EndIf
EndProcedure         

; GetAnalogDiffVoltage -------------------------------------------------------------------------

Procedure.d GetAnalogDiffVoltage(Obj, DeviceNr.l, Channel.l)
  Protected Result.d
  
  dhGetValue("%e", @Result, obj, "GetAnalogDiffVoltage(%d, %d)", DeviceNr, Channel)
  
  ProcedureReturn Result

EndProcedure

; AnalogVoltage -------------------------------------------------------------------------

Procedure AnalogVoltage(Obj.l, DeviceNr.l,Channel.l, Arg.d)

  dhPutValue(Obj, "AnalogVoltage(%d,%d,%e)", DeviceNr, Channel, Arg)

EndProcedure

dhToggleExceptions(#True) ; fehler melden!

Define.l Obj = dhCreateObject("ADUSB2XX.ADUSB2XXCtrl.1")

If obj
  ; machen und tun ...
  
  Debug obj
  dhReleaseObject(obj)
EndIf

AD_USB2XXLib Interface Definition
General Information

Library: AD_USB2XXLib (AD_USB2XX ActiveX-Steuerelement-Modul)

File name: AD_USB2XX.ocx

ProgID: "ADUSB2XX.ADUSB2XXCtrl.1"

GUID: {279E968D-F134-464E-ACE8-FC0D23958063}

Version: 1.0
Contents

* Classes
o AD_USB2XX
+ Methods
+ Events

Classes

This section lists the classes exposed by AD_USB2XX.ocx. For each class, the methods and events are listed. All arguments for methods are passed ByVal unless otherwise noted. Arguments in brackets [arg] are optional.
AD_USB2XX {3FA65AAD-3DF5-4D30-8FA7-799205B01C91}
Methods

Function Scan(DeviceNr As Integer) As Boolean

PureDispHelper method: dhGetValue

Property Get AnalogVoltage(DeviceNr As Integer, Channel As Integer) As Double

PureDispHelper method: dhGetValue

Property Let AnalogVoltage(DeviceNr As Integer, Channel As Integer, Arg As Double)

PureDispHelper method: dhPutValue

Property Get DigIO(DeviceNr As Integer) As Integer

PureDispHelper method: dhGetValue

Property Let DigIO(DeviceNr As Integer, Arg As Integer)

PureDispHelper method: dhPutValue

Function GetAnalogDiffVoltage(DeviceNr As Integer, Channel As Integer) As Double

PureDispHelper method: dhGetValue

Function GetDeviceType(DeviceNr As Integer) As Integer

PureDispHelper method: dhGetValue

Function GetError(DeviceNr As Integer) As Integer

PureDispHelper method: dhGetValue

Function GetSerialNr(DeviceNr As Integer) As Integer

PureDispHelper method: dhGetValue

Property Get AnalogIO(DeviceNr As Integer, Channel As Integer) As Long

PureDispHelper method: dhGetValue

Property Let AnalogIO(DeviceNr As Integer, Channel As Integer, Arg As Long)

PureDispHelper method: dhPutValue

Sub EnableCalibration(Password As String)

PureDispHelper method: dhCallMethod

Property Get Calibration(DeviceNr As Integer, IO As Integer, Level As Integer, Channel As Integer) As Long

PureDispHelper method: dhGetValue

Property Let Calibration(DeviceNr As Integer, IO As Integer, Level As Integer, Channel As Integer, Arg As Long)

PureDispHelper method: dhPutValue

Property Get SerialNr(DeviceNr As Integer) As Integer

PureDispHelper method: dhGetValue

Property Let SerialNr(DeviceNr As Integer, Arg As Integer)

PureDispHelper method: dhPutValue

Function ReadAnalogVoltage(DeviceNr As Integer, Channel As Integer) As Double

PureDispHelper method: dhGetValue

Sub WriteAnalogVoltage(DeviceNr As Integer, Channel As Integer, Voltage As Double)

PureDispHelper method: dhCallMethod

Function ReadDigIn(DeviceNr As Integer) As Integer

PureDispHelper method: dhGetValue

Sub WriteDigOut(DeviceNr As Integer, Value As Integer)

PureDispHelper method: dhCallMethod

Sub DataIO(DeviceNr As Integer)

PureDispHelper method: dhCallMethod

Sub Close

PureDispHelper method: dhCallMethod
Events

No Events.

Get sind die Getter-Methoden, um Werte zu ermitteln (dhGetValue)
Let sind die Setter-Methoden, um Werte zu setzen (dhPutValue)
Sub sind Methoden um etwas auszuführen (dhCallMethod)

[Falko]

Hallo ts-soft,
das sieht einfach aus, aber ist es leider nicht ( im Moment noch nicht)

Diese Meldug bekomme ich, wenn ich den nachfolgenden Source
mit der Procedure Scan ausprobiere.

---------------------------
Fehler
---------------------------
Member: Scan(%d)

Function: GetValue

Error In: GetValueV

Error: Falscher Parameter.

Code: 80070057

Source: Application
---------------------------
OK
---------------------------

Code: Alles auswählen

; Scan -------------------------------------------------------------------------------------
Global obj.l
Procedure.l Scan(Obj, DeviceNr.l)
  Protected Result.l
  dhGetValue("%b",@Result,obj,"Scan(%d)", DeviceNr)
  If Result <> 0 ; True = -1 achtung
    ProcedureReturn #True
  EndIf
EndProcedure         

; GetAnalogDiffVoltage -------------------------------------------------------------------------

Procedure.d GetAnalogDiffVoltage(Obj, DeviceNr.l, Channel.l)
  Protected Result.d
 
  dhGetValue("", @Result, obj, "GetAnalogDiffVoltage(%d, %d)", DeviceNr, Channel)
 
  ProcedureReturn Result

EndProcedure

; AnalogVoltage -------------------------------------------------------------------------

Procedure AD_AnalogVoltage(Obj.l, DeviceNr.l,Channel.l, Arg.d)

  dhPutValue(Obj, "AnalogVoltage(%d,%d,%e)", DeviceNr, Channel, Arg)

EndProcedure

dhToggleExceptions(#True) ; fehler melden!

;Declare.l obj = dhCreateObject("ADUSB2XX.ADUSB2XXCtrl.1") ; Zeigt "(" - Fehler an

If OpenWindow(0, #PB_Ignore, #PB_Ignore, 600, 470, "AD-USB 4")And CreateGadgetList(WindowID(0))
   StringGadget(0,0,0,150,20,"Wert")
EndIf

obj = dhCreateObject("ADUSB2XX.ADUSB2XXCtrl.1", WindowID(0))

If obj
  ; machen und tun ...
 
  SetGadgetText(0,Str(Scan(obj,1)))
  
  While WaitWindowEvent() <> #PB_Event_CloseWindow : Wend
  
  dhReleaseObject(obj)
  CloseWindow(0)
EndIf

Den Declare habe ich nochmal abgeändert, da ich einen Klammerfehler erhalte.

Ergebnis ist Null, beim Parameterwert 1 oder 0.

Irgendwie ist das noch nicht das Richtige.

Das OCX wird im Fenster aber korrekt als kleines Symbol angezeigt.

Gruß ..Falko

[ts-soft]

entweder ohne WindowID oder mit OCX_CreateGadget! (eins von beiden sollte gehen)
Der optionale Parameter von dhCreateObject wird nicht funktioniren!

[mk-soft]

Hi, bin wieder da.

@Falko

für Scan DeviceNr braucht man ein Variant von Type #VT_I2

@ts-soft,

Kannst du noch die fehlenden Identifier Typen nach flegen?
Variant wäre auch schon um Arrays auch übergeben zu können.

FF

P.S:

Identifier Type

%i für Word
%w für UWord
%v für Variant ByRef
%? für Variant ByValue

[ts-soft]

Da fehlen keine Identifier, nimm den kleinsten Nenner
Wenn der Variant ein bstr ist, übergib einen string usw.
Das macht die Lib intern. Für word nimmste long.

Ich parse nichts, kann also auch keine Identifier hinzufügen, es sollten aber
alle autom. ins passende Format gebracht werden.

[mk-soft]

Habe mir gerade den Scourecode von der LIB angeschaut.

Der Variant type VT_I2 wird nicht unterstützt aber der Type Variant.

Parse in der LIB:

Code: Alles auswählen

static HRESULT ExtractArgument(VARIANT * pvArg, WCHAR chIdentifier, BOOL * pbFreeArg, va_list * marker)
{
	HRESULT hr = NOERROR;

	/* By default, the argument does not need to be freed */
	*pbFreeArg = FALSE;

	/* Change 'T' identifier to 'S' or 's' based on UNICODE mode */
	if (chIdentifier == L'T') chIdentifier = (dh_g_bIsUnicodeMode ? L'S' : L's');

	switch (chIdentifier)
	{
		case L'd':   /* LONG */
			V_VT(pvArg)  = VT_I4;
			V_I4(pvArg)  = va_arg(*marker, LONG);
			break;

		case L'u':   /* ULONG */
			V_VT(pvArg)  = VT_UI4;
			V_UI4(pvArg) = va_arg(*marker, ULONG);
			break;

		case L'e':   /* DOUBLE */
			V_VT(pvArg)  = VT_R8;
			V_R8(pvArg)  = va_arg(*marker, DOUBLE);
			break;

		case L'b':   /* BOOL */
			V_VT(pvArg)   = VT_BOOL;
			V_BOOL(pvArg) = ( va_arg(*marker, BOOL) ? VARIANT_TRUE : VARIANT_FALSE );
			break;

		case L'v':   /*  VARIANT *  */
			*pvArg  = *va_arg(*marker, VARIANT *);
			break;

		case L'm':   /* Missing optional argument */
			V_VT(pvArg)    = VT_ERROR;
			V_ERROR(pvArg) = DISP_E_PARAMNOTFOUND;
			break;

		case L'B':   /* BSTR */
			V_VT(pvArg)   = VT_BSTR;
			V_BSTR(pvArg) = va_arg(*marker, BSTR);
			break;

		case L'S':   /* LPCOLESTR (aka LPCWSTR) */
		{
			LPOLESTR szTemp = va_arg(*marker, LPOLESTR);

			V_VT(pvArg)   = VT_BSTR;
			V_BSTR(pvArg) = SysAllocString(szTemp);

			if (V_BSTR(pvArg) == NULL && szTemp != NULL) hr = E_OUTOFMEMORY;

			*pbFreeArg = TRUE;   /* We must free this argument */
			break;
		}

		case L's':   /* LPCSTR */
			V_VT(pvArg) = VT_BSTR;
			hr = ConvertAnsiStrToBStr(va_arg(*marker, LPSTR), &V_BSTR(pvArg));
			*pbFreeArg = TRUE;   /* We must free this argument */
			break;

		case L'o':   /* IDispatch *   */
			V_VT(pvArg)       = VT_DISPATCH;
			V_DISPATCH(pvArg) = va_arg(*marker, IDispatch *);
			break;

		case L'O':   /* IUnknown *    */
			V_VT(pvArg)      = VT_UNKNOWN;
			V_UNKNOWN(pvArg) = va_arg(*marker, IUnknown *);
			break;

		case L'D':   /* DATE (Variant Date) */
			V_VT(pvArg)   = VT_DATE;
			V_DATE(pvArg) = va_arg(*marker, DATE);
			break;

		case L't':   /* time_t */
			V_VT(pvArg) = VT_DATE;
			hr = ConvertTimeTToVariantTime(va_arg(*marker, time_t), &V_DATE(pvArg));
			break;

		case L'W':   /* SYSTEMTIME *    */
			V_VT(pvArg) = VT_DATE;
			hr = ConvertSystemTimeToVariantTime(va_arg(*marker, SYSTEMTIME *), &V_DATE(pvArg));
			break;

		case L'f':   /* FILETIME *   */
			V_VT(pvArg) = VT_DATE;
			hr = ConvertFileTimeToVariantTime(va_arg(*marker, FILETIME *), &V_DATE(pvArg));
			break;

		case L'p':   /* Pointers, handles, etc */
#ifndef _WIN64
			V_VT(pvArg) = VT_I4;
			V_I4(pvArg) = (LONG) va_arg(*marker, LPVOID);
#else
			V_VT(pvArg) = VT_I8;
			V_I8(pvArg) = (LONGLONG) va_arg(*marker, LPVOID);
#endif
			break;

		default:    /* Invalid identifier */
			hr = E_INVALIDARG;
			DEBUG_NOTIFY_INVALID_IDENTIFIER(chIdentifier);
			break;
	}

	return hr;
}

Die Lösung für Falko könnte so funktionieren.

Code: Alles auswählen

Global obj.l
Procedure.l Scan(Obj, DeviceNr.l)
  Protected Result.l, Device.variant
  
  Device\vt = #VT_I2
  Device\iVal = DeviceNr
 
  dhGetValue("%b",@Result,obj,"Scan(%v)", Device)
  If Result <> 0 ; True = -1 achtung
    ProcedureReturn #True
  EndIf
EndProcedure         

FF

UPS: Tippfehler korrigiert.

[ts-soft]

Du hast dir den Original C-Source von DispHelper angeschaut, der
funktioniert nur mit Unicode und in PB bisher sogut wie garnicht!
Ich importiere eine ANSI-Version, die alles automatisch casted. Er muß nur
ein %d (long) übergeben! Es gibt nicht mehr Identifier als in der Hilfe
aufgeführt, bzw. würde mich das Wundern. Alle Variant werden automatisch
in ihren eigentlichen wert gewandelt, in beide Richtungen! Lediglich ein Datum
kommt als Strukture zurück, der Rest sind einfache Typen!

Allerdings probiert habe ich es noch nicht , wäre sehr verwundert,
wenn das klappt.