0,0 → 1,156 |
unit PP_COMON; |
|
{===========================================================================} |
{ (c) miho / DECROS 2000 } |
{===========================================================================} |
{ Zde jsou obecne uzivane pomocne procedury a funkce . } |
{===========================================================================} |
|
interface |
|
function UpStr(str:string):string; |
{== Prevede retezec na velka pismena ==} |
|
procedure PressEnter; |
{== Zobrazi hlasku a ceka na stisk klavesy ==} |
|
procedure HexByte(var f:text;data:word); |
{== Vytiskni byte jako 2 znaky ==} |
|
procedure HexWord(var f:text;data:word); |
{== Vytiskni word jako 4 znaky ==} |
|
procedure HexWordSp(var f:text;data:word); |
{== Vytiskni word jako 4 znaky a mezeru ==} |
|
procedure HexAdr(var f:text;data:word); |
{== Vytiskni adresu s dvojteckou ==} |
|
procedure Error(ErrorStr:string; LineNumber:integer); (* !! *) |
{== Vytiskne hlaseni o chybe a ukonci program ==} |
{ Pokud je LinNumber<=0 pak se netiskne } |
|
function DelSpace(s:string):string; |
{== Vyhodi vsechny mezery ze zacatku retezce s ==} |
|
function GetWord(s:string):string; |
{== Vrati prvni slovo ze zadaneho retezce ==} |
|
function DelWord(s:string):string; |
{== Odstrihne prvni slovo z retezce ==} |
|
procedure DisplayRange(Base, Len:word); |
{== obrazi rozsah jako dvojici hex cisel ==} |
|
function GetParamLine(First:integer):string; |
{== slozi vsechny parametry od First a vrati UpCase tohoto slozeni ==} |
|
implementation |
|
function UpStr(str:string):string; |
{== Prevede retezec na velka pismena ==} |
var i:integer; |
begin for i:=1 to length(str) do str[i]:=upcase(str[i]); |
UpStr:=str; |
end; {UpStr} |
|
procedure PressEnter; |
{== Zobrazi hlasku a ceka na stisk klavesy ==} |
begin write('Press ENTER to continue ...'); |
readln; |
writeln; |
end; {PressEnter} |
|
const prevod:array[0..15]of char=('0','1','2','3','4','5','6','7', |
'8','9','A','B','C','D','E','F'); |
|
procedure HexByte(var f:text;data:word); |
{== Vytiskni byte jako 2 znaky ==} |
begin write(f, prevod[(data shr 4) and $F], |
prevod[data and $F]); |
end; {HexByte} |
|
procedure HexWord(var f:text;data:word); |
{== Vytiskni word jako 4 znaky ==} |
begin write(f, prevod[(data shr 12) and $F], |
prevod[(data shr 8) and $F], |
prevod[(data shr 4) and $F], |
prevod[data and $F]); |
end; {HexWord} |
|
procedure HexWordSp(var f:text;data:word); |
{== Vytiskni word jako 4 znaky a mezeru ==} |
begin write(f, prevod[(data shr 12) and $F], |
prevod[(data shr 8) and $F], |
prevod[(data shr 4) and $F], |
prevod[data and $F], |
' '); |
end; {HexWordSp} |
|
procedure HexAdr(var f:text;data:word); |
{== Vytiskni adresu s dvojteckou ==} |
begin write(f, prevod[(data shr 12) and $F], |
prevod[(data shr 8) and $F], |
prevod[(data shr 4) and $F], |
prevod[data and $F], |
': '); |
end; {HexAdr} |
|
procedure Error(ErrorStr:string; LineNumber:integer); |
{== Vytiskne hlaseni o chybe a ukonci program ==} |
{ Pokud je LinNumber<=0 pak se netiskne } |
begin writeln; |
if LineNumber<=0 then writeln('FATAL: ',ErrorStr) |
else writeln('FATAL @ Line ',LineNumber,': ',ErrorStr); |
writeln; |
halt(1); |
end; {Error} |
|
function DelSpace(s:string):string; |
{== Vyhodi vsechny mezery ze zacatku retezce s ==} |
var i:integer; |
begin i:=1; |
while (i<=length(s)) and (s[i]=' ') |
do inc(i); |
DelSpace:=copy(s,i,255); |
end; {DelSpace} |
|
function GetWord(s:string):string; |
{== Vrati prvni slovo ze zadaneho retezce ==} |
var t:string; |
begin t:=DelSpace(s); |
GetWord:=copy(t,1,pos(' ',t+' ')-1); |
end; {GetWord} |
|
function DelWord(s:string):string; |
{== Odstrihne prvni slovo z retezce ==} |
var t:string; |
begin t:=DelSpace(s); |
t:=copy(t,pos(' ',t+' ')+1,255); |
DelWord:=DelSpace(t); |
end; {DelWord} |
|
procedure DisplayRange(Base, Len:word); |
{== obrazi rozsah jako dvojici hex cisel ==} |
begin if Len<>0 |
then begin hexword(Output,Base); |
write('..'); |
hexword(Output,Base+Len-1); |
write(' '); |
end |
else begin write('none '); |
end; |
end; {DisplayRange} |
|
function GetParamLine(First:integer):string; |
{== slozi vsechny parametry od First a vrati UpCase tohoto slozeni ==} |
var i:integer; |
s:string; |
begin s:=''; |
if First<1 then exit; |
for i:=First to paramcount do s:=s+paramstr(i)+' '; |
GetParamLine:=UpStr(s); |
end; {GetParamLine} |
|
begin |
end. |