Решите мне задачки

За вознаграждение или нахаляву (если повезёт)

Модераторы: Хыиуду, MOTOCoder, Medved, dr.Jekill

Ответить
DenW
Сообщения: 3
Зарегистрирован: 18 июл 2007, 05:32

1. Дан символьный файл f. Найти самое длинное слово среди слов, вторая буква которых есть e; если слов с наибольшей длинной несколько, то найти последнее. Если таких слов нет нет вообще, то сообщить об этом. Решить эту задачу: без ограничения на чило символов в слове.
2. Изобразить на экране равнобедренный треугольник, вращающийся с постоянной угловой скоростью вокруг своей высоты, расположенной параллельно вертикальной оси экрана.
Хыиуду
Сообщения: 2442
Зарегистрирован: 06 мар 2005, 21:03
Откуда: Москва
Контактная информация:

1. Разбиение строки на слова - см. раздел "Алгоритмы". Далее для каждого слова проверяем, вторая буква "е" или не "е", если "е" - сравниваем по длине с предыдущим найденым словом, если новое больше - запоминаем новое.
2. Треугольник строится по трем точкам: (А, В) - вершина, (A-L*cos(w*t), B+H) - левый конец основания, (A+L*cos(w*t), B+H), где А, В - произвольные координаты вершины, L - половина ширины основания, w - угловая скорость вращения, Н - высота треугольника (все задаются произвольно), t - параметр времени (изменяется по таймеру). На очередном шаге: нарисовать треугольник цветом фона (стереть), увеличить параметр t на определенную величину, нарисовать треугольник цветом, отличным от фона, сделать задержку.
Искусство программирования - заставить компьютер делать все то, что вам делать лень.
Для "спасибо" есть кнопка "Спасибо" в виде звездочки внизу под ником автора поста.
DenW
Сообщения: 3
Зарегистрирован: 18 июл 2007, 05:32

Вот что-то с первой получилось:

Код: Выделить всё

Program z;
uses crt;
var f:file of char;
r,t,p,v:string;
st:char;
l,j,k,q,i:integer;
function strtok(var s:string;delims:string):string;
var res:string; state:byte;
begin
state:=1;
res:='';
if s='' then begin r:=''; exit; end;
while pos(s[state],delims)<>0 do
begin
inc(state);
if state>length(s) then
begin
s:='';r:='';exit;
end;
end;
while pos(s[state],delims)=0 do
begin
res:=res+s[state];
inc(state);
if state>length(s) then begin
s:='';
r:=res;
exit;
end;
end;
delete(s,1,state-1);
r:=res;
end;

begin
clrscr;
k:=1;
l:=0;
q:=0;
assign(f,'f.txt');
reset(f);
while not eof(f) do begin read(f,st);
t:=t+st;
if st=' ' then inc(k);
end;
close(f);
for i:=1 to k do begin
strtok(t,' ');
for j:=1 to length(r) do begin
if (r[j]='e')and(j=2) then  l:=length(r);
if l>=q then begin v:=r;q:=l; end;
l:=0;
end;
end;
if q<>0 then writeln('Это слово ',v) else writeln('Таких слов в файле нет');
readkey;
end.
DenW
Сообщения: 3
Зарегистрирован: 18 июл 2007, 05:32

По второй не понятно как рисовать линии если присутствует cos?
Хыиуду
Сообщения: 2442
Зарегистрирован: 06 мар 2005, 21:03
Откуда: Москва
Контактная информация:

for j:=1 to length(r) do begin
if (r[j]='e')and(j=2) then l:=length(r); <...> end;
лучше заменить на
if r[2]='e' then begin l:=length(r); <...> end;

C косинусом - параметр w задаешь сам константой, параметр t изменяется с каким-то временным промежутком (модуль crt, функция delay). Потом значения w и t подставляешь в формулу - получаешь координаты точки (только надо до целых значений округлить). По двум точкам строить отрезки
Искусство программирования - заставить компьютер делать все то, что вам делать лень.
Для "спасибо" есть кнопка "Спасибо" в виде звездочки внизу под ником автора поста.
Ответить