PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

OCX und das, mit dem Cocreate usw.

https://www.purebasic.fr/german/viewtopic.php?t=7035

Seite 11 von 12

Verfasst: 05.03.2006 17:09
von Falko
Wow, das ist die richtige Lösung. :allright:
Dank an Dich und allen Mitwirkenden :allright:

Ich habe die Funktion mal in der Repeatschleife eingesetzt und mal nur mit dem Diodentest von meinem Messgerät mal die Spannung angelegt.

0.63040847201210293
0.62564296520423601
.....
.....
0.71210287443267772
0.71754916792738277
0.702571860816944
0.71244326777609679
0.71788956127080183
1.7240922844175492
1.7509833585476553
1.7741301059001513
...
...
1.7285173978819968
1.7142208774583965
-1.7317744672826703
-1.7120874976428437
-1.7314350367716389
...
...
-1.5182726758438618
-1.5393173675278145
Natürlich muss ich das erst mal alles zuordnen.
Dann versuch ich mich mal an den Wrapper
und hoffe das ich den Rest hinbekomme.

Viele Grüße
Falko

Verfasst: 05.03.2006 19:00
von mk-soft
Hi,
Neue Version von AtlHelper.pb

Code: Alles auswählen

;-TOP
; Kommentar : ATL Helper
; Datei     : AtlHelper.pb
; Version   : 1.01
; Erstellt  : 05.02.2006
; Geändert  : 05.02.2006

; ---------------------------------------------------------

Global Lastmessage.s
Global LastError.l

Prototype.l ProtoAtlAxWinInit()
Prototype.l ProtoAtlAxCreateControl(Control.p-unicode, hWnd.l, *pStream, *ppContainer.IUnknown)
Prototype.l ProtoAtlAxGetControl(hWnd.l, *Obj.IDispatch)

Procedure InitAtl()

  If OpenLibrary(0, "ATL.dll") = 0
    LastMessage = "Fehler OpenLibrary"
    LastError = $80080001
    ProcedureReturn 0
  EndIf

  ; Init Functions
  Global AtlAxWinInit.ProtoAtlAxWinInit = GetFunction(0, "AtlAxWinInit")
  Global AtlAxCreateControl.ProtoAtlAxCreateControl = GetFunction(0, "AtlAxCreateControl")
  Global AtlAxGetControl.ProtoAtlAxGetControl = GetFunction(0, "AtlAxGetControl")

  ProcedureReturn 1
  
EndProcedure

; ---------------------------------------------------------

Procedure.l CreateControl(Control.s, hWnd.l) ; Result IUnknown

  If AtlAxWinInit() = 0
    LastMessage = "Fehler AtlAxWinInit"
    LastError = $80080002
    ProcedureReturn 0
  EndIf
  
  AtlAxCreateControl(Control, hWnd, 0, @*Container.IUnknown)
  If *Container = 0
    LastMessage = "Fehler AtlAxCreateControl: " + Control
    LastError = $80080003
    ProcedureReturn 0
  Else
    ProcedureReturn *Container
  EndIf

EndProcedure

; ---------------------------------------------------------

Procedure ReleaseControl(*Container.IUnknown)

  If *Container
    *Container\Release()
  EndIf
  
EndProcedure

; ---------------------------------------------------------

Procedure.l GetControl(hWnd.l) ; Result IDispatch

  AtlAxGetControl(hWnd, @*Obj.IDispatch)
  If *Obj = 0
    LastMessage = "Fehler AtlAxGetControl"
    LastError = $80080004
    ProcedureReturn 0
  Else
    ProcedureReturn *Obj
  EndIf  

EndProcedure

; ---------------------------------------------------------

Procedure.l QueryInterface(*Control.IDispatch, *guid) ; Result IDispatch

  r1 = *Control\QueryInterface(*guid, @*Obj)
  If r1 <> #S_OK
    LastMessage = "Fehler QueryInterface: " + Hex(r1)
    LastError = r1
    ProcedureReturn 0
  Else
    ProcedureReturn *Obj
  EndIf

EndProcedure

; ---------------------------------------------------------

Procedure COMLIB_Init()
  CoInitialize_(#Null)
EndProcedure

Procedure COMLIB_End()
  CoUninitialize_() 
EndProcedure
Erweitert mit QueryInterface:

*ADUSB.IDispatch = QueryInterface(*Control, ?IID__DAD_USB2XX)
If *ADUSB = 0
Debug LastMessage
ReleaseControl(*Container)
End
EndIf

FF :wink:

Verfasst: 05.03.2006 21:03
von Falko
Hi, habe jetzt nochmal alles neu aus der Zip kopiert und die letzten Änderungen der AtlHelper.pb von dir gemacht.

Zusätzlich habe ich im 2. Wrapper versucht das GetSerialNr() einzubauen.
Aber irgendwie mache ich bestimmt da noch was falsch. Hier der
Ausgabewert und danach die Procedure aus dem Wrapper.
Wie kommt man auf die Werte für die Fehlerausgabe?
0.18755673222390318
0
Der Zweite Wert sollte mir die SerialNr ausgeben. Null kann ich mir nicht vorstellen.
Procedure.w GetSerialNr(*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(1, ?IID_NULL, 0, #DISPATCH_METHOD, @parms, @Result, 0, 0)
If r1 <> #S_OK
LastMessage = "Fehler GetSerialNr"
LastError = $8008010D
ProcedureReturn 0
Else
ProcedureReturn Result\iVal
EndIf

EndProcedure

Verfasst: 05.03.2006 21:28
von mk-soft
Falsche Funktionsnummer:

Falsch: r1 = *Obj\Invoke(1, ...
richtig: r1 = *Obj\Invoke($05, ...

VC5: InvokeHelper(0x5, ...

FF :wink:

Verfasst: 05.03.2006 21:39
von mk-soft
Die Fehlernummer habe ich selber festgelegt.

Fehlercode $800801xx -> xx ist die Funktionsnummer

Verfasst: 05.03.2006 21:48
von mk-soft
Ihr den neuen AdWrapper:

Code: Alles auswählen

;-TOP
; Kommentar : AD_USB2XX Wrapper
; Datei     : AdWrapper.pb
; Version   : 1.01
; Erstellt  : 05.02.2006
; Geändert  : 05.02.2006

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

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(1, ?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          

; GetAnalogVoltage

Procedure.d GetAnalogVoltage(*obj.IDispatch, DeviceNr.w, Channel.w)

  Dim Value.Variant(2)
  
  Result.Variant\vt = #VT_EMPTY
  Value(0)\vt = #VT_I2
  Value(0)\iVal = DeviceNr
  Value(1)\vt = #VT_I2
  Value(1)\iVal = Channel
  
  parms.DISPPARAMS
  With parms
    \rgvarg = @Value(0)        
    \rgdispidNamedArgs = 0
    \cArgs = 2
    \cNamedArgs = 0
  EndWith
  
  r1 = *Obj\Invoke($0d, ?IID_NULL, 0, #DISPATCH_PROPERTYGET, @parms, @Result, 0, 0)
  If r1 <> #S_OK
    LastMessage = "Fehler GetAnalogVoltage"
    LastError = $8008010D
    ProcedureReturn 0
  Else
    ProcedureReturn Result\dblVal  
  EndIf

EndProcedure

; ---------------------------------------------------------

Procedure.l GetAnalogIO(*obj.IDispatch, DeviceNr.w, Channel.w)

  Dim Value.Variant(2)
  
  Result.Variant\vt = #VT_EMPTY
  Value(0)\vt = #VT_I2
  Value(0)\iVal = DeviceNr
  Value(1)\vt = #VT_I2
  Value(1)\iVal = Channel
  
  parms.DISPPARAMS
  With parms
    \rgvarg = @Value(0)        
    \rgdispidNamedArgs = 0
    \cArgs = 2
    \cNamedArgs = 0
  EndWith
  
  r1 = *Obj\Invoke($0f, ?IID_NULL, 0, #DISPATCH_PROPERTYGET, @parms, @Result, 0, 0)
  If r1 <> #S_OK
    LastMessage = "Fehler GetAnalogIO"
    LastError = $8008010F
    ProcedureReturn 0
  Else
    ProcedureReturn Result\lVal  
  EndIf

EndProcedure

; ---------------------------------------------------------

Procedure.w GetSerialNr(*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($05, ?IID_NULL, 0, #DISPATCH_METHOD, @parms, @Result, 0, 0)
  If r1 <> #S_OK
    LastMessage = "Fehler GetSerialNr"
    LastError = $80080105
    ProcedureReturn 0
  Else
    ProcedureReturn Result\iVal
  EndIf

EndProcedure

; ---------------------------------------------------------

Procedure.w SetSerialNr(*Obj.IDispatch, DeviceNr.w, NewValue.w)

  Dim Value.Variant(2)
  
  Result.Variant\vt = #VT_EMPTY
  Value(0)\vt = #VT_I2
  Value(0)\iVal = DeviceNr
  Value(1)\vt = #VT_I2
  Value(1)\iVal = NewValue
  
  parms.DISPPARAMS
  With parms
  \rgvarg = @Value(0)
  \rgdispidNamedArgs = 0
  \cArgs = 2
  \cNamedArgs = 0
  EndWith
  
  r1 = *Obj\Invoke($11, ?IID_NULL, 0, #DISPATCH_PROPERTYPUT, @parms, 0, 0, 0)
  If r1 <> #S_OK
    LastMessage = "Fehler SetSerialNr"
    LastError = $80080111
    ProcedureReturn 0
  Else
    ProcedureReturn NewValue
  EndIf

EndProcedure

Verfasst: 05.03.2006 21:57
von Falko
Ich danke dir nochmals :allright:

Naja für mich ist das Verständnis der Objekte und Methoden noch nicht so
klar, aber hierdurch habe ich die Möglichkeit durch deine Hilfe und
tollen Beispiele es zu lernen.

Hier das richtige Ergebnis durch deinen Wrapper:
0.17326021180030257
4
Viele Grüße
Falko

Verfasst: 07.03.2006 11:26
von Falko
@MK-Soft

So, jetzt habe ich den Wrapper mit allen Funktionen ergänzt und hoffe,
das es soweit richtig ist (C-Syntax --> PB )
Könntest du das vom Syntax her prüfen, ob ich da noch was falsch gemacht habe?
Beim Close() wußte ich keine andere Lösung.

Hier erst mal der vollständige Wrapper zu AD-USB2XX:

Code: Alles auswählen

;-TOP 
; Kommentar : AD_USB2XX Wrapper 
; Author: MK-Soft 
; Second Author: Falko-Pure
; Datei     : AdWrapper.pb 
; Version   : 1.01 
; Erstellt  : 05.03.2006 
; Geändert  : 07.03.2006 

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

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          

; GetAnalogVoltage ------------------------------------------------------------------------- 

Procedure.d GetAnalogVoltage(*obj.IDispatch, DeviceNr.w, Channel.w) 

  Dim Value.Variant(2) 
  
  Result.Variant\vt = #VT_EMPTY 
  Value(0)\vt = #VT_I2 
  Value(0)\iVal = DeviceNr 
  Value(1)\vt = #VT_I2 
  Value(1)\iVal = Channel 
  
  parms.DISPPARAMS 
  With parms 
    \rgvarg = @Value(0)        
    \rgdispidNamedArgs = 0 
    \cArgs = 2 
    \cNamedArgs = 0 
  EndWith 
  
  r1 = *Obj\Invoke($0d, ?IID_NULL, 0, #DISPATCH_PROPERTYGET, @parms, @Result, 0, 0) 
  If r1 <> #S_OK 
    LastMessage = "Fehler GetAnalogVoltage" 
    LastError = $8008010d 
    ProcedureReturn 0 
  Else 
    ProcedureReturn Result\dblVal  
  EndIf 

EndProcedure 

; SetAnalogVoltage ------------------------------------------------------------------------- 

Procedure.d SetAnalogVoltage(*Obj.IDispatch, DeviceNr.w,Channel.w, newValue.d) 

  Dim Value.Variant(3) 
  
  Result.Variant\vt = #VT_EMPTY 
  Value(0)\vt = #VT_I2 
  Value(0)\iVal = DeviceNr 
  Value(1)\vt = #VT_I2 
  Value(1)\iVal = Channel 
  Value(2)\vt = #VT_R8 
  Value(2)\dblVal = newValue 
  
  parms.DISPPARAMS 
  With parms 
  \rgvarg = @Value(0) 
  \rgdispidNamedArgs = 0 
  \cArgs = 3 
  \cNamedArgs = 0 
  EndWith 
  
  r1 = *Obj\Invoke($0d, ?IID_NULL, 0, #DISPATCH_PROPERTYPUT, @parms, 0, 0, 0) 
  If r1 <> #S_OK 
    LastMessage = "Fehler SetAnalogVoltage" 
    LastError = $8008010d 
    ProcedureReturn 0 
  Else 
    ProcedureReturn newValue 
  EndIf 

EndProcedure 

; GetDigIO---------------------------------------------------------------------------------- 

Procedure.w GetDigIO(*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($0e, ?IID_NULL, 0, #DISPATCH_METHOD, @parms, @Result, 0, 0) 
  If r1 <> #S_OK 
    LastMessage = "Fehler GetDigIO" 
    LastError = $8008010e 
    ProcedureReturn 0 
  Else 
    ProcedureReturn Result\iVal  
  EndIf 

EndProcedure 

; SetDigIO --------------------------------------------------------------------------------- 

Procedure.w SetDigIO(*Obj.IDispatch, DeviceNr.w, NewValue.w) 

  Dim Value.Variant(2) 
  
  Result.Variant\vt = #VT_EMPTY 
  Value(0)\vt = #VT_I2 
  Value(0)\iVal = DeviceNr 
  Value(1)\vt = #VT_I2 
  Value(1)\iVal = NewValue 
  
  parms.DISPPARAMS 
  With parms 
  \rgvarg = @Value(0) 
  \rgdispidNamedArgs = 0 
  \cArgs = 2 
  \cNamedArgs = 0 
  EndWith 
  
  r1 = *Obj\Invoke($0e, ?IID_NULL, 0, #DISPATCH_PROPERTYPUT, @parms, 0, 0, 0) 
  If r1 <> #S_OK 
    LastMessage = "Fehler SetDigIO" 
    LastError = $8008010e 
    ProcedureReturn 0 
  Else 
    ProcedureReturn NewValue 
  EndIf 

EndProcedure 

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

Procedure.d GetAnalogDiffVoltage(*obj.IDispatch, DeviceNr.w, Channel.w) 

  Dim Value.Variant(2) 
  
  Result.Variant\vt = #VT_EMPTY 
  Value(0)\vt = #VT_I2 
  Value(0)\iVal = DeviceNr 
  Value(1)\vt = #VT_I2 
  Value(1)\iVal = Channel 
  
  parms.DISPPARAMS 
  With parms 
    \rgvarg = @Value(0)        
    \rgdispidNamedArgs = 0 
    \cArgs = 2 
    \cNamedArgs = 0 
  EndWith 
  
  r1 = *Obj\Invoke($02, ?IID_NULL, 0, #DISPATCH_PROPERTYGET, @parms, @Result, 0, 0) 
  If r1 <> #S_OK 
    LastMessage = "Fehler GetAnalogDiffVoltage" 
    LastError = $80080102 
    ProcedureReturn 0 
  Else 
    ProcedureReturn Result\dblVal  
  EndIf 

EndProcedure 

; GetDeviceType ---------------------------------------------------------------------------- 

Procedure.w GetDeviceType(*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($03, ?IID_NULL, 0, #DISPATCH_METHOD, @parms, @Result, 0, 0) 
  If r1 <> #S_OK 
    LastMessage = "Fehler GetDeviceType" 
    LastError = $80080103 
    ProcedureReturn 0 
  Else 
    ProcedureReturn Result\iVal  
  EndIf 

EndProcedure  

; GetError --------------------------------------------------------------------------------- 

Procedure.w GetError(*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($04, ?IID_NULL, 0, #DISPATCH_METHOD, @parms, @Result, 0, 0) 
  If r1 <> #S_OK 
    LastMessage = "Fehler GetError" 
    LastError = $80080104 
    ProcedureReturn 0 
  Else 
    ProcedureReturn Result\iVal  
  EndIf 

EndProcedure 

; GetSerialNr ------------------------------------------------------------------------------ 

Procedure.w GetSerialNr(*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($05, ?IID_NULL, 0, #DISPATCH_METHOD, @parms, @Result, 0, 0) 
  If r1 <> #S_OK 
    LastMessage = "Fehler GetSerialNr" 
    LastError = $80080105 
    ProcedureReturn 0 
  Else 
    ProcedureReturn Result\iVal 
  EndIf 

EndProcedure 

; GetAnalogIO ------------------------------------------------------------------------------ 

Procedure.l GetAnalogIO(*obj.IDispatch, DeviceNr.w, Channel.w) 

  Dim Value.Variant(2) 
  
  Result.Variant\vt = #VT_EMPTY 
  Value(0)\vt = #VT_I2 
  Value(0)\iVal = DeviceNr 
  Value(1)\vt = #VT_I2 
  Value(1)\iVal = Channel 
  
  parms.DISPPARAMS 
  With parms 
    \rgvarg = @Value(0)        
    \rgdispidNamedArgs = 0 
    \cArgs = 2 
    \cNamedArgs = 0 
  EndWith 
  
  r1 = *Obj\Invoke($0f, ?IID_NULL, 0, #DISPATCH_PROPERTYGET, @parms, @Result, 0, 0) 
  If r1 <> #S_OK 
    LastMessage = "Fehler GetAnalogIO" 
    LastError = $8008010f 
    ProcedureReturn 0 
  Else 
    ProcedureReturn Result\lVal  
  EndIf 

EndProcedure 

; SetAnalogIO ------------------------------------------------------------------------------ 

Procedure.l SetAnalogIO(*Obj.IDispatch, DeviceNr.w,Channel.w, NewValue.l) 

  Dim Value.Variant(3) 
  
  Result.Variant\vt = #VT_EMPTY 
  Value(0)\vt = #VT_I2 
  Value(0)\iVal = DeviceNr 
  Value(1)\vt = #VT_I2 
  Value(1)\iVal = Channel
  Value(2)\vt = #VT_I4 
  Value(2)\lVal = NewValue
  
  parms.DISPPARAMS 
  With parms 
  \rgvarg = @Value(0) 
  \rgdispidNamedArgs = 0 
  \cArgs = 3 
  \cNamedArgs = 0 
  EndWith 
  
  r1 = *Obj\Invoke($0f, ?IID_NULL, 0, #DISPATCH_PROPERTYPUT, @parms, 0, 0, 0) 
  If r1 <> #S_OK 
    LastMessage = "Fehler SetAnalogIO" 
    LastError = $8008010f 
    ProcedureReturn 0 
  Else 
    ProcedureReturn NewValue 
  EndIf 

EndProcedure 
               
; EnableCalibration -------------------------------------------------------------------------

Procedure.s EnableCalibration(*Obj.IDispatch, Password.s) 

  Dim Value.Variant(1) 
  
  Result.Variant\vt = #VT_EMPTY 
  Value(0)\vt = #VT_I2 
  Value(0)\bstrVal = *Password
  
  parms.DISPPARAMS 
  With parms 
  \rgvarg = @Value(0) 
  \rgdispidNamedArgs = 0 
  \cArgs = 1 
  \cNamedArgs = 0 
  EndWith 
  
  r1 = *Obj\Invoke($06, ?IID_NULL, 0, #DISPATCH_METHOD, @parms, 0, 0, 0) 
  If r1 <> #S_OK 
    LastMessage = "Fehler EnableCalibration" 
    LastError = $80080106 
    ProcedureReturn "0" 
  Else 
    ProcedureReturn Password
  EndIf 

EndProcedure
 
 ; GetCalibration --------------------------------------------------------------------------- 

Procedure.l GetCalibration(*obj.IDispatch, DeviceNr.w, IO.w,Level.w,Channel.w) 

  Dim Value.Variant(4) 
  
  Result.Variant\vt = #VT_EMPTY 
  Value(0)\vt = #VT_I2 
  Value(0)\iVal = DeviceNr 
  Value(1)\vt = #VT_I2 
  Value(1)\iVal = IO
  Value(2)\vt= #VT_I2
  Value(2)\iVal=Level
  Value(3)\vt= #VT_I2
  Value(3)\iVal=Channel
  
  parms.DISPPARAMS 
  With parms 
    \rgvarg = @Value(0)        
    \rgdispidNamedArgs = 0 
    \cArgs = 4 
    \cNamedArgs = 0 
  EndWith 
  
  r1 = *Obj\Invoke($10, ?IID_NULL, 0, #DISPATCH_PROPERTYGET, @parms, @Result, 0, 0) 
  If r1 <> #S_OK 
    LastMessage = "Fehler GetCalibration" 
    LastError = $80080110 
    ProcedureReturn 0 
  Else 
    ProcedureReturn Result\lVal  
  EndIf 

EndProcedure 

; SetCalibration --------------------------------------------------------------------------- 

Procedure.l SetCalibration(*Obj.IDispatch, DeviceNr.w,IO.w, Level.w, Channel.w, NewValue.l) 

  Dim Value.Variant(5) 
  
  Result.Variant\vt = #VT_EMPTY 
  Value(0)\vt = #VT_I2 
  Value(0)\iVal = DeviceNr 
  Value(1)\vt = #VT_I2 
  Value(1)\iVal = IO
  Value(2)\vt = #VT_I2 
  Value(2)\iVal = Level 
  Value(3)\vt = #VT_I2 
  Value(3)\iVal = Channel
  Value(4)\vt = #VT_I4 
  Value(4)\lVal = NewValue
  
  parms.DISPPARAMS 
  With parms 
  \rgvarg = @Value(0) 
  \rgdispidNamedArgs = 0 
  \cArgs = 5 
  \cNamedArgs = 0 
  EndWith 
  
  r1 = *Obj\Invoke($10, ?IID_NULL, 0, #DISPATCH_PROPERTYPUT, @parms, 0, 0, 0) 
  If r1 <> #S_OK 
    LastMessage = "SetCalibration" 
    LastError = $80080110 
    ProcedureReturn 0 
  Else 
    ProcedureReturn NewValue 
  EndIf 

EndProcedure 


; SetSerialNr ------------------------------------------------------------------------------ 

Procedure.w SetSerialNr(*Obj.IDispatch, DeviceNr.w, NewValue.w) 

  Dim Value.Variant(2) 
  
  Result.Variant\vt = #VT_EMPTY 
  Value(0)\vt = #VT_I2 
  Value(0)\iVal = DeviceNr 
  Value(1)\vt = #VT_I2 
  Value(1)\iVal = NewValue 
  
  parms.DISPPARAMS 
  With parms 
  \rgvarg = @Value(0) 
  \rgdispidNamedArgs = 0 
  \cArgs = 2 
  \cNamedArgs = 0 
  EndWith 
  
  r1 = *Obj\Invoke($11, ?IID_NULL, 0, #DISPATCH_PROPERTYPUT, @parms, 0, 0, 0) 
  If r1 <> #S_OK 
    LastMessage = "Fehler SetSerialNr" 
    LastError = $80080111 
    ProcedureReturn 0 
  Else 
    ProcedureReturn NewValue 
  EndIf 

EndProcedure 

; ReadAnalogVoltage ----------------------------------------------------------------------- 

Procedure.d ReadAnalogVoltage(*obj.IDispatch, DeviceNr.w,Channel.w) 

  Dim Value.Variant(2) 
  
  Result.Variant\vt = #VT_EMPTY 
  Value(0)\vt = #VT_I2 
  Value(0)\iVal = DeviceNr 
  Value(1)\vt = #VT_I2 
  Value(1)\iVal = Channel
  
  parms.DISPPARAMS 
  With parms 
    \rgvarg = @Value(0)        
    \rgdispidNamedArgs = 0 
    \cArgs = 2 
    \cNamedArgs = 0 
  EndWith 
  
  r1 = *Obj\Invoke($07, ?IID_NULL, 0, #DISPATCH_PROPERTYGET, @parms, @Result, 0, 0) 
  If r1 <> #S_OK 
    LastMessage = "Fehler ReadAnalogVoltage" 
    LastError = $80080107 
    ProcedureReturn 0 
  Else 
    ProcedureReturn Result\dblVal  
  EndIf 

EndProcedure 

; WriteAnalogVoltage ---------------------------------------------------------------------- 

Procedure.d WriteAnalogVoltage(*Obj.IDispatch, DeviceNr.w,Channel.w, Value.d) 

  Dim Value.Variant(3) 
  
  Result.Variant\vt = #VT_EMPTY 
  Value(0)\vt = #VT_I2 
  Value(0)\iVal = DeviceNr 
  Value(1)\vt = #VT_I2 
  Value(1)\iVal = Channel 
  Value(2)\vt = #VT_I2 
  Value(2)\dblVal = Value 
  
  parms.DISPPARAMS 
  With parms 
  \rgvarg = @Value(0) 
  \rgdispidNamedArgs = 0 
  \cArgs = 3 
  \cNamedArgs = 0 
  EndWith 
  
  r1 = *Obj\Invoke($08, ?IID_NULL, 0, #DISPATCH_PROPERTYPUT, @parms, 0, 0, 0) 
  If r1 <> #S_OK 
    LastMessage = "Fehler WriteAnalogVoltage" 
    LastError = $80080108 
    ProcedureReturn 0 
  Else 
    ProcedureReturn Value 
  EndIf 

EndProcedure 

; ReadDigIn ------------------------------------------------------------------------------- 

Procedure.w ReadDigIn(*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($09, ?IID_NULL, 0, #DISPATCH_PROPERTYGET, @parms, @Result, 0, 0) 
  If r1 <> #S_OK 
    LastMessage = "Fehler ReadDigIn" 
    LastError = $80080109 
    ProcedureReturn 0 
  Else 
    ProcedureReturn Result\iVal  
  EndIf 

EndProcedure 

; WriteDigOut -----------------------------------------------------------------------------
Procedure.w WriteDigOut(*Obj.IDispatch, DeviceNr.w,Value.w) 

  Dim Value.Variant(2) 
  
  Result.Variant\vt = #VT_EMPTY 
  Value(0)\vt = #VT_I2 
  Value(0)\iVal = DeviceNr 
  Value(1)\vt = #VT_I2 
  Value(1)\iVal = Value 
    
  parms.DISPPARAMS 
  With parms 
  \rgvarg = @Value(0) 
  \rgdispidNamedArgs = 0 
  \cArgs = 2 
  \cNamedArgs = 0 
  EndWith 
  
  r1 = *Obj\Invoke($0a, ?IID_NULL, 0, #DISPATCH_PROPERTYPUT, @parms, 0, 0, 0) 
  If r1 <> #S_OK 
    LastMessage = "Fehler WriteDigOut" 
    LastError = $8008010a 
    ProcedureReturn 0 
  Else 
    ProcedureReturn Value 
  EndIf 

EndProcedure 

; DataIO ----------------------------------------------------------------------------------

Procedure.b DataIO(*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($0b, ?IID_NULL, 0, #DISPATCH_METHOD, @parms, @Result, 0, 0) 
  If r1 <> #S_OK 
    LastMessage = "Fehler DataIO" 
    LastError = $8008010b 
    ProcedureReturn 0 
  Else 
    ProcedureReturn Result\bVal 
  EndIf 

EndProcedure 

  ;Close ----------------------------------------------------------------------------------

Procedure.b Close(*Obj.IDispatch) 

  Dim Value.Variant(0) 
  
  Result.Variant\vt = #VT_EMPTY 
  
  
  parms.DISPPARAMS 
  With parms 
    \rgvarg = @Value(0) 
    \rgdispidNamedArgs = 0 
    \cArgs = 0 
    \cNamedArgs = 0 
  EndWith 
  
  r1 = *Obj\Invoke($0c, ?IID_NULL, 0, #DISPATCH_METHOD, @parms, 0, 0, 0) 
  If r1 <> #S_OK 
    LastMessage = "Fehler Close" 
    LastError = $8008010c 
    ProcedureReturn 0 
  Else 
    ProcedureReturn 1
  EndIf 

EndProcedure
Viele Grüße
Falko

Verfasst: 07.03.2006 12:53
von mk-soft
Schaue ich mir heute abend an und Plege es bei mir ein.
Muss jetzt erst einmal Arbeiten

Alles Gute

Michael :wink:

Verfasst: 07.03.2006 13:13
von Falko
Ich leide mit Dir. Nur bei mir fängt die Spätschicht um 14.00Uhr an
und geht bis 22.00Uhr. <)
Alle Zeiten sind UTC+02:00
Seite 11 von 12

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de