Algoritmy:

Zadání:

Vytvořte funkci pro určení délky řetězce

Function DelkaRetezce(S:String):byte;
{Funkce urci skutecnou delku retezce}
begin {DelkaRetezce}
  DelkaRetezce:=Ord(S[0]);
end; {DelkaRetezce}
  

Zadání:

Vytvořte funkci k určení pozice prvního nemezerového znaku

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}
  

Zadání:

Vytvořte funkci k určení pozice posledního nemezerového znaku

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}
  

Zadání:

Vytvořte proceduru, která odstraní úvodní mezery

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}
  

Zadání:

Vytvořte proceduru, která odstraní koncové mezery

Procedure RemTrail(var s:String);
{Procedura odstrani koncove mezery}
begin {RemTrail}
  s:=copy(s,1,LastNoBlank(s));
end; {RemTrail}
  

Zadání:

Vytvořte proceduru, která odstraní okrajové mezery

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}
  

Zadání:

Vytvořte funkci, která odstraní opakující se mezery

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}
  

Zadání:

Vytvořte funkci, která zarovná daný řetězec vpravo

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) < Len do s:=' '+s;
  RightJust := s;
end; {RightJust}  

Zadání:

Vytvořte funkci, která zarovná daný řetězec vlevo

Function LeftJust(s:String; Len:byte ):string;
{Funkce zarovna text vpravo na zadanou delku radku}
begin {LeftJust}
  s := copy(s,1,Len);
  while Length(s) < Len do s:=s+' ';
  LeftJust := s;
end;{LeftJust}
  

Zadání:

Vytvořte funkci, která zarovná daný řetězec doprostřed

Function StrCentr(s:String;Len:Byte):string;
{Funkce vycentruje text doprostred radky zadane delky}
var i:Byte;
begin {StrCentr}
  s:=DelBlanks(s);
  while (Length(s) < Len) do
    begin
      s:=s+' ';
      if Length(s) < Len then s:=' '+s;
    end;
  StrCentr:=s;
end; {StrCentr}
  

Zadání:

Vytvořte funkci, která překóduje daný řetězec dle dané kódovací tabulky

Function XlateStr(Source: string;Table: string):string;
{Funkce prekoduje retezec dle konverzni tabulky
 Jedna z mnoha variant prekodovani retezce}
var I,J : byte;
begin {XlateStr}
  for I := 1 to Length(Source) do
    if byte(Source[I]) < = Length(Table) then
      XlateStr[I] := Table[byte(Source[I])]
    else
      XlateStr[I] := Source[I];
  XlateStr[0] := Source[0];
end; {XlateStr}
  

Zadání:

Vytvořte funkci, která provede reverzaci řetězce

Function ObratRetezec(s:string):string;
{Funkce obrati retezec}
var I,delka : byte;
begin {ObratRetezec}
  ObratRetezec[0] := s[0];
  delka:=Length(s);
  for I:=1 to delka do
    ObratRetezec[I]:=s[delka-I+1];
end; {ObratRetezec}
  

Zadání:

Vytvořte funkci, která určí počet slov ve větě ukončené tečkou. Je-li tečka umístěna kdekoli uvnitř řetězce, je zbytek řetězce ignorován. Za slovo je považován jakýkoli nemezerový znak (skupina znaků), oddělený mezerami nebo začátkem a mezerou, nebo mezerou a koncem. Samotná tečka obklopená mezerou a koncem řetězce se za slovo POVAŽUJE.

Function GetNrOfWords(Veta:string):byte;
{Funkce vraci pocet slov ve vete. Vsechny znaky za teckou se ignoruji.
 Neni-li ve vete tecka, zpracovava se cela od zacatku az do konce.
 Je-li samotna tecka oddelena mezerou, napr ' a  .', je povazovana za slovo,
 tj. vysledek by byl roven pro tento priklad 2.}
var Mezera,Pocet:byte;
begin {GetNrOfWords}
  Mezera:=1;
  Pocet:=0;
  if Pos('.',Veta)<>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}
  

Zadání:

Vytvořte funkci, která převede zadané písmeno anglické abecedy na malé písmeno, tj. opak funkce UpCase.

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}
  

Zadání:

Vytvořte funkci, která převede zadané písmeno české či anglické abecedy na malé písmeno, tj. opak funkce UpCase, avšak fungující i na české znaky.

Tento algoritus závisí na použitém kódování češtiny.

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}
  

Zadání:

Vytvořte funkci, která převede zadané písmeno české či anglické abecedy na velké písmeno, tj. funkci UpCase fungující i na české znaky.

Tento algoritus závisí na použitém kódování češtiny.

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}
  

Zadání:

Vytvořte funkci, která převede zadaný řetězec na řetězec obsahující jen velká písmena, a to ve dvou verzích - pro anglickou a pro českou i anglickou abecedu.

Tento algoritus závisí na použitém kódování češtiny.

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}  

Zadání:

Vytvořte funkci, která převede zadaný řetězec na řetězec obsahující jen malá písmena, a to ve dvou verzích - pro anglickou a pro českou i anglickou abecedu.

Tento algoritus závisí na použitém kódování češtiny.

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}