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

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


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

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-х строчках. Последующие подобные сообщения сразу будут оцениваться как флуд и будут применены соответствующие меры

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

Присоединяйтесь к обсуждению

Вы можете написать сейчас и зарегистрироваться позже. Если у вас есть аккаунт, авторизуйтесь, чтобы опубликовать от имени своего аккаунта.

Гость
Ответить в этой теме...

×   Вставлено с форматированием.   Вставить как обычный текст

  Разрешено использовать не более 75 эмодзи.

×   Ваша ссылка была автоматически встроена.   Отображать как обычную ссылку

×   Ваш предыдущий контент был восстановлен.   Очистить редактор

×   Вы не можете вставлять изображения напрямую. Загружайте или вставляйте изображения по ссылке.

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

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



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