;Programmcode PIO_E/A_V0.1 by Jens Haipeter 03.08.2004 
;erstellt mit PB_V3.91 fullversion
;
;Das Programm benötigt die InpOut32.dll von www.logix4u.net
;Diese DLL sollte entweder im Verzeichnis Compilers liegen oder
;noch besser, da dort ebenfalls gesucht wird in Windows\System32
;
;Das Programm stellt einen ersten Versuch dar meine vorhandene
;BMCM-PIO-48-II anzusteuern
;Hierzu ggf. auf http://forums.purebasic.com/german/viewtopic.php?t=2702
;nachlesen, dort stehen noch Erläuterungen zu den Variablen

;Konstanten 
#WinName = "PIO-Port Ein-/Ausgabe by Jens Haipeter V0.1-2004-08-03" 
#Lib_0    = 0 
#Window_0 = 0 
#Text_0   = "Wert Datenbyte :" 
#Text_1   = "Wert Adressbyte:" 
#Text_2   = "Datenbyte binär:" 

;Buttonnummerierung 
Enumeration 
#Button_0 : #Button_1 : #Button_2 : #Button_3 : #Button_4 
#String_0 : #String_1 
#TextGT_0 : #TextGT_1 : #TextGT_2 
EndEnumeration 

;Globale 
Global _addr.l 
Global _data.l 
Global _datb.s 
Global _RwSelect.s 
Global _infotit.s 
Global _infomsg.s 

;Wertzuweisungen 
_addr     = 256 
_data     =-1 
MessageID = 0 
_infotit  = "INFORMATION" 
_infomsg  = "no message" 

;Proceduren 
;Message Box 
Procedure MessageBox() 
  MessageRequester(_infotit,_infomsg,0) 
  _infotit="INFORMATION" 
  _infomsg="no message" 
  MessageID=1 
EndProcedure 

;Button erzeugen 
Procedure GadgetList() 
  If CreateGadgetList(WindowID()) 
    ButtonGadget(#Button_0, 10,215,120, 25,"Datenbyte lesen") 
    ButtonGadget(#Button_1,140,215,120, 25,"Datenbyte schreiben") 
    ButtonGadget(#Button_2,270,215,120, 25,"verlassen") 
    ButtonGadget(#Button_4, 10, 60,120, 25,"Datenbyte übernehmen") 
    ButtonGadget(#Button_3,140, 60,120, 25,"Adressbyte übernehmen") 
    StringGadget(#String_1, 10, 20,120, 25,"") 
    StringGadget(#String_0,140, 20,120, 25,"") 
    TextGadget  (#TextGT_0, 10,150,120, 50,#Text_0+Chr(13)+Chr(13)+Str(_data)+"/"+Hex(_data)+"H",#PB_Text_Center) 
    TextGadget  (#TextGT_1,140,150,120, 50,#Text_1+Chr(13)+Chr(13)+Str(_addr)+"/"+Hex(_addr)+"H",#PB_Text_Center) 
    TextGadget  (#TextGT_2,270,150,120, 50,#Text_2+Chr(13)+Chr(13)+_datb,#PB_Text_Center) 
  EndIf 
  DisableGadget(#String_0,1) 
  DisableGadget(#Button_3,1) 
  DisableGadget(#String_1,1) 
  DisableGadget(#Button_4,1) 
EndProcedure 

;Dll laden 
Procedure LoadDll() 
  If OpenLibrary(#Lib_0,"inpout32.dll") 
  Else 
    End ;Abbruch wenn nicht geladen 
  EndIf 
EndProcedure 

;Grundzustand herstellen 
Procedure PIOClear() 
  ;PIO1 
  CallFunction(#Lib_0,"Out32",$213,$82)       ;Kanal B auf lesen 
  CallFunction(#Lib_0,"Out32",$212,$0)        ;Systembus auf 0 
  CallFunction(#Lib_0,"Out32",$210,$FF)       ;Adressbus auf 255 
  Delay(1) 
  CallFunction(#Lib_0,"Out32",$212,$1)        ;Systembus auf 1, Adresse FFH setzen 
  Delay(1) 
  CallFunction(#Lib_0,"Out32",$212,$0)        ;Systembus auf 0 
  ;PIO2 
  CallFunction(#Lib_0,"Out32",$217,$82)       ;Kanal B auf lesen 
  CallFunction(#Lib_0,"Out32",$216,$0)        ;Systembus auf 0 
  CallFunction(#Lib_0,"Out32",$214,$FF)       ;Adressbus auf 255 
  Delay(1) 
  CallFunction(#Lib_0,"Out32",$216,$1)        ;Systembus auf 1, Adresse FFH setzen 
  Delay(1) 
  CallFunction(#Lib_0,"Out32",$216,$0)        ;Systembus auf 0 
EndProcedure 

;Datenkanal lesen PIO1 
Procedure ReadPIO() 
  _data=-1 
  If _addr>-1 And _addr<256 
    CallFunction(#Lib_0,"Out32",$213,$82)     ;Kanal B auf lesen 
    CallFunction(#Lib_0,"Out32",$210,_addr)   ;Adresse setzen 
    Delay(1) 
    CallFunction(#Lib_0,"Out32",$212,$1)      ;Systembus auf 1, Adresse übernehmen 
    Delay(1) 
    CallFunction(#Lib_0,"Out32",$212,$0)      ;Systembus auf 0 
    CallFunction(#Lib_0,"Out32",$212,$A)      ;IORQ und RD setzen 
    Delay(1) 
    _data=CallFunction(#Lib_0,"Inp32",$211)   ;Datenübernahme von aussen 
    Delay(1) 
    CallFunction(#Lib_0,"Out32",$212,$0)      ;Systembus auf 0 
    CallFunction(#Lib_0,"Out32",$210,$FF)     ;Adressbus auf 255 
    Delay(1) 
    CallFunction(#Lib_0,"Out32",$212,$1)      ;Systembus auf 1, Adresse FFH setzen 
    Delay(1) 
    CallFunction(#Lib_0,"Out32",$212,$0)      ;Systembus auf 0 
  Else 
    _infomsg="Adressbyte falscher Wert"+Chr(13)+Chr(13)+"Adress-Wert :"+Hex(_addr)+"H" 
    MessageBox() 
  EndIf 
  SetGadgetText(#TextGT_0,#Text_0+Chr(13)+Chr(13)+Str(_data)+"/"+Hex(_data)+"H") 
  SetGadgetText(#TextGT_1,#Text_1+Chr(13)+Chr(13)+Str(_addr)+"/"+Hex(_addr)+"H") 
EndProcedure 

;Datenkanal schreiben PIO1 
Procedure WritePIO() 
  If _addr>-1 And _addr<256 
    If _data>-1 And _data<256 
      CallFunction(#Lib_0,"Out32",$213,$80)   ;Kanal B auf schreiben 
      CallFunction(#Lib_0,"Out32",$210,_addr) ;Adresse setzen 
      Delay(1) 
      CallFunction(#Lib_0,"Out32",$212,$1)    ;Systembus auf 1, Adresse übernehmen 
      Delay(1) 
      CallFunction(#Lib_0,"Out32",$212,$0)    ;Systembus auf 0 
      CallFunction(#Lib_0,"Out32",$211,_data) ;Datenübergabe nach aussen 
      Delay(1) 
      CallFunction(#Lib_0,"Out32",$212,$6)    ;IORQ und WR setzen 
      Delay(1) 
      CallFunction(#Lib_0,"Out32",$212,$0)    ;Systembus auf 0 
      CallFunction(#Lib_0,"Out32",$213,$82)   ;Kanal B auf lesen 
      CallFunction(#Lib_0,"Out32",$210,$FF)   ;Adressbus auf 255 
      Delay(1) 
      CallFunction(#Lib_0,"Out32",$212,$1)    ;Systembus auf 1, Adresse FFH setzen 
      Delay(1) 
      CallFunction(#Lib_0,"Out32",$212,$0)    ;Systembus auf 0 
    Else 
      _infomsg="Datenbyte falscher Wert"+Chr(13)+Chr(13)+"Daten-Wert :"+Hex(_data)+"H" 
      MessageBox() 
    EndIf 
  Else 
    _infomsg="Adressbyte falscher Wert"+Chr(13)+Chr(13)+"Adress-Wert :"+Hex(_addr)+"H" 
    MessageBox() 
  EndIf 
  SetGadgetText(#TextGT_0,#Text_0+Chr(13)+Chr(13)+Str(_data)+"/"+Hex(_data)+"H") 
  SetGadgetText(#TextGT_1,#Text_1+Chr(13)+Chr(13)+Str(_addr)+"/"+Hex(_addr)+"H") 
EndProcedure 

;Umsetzen in Bit-Schreibweise 
Procedure ConvData() 
  If _data>-1 
    _datb="%"+Bin(_data) 
    SetGadgetText(#TextGT_2,#Text_2+Chr(13)+Chr(13)+_datb) 
  EndIf 
EndProcedure 

;Selection Ein-/Ausgabe 
Procedure InOutSelect() 
  If GetGadgetText(#String_0)="" 
    SetGadgetText(#String_0,"256") 
  EndIf  
  If _RwSelect="read" 
    _addr=Val(LTrim(GetGadgetText(#String_0))) 
    ReadPIO() 
    ConvData() 
    _addr=256 
    _data=-1  
  EndIf 
  If _RwSelect="write"  
    If GetGadgetText(#String_1)="" 
      SetGadgetText(#String_1,"-1") 
    EndIf  
    _addr=Val(LTrim(GetGadgetText(#String_0))) 
    _data=Val(LTrim(GetGadgetText(#String_1))) 
    WritePIO() 
    ConvData() 
    _addr=256 
    _data=-1  
  EndIf 
  DisableGadget(#Button_0,0) 
  DisableGadget(#Button_1,0) 
  DisableGadget(#Button_3,1) 
  DisableGadget(#String_0,1) 
  DisableGadget(#Button_4,1) 
  DisableGadget(#String_1,1) 
  _RwSelect="Off" 
EndProcedure 

;Hauptschleife 
If OpenWindow(#Window_0,200,200,400,250,#PB_Window_TitleBar,#WinName) 
  GadgetList() 
  LoadDll() 
  PIOClear() 
  _RwSelect="Off" 
  Repeat 
    EventID = WaitWindowEvent() 
    If EventID = #PB_EventGadget 
      Select EventGadgetID() 
        Case #Button_0 ;lesen 
          DisableGadget (#Button_0,1) 
          DisableGadget (#Button_1,1) 
          DisableGadget (#Button_3,0) 
          DisableGadget (#String_0,0) 
          SetGadgetText (#String_0,"") 
          SetGadgetText (#String_1,"") 
          ActivateGadget(#String_0) 
          _RwSelect="read" 
        Case #Button_1 ;schreiben 
          DisableGadget (#Button_0,1) 
          DisableGadget (#Button_1,1) 
          DisableGadget (#Button_3,1) 
          DisableGadget (#String_0,1) 
          DisableGadget (#String_1,0) 
          DisableGadget (#Button_4,0) 
          SetGadgetText (#String_0,"") 
          SetGadgetText (#String_1,"") 
          ActivateGadget(#String_1) 
          _RwSelect="write" 
        Case #Button_2 ;verlassen 
          EventID=#PB_EventCloseWindow 
        Case #Button_3 ;Adresse auswählen und setzen 
          InOutSelect() 
        Case #Button_4 ;Daten auswählen und setzen 
          DisableGadget (#String_1,1) 
          DisableGadget (#Button_4,1) 
          DisableGadget (#String_0,0) 
          DisableGadget (#Button_3,0) 
          ActivateGadget(#String_0) 
      EndSelect 
    EndIf  
  Until EventID = #PB_EventCloseWindow 
EndIf 
;kann auch wegbleiben, da eigentlich automatisch 
;ich bin aber für saftyprocess 
If CloseLibrary(#Lib_0)  :EndIf 
If CloseWindow(#Window_0):EndIf 
;Programmende 
End 

; ExecutableFormat=Windows
; CursorPosition=10
; FirstLine=1
; EOF