home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
pascal
/
library
/
dos
/
s5
/
extend.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-12-27
|
28KB
|
1,130 lines
unit extend;
{$D+,I-,R-,S-,F-,V-,B-,L-}
{$M 4096,0,65535}
interface
uses
crt,dos;
type
range = set of char;
str12 = string[12];
str20 = string[20];
filename = str12;
screenptr = ^screentype;
screentype = record
pos : array[1..25,1..80] of record
ch : char;
at : byte;
end;
end;
const
_spmax : byte = 80;
_zmax : byte = 25;
_inpwinsp : byte = 20;
_inpwinz : byte = 11;
_inpwinlen : byte = 40;
_dirwinmax : byte = 60;
_dirwinsp : byte = 15;
_dirwinz : byte = 7;
_dirwinfwide : byte = 13;
_dirwinanzsp : byte = 4;
_auswahl_chpos : byte = 1;
terminator : range = [#13,#27];
extterminator : range = [#1..#27];
csrterm : range = [#73,#81];
jn : range = ['J','j','Y','y','N','n'];
buchstaben : range = ['A'..'Z','a'..'z'];
filechar : range = ['A'..'Z','a'..'z','_','.','\',':'];
wildcards : range = ['*','?'];
umlaute : range = ['Ü','ü','Ö','ö','Ä','ä','ß'];
grossbuchstaben : range = ['A'..'Z','Ä','Ö','Ü'];
kleinbuchstaben : range = ['a'..'z','ä','ö','ü','ß'];
ziffern : range = ['0'..'9'];
vorzeichen : range = ['+','-'];
punkt : range = ['.'];
binchar : range = ['0','1'];
hexchar : range = ['0'..'9','A'..'F'];
backspace = #8;
space = #32;
esc = #27;
cr = #13;
lf = #10;
ff = #12;
f1 = #59;
f2 = #60;
f3 = #61;
f4 = #62;
f5 = #63;
f6 = #64;
f7 = #65;
f8 = #66;
f9 = #67;
f10 = #68;
sf1 = #84;
sf2 = #85;
sf3 = #86;
sf4 = #87;
sf5 = #88;
sf6 = #89;
sf7 = #90;
sf8 = #91;
sf9 = #92;
sf10 = #93;
cf1 = #94;
cf2 = #95;
cf3 = #96;
cf4 = #97;
cf5 = #98;
cf6 = #99;
cf7 = #100;
cf8 = #101;
cf9 = #102;
cf10 = #103;
af1 = #104;
af2 = #105;
af3 = #106;
af4 = #107;
af5 = #108;
af6 = #109;
af7 = #110;
af8 = #111;
af9 = #112;
af10 = #113;
csr_up = #72;
csr_dn = #80;
csr_l = #75;
csr_r = #77;
pgup = #73;
pgdn = #81;
home = #71;
ende = #79;
initdrucker = #27'@'#24;
schmalschriftein = #15;
schmalschriftaus = #18;
normalschriftein = #27'T';
fettdruckein = #27'E';
fettdruckaus = #27'F';
elite = #27'M';
pica = #27'P';
doppeldruckein = #27'G';
doppeldruckaus = #27'H';
tiefstellenein = #27'S1';
hochstellenein = #27'S0';
breitschriftein = #27'W1';
breitschriftaus = #27'W0';
unterstreichenein = #27'-1';
unterstreichenaus = #27'-0';
kursivein = #27'4';
kursivaus = #27'5';
messageattr : byte = $F0;
frageattr : byte = $F0;
inputattr : byte = $F0;
fensterattr : byte = $70;
auswahlattr : byte = $17;
normalattr : byte = $07;
highlightattr : byte = $F0;
askmask : boolean = true;
extterm : boolean = false;
_80x87 : boolean = false;
_game : boolean = false;
_dma : boolean = false;
screenadr : word = $B800;
screen_init : boolean = false;
var
com1 : word absolute $0040:$0000;
com2 : word absolute $0040:$0002;
com3 : word absolute $0040:$0004;
com4 : word absolute $0040:$0006;
lpt1 : word absolute $0040:$0008;
lpt2 : word absolute $0040:$000A;
lpt3 : word absolute $0040:$000C;
lpt4 : word absolute $0040:$000E;
equipment : word absolute $0040:$0010;
ram : word absolute $0040:$0013;
kbdstat : byte absolute $0040:$0017;
videomode : byte absolute $0040:$0049;
cursor_form : word absolute $0040:$0060;
doszeit : longint absolute $0040:$006C;
anz_hd : byte absolute $0040:$0075;
last_fd : byte absolute $0050:$0004;
computer : byte absolute $F000:$FFFE;
anz_fd : byte;
anz_com : byte;
anz_lpt : byte;
regs : registers;
fkey,ja : boolean;
ch,key : char;
mask : string;
screen : screenptr;
screenbuffer : array[1..6] of screenptr;
value : range;
errnum : word;
wahlterm : byte;
_wherex,_wherey : byte;
_windmin,_windmax : word;
_textattr : word;
max_screen : word;
dira : array[1..100] of str12;
function tstbit (zahl : word; bitnr : byte) : boolean;
function setbit (zahl : word; bitnr : byte) : word;
function clrbit (zahl : word; bitnr : byte) : word;
function bytehex (b : byte) : string;
function bytebin (b : byte) : string;
function wordhex (w : word) : string;
function wordbin (w : word) : string;
procedure save_cursor;
procedure restore_cursor;
procedure save_window;
procedure restore_window;
procedure save_textattr;
procedure restore_textattr;
procedure cursor_block;
procedure cursor_ein;
procedure cursor_aus;
procedure write_screen( s,z : integer; str : string);
procedure screen_attr(nr,ss,es,sz,ez : integer; attr : byte);
procedure init_screen( max : integer );
procedure save_screen( i : integer );
procedure restore_screen( i : integer);
procedure getkey;
procedure std_inout;
procedure crt_inout;
function upstring(s : string) : string;
function lostring(s : string) : string;
function exist(n : string) : boolean;
function load_screen(i : integer; n : string) : boolean;
procedure rahmen(s,z,b,h : integer);
procedure fenster(s,z,b,h : integer);
procedure wait(s : word);
procedure p1(attr : byte);
procedure message(s : string);
function frage_jn(s : string) : boolean;
procedure input_str(msg : string;VAR s : string; l : integer; valid : range);
function input_int(s : string;a : boolean;l : integer; i, min, max : longint) : longint;
function input_real(s : string;a : boolean;l, d : integer; i, min, max : real) : real;
procedure read_str(VAR s : string; l : integer; valid : range);
function read_int(a : boolean;l : integer; i, min, max : longint) : longint;
function read_real(a : boolean;l, d : integer; i, min, max : real) : real;
function int_to_str(i : longint; w : integer) : string;
function real_to_str(r : real; w,d : integer) : string;
function int_from_str(z : string; von,len : integer) : longint;
function real_from_str(z : string; von,len : integer) : real;
function int_from_cmdline(nr,von,bis : integer) : longint;
function real_from_cmdline(nr : integer;von,bis : real) : real;
procedure Auswahl(xPos,yPos,Breite,Spalten : INTEGER;
UmRahmung : BOOLEAN; AnzahlBytes : INTEGER;
VAR Menue; Anzahl : INTEGER; VAR Wahl : INTEGER);
function dirwin : string;
implementation
const
spaces = ' ';
line = '════════════════════════════════════════════════════════════════════════════════';
var
i,j,max : integer;
path : string;
srec : searchrec;
function tstbit (zahl : word; bitnr : byte) : boolean;
begin
tstbit := (((zahl shr bitnr) and 1) = 1);
end;
function setbit (zahl : word; bitnr : byte) : word;
begin
setbit := zahl or (1 shl bitnr);
end;
function clrbit (zahl : word; bitnr : byte) : word;
begin
clrbit := zahl and not (1 shl bitnr);
end;
function bytehex (b : byte) : string;
var
nl,nh : byte;
begin
nh := b div 16;
if (nh > 9) then inc(nh,7);
nl := b mod 16;
if (nl > 9) then inc(nl,7);
bytehex := chr(nh+48) + chr(nl+48);
end;
function bytebin (b : byte) : string;
const
c : array[1..8] of byte = (128,64,32,16,8,4,2,1);
var
n : integer;
s : str20;
begin
s := '';
for n := 1 to 8 do
if (c[n] > b) then
s := s + '0'
else
begin
s := s + '1';
b := b - c[n];
end;
bytebin := s;
end;
function wordhex (w : word) : string;
begin
wordhex := bytehex(hi(w)) + bytehex(lo(w));
end;
function wordbin (w : word) : string;
begin
wordbin := bytebin(hi(w)) + bytebin(lo(w));
end;
procedure save_cursor;
begin
_wherex := wherex;
_wherey := wherey;
end;
procedure restore_cursor;
begin
gotoxy(_wherex,_wherey);
end;
procedure save_window;
begin
_windmin := windmin;
_windmax := windmax;
end;
procedure restore_window;
begin
windmin := _windmin;
windmax := _windmax;
end;
procedure save_textattr;
begin
_textattr := textattr;
end;
procedure restore_textattr;
begin
textattr := _textattr;
end;
procedure cursor( l,h : byte );
begin
regs.ah := 1;
regs.cl := l;
regs.ch := h;
intr (16,regs);
end;
procedure cursor_block;
begin
if (videomode = 7) then
cursor (13, 0)
else
cursor ( 7, 0);
end;
procedure cursor_ein;
begin
if (videomode = 7) then
cursor (13,12)
else
cursor ( 7, 6);
end;
procedure cursor_aus;
begin
if (videomode = 7) then
cursor ( 0,14)
else
cursor ( 0, 1);
end;
procedure write_screen( s,z : integer; str : string);
var
i : integer;
begin
if ((s in [1.._spmax]) and (z in [1.._zmax])) then
begin
dec(s);
if ((length(str) + s) <= _spmax) then
for i := 1 to length(str) do
screen^.pos[z,s+i].ch := str[i];
end;
end;
procedure screen_attr(nr,ss,es,sz,ez : integer; attr : byte);
var
i : integer;
begin
if (screen_init and (nr <= max_screen)) then
begin
if ((ss in [1.._spmax]) and (es in [1.._spmax]) and
(sz in [1.._zmax ]) and (ez in [1.._zmax])) then
begin
for j := sz to ez do
for i := ss to es do
screenbuffer[nr]^.pos[j,i].at := attr;
end;
end;
end;
procedure save_screen( i : integer );
begin
if (screen_init and (i <= max_screen)) then
screenbuffer[i]^ := screen^;
end;
procedure restore_screen( i : integer );
begin
if (screen_init and (i <= max_screen)) then
screen^ := screenbuffer[i]^;
end;
procedure getkey;
begin
while keypressed do key := readkey;
repeat
until keypressed;
key := readkey;
if (key = #0) then
begin
key := readkey;
fkey := true;
ja := false;
end
else
begin
fkey := false;
ja := (upcase(key) in ['Y','J']);
end;
end;
procedure std_inout;
begin
assign (input,''); Reset (input);
assign (output,''); Rewrite (output);
end;
procedure crt_inout;
begin
close(input); assignCrt (input); Reset (input);
close(output); assignCrt (output); Rewrite (output);
end;
function upstring(s : string) : string;
var
i : integer;
begin
for i := 1 to length(s) do s[i] := upcase(s[i]);
upstring := s;
end;
function lostring(s : string) : string;
var
i : integer;
begin
for i := 1 to length(s) do
if (s[i] in ['A'..'Z']) then
s[i] := char(byte(s[i])+32);
lostring := s;
end;
function exist(n : string) : boolean;
var
f : file;
begin
assign (f,n);
(*$I-*)
reset (f);
errnum := ioresult;
(*$I+*)
if errnum = 0 then close (f);
exist := (errnum = 0);
end;
function load_screen(i : integer; n : string) : boolean;
var
f : file;
ids : word;
begin
if ((screen_init and (i <= max_screen)) or (i = 0)) then
begin
if exist(n) then
begin
assign (f,n);
reset (f,1);
if (filesize(f) = (_spmax*_zmax*2)) then
begin
if i=0 then
blockread(f,screen^,(_spmax*_zmax*2),ids)
else
blockread(f,screenbuffer[i]^,(_spmax*_zmax*2),ids);
load_screen := true;
end
else
load_screen := false;
close (f);
end
else
load_screen := false;
end;
end;
procedure rahmen(s,z,b,h : integer);
var
i : integer;
begin
gotoxy (s, z);
write ('╒',copy(line,1,b),'╕');
gotoxy (s,z+h+1);
write ('╘',copy(line,1,b),'╛');
for i := z+1 to z+h do
begin
gotoxy (s, i);
write ('│',copy(spaces,1,b),'│');
end;
end;
procedure fenster(s,z,b,h : integer);
begin
textattr := fensterattr;
rahmen(s,z,b,h);
window(s+1,z+1,s+b,z+h);
clrscr;
end;
procedure wait(s : word);
begin
for i := 1 to s * 1000 do
begin
delay(1);
if keypressed then
begin
ch := readkey;
exit;
end;
end;
end;
procedure Auswahl(xPos,yPos,Breite,Spalten : INTEGER;
UmRahmung : BOOLEAN; AnzahlBytes : INTEGER;
VAR Menue; Anzahl : INTEGER; VAR Wahl : INTEGER);
(* *)
(* p Auswahl(xPos,yPos,Breite,Spalten,UmRahmung, *)
(* AnzahlBytes,Menue,Anzahl,Wahl *)
(* xPos, yPos : Bildschirm-Koordinaten des ersten Menüpunktes *)
(* Breite : (INTEGER) Breite des Leuchtbalkens *)
(* Spalten : (INTEGER) Anzahl der Tabellen-Spalten *)
(* UmRahmung : (BOOLEAN) Rahmen zeichnen oder nicht *)
(* AnzahlBytes: (INTEGER) = SizeOf(Menue[1]) *)
(* Menue : (ARRAY[1..Anzahl] OF STRING[X]) das Menü *)
(* Anzahl : (INTEGER) Anzahl der angezeigten Menüpunkte *)
(* Wahl : (VAR INTEGER) *)
(* >0 Der gewählte Punkt *)
(* =0 Auswahl wurde über <ESC> verlassen *)
TYPE StrPtr = ^String;
VAR MenueStr : ARRAY[1..255] OF StrPtr;
Zeilen, i,j : INTEGER;
term : range;
PROCEDURE Locate(Nr : INTEGER);
BEGIN
gotoxy(xPos+(pred(Nr) DIV Zeilen)*Breite,yPos+(pred(Nr) MOD Zeilen))
END (* Locate *);
PROCEDURE Print(Nr : INTEGER);
VAR i : INTEGER;
BEGIN
Write(copy(MenueStr[Nr]^,1,Breite));
FOR i:=succ(length(MenueStr[Nr]^)) TO Breite DO Write(' ')
END (* Print *);
PROCEDURE ChangeHighLight(VAR alt, neu : INTEGER);
BEGIN
Locate(alt); textattr := auswahlattr; Print(alt);
Locate(neu); textattr := highlightattr; Print(neu);
Locate(neu); textattr := auswahlattr; alt:=neu;
END (* ChangeHighLight *);
BEGIN
cursor_aus;
save_textattr;
textattr := auswahlattr;
term := terminator;
if extterm then term := extterminator;
Zeilen:=pred(Anzahl+Spalten) DIV Spalten; Wahl:=Wahl AND 255;
IF UmRahmung THEN Rahmen(xPos-1,yPos-1,Breite*Spalten,Zeilen);
IF (Wahl>Anzahl) OR (Wahl<1) THEN Wahl:=1;
FOR i:=1 TO Anzahl DO BEGIN
MenueStr[i]:=Ptr(Seg(Menue),Ofs(Menue)+pred(i)*AnzahlBytes);
Locate(i); IF i=Wahl THEN textattr := highlightattr ELSE textattr := auswahlattr;
Print(i)
END; (* FOR *)
Locate(Wahl); i:=Wahl;
REPEAT
IF i<>Wahl THEN ChangeHighLight(i,Wahl);
getkey;
if fkey then
begin
CASE key OF
csr_l : IF Wahl>Zeilen THEN Wahl:=Wahl-Zeilen ELSE
IF Wahl>1 THEN Wahl:=Wahl+pred(Spalten)*Zeilen-1 ELSE
WAHL:=Anzahl;
csr_r : IF Wahl<=Anzahl-Zeilen THEN Wahl:=Wahl+Zeilen ELSE
IF (Wahl>pred(Spalten)*Zeilen) AND (Wahl<Anzahl)
THEN Wahl:=Wahl-pred(Spalten)*Zeilen+1 ELSE
Wahl:=1;
csr_up: IF Wahl>1 THEN Wahl:=Wahl-1
ELSE Wahl:=Anzahl;
csr_dn: IF Wahl<Anzahl THEN Wahl:=Wahl+1
ELSE Wahl:=1;
home : Wahl:=1;
ende : Wahl:=Anzahl;
END (* CASE *)
end
else
begin
if (upcase(key) in buchstaben) then
begin
if (upcase(key) = copy(MenueStr[Wahl]^,_auswahl_chpos,1)) then
j := Wahl
else
j := 0;
repeat
inc(j);
until (j >= Anzahl) or (upcase(key) = copy(MenueStr[j]^,_auswahl_chpos,1));
if (upcase(key) = copy(MenueStr[j]^,_auswahl_chpos,1)) then
Wahl := j;
end;
if ((key in ziffern) and ((ord(key)-48) <= Anzahl)) then
begin
Wahl := ord(key)-48;
end;
end;
if (key = esc) then wahl := 0;
UNTIL ((key in term) and not fkey) or (fkey and (key in csrterm));
wahlterm := byte(key);
restore_textattr;
cursor_ein;
END (* Auswahl *);
procedure p9;
begin
delay(500);
restore_textattr;
if screen_init then restore_screen(max_screen);
end;
function dirwin : string;
var
marked : integer;
ende : boolean;
procedure sortdira(von,bis : integer);
var
i,j : integer;
s : str12;
begin
for i := von to bis do
for j := von to bis do
if dira[j] > dira[i] then
begin
s := dira[i];
dira[i] := dira[j];
dira[j] := s;
end;
end;
procedure dir;
begin
srec.name := '*.*';
i := 0;
findfirst(copy(path,1,length(path)-length(mask))+'*.*',$20+$10,srec);
while not (doserror = 18) and (i <= _dirwinmax) do
begin
if srec.attr = Directory then
begin
if srec.name <> '.' then
begin
inc(i);
dira[i] := srec.name + '\';
end;
end;
findnext(srec);
end;
max := i;
if (i > 1) then sortdira(1,i);
srec.name := path;
findfirst(path,Archive or Hidden,srec);
while not (doserror = 18) and (i <= _dirwinmax) do
begin
inc(i);
if ((srec.attr and Hidden) = Hidden) then
dira[i] := lostring(srec.name)
else
dira[i] := srec.name;
findnext(srec);
end;
if dira[1] = (copy(path,1,3) + mask) then dec(i);
if (i > max+1) then sortdira(max+1,i);
max := i;
end;
begin
if screen_init then save_screen(max_screen);
save_textattr;
if askmask then input_str('Suchmaske',mask,12,filechar + wildcards);
if (key <> esc) then
begin
getdir(0,path);
if length(path) > 3 then path := path + '\';
path := path + mask;
repeat
clrscr;
dir;
if max < 1 then
begin
max := 1;
dira[max] := 'No files!';
end;
marked := 1;
ende := true;
auswahl(_dirwinsp,_dirwinz,_dirwinfwide,_dirwinanzsp,true,sizeof(dira[1]),dira,max,marked);
if (marked > 0) then
begin
if (dira[marked][length(dira[marked])] = '\') then
begin
ende := false;
if dira[marked] = '..\' then
begin
if path <> mask then
begin
i := length(path)-length(mask)-1;
while (path[i] <> '\') do dec(i);
delete(path,i,length(path)-length(mask)-i);
end;
end
else
begin
delete(dira[marked],length(dira[marked]),1);
dira[marked] := '\' + dira[marked];
insert(dira[marked],path,length(path)-length(mask));
end;
end
else
dirwin := copy(path,1,length(path)-length(mask)) + dira[marked];
end;
if (marked < 1) or (dira[1] = 'No files!') then
dirwin := '<ESC>';
until ende;
if (length(path)-length(mask)) > 3 then
chdir(copy(path,1,length(path)-length(mask)-1))
else
chdir(copy(path,1,length(path)-length(mask)));
end
else
dirwin := '<ESC>';
p9;
end;
procedure p1(attr : byte);
begin
if screen_init then save_screen(max_screen);
save_textattr;
textattr := attr;
rahmen(_inpwinsp-1,_inpwinz-1,_inpwinlen,1);
gotoxy(_inpwinsp,_inpwinz);
end;
procedure message(s : string);
begin
p1(messageattr);
write (s);
wait(4);
p9;
end;
function frage_jn(s : string) : boolean;
begin
p1(frageattr);
if length(s) > (_inpwinlen-14) then delete(s,(_inpwinlen-14),255);
write (s + ' (J/N): ');
repeat
getkey;
until (key in jn);
if ja then
writeln('Ja')
else
writeln('Nein');
frage_jn := ja;
p9;
end;
procedure read_str(VAR s : string; l : integer; valid : range);
var
i, j, x, y : integer;
begin
i := length(s);
x := wherex;
y := wherey;
gotoxy (x,y);
write (s);
for j := i + 1 to l do write ('_');
repeat
repeat
gotoxy (x + i,y);
key := readkey;
until (key in terminator) or (key in valid) or (key = backspace);
if ((key in valid) and (i < l)) then
begin
inc(i);
s := s + key;
write (key);
end
else
begin
if (key = backspace) and (i > 0) then
begin
dec(i);
delete(s,length(s),1);
gotoxy (x + i,y);
write ('_');
end;
end;
until (key in terminator);
end;
function read_int(a : boolean;l : integer; i, min, max : longint) : longint;
var
j : integer;
s : string;
begin
save_cursor;
repeat
if a then
str(i, s)
else
s := '';
restore_cursor;
read_str(s, l, vorzeichen + ziffern);
val(s, i, j);
until (j = 0) and ((i >= min) and (i <= max));
read_int := i;
end;
function read_real(a : boolean;l, d : integer; i, min, max : real) : real;
var
j : integer;
s : string;
begin
save_cursor;
repeat
if a then
str(i:0:d, s)
else
s := '';
restore_cursor;
read_str(s, l, vorzeichen + punkt + ziffern + [',']);
for j := 1 to length(s) do
if s[j] = ',' then s[j] := '.';
val(s, i, j);
until (j = 0) and ((i >= min) and (i <= max));
read_real := i;
end;
procedure p3(VAR msg : string;l : integer);
begin
if (length(msg)+l) > 35 then delete(msg,35-l,255);
write (msg + ': ');
end;
procedure input_str(msg : string;VAR s : string; l : integer; valid : range);
begin
p1(inputattr);
p3(msg,l);
read_str(s,l,valid);
p9;
end;
function input_int(s : string;a : boolean;l : integer; i, min, max : longint) : longint;
begin
p1(inputattr);
p3(s,l);
input_int := read_int(a,l,i,min,max);
p9;
end;
function input_real(s : string;a : boolean;l, d : integer; i, min, max : real) : real;
begin
p1(inputattr);
p3(s,l);
input_real := read_real(a,l,d,i,min,max);
p9;
end;
function int_to_str(i : longint; w : integer) : string;
var
s : string;
begin
str(i:w,s);
int_to_str := s;
end;
function real_to_str(r : real; w,d : integer) : string;
var
s : string;
begin
str(r:w:d,s);
real_to_str := s;
end;
function int_from_str(z : string; von,len : integer) : longint;
var
i,j : integer;
r : longint;
s : string;
begin
s := copy(z,von,len);
for i := 1 to length(s) do
if not (s[i] in (vorzeichen + ziffern)) then s[i] := '0';
val(s,r,j);
if j = 0 then
int_from_str := r
else
int_from_str := 0;
end;
function real_from_str(z : string; von,len : integer) : real;
var
i,j : integer;
r : real;
s : string;
begin
s := copy(z,von,len);
for i := 1 to length(s) do
if not (s[i] in (vorzeichen + ziffern + punkt)) then s[i] := '0';
val(s,r,j);
if j = 0 then
real_from_str := r
else
real_from_str := 0.0;
end;
function int_from_cmdline(nr,von,bis : integer) : longint;
var
i,j : integer;
r : longint;
begin
val(paramstr(nr),r,i);
if ((i <> 0) or (r < von) or (r > bis)) then
begin
writeln('Parameter ',paramstr(nr),' ungültig.');
halt(nr);
end;
int_from_cmdline := r;
end;
function real_from_cmdline(nr : integer;von,bis : real) : real;
var
i : integer;
r : real;
begin
val(paramstr(nr),r,i);
if ((i <> 0) or (r < von) or (r > bis)) then
begin
writeln('Parameter ',paramstr(nr),' ungültig.');
halt(nr);
end;
real_from_cmdline:= r;
end;
procedure init_screen( max : integer );
begin
if screen_init then exit;
if max > 6 then max := 6;
for i := 1 to max do
new(screenbuffer[i]);
screen_init := true;
max_screen := max;
end;
(* Initialisierung der UNIT *)
begin
_wherex := 1;
_wherey := 1;
mask := '*.*';
if (videomode = 7) then
screenadr := $B000;
new(screen);
screen := ptr(screenadr,$0000);
_dma := (equipment and $0100) = $0100;
_game := (equipment and $1000) = $1000;
_80x87 := (equipment and $0002) = $0002;
anz_lpt := hi(equipment) shr 6;
anz_com := hi(equipment) and $0F shr 1;
if (equipment and $0001) = 1 then
anz_fd := lo(equipment) shr 6 + 1
else
anz_fd := 0;
end.