delphi текст

[werus]

здравствуйте...поможете с задачкой?....
дана строка состоящая из латинских букв, в которой слова разбиты пробелами,напечатать те слова, которые отличны от последнего слова, и удовлетворяют след..требованию:каждая буква входит в слово не менее 2-х раз...вот как раз тут у меня и запарка..помогите...код ниже...

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);
begin
FORM1.Close;
end;

procedure TForm1.Button1Click(Sender: TObject);
VAR I,L,LEN,k:INTEGER;     OK:BOOLEAN;
     S,str:STRING;       st:array[1..100] of string;
     n,m:integer;
     ch:integer;

begin

S:=MEMO1.Text;
LEN:=LENGTH(S);
l:=1;k:=0; str:='';
MEMO1.Lines[0];
FOR I:=1 TO len DO
 BEGIN
  if (s[i]=' ') then
   BEGIN
   LEN:=i-l;
   inc(k);
   st[k]:= copy(s,l,i-l);
   L:=I+1;
   end;
 end;
 FOR I:=1 TO k-1 DO
 BEGIN
 for l:=1 to k do
 ch:=0;
for i=1 to Length st[l];
for j= i to length st[l];
 if st[l][k]=st[l][j] then ch=st[l][k]+1
  END;
 Memo1.Lines.Add(str);
end;

end.

[werus]

ну...люди..то нибудь

[vovk]

держи мою карявку, вроде должна работать

procedure TForm1.Button1Click(Sender: TObject);

function  main_(str:string ):boolean;
var
ch:string [1];
i:integer;
begin
 Result:=true;
  str:=uppercase(TRIM(str));
  while (str<>'') and result  do
 begin
 i:= length(str);
  ch:=str[i];
   while  result   do
    begin
      dec(i);
      if i<1 then
      result:=false
      else
       if ch=str[i] then
       begin
        str:=StringReplace(str,ch,'',[rfReplaceAll]);
         Break;
       end;
      end;
  end;
end;var
x:integer;
begin
 for x := 0 to Memo1.Lines.Count - 2 do
  if (Uppercase(trim(memo1.Lines.Strings[x]))<>Uppercase(trim(memo1.Lines.Strings[Memo1.Lines.Count - 1])))
  and main_(memo1.Lines.Strings[x]) then
  Memo2.Lines.Add.Add(memo1.Lines.Strings[x]);
end;

всё вроде поправил


правда это будет работать только если каждое слово на своей линии.. сейчас добавлю чтоб с пробелами заработало

[werus]

спасибо.) жду

[vovk]

както так в общем только надо в USES добавить strutils не вместо ReverseString неохото было ничего придумывать
немного подумать в общем то можно гораздо проще сделать, мне кажется

procedure TForm1.Button3Click(Sender: TObject);
function  main_(str:string ):boolean;
var
ch:string [1];
i:integer;
begin
 Result:=true;
  str:=uppercase(TRIM(str));
  while (str<>'') and result  do
 begin
 i:= length(str);
  ch:=str[i];
   while  result   do
    begin
      dec(i);
      if i<1 then
      result:=false
      else
       if ch=str[i] then
       begin
        str:=StringReplace(str,ch,'',[rfReplaceAll]);
         Break;
       end;
      end;
  end;
end;
var
x:integer;
str1,str2:String;
begin
str1:=Trim(StringReplace((StringReplace(Memo1.Lines.Text,#10,' ',[rfReplaceAll])),#13,' ',[rfReplaceAll]))+' ';
str1:=StringReplace(str1,'  ',' ',[rfReplaceAll]);
x:= pos(' ',ReverseString(Trim(str1)));
str2:= Copy(str1, length(Trim(str1))- x+2,x);
memo1.Lines.Clear;
while str1<>'' do
 begin
   x:=Pos(' ',str1);
   if  (copy(str1,1,x)<>str2) and main_(copy(str1,1,x)) then
   Memo1.Text:=Memo1.Text+copy(str1,1,x);
   Delete(str1,1,x);
 end;
end;