PASCAL.TXT

program Wyswietlacz_Alfanum;
{$DEFINE TEST}
{skasowanie znaczku $ spowoduje,ľe program demo nie zostanie uruchomione}

uses
dos,crt;
const
LptBase:word=$278;	{adres portu lpt, w tym przypadku LPT1:}
RS:byte=$40;		{wyb˘r rejestru danych lub rozkaz˘w}
EN:byte=$80;
var
	i:byte;

procedure outlpt(x:byte);
var
W:word;
B:byte;
begin
W:=LptBase;
B:=x;
asm
PUSH  DX
MOV   DX,W
MOV   AL,B
OUT   DX,AL
POP   DX
end;
end;

{wystawienie danych na szyn© i ich "zatrzani©cie"}
procedure clock(x:byte);
begin
outlpt(x or EN); {enable z L na H i jednoczenie dane}
delay(1);
outlpt(x); {ustaw en na L, dane zostajĄ zapisane przez kontroler lcd}
delay(1);
end;

{wyprowadzenie poowy bajtu do wywietlacza}
procedure out(x:byte);
begin
x:=x and $4F; {tylko 4 mniej znaczace bity i rs}
clock(x);
end;

{wyprowadzenie aäcucha znak˘w do wywietlacza}
procedure outstr(s:string);
var
l:byte;
begin
for l:=1 to Length(s) do begin
out((((Ord(s[l])) shr 4) and $0F) or RS);
out(((Ord(s[l])) and $0F) or RS);
end;
end;

{wyprowadzenie znaku ch na wsp˘rz©dnych x,y}
procedure outcharxy(x,y:byte;ch:char);
begin
out(0);
out(2); {powr˘t do poz.home}
case y of
0:y:=0;
1:y:=40;
2:y:=20;
3:y:=60;
end;
while not(y=0) do begin
out($1);
out($4);
dec(y);
end;
while not(x=0) do begin
out($1);
out($4);
dec(x);
end;
out(((Ord(ch) shr 4) and $0F) or RS);
out((Ord(ch) and $0F) or RS);
end;

{wyprowadzenie aäcucha znak˘w na wsp˘rz©dnych x,y}
procedure outstrxy(x,y:byte;s:string);
begin
out(0);
out(2); {powr˘t do poz.home}
case y of
0:y:=0;
1:y:=40;
2:y:=20;
3:y:=60;
end;
while not(y=0) do begin
out($1);
out($4);
dec(y);
end;
while not(x=0) do begin
out($1);
out($4);
dec(x);
end;
outstr(s);
end;

{przesuni©cie ekranu w prawo o x kolumn}
procedure ScreenRight(x:byte);
begin
while not(x<=0) do begin
out($1);
out($C);
dec(x);
{$IFDEF TEST}
delay(100);
{$ENDIF}
end;
end;

{przesuni©cie ekranu w lewo o x kolumn}
procedure ScreenLeft(x:byte);
begin
while not(x<=0) do begin
out($1);
out($8);
dec(x);
{$IFDEF TEST}
delay(100);
{$ENDIF}
end;
end;

{przesuni©cie kursora w lewo o x kolumn}
procedure CursorLeft(x:byte);
begin
while not(x<=0) do begin
out($1);
out($0);
dec(x);
{$IFDEF TEST}
delay(100);
{$ENDIF}
end;
end;

{przesuni©cie kursora w prawo o x bajt˘w}
procedure CursorRight(x:byte);
begin
while not(x<=0) do begin
out($1);
out($4);
dec(x);
{$IFDEF TEST}
delay(100);
{$ENDIF}
end;
end;

{kasowanie ekranu wywietlacza}
procedure ClearLCD;
begin
out($0);
out($1);
end;

procedure CursorON(ON:byte);
begin
out(0);
if (on=0) then out($C) else out($F);
end;



begin
{cz©† inicjujĄca wywietlacz,wĄcza interfejs 4-bitowy}
for i:=1 to 3 do begin
out($03);
delay(5);
end;
out($2); {operacje 4-bitowe}
out($2); {najpierw bardziej znaczaca czesc}
out($C); {pozniej mniej znaczaca}
out($0); {wylacz lcd,wylacz kursor,wlacz mruganie kursora}
out($8);
out($0); {skasuj lcd,kursor do pozycji home}
out($1);
out($0); {przesuwaj kursor w prawo w trakcie wyswietlania}
out($6);
out($0);
out($F); {wlacz lcd}

{$IFDEF TEST}
repeat
ClearLCD;
outstrxy(0,0,'Test wyswietlacza');
outstrxy(0,1,'Praktyka elektroniki');
outstrxy(0,2,'z Elektroniki');
outstrxy(0,3,'Praktycznej');
CursorON(0);
delay(3000);
ClearLCD;
outcharxy(0,0,'1');
outcharxy(0,1,'2');
outcharxy(0,2,'3');
outcharxy(0,3,'4');
outcharxy(1,0,'.');
outcharxy(1,1,'.');
outcharxy(1,2,'.');
outcharxy(1,3,'.');
outstrxy(2,0,'start');
outstrxy(2,1,'stop');
outstrxy(2,2,'config');
outstrxy(2,3,'exit');
CursorON(1);
delay(1000);
ScreenRight(25);
delay(1000);
ScreenLeft(25);
delay(1000);
CursorRight(55);
delay(1000);
CursorLeft(55);
delay(1000);

until keypressed;
{$ENDIF}
end.