TMemo selekcija od prve do zadnje riječi

TMemo selekcija od prve do zadnje riječi 08.10.2011. u 15:55 · pre 183 meseca #1

Pitanje...

imam TMemo componentu i u nju kopiram tekst, nakon čega bi na ButtonClick event trebalo izlistat sve riječi iz teksta po redu ( u neku drugu komponentu).

Code:
procedure TForm1.Button1Click(Sender: TObject);
var
  i : integer;
  N1 : integer;
  strS : string;
  strS1 : string;
  chZn : char;
const
  ALF =['a'..'z', 'A'..'Z', 'č', 'ć', 'đ', 'š', 'ž', 'Č', 'Ć', 'Đ', 'Š', 'Ž'] ;
begin
  i := 1;
  strS1 := memo1.Text;
  strS := '';
  N1 := length(strS1);
  chZn := strS1[i];
    while (chZn in ALF) and (N1 <> 0) do
       begin
        i := i + 1;
        strS := strS + chZn;
        chZn := strS1[i];
        ShowMessage('strS: ' + strS);
    end; (*kraj while strZn in ALF and (i < N) do *)
  strS1 := RightStr(strS1, length(strS1) - length(strS) - 1);
  ShowMessage('strS1: ' + strS1);
end;

end.

ovo je kod koji sam napisala ali on ispisuje samo prvu riječ .... KAKO DA GA NATJERAM DA NASTAVI LISTAT/ČITAT

hvala!

Re: TMemo selekcija od prve do zadnje riječi 08.10.2011. u 16:18 · pre 183 meseca #2

while dodje do "space" karaktera u tekstu i izadje iz petlje (posto nije u "ALF"), a to je posle prve reci, i zato ti ispisuje samo prvu rec,

zar nije bolje ovo odraditi for petljom? nesto ovako:

Code:

s := '';

for 0 to Length(tekst) do
begin
  if tekst[i] = ' ' then
  ShowMessage("Rec: " + s);
  s := '';
  else
  s := s + tekst[i];
end;

Re: TMemo selekcija od prve do zadnje riječi 08.10.2011. u 16:54 · pre 183 meseca #3

ne funkcionira tako, jer treba uzet u obzir da kopirani text osim razmaka i slova sadrži i interpunkcijske znakove i zagrade itd. koje bi na ovaj način uključio u riječ a to ne valja

Re: TMemo selekcija od prve do zadnje riječi 08.10.2011. u 17:36 · pre 183 meseca #4

Zamenis sve znakove interpunkcije i razmake sa #10#13 i dobijeno prebacis u drugi memo. Pogledaj ReplaceStr i slicno.

Re: TMemo selekcija od prve do zadnje riječi 08.10.2011. u 21:00 · pre 183 meseca #5

onda dodaj

StringReplace(tekst, ',', ' ',[rfReplaceAll, rfIgnoreCase]);

Re: TMemo selekcija od prve do zadnje riječi 08.10.2011. u 23:50 · pre 183 meseca #6

velika hvala

Re: TMemo selekcija od prve do zadnje riječi - još uvijek 16.11.2011. u 17:14 · pre 182 meseca #7

Code:

procedure get_rijec(tekst: string);
var
  i : integer;
  strS : string;
  strS1 : string;
  chZn : char;
  rijec: string;
const
  ALF =['a'..'z', 'A'..'Z', 'č', 'ć', 'đ', 'š', 'ž', 'Č', 'Ć', 'Đ', 'Š', 'Ž'] ;
begin
  strS1:= tekst;
  strS := '';
  rijec := '';
  i := 1;
  strS := '';
  chZn := strS1[i];
    while (chZn in ALF)  do begin
      i := i + 1;
      strS := strS + chZn;
      chZn := strS1[i];
    end;
  rijec := strS;
  ShowMessage(rijec);
// strS1 := RightStr(strS1, length(strS1) - length(rijec) - 1);
// ShowMessage('strS1: ' + strS1);
end;

molim vas ako mi neko može pomoći ... cijeli dan se maltretiram s ovim!!
to je onaj isti kod kao na početku teme, i na takav neki način moram rješit problem, al stvarno ne znam. Čitavo vrijeme mi se izvlači samo prva riječ ... ako upotrijebim ovu liniju :

strS1 := RightStr(strS1, length(strS1) - length(rijec) - 1);

i stavim bilo koju petlju da ponavlja dolazi do neke fatalne greške...

Rješenje koje su dobri ljudi dali na ovaj zadatak super radi (malo je kod duži, ali .... hm) , međutim od mene se zahtijeva da to napravim sa while petljom...

znači ono što trebam uraditi je: iščitati sve riječi iz Mema, jednu po jednu, koristeći na ovaka neki način while petlju!!!

Re: TMemo selekcija od prve do zadnje riječi 16.11.2011. u 20:20 · pre 182 meseca #8

Probaj da stavis sve u TStringList

Code:

procedure TForm1.Button1Click(Sender: TObject);
var
  lista : TStringList;
  i : Integer;
begin
  lista := TStringList.Create;
  lista.Delimiter := ' ';
  lista.DelimitedText := Memo1.Text;
  i:=0;
  while i <= lista.Count-1 do begin
    ShowMessage(lista[i]);
    Inc(i, 1);
  end;
end;

Potpis

"Ne menjaj nesto sto te sasvim dobro sluzi, ne trazi leba preko pogace" - Aleksandar Andrijevic

Re: TMemo selekcija od prve do zadnje riječi 16.11.2011. u 20:44 · pre 182 meseca #9

Code (delphi):

  procedure get_rijec(tekst: string);

  var

    i : integer;

    strS : string;

    strS1 : string;

    chZn : char;

    rijec: string;

  const

    ALF =['a'..'z', 'A'..'Z', 'č', 'ć', 'đ', 'š', 'ž', 'Č', 'Ć', 'Đ', 'Š', 'Ž'] ;

  begin

    strS1:= tekst;

    strS := '';

    rijec := '';

    i := 0;

    strS := '';

    while i < Length(tekst) do

    begin

      i := i + 1;

      chZn := strS1[i];

      if (chZn in ALF) then

        strS := strS + chZn

      else

      if chZn = ' ' then

        strS := strS + #13#10;

    end;

    rijec := strS;

    ShowMessage(rijec);

  end;

Re: TMemo selekcija od prve do zadnje riječi 02.12.2011. u 23:18 · pre 181 mesec #10

hvala tkaranoviću ... ovako sam riješila problem:

Code:

  S1 := Form1.Memo1.Text;
  ii := 0;
  S := ' ';
  while ii < Length(S1) do begin
    ii := ii + 1;
    Zn := S1[ii];
    if (Zn in ALF) or (Zn in BR) then S := S + Zn else S := S + ' ';
  end;
  S1 := S;

  for i := 1 to length(S1) do begin
    if (S1[i] <> ' ') and (S1[i] <> Chr(13)) and (S1[i] <> Chr(10))then begin
      StringGrid1.Cells[0, StringGrid1.RowCount - 1] := StringGrid1.Cells[0, StringGrid1.RowCount - 1] + S1[i];
      end
    else begin
      if StringGrid1.Cells[0, StringGrid1.RowCount - 1] <> '' then StringGrid1.RowCount := StringGrid1.RowCount + 1;
    end;
  end;

Forum kao aplikacija na telefonu

Srodne teme