OCX und das, mit dem Cocreate usw.

Anfängerfragen zum Programmieren mit PureBasic.
Antworten
Benutzeravatar
Falko
Admin
Beiträge: 3535
Registriert: 29.08.2004 11:27
Computerausstattung: PC: MSI-Z590-GC; 32GB-DDR4, ICore9; 2TB M2 + 2x3TB-SATA2 HDD; Intel ICore9 @ 3600MHZ (Win11 Pro. 64-Bit),
Acer Aspire E15 (Win11 Home X64). Purebasic LTS 6.11b1
HP255G8 Notebook @AMD Ryzen 5 5500U with Radeon Graphics 2.10 GHz 3.4GHz, 32GB_RAM, 3TB_SSD (Win11 Pro 64-Bit)
Kontaktdaten:
Kontaktdaten von Falko

Beitrag 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
Bild
Win11 Pro 64-Bit, PB_6.11b1
‮
Nach oben
Benutzeravatar
mk-soft
Beiträge: 3855
Registriert: 24.11.2004 13:12
Wohnort: Germany

Beitrag 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:
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Nach oben
Benutzeravatar
Falko
Admin
Beiträge: 3535
Registriert: 29.08.2004 11:27
Computerausstattung: PC: MSI-Z590-GC; 32GB-DDR4, ICore9; 2TB M2 + 2x3TB-SATA2 HDD; Intel ICore9 @ 3600MHZ (Win11 Pro. 64-Bit),
Acer Aspire E15 (Win11 Home X64). Purebasic LTS 6.11b1
HP255G8 Notebook @AMD Ryzen 5 5500U with Radeon Graphics 2.10 GHz 3.4GHz, 32GB_RAM, 3TB_SSD (Win11 Pro 64-Bit)
Kontaktdaten:
Kontaktdaten von Falko

Beitrag 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
Bild
Win11 Pro 64-Bit, PB_6.11b1
‮
Nach oben
Benutzeravatar
mk-soft
Beiträge: 3855
Registriert: 24.11.2004 13:12
Wohnort: Germany

Beitrag von mk-soft »

Falsche Funktionsnummer:

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

VC5: InvokeHelper(0x5, ...

FF :wink:
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Nach oben
Benutzeravatar
mk-soft
Beiträge: 3855
Registriert: 24.11.2004 13:12
Wohnort: Germany

Beitrag von mk-soft »

Die Fehlernummer habe ich selber festgelegt.

Fehlercode $800801xx -> xx ist die Funktionsnummer
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Nach oben
Benutzeravatar
mk-soft
Beiträge: 3855
Registriert: 24.11.2004 13:12
Wohnort: Germany

Beitrag 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
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Nach oben
Benutzeravatar
Falko
Admin
Beiträge: 3535
Registriert: 29.08.2004 11:27
Computerausstattung: PC: MSI-Z590-GC; 32GB-DDR4, ICore9; 2TB M2 + 2x3TB-SATA2 HDD; Intel ICore9 @ 3600MHZ (Win11 Pro. 64-Bit),
Acer Aspire E15 (Win11 Home X64). Purebasic LTS 6.11b1
HP255G8 Notebook @AMD Ryzen 5 5500U with Radeon Graphics 2.10 GHz 3.4GHz, 32GB_RAM, 3TB_SSD (Win11 Pro 64-Bit)
Kontaktdaten:
Kontaktdaten von Falko

Beitrag 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
Bild
Win11 Pro 64-Bit, PB_6.11b1
‮
Nach oben
Benutzeravatar
Falko
Admin
Beiträge: 3535
Registriert: 29.08.2004 11:27
Computerausstattung: PC: MSI-Z590-GC; 32GB-DDR4, ICore9; 2TB M2 + 2x3TB-SATA2 HDD; Intel ICore9 @ 3600MHZ (Win11 Pro. 64-Bit),
Acer Aspire E15 (Win11 Home X64). Purebasic LTS 6.11b1
HP255G8 Notebook @AMD Ryzen 5 5500U with Radeon Graphics 2.10 GHz 3.4GHz, 32GB_RAM, 3TB_SSD (Win11 Pro 64-Bit)
Kontaktdaten:
Kontaktdaten von Falko

Beitrag 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
Bild
Win11 Pro 64-Bit, PB_6.11b1
‮
Nach oben
Benutzeravatar
mk-soft
Beiträge: 3855
Registriert: 24.11.2004 13:12
Wohnort: Germany

Beitrag von mk-soft »

Schaue ich mir heute abend an und Plege es bei mir ein.
Muss jetzt erst einmal Arbeiten

Alles Gute

Michael :wink:
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Nach oben
Benutzeravatar
Falko
Admin
Beiträge: 3535
Registriert: 29.08.2004 11:27
Computerausstattung: PC: MSI-Z590-GC; 32GB-DDR4, ICore9; 2TB M2 + 2x3TB-SATA2 HDD; Intel ICore9 @ 3600MHZ (Win11 Pro. 64-Bit),
Acer Aspire E15 (Win11 Home X64). Purebasic LTS 6.11b1
HP255G8 Notebook @AMD Ryzen 5 5500U with Radeon Graphics 2.10 GHz 3.4GHz, 32GB_RAM, 3TB_SSD (Win11 Pro 64-Bit)
Kontaktdaten:
Kontaktdaten von Falko

Beitrag von Falko »

Ich leide mit Dir. Nur bei mir fängt die Spätschicht um 14.00Uhr an
und geht bis 22.00Uhr. <)
Bild
Win11 Pro 64-Bit, PB_6.11b1
‮
Nach oben
Antworten

Zurück zu „Anfänger“