var
Form1: TForm1;
value : Byte ;
i, cnt_s, cnt_LED, cnt_PB, cnt_PC : Integer;
A_code, B_Code, verr1, verr2, zustand : Byte;
ff,ff2: real;
[color=#ff0000]
const port1 = $1b0 ;
pa = port1+$0 ; pb = port1+$1 ; pc = port1+$2 ;
pd = port1+$4 ;
pe = port1+$5 ; pf = port1+$6 ;
Steuer1 = port1+$3;
Steuer2 = port1+$7;[/color]
function ausnib(x : Byte) : Char ;stdcall; export ;
function ausbyte(x : Byte) : Shortstring ;stdcall; export ;
function ausbhex (x : Byte) : Shortstring ;stdcall; export ;
function auswhex (x : Word): Shortstring ;stdcall; export ;
function ausbin (x : byte) : Shortstring ; stdcall; export ;
procedure Output (PortAdresse : smallint; Value : smallint) ; stdcall; export;
function Input (PortAdresse : smallint) : smallint ; stdcall; export;
implementation
{$R *.dfm}
procedure Output (PortAdresse : smallint; Value : smallint) ; stdcall; export;
var ByteValue : Byte ;
begin
ByteValue := Byte(Value) ;
asm
push dx
mov dx, PortAdresse
mov al, ByteValue
out dx, al
pop dx
end;
end;
function Input (PortAdresse : smallint) : smallint ; stdcall; export;
var ByteValue : Byte;
begin
asm
push dx
mov dx, PortAdresse
in al, dx
mov ByteValue, al
pop dx
end;
input := smallint(Bytevalue) and $00ff
end;
[color=#ff001f]procedure Hochfahren(hoch : byte);
begin
if (A_code and $01 = $01) and (A_code and $10 = $00)
and (B_code and $03 =$00) then
Zustand := $85;
if (A_code and $80 = $80) then
zustand := $80;
if (A_code and $10 = $10) and (B_code and $01 = $01) then
zustand := $80;
end; [/color]
procedure Runterfahren(runter : byte);
begin
if (A_code and $02 = $02) and (A_code and $20 = $00)
and (B_code and $03 =$00) then
Zustand := $8A;
if (A_code and $80 = $80) then
zustand := $80;
if (A_code and $20 = $20) and (B_code and $02 = $02) then
zustand := $80;
end;
[color=#ff0000]procedure Tasten;
begin
if (Form1.Speedbutton3.down = true)
and (Form1.Speedbutton4.down = false)
and (B_code and $03 =$00) then
Zustand := $85;
if (Form1.Speedbutton10.down = true) then
Zustand := $80;
if (A_code and $10 = $10)
and (B_code and $01 = $01) then
zustand := $80;
if (Form1.Speedbutton4.down = true)
and (Form1.Speedbutton3.down = false)
and (B_code and $03 =$00) then
Zustand := $8A;
if (Form1.Speedbutton10.down = true) then
Zustand := $80;
if (A_code and $20 = $20)
and (B_code and $02 = $02) then
zustand := $80;
end;[/color]
[color=#ff0000]procedure TForm1.FormCreate(Sender: TObject);
begin
Output(Steuer1,$90);
Output(Steuer2,$90);
Output(PD,$00);
Output(
PE,$00);
zustand := $80;
ff := 0;
end;[/color]
function ausnib(x : Byte) : Char ;stdcall; export ;
begin
x := x and $0F;
if x <= $09 then ausnib := chr(x+48) else ausnib := chr(x+55) ;
end;
function ausbyte(x : Byte) : Shortstring ;stdcall; export ;
begin
ausbyte := (ausnib(x shr 4) + ausnib(x))
end;
function ausbhex (x : Byte) : Shortstring ;stdcall; export ;
begin
ausbhex := '$' + ausbyte(x) + ' ';
end;
function auswhex (x : Word): Shortstring ;stdcall; export ;
begin
auswhex := '$' + auswhex(x shr 8) + ausbyte(x) ;
end;
function ausbin (x : byte) : Shortstring ; stdcall; export ;
var i : INTEGER; m : Byte; bin : shortstring ;
begin
bin := '';
m := $80;
for i := 1 to 8 do
begin
if (x and m) = 0
then bin := bin + '0' else bin := bin + '1';
m := m shr 1 ;
if i = 4 then bin := bin + ' ';
end;
ausbin := '%' + bin ;
end;
procedure LED_PORTA_Anzeige (Val : Byte);
begin
with form1 do
begin
if Val and $01 = $01 then LEDA1.Brush.Color := Clgreen
else LEDA1.Brush.Color := Clred;
if Val and $02 = $02 then LEDA2.Brush.Color := Clgreen
else LEDA2.Brush.Color := Clred;
if Val and $04 = $04 then LEDA3.Brush.Color := Clgreen
else LEDA3.Brush.Color := Clred;
if Val and $08 = $08 then LEDA4.Brush.Color := Clgreen
else LEDA4.Brush.Color := Clred;
if Val and $10 = $10 then LEDA5.Brush.Color := Clgreen
else LEDA5.Brush.Color := Clred;
if Val and $20 = $20 then LEDA6.Brush.Color := Clgreen
else LEDA6.Brush.Color := Clred;
if Val and $40 = $40 then LEDA7.Brush.Color := Clgreen
else LEDA7.Brush.Color := Clred;
if Val and $80 = $80 then LEDA8.Brush.Color := Clgreen
else LEDA8.Brush.Color := Clred;
end;
end;
procedure LED_PORTB_Anzeige (Val : Byte);
begin
with form1 do
begin
if Val and $01 = $01 then LEDB1.Brush.Color := Clgreen
else LEDB1.Brush.Color := Clred;
if Val and $02 = $02 then LEDB2.Brush.Color := Clgreen
else LEDB2.Brush.Color := Clred;
if Val and $04 = $04 then LEDB3.Brush.Color := Clgreen
else LEDB3.Brush.Color := Clred;
if Val and $08 = $08 then LEDB4.Brush.Color := Clgreen
else LEDB4.Brush.Color := Clred;
if Val and $10 = $10 then LEDB5.Brush.Color := Clgreen
else LEDB5.Brush.Color := Clred;
if Val and $20 = $20 then LEDB6.Brush.Color := Clgreen
else LEDB6.Brush.Color := Clred;
if Val and $40 = $40 then LEDB7.Brush.Color := Clgreen
else LEDB7.Brush.Color := Clred;
if Val and $80 = $80 then LEDB8.Brush.Color := Clgreen
else LEDB8.Brush.Color := Clred;
end;
end;
[color=#ff0000]
procedure Tasten_Einlesen (var Daten : Byte); stdcall; export;
begin
if Form1.SpeedButton1.Down = True then Daten := Daten or $01;
if Form1.SpeedButton2.Down = True then Daten := Daten or $02;
if Form1.SpeedButton3.Down = True then Daten := Daten or $04;
if Form1.SpeedButton4.Down = True then Daten := Daten or $08;
if Form1.SpeedButton5.Down = True then Daten := Daten or $10;
if Form1.SpeedButton6.Down = True then Daten := Daten or $20;
if Form1.SpeedButton7.Down = True then Daten := Daten or $40;
if Form1.SpeedButton8.Down = True then Daten := Daten or $80;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
A_Code := Input(PD);
B_code := Input(
PE);
Output(
PE,zustand);
if Form1.Speedbutton11.down = True then
Tasten;
if Form1.Speedbutton11.down = False then
begin
Hochfahren(A_code);
Runterfahren(A_code);
end;
LED_PORTA_Anzeige (A_Code);
LED_PORTB_Anzeige (B_Code);
Edit1.Text := ausbin (A_code);
Edit2.Text := ausbin (B_code);
Edit3.Text := ausbhex (A_code);
Edit4.Text := ausbhex(B_code);
end;[/color][color=#ff0000][/color]
end.