Это помощь? Опции

[Катюша]

Помните, я просила о помощи.. 10 заданий лаб.. + еще какие-то

Получила подтверждение - что поможете, нашла лабы.. Задания показала..

На меня рыкнули - что в топе с заданиями будут флудить.. типа будет много непорядка. Там было 10 штук.
Разделила задания..

И что? Если, мне, ламеру, не сделать задания- я кроме слов Бегин и Енд ничего не знаю - кто мне поможет кроме вас?

А вы и это не сделали.. Какая разница как размещены задания и в скольких топах?

Получилась ситуация, описанная Крыловым..

Может все таки сделаете? Мне еще дофига учить.. А времени осталось мало. Я буду благодарна, если те программы все таки будут написаны полностью.. От первого до последнего символа...

[klem4]

;)Зачем закатывать такую истереку ? Volvo решил тебе одну задачу, вот щас накатал решение для задачи с файлами.

program kat_files;
uses crt;
type

   TFile  = text;
   Tstr   = string;
   TWords = array[1..50] of TStr;

var

       words  : TWords;
   f_in,f_out : TFile;

   n:integer;

   ch:char;


function FileExist(var f:TFile; path:string):boolean;
begin
   Assign(f,path);
   {$i-}
   Reset(f);
   {$i+}
   FileExist:=(IOResult=0);
end;

function GetWords(var f:TFile; var W:TWords):integer;
const
   limits=[#0..#32,'.',',',';','!','?','-',':'];
var
   i,count,bword:integer;
   s:TStr;

begin
   count:=0;

   while not(EoF(f)) do begin
       readln(f,s);
       i:=1;
       while(i<=Length(s)) do begin
           while(i<=length(s))and(s[i] in limits) do
            inc(i);
           if i<=length(s) then begin
               bword:=i;
               while(i<=length(s))and(not(s[i] in limits))
                do inc(i);

               inc(count);
               W[count]:=copy(s,bword,i-bword);
           end;
       end;
   end;

   GetWords:=count;

end;

function Sort(var W:TWords; size:integer):integer;
var
   i:integer;
   flag:boolean;
   temp:TStr;

begin

   repeat
       flag:=true;
       for i:=1 to size-1 do
        if not(length(W[i])>=length(W[i+1])) then
         begin
            temp:=w[i];
            w[i]:=w[i+1];
            w[i+1]:=temp;
            flag:=false;
         end;
   until flag;

end;


function DelDoubleWords(var W:TWords; size:integer):integer;
var
   i,j,t:integer;
begin


   repeat
      i:=1;
      while(w[i]<>w[i+1])and(i<size) do
       inc(i);
      for j:=i to size-1 do
       w[j]:=w[j+1];
      dec(size);
   until i>=size;


    DelDoubleWords:=size;

end;

procedure Out(var f:TFile; var W:TWords; c:char; size:integer);
var
   i,j,count:integer;
   temp:TStr;

begin
   assign(f,'d:\Kat_out');
   rewrite(f);
   i:=1; count:=0;
   while(i<=size)and(count<>4) do begin
       temp:=W[i];
       if temp[length(temp)]=c then begin
           writeln(f,temp);
           inc(count);
        end;
       inc(i);
   end;

   close(f);

end;



Begin

  clrscr;

  if FileExist(f_in,'d:\kat_in.txt') then begin

      write('ch='); readln(ch);

      n:=GetWords(f_in,words);

      close(f_in);

      Sort(words, n);

      n:=DelDoubleWords(words, n);

      Out(f_out, words, ch, n);

  end;

  readln;

End.

и ненадо ругаться и возмщаться, своими словами ты можешь обидеть форумчан, и для тебя это врядли хорошо закончится, могут и забанить.

Если надо, могу решить еще одну задачу с числами LongInt которая.

Сообщение отредактировано: klem4 - 6.08.2005 23:53