Buscar por:

Divisão silábica para número por extenso

Código

Unit silaba;

interface

function silaba(pala: string): string;

implementation

uses 

SysUtils;

function silaba(pala: string): string;

type

  vetor = array[1..20] of string;

var

  ac: vetor;

  res: vetor;

  ex: vetor;

  i: integer;

  j: integer;

  k: integer;

  sim: boolean;

  ax: string;

  pal: integer;

  palavra: string;

begin

j:= 1;

palavra:= pala;

pal:= length(trim(palavra));

for i:= 1 to pal do

   ac[i]:= upercase(palavra[i]);

i:= 1;

sim:= true;

while i<= pal do

   begin

    if (ac[i]='B') or (ac[i]='C') or (ac[i]='D') or (ac[i]='F') or (ac[i]='G') or (ac[i]='P') or (ac[i]='T') or (ac[i]='V') then

        begin

           if (ac[i+1]='L') or (ac[i+1]='R') then

              begin

                 ex[i]:='*';

                 ex[i+1]:='*';

                 i:=i+2;

                 continue;

              end;

    if (ac[i]='C') or (ac[i]='L') or (ac[i]='N') then

        begin

           if (ac[i+1]='H') then

              begin

                 ex[i]:='*';

                 ex[i+1]:='*';

                 i:=i+2;

                 continue;

              end;

        end;

      i:=i+1;

   end;

i:=1;

j:=1;

sim:=false;

for i:=1 to pal do

  begin

    if econ(ac[i]) then

      begin

        if i= 1 then

          begin

             res[j]:= ac[i];

             j:=j+1;

             continue;

          end;

        if (i= 2) and (ex[i] = '*') then

          begin

             res[j]:= ac[i];

             j:=j+1;

             sim:= true;

             continue;

          end;

        if not econ(ac[i+1]) then

          begin

            if not sim then

              begin

               res[j]:= '-';

               j:=j+1;

               res[j]:= ac[i];

               j:=j+1;

               sim:=false;

               continue;

              end

            else

              begin

               sim:= false;

               continue

              end;

          end;

        sim:= false;

        if econ(ac[i+1]) then

          begin

            if ex[i]<> '*' then

              begin

               res[j]:= ac[i];

               j:=j+1;

               res[j]:= '-';

               j:=j+1;

               res[j]:= ac[i+1];

               j:=j+1;

               sim:=true;

               continue;

              end

            else

              begin

               res[j]:= '-';

               j:=j+1;

               res[j]:= ac[i];

               j:=j+1;

               res[j]:= ac[i+1];

               j:=j+1;

               sim:=true;

               continue;

              end;

          end;

      end;

      res[j]:=ac[i];

      j:=j+1;

      sim:= false;

  end;

ax:= '';

  for i:= 1 to 20 do

    begin

      ax:= ax + res[i];

    end;

result:= ax;

end;

function econ(le:string): boolean;

begin

    if (le<>'A') and (le<>'E') and (le<>'I') and (le<>'O') and (le<>'U') then

        result:= true

    else

        result:= false;

end;

end.