Перейти к содержанию
СофтФорум - всё о компьютерах и не только

Заказы "Сделайте все за меня"


Рекомендуемые сообщения

koketka15:

uses Graph,CRT;const m=20; rmax=80;var i,j,GrDriver,GrMode:integer;c:array[1..m]of record r,x,y:longint end; b:array[1..m]of boolean;beginGrDriver:=VGA; GrMode:=VGAHi; InitGraph(GrDriver,GrMode,'\TP\BGI');if GraphResult<>GrOk then begin WriteLn('Graphic driver?'); i:=Ord(ReadKey); Halt end;SetBkColor(1);Randomize;for i:=1 to m do with c[i] do begin r:=random(rmax)+1; x:=r+random(640-2*r); y:=r+random(480-2*r) end;for i:=1 to m do b[i]:=true;for i:=1 to m do for j:=1 to m do if (i<>j)and((sqr(c[i].r+c[j].r)>=sqr(c[i].x-c[j].x)+sqr(c[i].y-c[j].y)) and(sqr(c[i].r-c[j].r)<=sqr(c[i].x-c[j].x)+sqr(c[i].y-c[j].y))) then b[i]:=false;for i:=1 to m do begin setcolor(2); if b[i] then setcolor(15);circle(c[i].x,c[i].y,c[i].r) end;writeln; i:=Ord(ReadKey)end.

Kentri:

#include <stdio.h>main(){char t[100]; int i=0; printf("\nString? "); gets(t); do if(t[i]!='A')putchar(t[i]); while(t[i++]!='@'); getchar();}
Ссылка на комментарий
Поделиться на другие сайты

Спасибо, Тролль. *Не нашёл как в репутацию + поставить... :D *

Вот, посмотри, что надо изменить в запросе.

Вот условие задачи (обработка записей):

Создать файл, содержащий сведения об автомобилях: марка, вместимость, год выпуска, цвет. Программа должна иметь меню, состоящее из следующих пунктов: обновление БД, пополнение БД, вывод БД, запрос и выход из программы.

Запрос: Вывести марку самого старого автомобиля и его вместимость.

uses crt;type avto=recordmarka,cvet:string; vmest,god:integer;end;var f:file of avto; st:avto; max,v:integer;...procedure zapros;beginclrscr;seek(f,0); max:=0; reset(f);write('Самый старый автомобиль: ');while not eof(f) do begin read(f,st); if st.god<max then max:=st.god; end;writeln(st.marka);seek(f,0); write('Вместимость: '); v:=0; reset(f);while not eof(f) do begin read(f,st); v:=st.vmest; end;writeln(v);repeatuntil keypressed;menu;end;... 
Ссылка на комментарий
Поделиться на другие сайты

merda_inter:

а) seek(f,0) - избыточно, reset и так поставит указатель на начало файла.

б) if st.god<max then max:=st.god - так как max первоначально нуль (кстати, почему он max :D, когда он должен стать минимальным из годов выпуска?), то сохраненный в нем год выпуска будет или нуль или меньше нуля (для автомобилей, выпущенных до Рождества Христова :)). Нужно задать сначала год, скажем, 3000 (в 3000-м году тогда появится "проблема 3000-го года", но нас к тому времени, вероятно, уже не будет :) )

writeln(st.marka); - файл к этому моменту будет в любом случае просмотрен до конца, выведется марка последней записи (та же ошибка, кстати, делается в программе чуть позже для вместимости). Надо одновременно с запоминанием каждого нового минимального года выпуска max запоминать в отдельных переменных (или, лучше, в отдельной записи типа avto) и марку автомобиля и его вместимость из той же записи, после первого же просмотра файла в ней будут все нужные данные и надо только их напечатать.

-=vitek=-

1. сформировать по исходной строке новую строку по правилу: в каждом слове перенести первую букву в конец слова
PRINT "String "; : INPUT t$: t$ = t$ + " ": p$ = "": k = 0FOR i = 1 TO LEN(t$)IF MID$(t$, i, 1) >= "A" THENk = k + 1ELSEIF k <> 0 THEN p$ = p$ + MID$(t$, i - k + 1, k - 1) + MID$(t$, i - k, 1): k = 0p$ = p$ + MID$(t$, i, 1)END IFNEXTPRINT p$: PRINT
2. по исходной строке определить количество слов, заканчивающихся заданным символом вывести строку и результаты ее анализа
PRINT "String "; : INPUT t$: t$ = t$ + " ": k = 0PRINT "Letter "; : INPUT l$FOR i = 1 TO LEN(t$) - 1IF MID$(t$, i, 1) >= "A" AND MID$(t$, i + 1, 1) < "A" AND MID$(t$, i, 1) = l$ THEN k = k + 1NEXTPRINT t$ : PRINT k : PRINT

P.S. При просмотре увеличь окно на весь экран, так как преждевременный перенос строки для Бейсика - нежданно случившееся светопреставление :).

Изменено пользователем Тролль
Ссылка на комментарий
Поделиться на другие сайты

Хэлп ми ;))

Дана матрица (3,3) из произвольных чисел.

Надо вычислить произведение сумм элементов 1-ой и 3-ей строк матрицы, используя для этого подпрограмму вычисления суммы лементов k-ой строки матрицы.

Ссылка на комментарий
Поделиться на другие сайты

s1ck bastard:

var a:array[1..3,1..3]of real; i,j:byte; s:real;function sum(k:byte):real; var i:byte; s:real;   begin s:=0; for i:=1 to 3 do s:=s+a[k,i]; sum:=s end;beginfor i:=1 to 3 do for j:=1 to 3 do begin write('a[',i,',',j,'] ? '); readln(a[i,j]) end;s:=sum(1)*sum(3); writeln('Result: ',s:15:5); readlnend.
Изменено пользователем Тролль
Ссылка на комментарий
Поделиться на другие сайты

Задача для Турбо Паскаля 7.0:

Псостроить совокупность попарно связаных N точек с заданными координатами (координаты и количество точек задются с клавиатуры)

PS посмотрите кто-нибудь поскорее, если это возможно...а то надо к среде..а я вообще в панике=(

Ссылка на комментарий
Поделиться на другие сайты

BaPeHbE:

Попарно точки надо вязать веревками. А как еще? :)

uses Graph,CRT;var i,j,n,GrDriver,GrMode:integer; x,y:array[1..100,1..2]of integer;beginwrite('Number of pairs? '); readln(n);for i:=1 to n do begin write(i:2,'-pair: (X1 Y1 X2 Y2)? '); readln(x[i,1],y[i,1],x[i,2],y[i,2]) end;GrDriver:=VGA; GrMode:=VGAHi; InitGraph(GrDriver,GrMode,'\TP\BGI');if GraphResult<>GrOk then begin WriteLn('Graphic driver?'); i:=Ord(ReadKey); Halt end;SetBkColor(1);for i:=1 to n do begin setcolor(15); circle(x[i,1],y[i,1],1); circle(x[i,2],y[i,2],1); setcolor(2);line(x[i,1],y[i,1],x[i,2],y[i,2]); end;i:=Ord(ReadKey)end.

P.S. Может, не совсем понял, сделал для N пар точек. Если N - общее число точек, то надо вместо Number of pairs написать Number of points и после readln(n); добавить n:=n div 2;

Оффтоп
s1ck bastard:
Можно спросить, почему ты помогаешь?
Да у нас, троллей, в пещере скучно... ;) Это не занимает много времени. Отчасти развлечение, отчасти альтруизм. Как и у других форумчан, наверно :). Изменено пользователем Тролль
Ссылка на комментарий
Поделиться на другие сайты

напишите еще одну задачу пожалуйста! ребят, очень надо!

в паскале

даны натуральные числа B1,..,B(n)- число последовательностей(задается с клавиатуры). каждые шесть чисел B(i), B(i+1), B(i+2), B(i+3), B(i+4), B(i+5), B(i+6), где i кратно 6, задают координаты вершин треугольника со сторонами, где B(i), B(i+1)- координаты первой вершины, B(i+2), B(i+3)- координаты второй вершины, B(i+4), B(i+5)- координаты третьей вершины треугольника. Постороить и закрасить треугольники.

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

Ссылка на комментарий
Поделиться на другие сайты

опять ггггггорячо любимый паскаль застал в расплох...Ребятки,помогайте...

Реализовать программу вычисления последовательности десятичных цифр при вычислении n!(n-факториал),(n<=50).Результат оформить в виде многоразрядного десятичного числа;плоской горизонтальной гистограммы цифр в пределах выбранного десятка десятичных цифр.

Ссылка на комментарий
Поделиться на другие сайты

Напишите еще одну задачу, пожалуйста! Ребят, очень надо! Хотя кроме Тролля тут ребят ароде и нет...

В Паскале.=)

Пусть даны координаты трёх точек на плоскости. Если они могут быть вершинами прямоугольного треугольника, вычислить его площадь.

Ссылка на комментарий
Поделиться на другие сайты

Помогите с программой на С++

Пользователь вводит с клавиатуры числа к примеру -3 и 7 и ему на экране появляется график sin x на промежутке от -3 до 7. :)

И еще одна программа как бы дана матрица размером 20*20 и она заполнена числами к примеру 1 и 0 эта матрица программа должна использовать эту матрицу как лабиринт к примеру 1 это стены а 0 там где можно пройти. Есть вход и выход и в зависимости от самого лабиринта программа должна находить самый короткий путь от входа к выходу.

Зарание спосибо :)

Ссылка на комментарий
Поделиться на другие сайты

Надо одновременно с запоминанием каждого нового минимального года выпуска max запоминать в отдельных переменных (или, лучше, в отдельной записи типа avto) и марку автомобиля и его вместимость из той же записи, после первого же просмотра файла в ней будут все нужные данные и надо только их напечатать.

Я идею-то понял и даже, честно говоря, так пробовал сделать, но у меня не получилось ничего.

Вот в течение года шёл хорошо, а на практике сижу пасьянс раскладываю. Ещё и дома TP не запускается. :)

uses crt;type avto=recordmarka,cvet:string; vmest,god:integer;end;var f:file of avto; st:avto; min,v:integer; n,i,r:integer;procedure menu;procedure obnov;beginclrscr; rewrite(f); writeln(‘Введите количество автомобилей’); readln(n);for i:=1 to n do begin writeln(‘Введите марку, вместимость, год выпуска и цвет’);readln(st.marka); readln(st.vmest); readln(st.god); readln(st.cvet); write(f,st); end;repeat until keypressed; menu;end;procedure popoln;beginclrscr; writeln(‘Введите количество пополнений’); readln(n);for i:=1 to n do begin writeln(‘Введите марку, вместимость, год выпуска и цвет’);readln(st.marka); readln(st.vmest); readln(st.god); readln(st.cvet); write(f,st); end;repeat until keypressed; menu;end;procedure vivod;beginseek(f,0); clrscr; writeln(‘БД о автомобилях’);while not eof(f) do begin read(f,st); writeln(st.marka,’ ‘,st.vmest,’ ‘,st.god,’ ‘,st.cvet); end; repeat until keypressed; menu;end;procedure zapros;beginclrscr; seek(f,0); min:=3000; reset(f); write('Самый старый автомобиль - ');while not eof(f) do begin read(f,st); if st.god<=min then min:=st.god; end; writeln(min);seek(f,0); v:=0; reset(f); write('Вместимость: ');while not eof(f) do begin read(f,st); v:=st.vmest; end; writeln(v);repeat until keypressed; menu;end;beginclrscr; writeln(‘Меню’); writeln(‘1. Обновление’); writeln(‘2. Пополнение’); writeln(‘3. Вывод’); writeln(‘4. Запрос’); writeln(‘5. Выход’); writeln(‘Выберите номер пункта’); readln®;case r of 1:obnov; 2:popoln; 3:vivod; 4:zapros; 5:exit; end;end;beginrepeatclrscr; assign(f,’путь к файллу’); reset(f); menu; close(f);until r=5;End.

Извиняюсь, но не нашёл как вставить файл. :)

Ссылка на комментарий
Поделиться на другие сайты

ребят помогите пожалуйста надо сделать 2 программы в турбопаскале:

1)по исходным строкам а$ и b$ определить слова,входящие в строку b$,но не входящие в строку a$, добавить их к концу строки a$.Вывести полученную строку.

2)заполнить одномерный массив 20-тью случайными числами.Вычислить сумму всех элементов массива.Найти произведение всех элементов массива.Определить сумму квадратов всех элементов.Оформить в виде таблицы входные данные.Оформить в виде таблицы результат вычислений.

заранее огромное спасибо!!!!)))

Ссылка на комментарий
Поделиться на другие сайты

koketka15:

сама не понимаю что нужно, поэтому сделайте как поймете
Чего ж тут понимать? Даны координаты вершин, построить и закрасить треугольники. После ввода данных построение всех, сразу закрашенных, треугольников делается одним оператором: for i:=1 to n do FillPoly(3,x)

Программа целиком:

uses Graph,CRT;var i,j,n,GrDriver,GrMode:integer; x:array[1..100,1..6]of integer; beginwrite('Number of triangles? '); readln(n);for i:=1 to n do begin write(i:2,'-triangle: (X1 Y1 X2 Y2 X3 Y3)? '); for j:=1 to 6 do read(x[i,j]); readln end;GrDriver:=VGA; GrMode:=VGAHi; InitGraph(GrDriver,GrMode,'\TP\BGI');if GraphResult<>GrOk then begin WriteLn('Graphic driver?'); i:=Ord(ReadKey); Halt end;SetBkColor(1); for i:=1 to n do FillPoly(3,x[i]); i:=Ord(ReadKey)end.

s1ck bastard:

Если они могут быть вершинами , вычислить его площадь.
Если пифагоровы штаны на все стороны равны... проверка, равен ли квадрат какой-нибудь стороны сумме квадратов остальных сторон. Тогда площадь - половина произведения этих остальных сторон. На уровне предыдущей задачи, даже без графики.
var l:array[0..2]of longint; x:array[0..2,0..1]of longint; i,j:integer; s:real;begin write('triangle: (X1 Y1 X2 Y2 X3 Y3)? '); for i:=0 to 2 do for j:=0 to 1 do read(x[i,j]); readln; s:=0;for i:=0 to 2 do begin l[i]:=0; for j:= 0 to 1 do l[i]:=l[i]+sqr(x[i,j]-x[(i+1)mod 3,j]) end;for i:=0 to 2 do if l[i]=l[(i+1)mod 3]+l[(i+2)mod 3] then s:=sqrt(l[(i+1)mod 3])*sqrt(l[(i+2)mod 3])/2;  if s=0 then writeln('It is not right-angled triangle!') else writeln('Square is ',s:10:2); readlnend.
Ссылка на комментарий
Поделиться на другие сайты

Хулиганка:

опять ггггггорячо любимый паскаль застал в расплох...
Следовало бы любить. Проще Паскаля языков нет. Паскаль на порядок понятнее, чем, например, C++. Другое дело, зачем вам вообще дают программирование - нужно оно вам, как рыбке зонтик.
Реализовать программу вычисления последовательности десятичных цифр при вычислении n!(n-факториал),(n<=50).Результат оформить в виде многоразрядного десятичного числа;плоской горизонтальной гистограммы цифр в пределах выбранного десятка десятичных цифр.
Кому понадобилась горизонтальная гистограмма цифр в записи числа? :D Еще бы предложили расположить цифры записи числа по параболе... ;) Нечеловеческое какое-то требование. Ну ладно...
var k:array[1..11]of longint; m,l:longint; i,j,n:integer; p,s:string;beginfor i:=1 to 11 do k[i]:=0; l:=1000000; s:='';write('n ? '); readln(n); k[1]:=1;for i:=1 to n do begin m:=0; for j:=1 to 11 do begin k[j]:=k[j]*i+m; m:=k[j] div l; k[j]:=k[j] mod l end end;for j:=11 downto 1 do begin str(k[j]:6,p); s:=s+p end;for j:=1 to length(s) do if s[j]=' ' then s[j]:='0';for j:=1 to length(s) do if s[j]>'0' then begin s:=copy(s,j,length(s)-j+1); break end;j:=1; while(s[j]='0')do begin s[j]:=' '; inc(j) end;writeln; writeln(s); writeln;for i:=length(s) downto 1 do begin fillchar(p[1],ord(s[i])-48,s[i]); p[0]:=chr(ord(s[i])-48); if (length(s)-i)mod 10=0 then begin write('***********'); readln end; writeln(p) end;readlnend.

После ввода аргумента факториала вычисляет и выводит его значение, потом по нажатиям Enter выводит горизонтальные гистограммы значений десятичных разрядов ("цифр") в записи числа по десятку за раз, начиная с младших разрядов.

Изменено пользователем Тролль
Ссылка на комментарий
Поделиться на другие сайты

merda_inter:

Это должно выглядеть, например, так (обрати внимание на появление новой записи sm, кроме того, я заменил max на min: называть минимум максимумом - путь к сумасшествию)

uses crt;type avto=record marka,cvet:string; vmest,god:integer; end;var f:file of avto; st,sm:avto; min,v:integer;...procedure zapros;beginclrscr; min:=3000; reset(f); write('Самый старый автомобиль: ');while not eof(f) do begin read(f,st); if st.god<min then begin min:=st.god; sm:=st; end; end;writeln('Марка: ',sm.marka); writeln('Вместимость: ',sm.vmest); repeat until keypressed; menu;end;

- с одним "но", касающимся вызова процедуры menu, его на самом деле там вообще не должно быть.

У тебя программа построена по принципу "у попа была собака..." - каждая процедура вызывает в конце процедуру меню, а та в свою очередь, вызывает одну из этих процедур, и так далее. Так называемая косвенная рекурсия. Вместо выхода из использованной процедуры мы непрерывно углубляем цепочку вызовов. При каждом вызове будет заниматься новая память под вызов и данные нового экземляра процедуры, это бессмысленная трата памяти и на каком-то вызове программа скажет: хватит, глубина рекурсии превзошла допустимую глубину. В правильно построенной программе после отработки пункта меню управление должно возвращаться обратно в то же меню для нового выбора пункта, а не оставаться в старом меню и требовать создания еще одного, вложенного, экземпляра меню. Например, так:

procedure menu;beginrepeat	 clrscr; writeln(‘Меню’); writeln(‘1. Обновление’); writeln(‘2. Пополнение’); writeln(‘3. Вывод’); writeln(‘4. Запрос’); writeln(‘5. Выход’); writeln(‘Выберите номер пункта’); readln®;case r of 1:obnov; 2:popoln; 3:vivod; 4:zapros; 5:exit; end;until false;end;

и вызовы menu из всех процедур надо исключить.

Кстати, заметил, что после предварительного объявления процедуры menu не хватает forward;

но при нерекурсивном построении программы процедуру menu объявлять предварительно не нужно, просто надо ее поместить после остальных или, еще проще, включить ее текст в основную программу.

P.S. Заметил, что в скопированном тексте твоих подпрограмм кавычки у строк какие-то странные: открывающая и завершающая разные. Ну, это и компилятор заметит...

И, кстати, переменная max (или min) вообще не нужна, без нее даже проще: надо вместо

clrscr; min:=3000; reset(f); write('Самый старый автомобиль: ');

while not eof(f) do begin read(f,st); if st.god<min then begin min:=st.god; sm:=st; end; end;

написать

clrscr; sm.god:=3000; reset(f); write('Самый старый автомобиль: ');

while not eof(f) do begin read(f,st); if st.god<sm.god then sm:=st end;

Изменено пользователем Тролль
Ссылка на комментарий
Поделиться на другие сайты

vovka8888:

1)по исходным строкам а$ и b$ определить слова,входящие в строку b$,но не входящие в строку a$, добавить их к концу строки a$.Вывести полученную строку.

var a,b,c,d:string; i,k:integer; beginwrite('String 1? '); readln(a); c:=a; write('String 2? '); readln(b);k:=0; b:=b+' ';for i:=1 to length(b) do if b[i]>'@' then inc(k) else if k<>0 then begin d:=copy(b,i-k,k); if pos(d,a)=0 then c:=c+' '+d; k:=0 end;writeln©; readlnend.

2)заполнить одномерный массив 20-тью случайными числами.Вычислить сумму всех элементов массива.Найти произведение всех элементов массива.Определить сумму квадратов всех элементов.Оформить в виде таблицы входные данные.Оформить в виде таблицы результат вычислений.

var a:array[1..20]of integer; i:integer; s,m,q:real; beginrandomize; for i:=1 to 20 do a[i]:=random(199)-99; s:=0; m:=1; q:=0;for i:=1 to 20 do begin s:=s+a[i]; m:=m*a[i]; q:=q+sqr(a[i]) end;writeln('Array':40); for i:=1 to 20 do write(a[i]:8); writeln;writeln('Sum':10,'Product':35,'Sum of squares':30);writeln(S:10:0,m:45:0,q:20:0); readlnend.
Изменено пользователем Тролль
Ссылка на комментарий
Поделиться на другие сайты

Помогите написать програмки, незнаю даже как к ним подойти.

**************************************

i

Уведомление:

удалено

!

Предупреждение:

Artur88: Вам уже дали ответ по вашим задачкам.

Ссылка на комментарий
Поделиться на другие сайты

Тролль

спасибо большое)))в который раз помог...

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

Даны последовательность 20-ти случайных чисел и n - натуральное число,введенное с клавиатуры.Отсортировать все числа по возрастанию,сделав предварительные вычисления Х1+n,X2- n,X3+n,X4-n и т.д.Результат оформить в виде таблицы

Изменено пользователем Artur88
Ссылка на комментарий
Поделиться на другие сайты

Хулиганка:

Странные вам какие-то задания дают. Это, например, на порядок проще, чем предыдущее.

const l=20;var a:array[1..l]of integer; i,j,n,t:integer;beginrandomize; for i:=1 to l do a[i]:=random(199)-99;write('N ? '); readln(n); writeln;for i:=1 to l do begin a[i]:=a[i]+n; n:=-n end;for i:=1 to l-1 do for j:=1 to l-i do if a[j]>a[j+1] then begin t:=a[j]; a[j]:=a[j+1]; a[j+1]:=t end;writeln('Otsortirovannij massiv':50); writeln;for i:=1 to l do write(a[i]:8); writeln; readlnend.

P.S. Не надо в ответах цитировать целиком другие посты - загромождает тему.

Изменено пользователем Тролль
Ссылка на комментарий
Поделиться на другие сайты

Тролль

ооо...там ппц полный...кому что попадется...есть такое что даже я могу сделать,а есть тааакое...гм...вообщем где ни слова не понятно)))

СПАСИБО)))

Ссылка на комментарий
Поделиться на другие сайты

я уже писал но никто не ответил надо 2 программки вроди несложные но как то не могу понять как их сделать (

Пользователь вводит с клавиатуры числа к примеру -3 и 7 и ему на экране появляется график sin x на промежутке от -3 до 7.

И еще одна программа как бы дана матрица размером 20*20 и она заполнена числами к примеру 1 и 0 эта матрица программа должна использовать эту матрицу как лабиринт к примеру 1 это стены а 0 там где можно пройти. Есть вход и выход и в зависимости от самого лабиринта программа должна находить самый короткий путь от входа к выходу.

Зарание спосибо .

!

Предупреждение:

Artur88: Прочитайте шапку (первый пост) данный темы, в частности что написано в последних 3-х строчках. Последующие подобные сообщения сразу будут оцениваться как флуд и будут применены соответствующие меры

Ссылка на комментарий
Поделиться на другие сайты

Для публикации сообщений создайте учётную запись или авторизуйтесь

Вы должны быть пользователем, чтобы оставить комментарий

Создать учетную запись

Зарегистрируйте новую учётную запись в нашем сообществе. Это очень просто!

Регистрация нового пользователя

Войти

Уже есть аккаунт? Войти в систему.

Войти
  • Последние посетители   0 пользователей онлайн

    • Ни одного зарегистрированного пользователя не просматривает данную страницу



×
×
  • Создать...