{Autor: Stanislav Chromcak
Kontakt: ANCHOR@POST.CZ
WWW: http://freeweb.coco.cz/ANCHOR/pascal/
Tento soubor je soucasti projektu PASCAL V PRIKLADECH }
Function DelkaRetezce(S:String):byte;
{Funkce urci skutecnou delku retezce}
begin {DelkaRetezce}
DelkaRetezce:=Ord(S[0]);
end; {DelkaRetezce}
Function FirstNoBlank(s:String):byte;
{Funkce urci pozici prvniho nemezeroveho znaku}
var P:Byte;
begin {FirstNoBlank}
P := 1;
while (P<=length(s))and(s[P]=' ') do Inc(P);
FirstNoBlank:=P;
end; {FirstNoBlank}
Function LastNoBlank(s:String):Byte;
{Funkce urci pozici posledniho nemezeroveho znaku}
var P:Byte;
begin {LastNoBlank}
P := Length(s);
while (P>0)and(s[P]=' ') do Dec(P);
LastNoBlank:=P;
end; {LastNoBlank}
Procedure RemLead(var s:String);
{Procedura odstrani uvodni mezery}
var P:integer;
begin {RemLead}
P := FirstNoBlank(s);
s := copy(s,P,Length(s)-P+1);
end; {RemLead}
Procedure RemTrail(var s:String);
{Procedura odstrani koncove mezery}
begin {RemTrail}
s:=copy(s,1,LastNoBlank(s));
end; {RemTrail}
Function DelBlanks(s:String):string;
{Funkce odstrani okrajove mezery.}
var L:byte;
begin {DelBlanks}
L := LastNoBlank(s)-FirstNoBlank(s)+1;
if L>0 then
DelBlanks := Copy(s,FirstNoBlank(s),L)
else
DelBlanks := '';
end; {DelBlanks}
Function DelNSpaces(s:String):string;
{Funkce redukuje opakovane mezery}
var P:byte;
begin {DelNSpaces}
P:=Pos(' ',s);
while P > 0 do
begin
Delete(s,P,1);
P:=Pos(' ',s);
end;
DelNSpaces:=s;
end; {DelNSpaces}
Function RightJust(s:String; Len:byte ):string;
{Funkce zarovna text vpravo na zadanou delku radku}
begin {RightJust}
s := copy(s,Length(s)-Len+1,Len);
while Length(s)0 then {Pokud je ve vete tecka}
Delete(Veta,Pos('.',Veta)+1,Length(Veta)); {Odstran vse za teckou}
while (Length(Veta)>0)and(Mezera<>0) do begin
{Dokud neni veta prazdna a vyskytuje se tam jeste mezera}
Mezera:=Pos(' ',Veta); {Urci pozici mezery ve vete}
if Mezera<>1 then Inc(Pocet); {Neni-li na prvnim miste mezera, zvys pocet
slov}
Delete(Veta,1,Mezera); {Smaz vse do mezery}
end; {while}
GetNrOfWords:=Pocet; {Vrat pocet slov}
end; {GetNrOfWords}
Function LowCase(p:char):char;
{Funkce prevede zadany znak na male pismeno.}
begin {LowCase}
if ord(p) in [65..90] then
LowCase:=chr(ord(p)+32)
else
LowCase:=p;
end; {LowCase}
Function CLowCase(p:char):char;
{Funkce prevede zadany cesky znak na male pismeno.}
begin {CLowCase}
case p of
'':CLowCase:='';
'':CLowCase:='';
'':CLowCase:='';
'':CLowCase:='';
'':CLowCase:='';
'':CLowCase:='';
'':CLowCase:='';
'':CLowCase:='';
'':CLowCase:='';
'':CLowCase:='';
'':CLowCase:='';
'':CLowCase:='';
'':CLowCase:='';
'':CLowCase:='';
'':CLowCase:='';
else CLowCase:=LowCase(p);
end; {case}
end; {CLowCase}
Function CUpCase(p:char):char;
{Funkce prevede zadany cesky znak na male pismeno.}
begin {CUpCase}
case p of
'':CUpCase:='';
'':CUpCase:='';
'':CUpCase:='';
'':CUpCase:='';
'':CUpCase:='';
'':CUpCase:='';
'':CUpCase:='';
'':CUpCase:='';
'':CUpCase:='';
'':CUpCase:='';
'':CUpCase:='';
'':CUpCase:='';
'':CUpCase:='';
'':CUpCase:='';
'':CUpCase:='';
else CUpCase:=UpCase(p);
end; {case}
end; {CUpCase}
Function StrLowCase(p:string):string;
{Funkce prevede zadany retezec na retezec malych pismen.}
var i:byte;
begin {StrLowCase}
StrLowCase[0]:=p[0];
for i:=1 to ord(P[0]) do
StrLowCase[i]:=LowCase(p[i]);
end; {StrLowCase}
Function StrCLowCase(p:string):string;
{Funkce prevede zadany cesky retezec na retezec malych pismen.}
var i:byte;
begin {StrCLowCase}
StrCLowCase[0]:=p[0];
for i:=1 to ord(P[0]) do
StrCLowCase[i]:=CLowCase(p[i]);
end; {StrCLowCase}
Function StrUpCase(p:string):string;
{Funkce prevede zadany retezec na retezec velkych pismen.}
var i:byte;
begin {StrUpCase}
StrUpCase[0]:=p[0];
for i:=1 to ord(P[0]) do
StrUpCase[i]:=UpCase(p[i]);
end; {StrUpCase}
Function StrCUpCase(p:string):string;
{Funkce prevede zadany cesky retezec na retezec velkych pismen.}
var i:byte;
begin {StrCUpCase}
StrCUpCase[0]:=p[0];
for i:=1 to ord(P[0]) do
StrCUpCase[i]:=CUpCase(p[i]);
end; {StrCUpCase}