//Paralel Portdaki 2.pin yeşil, 3.pin sarı, 4.pin ise kırmızı led yakacak şekilde planladım
//form üzerinde de Shape ile simule ettim fakat dikkat edin Yeşil ışık trafik ışıklarında hep
//altta iken bizde ters... :)
//NT,XP ve 2000 için bu kodlar geçersizdir... neden acaba?
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ComCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Timer1: TTimer;
Shape1: TShape;
Shape2: TShape;
Shape3: TShape;
Label1: TLabel;
TrackBar1: TTrackBar;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
CheckBox1: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
axx:word;zaman:byte;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
close
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
axx:=256;
zaman:=0;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var deger:byte;
begin
inc (zaman);
case zaman of
1 :begin
shape1.Brush.Color:=clgreen;
shape2.Brush.Color:=clwhite;
shape3.Brush.Color:=clwhite;
end;
2 :begin
shape1.Brush.Color:=clwhite;
shape2.Brush.Color:=clyellow;
shape3.Brush.Color:=clwhite;
end;
3 :begin
shape1.Brush.Color:=clwhite;
shape2.Brush.Color:=clwhite;
shape3.Brush.Color:=clred;
end;
4 :begin
shape1.Brush.Color:=clwhite;
shape2.Brush.Color:=clyellow;
shape3.Brush.Color:=clred;
zaman:=0;
end;
end;
if shape1.Brush.Color=clgreen then
asm
mov ax,2
mov dx,0378h
out dx,ax
end;
if (shape2.Brush.Color=clyellow)and(shape3.Brush.Color=clred) then
asm
mov ax,4+8
mov dx,0378h
out dx,ax
end
else if shape2.Brush.Color=clyellow then
asm
mov ax,4
mov dx,0378h
out dx,ax
end
else if shape3.Brush.Color=clred then
asm
mov ax,8
mov dx,0378h
out dx,ax
end;
asm
mov dx,0378h
in ax,dx
mov deger,al
end;
Label1.Caption:=format('%d - %x',[deger,deger]);
end;
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
timer1.Interval:=trackbar1.Position;
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
timer1.Enabled:=CheckBox1.Checked;
end;
end.