Fórum Separação silábica #357562

24/04/2008

0

Delphi

Bom dia a todos.

Preciso separar palavras para que caibam em etiquetas de gôndola de forma coerente. Nessa etiqueta, cabem (no meu caso) 2 linhas de 20 caracteres para a descrição do produto.
Vi que aqui no fórum esse assunto foi bem discutido, mas não houve solução.
Dei uma ´Googalhada´ e encontrei essa função, porém não consegui executá-la (para não dizer a não entendi), devido a falta de uma função chamada RIGHT.
Eis a função:

function hifenar(_word:string):string;
var
_word2 : string;
_point : Integer;
Letra, c1, c2  : String;
begin
_word  := ALLTRIM(_word);
_word2 := ´´;

for _point := 1 TO length(_word) do
    begin
    LETRA := UPPER(Copy(_word,_point,1));
    If Pos(Letra,´AÀÄÃÁÂEÈËÉÊIÌÏÍÎOÕÖÕÓÔUÙÜÚÛYŸÝ´)>0 then
       _word2 := _word2 + ´V´
      ELSE IF Pos(LETRA,´BCDFGHJLMNPQRSTVXZKYW´+´Çç´)>0 then
        _word2 := _word2 + ´C´
      Else
        _word2 := _word2 + ´?´;
    end;

_point := Pos(´VCV´,_word2);
while (_point <> 0) do
   begin
   _word  := Copy(_word ,1,_point)+´-´+RIGHT(_word ,Length(_word )-_point);
   _word2 := Copy(_word2,1,_point)+´-´+RIGHT(_word2,Length(_word2)-_point);
   _point := Pos(´VCV´,_word2);
   end;

_point := Pos(´VCCV´,_word2);
while _point <> 0 do
   begin
   C1 := UPPER(Copy(_word,_point+1,1));
   C2 := UPPER(Copy(_word,_point+2,1));
   if ( ( not Contem(C1,´JLHMNQRSXZ´) ) and Contem(C2,´LR´) ) or ( (Pos(C1,´CLNPST´)>0) and (Pos(C2,´H´)>0) ) then
      begin
      // V-CCV
      _word  := Copy(_word ,1,_point)+´-´+RIGHT(_word ,Length(_word )-_point);
      _word2 := Copy(_word2,1,_point)+´-´+RIGHT(_word2,Length(_word2)-_point);
      end
     else
      begin
      // VC-CV
      _word  := Copy(_word ,1,_point+1)+´-´+RIGHT(_word ,Length(_word )-(_point+1));
      _word2 := Copy(_word2,1,_point+1)+´-´+RIGHT(_word2,Length(_word2)-(_point+1));
      end;
   _point := Pos(´VCCV´,_word2);
   end;

_point := Pos(´VCCCV´,_word2);
while _point <> 0 do
   begin
   C1 := UPPER(Copy(_word,_point+2,1));
   C2 := UPPER(Copy(_word,_point+3,1));
   if ( (NOT Contem(C1,´JLHMNQRSXZ´) ) and Contem(C2,´LR´) ) or ( Contem(C1,´CLNPST´) and (C2=´H´)) then
      begin
      _word  := Copy(_word ,1,_point+1)+´-´+RIGHT(_word ,Length(_word )-(_point+1));
      _word2 := Copy(_word2,1,_point+1)+´-´+RIGHT(_word2,Length(_word2)-(_point+1));
      end
     else
      begin
      _word  := Copy(_word ,1,_point+2)+´-´+RIGHT(_word ,Length(_word )-(_point+2));
      _word2 := Copy(_word2,1,_point+2)+´-´+RIGHT(_word2,Length(_word2)-(_point+2));
      end;
   _point := Pos(´VCCCV´,_word2);
   end;

_point := Pos(´VCCCCV´,_word2);
while _point <> 0 do
      begin
      _word  := Copy(_word ,1,_point+2)+´-´+RIGHT(_word ,Length(_word )-(_point+2));
      _word2 := Copy(_word2,1,_point+2)+´-´+RIGHT(_word2,Length(_word2)-(_point+2));
      _point := Pos(´VCCCCV´,_word2);
      end; 

_point := Pos(´VV´,_word2); 
while _point <> 0 do 
      begin 
      if not Pos(´!´+UPPER(Copy(_word,_point  ,2))+´!´,´!AI!AO!ÃO!ãO!AU!EI!EU!OE!ÕE!õE!OI!OO!OU!´+iif(_point<>1,iif(Pos(UPPER(Copy(_word,_point-1,1)),´GQ´)>0,´UA!ÜA!üA!UE!ÜE!üE!UI!ÜI!üI!UO!ÜO!üO!UU!ÜU!üU!´,´´),´´))>0 then 
         begin
         _word  := Copy(_word ,1,_point)+´-´+RIGHT(_word ,Length(_word )-_point);
         _word2 := Copy(_word2,1,_point)+´-´+RIGHT(_word2,Length(_word2)-_point);
         end;
      if Pos(´VV´,RIGHT(_word2,Length(_word2)-_point)) <> 0 then
         _point := _point + Pos(´VV´,RIGHT(_word2,Length(_word2)-_point))
        else
         _point := 0;
      end;

result := (_word); 

end;


Caso os colegas consigam decifrar como funcionam ou tenham uma outra solução, por favor coloquem aqui no fórum.

Grato pela atenção.


Turbo Drive

Turbo Drive

Responder

Posts

24/04/2008

Tiagotecchio

Ajustei a função e aparentemente funciona. Parece que foi feita com base em uma função clipper...


function hifenar(PPalavras: string): string;
var
    ss: string;
    p: Integer;
    Letra, c1, c2: string;
begin
    PPalavras := TRIM(PPalavras);
    ss := ´´;

    for p := 1 to length(PPalavras) do
    begin
        LETRA := UPPERcase(Copy(PPalavras, p, 1));
        if Pos(Letra, ´AÀÄÃÁÂEÈËÉÊIÌÏÍÎOÕÖÕÓÔUÙÜÚÛYŸÝ´) > 0 then
            ss := ss + ´V´
        else
            if Pos(LETRA, ´BCDFGHJLMNPQRSTVXZKYW´ + ´Çç´) > 0 then
            ss := ss + ´C´
        else
            ss := ss + ´?´;
    end;

    p := Pos(´VCV´, ss);
    while (p <> 0) do
    begin
        PPalavras := Copy(PPalavras, 1, p) + ´-´ + rightstr(PPalavras, Length(PPalavras) - p);
        ss := Copy(ss, 1, p) + ´-´ + rightstr(ss, Length(ss) - p);
        p := Pos(´VCV´, ss);
    end;

    p := Pos(´VCCV´, ss);
    while p <> 0 do
    begin
        C1 := UPPERcase(Copy(PPalavras, p + 1, 1));
        C2 := UPPERcase(Copy(PPalavras, p + 2, 1));
        if ((not ansicontainstext(C1, ´JLHMNQRSXZ´)) and ansicontainstext(C2, ´LR´)) or ((Pos(C1, ´CLNPST´) > 0) and (Pos(C2, ´H´) > 0)) then
        begin
            // V-CCV
            PPalavras := Copy(PPalavras, 1, p) + ´-´ + rightstr(PPalavras, Length(PPalavras) - p);
            ss := Copy(ss, 1, p) + ´-´ + rightstr(ss, Length(ss) - p);
        end
        else
        begin
            // VC-CV
            PPalavras := Copy(PPalavras, 1, p + 1) + ´-´ + rightstr(PPalavras, Length(PPalavras) - (p + 1));
            ss := Copy(ss, 1, p + 1) + ´-´ + rightstr(ss, Length(ss) - (p + 1));
        end;
        p := Pos(´VCCV´, ss);
    end;

    p := Pos(´VCCCV´, ss);
    while p <> 0 do
    begin
        C1 := UPPERcase(Copy(PPalavras, p + 2, 1));
        C2 := UPPERcase(Copy(PPalavras, p + 3, 1));
        if ((not ansicontainstext(C1, ´JLHMNQRSXZ´)) and ansicontainstext(C2, ´LR´)) or (ansicontainstext(C1, ´CLNPST´) and (C2 = ´H´)) then
        begin
            PPalavras := Copy(PPalavras, 1, p + 1) + ´-´ + rightstr(PPalavras, Length(PPalavras) - (p + 1));
            ss := Copy(ss, 1, p + 1) + ´-´ + rightstr(ss, Length(ss) - (p + 1));
        end
        else
        begin
            PPalavras := Copy(PPalavras, 1, p + 2) + ´-´ + rightstr(PPalavras, Length(PPalavras) - (p + 2));
            ss := Copy(ss, 1, p + 2) + ´-´ + rightstr(ss, Length(ss) - (p + 2));
        end;
        p := Pos(´VCCCV´, ss);
    end;

    p := Pos(´VCCCCV´, ss);
    while p <> 0 do
    begin
        PPalavras := Copy(PPalavras, 1, p + 2) + ´-´ + rightstr(PPalavras, Length(PPalavras) - (p + 2));
        ss := Copy(ss, 1, p + 2) + ´-´ + rightstr(ss, Length(ss) - (p + 2));
        p := Pos(´VCCCCV´, ss);
    end;

    p := Pos(´VV´, ss);
    while p <> 0 do
    begin
        if not Pos(´!´ + UPPERcase(Copy(PPalavras, p, 2)) + ´!´, ´!AI!AO!ÃO!ãO!AU!EI!EU!OE!ÕE!õE!OI!OO!OU!´ + ifthen(p <> 1, ifthen(Pos(UPPERcase(Copy(PPalavras, p - 1, 1)), ´GQ´) > 0, ´UA!ÜA!üA!UE!ÜE!üE!UI!ÜI!üI!UO!ÜO!üO!UU!ÜU!üU!´, ´´), ´´)) > 0 then
        begin
            PPalavras := Copy(PPalavras, 1, p) + ´-´ + rightstr(PPalavras, Length(PPalavras) - p);
            ss := Copy(ss, 1, p) + ´-´ + rightstr(ss, Length(ss) - p);
        end;
        if Pos(´VV´, rightstr(ss, Length(ss) - p)) <> 0 then
            p := p + Pos(´VV´, rightstr(ss, Length(ss) - p))
        else
            p := 0;
    end;

    result := (PPalavras);
end;



Responder

Gostei + 0

24/04/2008

Turbo Drive

Não consegui compilar, pq não encontro a função rightstr.
Vc poderia postar ou dizer qual unit ela utiliza ?

Grato pela atenção.


Responder

Gostei + 0

24/04/2008

Turbo Drive

Achei galera, tem q declarar a Unit StrUtils, mas infelizmente essa função não funciona 100 ¬.
Fiz uns testes aqui e qdo vc tenta separar a palavras como [b:66ad2c1d0c]quadro[/b:66ad2c1d0c], [b:66ad2c1d0c]concepção[/b:66ad2c1d0c], elas não separam corretamente [b:66ad2c1d0c]quad - ro[/b:66ad2c1d0c], [b:66ad2c1d0c]con-cepção[/b:66ad2c1d0c].
Como não estudei no Mobral (entra burro sai animal), tenho certeza q está errado.

Alguém teria uma outra função ou correção para esta função.[/b]


Responder

Gostei + 0

29/01/2009

Amanda P.f

Oi! boa tarde!
Estou tentando fazer com que uma string pule para a próxima linha, mas fazendo a separação silábica corretamente. Estava observando essa função hifenar... o trecho de código que eu tenho onde quero chamar essa função é esse:

//a string será impressa a partir da posição ´1´
posicao_inicial := 1;
//a variável ´descrição´ recebe a string
descricao := Q_ItemVendaServico.FieldByName(´descricao_servico´).AsString;
//a variavel ´qtde_linhas´ recebe o Nº de linhas necessárias para armazenar a string, sendo que em cada linha cabe 48 caracteres
qtde_linhas := (Round(((Length(descricao)) / 48)));
if((Length(descricao)) > 48) then
begin
for x := 1 to qtde_linhas do
begin
RDprint.ImpF (Linha,13,(Copy(descricao, posicao_inicial, 48)),[Comp17]);
linha := (linha + 1);
posicao_inicial := (posicao_inicial + 48) ;
end;
end
else
RDprint.ImpF (Linha,13,(Copy(Q_ItemVendaServico.FieldByName(´descricao_servico´).AsString, 1, 48)),[Comp17]);

A minha dúvida é: nesse trecho de código, onde seria o lugar correto para que eu chamasse essa função...Poderia chamá-la antes do ´copy´?
EX : RDprint.ImpF (Linha,13,(Copy(hifenar(descricao, posicao_inicial, 48)),[Comp17]));


Responder

Gostei + 0

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar