Dale
Участник
|
      
DELUZA , сами решайте
Простое число - число, делящееся только на себя и на 1. Не вызовет затруднений перебрать все числа в цикле, пока не найдется нужное
(Сообщение отредактировал Dale 16 июня 2009 15:46)
(Сообщение отредактировал Dale 16 июня 2009 17:20)
|
Всего сообщений: 139 | Присоединился: май 2009 | Отправлено: 15 июня 2009 23:44 | IP
|
|
|
|
DikayaKiska
Новичок
|
Мальчишки помогите пожалуйста глупенькой девушке с паскалем ....
решите 2 простеньких задачки плз..... и если можете напишите объяснение нам так препод требует, заранее чмокси.....
Удалить все элементы, кроме имеющих заданное произведение цифр
Составить вектор минимальных чисел Фибоначчи в столбцах матрицы.
ПОскаль - сделать решение
|
Всего сообщений: 2 | Присоединился: июнь 2009 | Отправлено: 16 июня 2009 17:30 | IP
|
|
Dale
Участник
|
DikayaKiska
1)Как я понимаю, речь идет об эллементах массива? И удалять нужно наварняка со сдвигом?
Тогда алгоритм следующий:
1)С помощью процедуры readln организовываем ввод с клавиатуры массива и двух чисел.
2)Перебераем в цикле while массив и сравниваем его элементы с произведением этих чисел. Если что-то совпало, то:
- Если да: сдвигаем массив начиная со следующего элемента, при этом не забыв уменьшить N (количество элементов в массиве).
- Если нет: увеличиваем счетчик i, для на следующий элемент массива
Условие выхода из цикла - если i = n.
3)Выводим массив.
Код выглядит примерно так:
____________________
uses crt; {подкл. модуль crt, необходимый для исп.
процедуры readkey в конце и clrscr}
const N1=5; {Количество элементов в массиве
константа потому, что описание массива в
разделе var этого требует. Для операций будет
исп. переменная N, которой будет присвоено
значение N1 перед входом в цикл.}
var N,i,j:integer;
a,b:integer;{числа, вводимые с клавиатуры}
mas:array[1..N1] of integer; {массив}
begin
clrscr;
writeln('BBEDUTE nOO4EPEDHO MaCCuB');
for i:=1 to N1 do readln(mas[ i ]);
{BbIB. massiv dJI9I ydo6cTBA }
clrscr;{очистка экрана}
for i:=1 to N1 do write(mas[ i ],' ');
writeln('Введите два числа');
readln(a); readln(b);
writeln;
i:=1;
N:=N1;
While i<>N do begin
if mas[ i ]=(a*b) then begin
for j:=i to N-1 do mas[ j ]:= mas[ j + 1];
N:=N-1;
end else i:=i+1;
end;{Вот и все!}
{выводим массив}
writeln;
for i:=1 to N do write(mas[ i ],' ');
readkey;{Ждеп, пока нажмут клавишу}
end.
(Сообщение отредактировал Dale 17 июня 2009 1:06)
|
Всего сообщений: 139 | Присоединился: май 2009 | Отправлено: 17 июня 2009 0:36 | IP
|
|
Dale
Участник
|
Если по 1-ой задаче есть вопросы, обращайтесь
Что касается второй, то я забыл, что такое числа Фибоначчи.
(Сообщение отредактировал Dale 17 июня 2009 0:43)
|
Всего сообщений: 139 | Присоединился: май 2009 | Отправлено: 17 июня 2009 0:40 | IP
|
|
KMA 
Долгожитель
|
Числа Фиббоначи это одна из сторон треугольника Паскаля. Здесь рассматривалась не раз.
Их суть: 1 1 2 3 5 8 13 21 и т. д., т. е. каждое последующее число является суммой двух предыдущих. Реализуется примерно так:
Code Sample:
fst:=1;
scnd:=1;
i:=0;
write(scnd);
while (i<=20) do
begin
buf:=scnd;
scnd:=scnd+fst;
fst:=buf;
write(scnd, ' ');
inc(i)
end;
Вроде должно работать.
|
Всего сообщений: 940 | Присоединился: декабрь 2005 | Отправлено: 19 июня 2009 18:38 | IP
|
|
Lenin
Новичок
|
Опять здравствуйте! Помогите мне пожалуйста!
Мне нада сделать курсовую роботу. У меня есть три задачи, из них одна готовая, другуя нада чуть чуть переделать, а третью сделать! Есть готовое меню и пример курсовой роботы! протсо нада подставить все мое и сделать так чтобы она работала! если этим ктонибудь займется прошу написать!
|
Всего сообщений: 12 | Присоединился: май 2009 | Отправлено: 21 июня 2009 13:11 | IP
|
|
Lenin
Новичок
|
Міністерство освіти і науки України
Київський національний університет будівництва і архітектури
Кафедра АТП
Курсова робота на тему:
“Створення меню”
Виконав: студент групи АТП-12
Досенко А.М.
Перевірив викладач: Бондарчук О.В.
Київ 2009
Курсова робота №26
1.Дано файл f, в якому знаходиться інформація про товари, що експортуються: вказується найменування товару, країна, яка імпортує товар і об’єм партії в штуках. Знайти країни, в які експортується даний товар, і загальний об’єм його експорту.
2.Дано дійсні числа а₁,…,а₁₅ (всі числа попарно різні). Поміняти у послідовності місцями найбільший та найменший елементи.
3.Дано дійсна матриця порядку n. Знайти найбільший по модулю елемент. Отримати квадратну матрицю порядку n-1 шляхом викидання з початкової матриці будь-якого рядка та стовпця, на перетині яких розташований максимальний елемент.
Теоретичні відомості
Для розробки меню обов’язково використовується модуль crt. В ньому містяться усі необхідні функції та процедури для створення інтерактивного середовища, в якому буде повноцінний зв'язок між діями користувача та переходом між операціями запрограмованими в меню. Завдяки йому здійснюється повний контроль положення курсору та всього, що виводиться на екран, зміна кольору тексту чи фону, використання звукових сигналів.
Подібні меню є повністю придатними для роботи з базами даних, обчисленням необхідних задач і, знову ж таки, подальшого оперування з отриманими в них результатами. Користувач сам зможе вибрати необхідний підпункт меню, необхідну кількість раз до завершення головної програми.
Для кращого візуального сприйняття програми, можна також використовувати модуль graph, який дозволить “оживити” меню за допомогою виведення на екран графічних об’єктів.
1 2 3 else
4
Текст головної програми
Program DosMenu;
uses crt, graph, export, archis, matrix;
const
k=4;
NameRegime:array[1..k] of string[26]=('1 - work with files',
'2 - work with digits',
'3 - work with matrix',
'4 - exit');
var
driver, mode, error:integer;
x1,x2,x3,y1,y2,y3,i,j,w,z,deltime,grm:integer;
p:array[1..20] of pointtype;
ch:char;
label
mlab;
procedure intro;
begin
driver:=detect;
initgraph(driver,mode,'C:\Program Files\TURBO PASCAL 7.1\BGI');
error:=graphresult;
getgraphmode;
if error <> grok then begin
writeln (grapherrormsg(error));
halt; end
else
begin
x1:=((getmaxx div 2)-150);
x2:=((getmaxx div 2)+152);
y1:=((getmaxy div 2)-70);
y2:=((getmaxy div 2)+72);
setfillstyle (1, white);
bar (x1,y1,x2,y2);
setcolor (black);
settextjustify (centertext,centertext);
outtextXY(getmaxx div 2, (getmaxy div 2)-30, 'Welcome to D91-Menu');
outtextXY(getmaxx div 2, (getmaxy div 2)+20, 'press any key to continue');
repeat
sound (300);
delay (4000);
setfillstyle (1,white);
nosound;
delay (50000);
delay (50000);
sound (300);
delay (4000);
setfillstyle (1,white);
nosound;
bar ((getmaxx div 2)-120, (getmaxy div 2)+10, (getmaxx div 2)+120, (getmaxy div 2)+30);
delay (50000);
delay (50000);
for i:=1 to 20 do
with p do begin
w:=random (16);
x:=random(getmaxx);
y:=random(getmaxy);
putpixel (x,y,w);
end;
setfillstyle (1, white);
bar (x1,y1,x2,y2);
setcolor (black);
settextjustify (centertext,centertext);
settextstyle (3,0,9);
outtextXY(getmaxx div 2, (getmaxy div 2)-30, 'Welcome to D91-Menu');
outtextXY(getmaxx div 2, (getmaxy div 2)+20, 'press any key to continue');
delay (500);
until keypressed;
restorecrtmode;
end;
end;
procedure fin;
begin
setgraphmode (grm);
settextjustify (centertext,centertext);
outtextxy (getmaxx div 2, (getmaxy div 2), 'Have a nice day!');
sound (400);
delay (20000);
sound (500);
delay (20000);
sound (600);
delay (40000);
nosound;
repeat
for i:=1 to 20 do
with p do begin
w:=random(16);
x:=random(getmaxx);
y:=random(getmaxy);
putpixel (x,y,w);
end;
delay (50000); delay (50000);
for i:=1 to 20 do
with p do begin
w:=0;
putpixel (x,y,w);
end;
until keypressed;
readln;
halt;
end;
procedure errorro;
begin
gotoxy (20,17);
write ('This option doesnt exists. Try again.');
sound (300);
delay (20000);
nosound;
for deltime:=1 to 8 do
delay (50000);
end;
begin
intro;
while True do begin
clrscr;
gotoXY (18,2);
write ('===============================================');
gotoXY (18,18);
write ('===============================================');
z:=3;
repeat
gotoXY (17,z);
write ('|');
z:=z+1
until z=18;
z:=3;
repeat
gotoXY (65,z);
write ('|');
z:=z+1
until z=18;
gotoXY (24, 4);
textcolor (green);
write ('Main menu');
textcolor (white);
for j:=1 to k do begin
gotoXY (25, 7+j);
write (nameregime[j]);
end;
gotoXY (20,15);
write ('Type in number of option and press enter: ');
gotoxy (62,15);
readln (i);
case i of
1: begin
clrscr;
dataexp;
workexp;
end;
2: begin
clrscr;
datachis;
workchis;
outchis;
readln;
end;
3: begin
clrscr;
datamatr;
workmatr;
outmatr;
end;
4: begin
fin;
end;
else
begin
errorro;
end; end; end;
end.
Текст модуля “export”
unit export;
interface
const
n=10;
type
tovar=record
g:string[6];
c:string[11];
a:integer;
end;
var
sg:string;
t:array[1..n] of tovar;
f:file of tovar;
procedure dataexp;
procedure workexp;
implementation
procedure dataexp;
var
i:integer;
begin
assign (f, 'expo.txt');
rewrite (f);
for i:=1 to n do begin
write ('Type in goods name: ');
readln (t.g);
write ('Type in country name: ');
readln (t.c);
write ('Type in amount of a deal: ');
readln (t.a);
writeln;
write (f, t);
end;
close (f);
end;
procedure workexp;
var
i:integer;
begin
write ('- Chose type of good: ');
readln (sg);
reset (f);
writeln;
writeln (sg, ' is exported to: ');
for i:=1 to n do begin
read (f, t);
with t do begin
if g=sg then
writeln (c, ' in amount of ', a);
end; end;
readln
end;
end.
Текст модуля archis
unit archis;
interface
const
n=15;
type
digi=array[1..n] of real;
var
achis:digi;
procedure datachis;
procedure workchis;
procedure outchis;
implementation
procedure datachis;
var i:integer;
begin
writeln ('Type in 15 digits');
for i:=1 to n do
read (achis);
end;
procedure workchis;
var
i,j,k:integer;
max,min:real;
begin
min:=200; max:=-200;
for i:=1 to n do begin
if achis > max then begin
max:=achis;
j:=i;
end;
end;
for i:=1 to n do begin
if achis < min then begin
min:=achis;
k:=i;
end;
end;
achis[j]:=min;
achis[k]:=max;
end;
procedure outchis;
var
i:integer;
begin
writeln ('New array');
for i:=1 to n do
write (achis:3:0, ' ');
readln
end;
end.
Текст модуля matrix
unit matrix;
interface
const
n=5;
type
matr=array[1..n, 1..n] of integer;
newmatr=array[1..n-1, 1..n-1] of integer;
var
mat:matr;
newmat:newmatr;
procedure datamatr;
procedure workmatr;
procedure outmatr;
implementation
procedure datamatr;
var i,j:integer;
begin
writeln ('Type in matrix elements');
writeln;
for i:=1 to n do begin
for j:=1 to n do
read (mat[i,j]);
readln;
end;
end;
procedure workmatr;
var i,j,k,t,i2,j2,max:integer;
begin
max:=-200;
for i:=1 to n do
for j:=1 to n do
if abs(mat[i,j]) > max then begin
max:=abs(mat[i,j]);
k:=i; t:=j;
end;
i2:=1; j2:=1;
for i:=1 to n do begin
for j:=1 to n do
if (i<>k) and (j<>t) then begin
newmat[i2,j2]:=mat[i,j];
if j2=4 then begin
j2:=1; i2:=i2+1;
end
else j2:=j2+1;
end;
end; end;
procedure outmatr;
var
i,j:integer;
begin
writeln;
writeln ('New matrix');
writeln;
for i:=1 to n-1 do begin
for j:=1 to n-1 do
write (newmat[i,j], ' ');
writeln;
end;
readln;
end;
end.
Результати роботи пункту меню №3
Type in matrix elements
3 4 1 2 0
5 2 0 3 2
4 9 1 6 7
1 3 4 7 2
0 3 5 2 8
New matrix
3 1 2 0
5 0 3 2
1 4 7 2
0 6 2 8
Пояснення до програми
В даній роботі були використані наступні процедури та функції модуля crt:
- clrscr; – очищення екрану від раніше виведеного тексту;
- sound (І); – використання в програмі звукового сигналу з вбудованого в комп'ютер динаміка. І – частота звуку в герцах ;
- nosound; – вимкнення динаміку;
- delay (F); – забезпечує затримку роботи програми на заданий інтервал часу F (у мілісекундах);
- gotoxy (x,y); – встановлює курсор в положення з відповідно заданими координатами x (по горизонталі) та y (по вертикалі) відносно поточного вікна;
- textcolor (color); – надання тексту на екрані необхідного кольору. Щоб задати колір, можна використовувати як відповідний код, так і вводити назву кольору англійською мовою;
- keypressed; – повертає логічне значення true, якщо натиснута будь-яка клавіша та false у протилежному випадку;
|
Всего сообщений: 12 | Присоединился: май 2009 | Отправлено: 21 июня 2009 13:14 | IP
|
|
Lenin
Новичок
|
Из всего выше написаного нада сделать такоеже только с моими задачами! А вот и они! http://fileshare.in.ua/2089003
|
Всего сообщений: 12 | Присоединился: май 2009 | Отправлено: 21 июня 2009 13:29 | IP
|
|
Lenin
Новичок
|
меню у нас есть, нужно вставить процедуры к задачам. если так удобнее, то можно написать отдельный модуль для каждой и уже их использовать в основном меню.
в самом меню должно быть задействовано не меньше пяти процедур, функций модуля crt.
потом сделать блоксхемы - одна ко всему меню в общем и ещё к каждой отдельной задаче тоже прописать блоксхему как она работает.
в обьяснении к програме нужно написать какие и для чего использовались функции, процедуры crt и дальше главные моменты всего меню описать, с помощью чего, что у нас там происходит
ВОООООТ!
|
Всего сообщений: 12 | Присоединился: май 2009 | Отправлено: 21 июня 2009 13:34 | IP
|
|
|
Форум
Решение задач на Pascal. Форум 2
