Задачи на Pascal/Delphi (РЕШЕНИЕ)

[Синек]

toll

Ну раз элементарную помог бы тогда что ли, чем нотации читать.

[Jinchuuriki]

Синек

Если чё, в Delphi тоже можно консольные программки писать. Ты только в конце самой программы добавь оператор readln;

Скажешь, что в Delphi писал и пошли вы, преподА, куда-подальше, я вам не официант, чтобы всё по формочкам раскидывать. Главное ты задачу понял, решение нашел, в Delphi разобрался.

[toll]

Синек

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

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

[Синек]

Ага спасибо уже сделал.

[enDoffzenait]

Lakers пасиб но с этой мне уже помогл))

Нужна помашь вот с этим на паскале:

имеется последов. слов, нувно

1. Определить, имеются ли в последовательности слова, в которых все буквы различны.

2. Слова, начинающиеся с буквы ‘а’, расположить в начале последовательности, сохраняя исходный порядок следования слов.

чезаерунда?

[Lakers]

1. Определить, имеются ли в последовательности слова, в которых все буквы различны.

program slova_1;

uses crt;

type mas=array[1..113] of string;

procedure razbienie(var a:mas;var k:integer);

var s:string;

b:array[1..255]of byte;

i,n:byte;

w:set of char;

begin

writeln('vvedite frazu');readln(s);

k:=1;

n:=length(s);

b[k]:=1;

w:=[' ',';','.','/',',','!','"',':','<','>','(',')','[',']','{','}','*','=','-'];

for i:=1 to n do

if s in w then

begin

inc(k);

B[k]:=i+1;

end;

b[k+1]:=n+2;

for i:=1 to k do

a:=copy(s,b,b[i+1]-b-1);

end;

function pro(s:string):boolean;

var i,j:integer;f:boolean;

begin

if s<>'' then begin

f:=true;

for i:=1 to length(s) do

for j:=1 to length(s) do

if (s=s[j])and(i<>j)then f:=false;

pro:=f end else pro:=false;

end;

VAR

A:MAS;

k,i,m:integer;

f:boolean;

begin

clrscr;

razbienie(a,k);

f:=false;

writeln;

for i:=1 to k do

if pro(a)then begin

f:=true;

writeln(a);

end;

if f=false then writeln('Takix slov net');

readkey;

end.

Вторую потом сделаю...

[EVGeN]

Помогите с задачей на Паскале...плиз!(( Тип данных: записи.

Справка о междугороднем телефонном разговоре содержит: номер телефона абонента (6 цифр), дату (год, месяц, день), время (час, минута), код города (3 цифры), номер телефона в другом городе (7 цифр), продолжительность разговора (в минутах), категорию (срочный, обычный) и тариф (плата в рублях за минуту). Определить дату такого телефонного разговора, которой является максимальным по продолжительности среди срочных разговоров за указанный месяц.

[martinges]

имя программы;

подключение библиотек;

раздел типов

мой_тип=запись

телефон:строка(6);

год,месяц,день,час,минута,код,продолжительность:целый_тип;

телефон1:строка(7);

категория:булева переменная;//true срочный false обычный)

тариф:вещественный_тип;

конец_записи;

раздел переменных

n,i,month:целый_тип;

a:массив[индексация]элементов типа "мой_тип";

b:переменная типа "мой_тип";

начало блока кода

ввод количества записей(n);

запрос какой требуется месяц(month);

начало цикла с параметром(i от 1 до n);

ввод всех полей i элемента массива;

//проверка на корректность ввода параметров

конец цикла;

присвоим b значение первой записи массива a;

начало цикла с параметром(i от 1 до n);

если (month=месяцу i элемента массива a)и(разговор срочный)и(продолжительность i элемента массива a>продолжительность переменной тогда b присваиваем значение i элемента массива a;

конец цикла;

вывод поля дата переменной b;

ожидание нажатия клавиши;

конец программы.

[Chosen One]

Реализация дека двумя способами: последовательным (хранение в массиве) и связным (хранение в списке).

Может кто сможет помочь написать прогу, а то уже битый час сижу пиши, ну ещё попробую

[Vanix]

реализация дека последовательным способом:

uses crt;

const n=100;

m=10;

type ConDec=array[1..n] of integer;

var Dec1:ConDec;

i:byte;

elm:integer;

procedure InitDec(var CurDec:ConDec);

begin

for i:=1 to n do

Dec1:=0;

end;

function AmtElmInDec(CurDec:ConDec):byte;

var TmpAmt:byte;

begin

AmtElmInDec:=0;

TmpAmt:=0;

for i:=1 to n do

if CurDec<>0 then

inc(TmpAmt)

else

break;

AmtElmInDec:=TmpAmt;

end;

procedure CrtDec(var CurDec:ConDec);

begin

InitDec(CurDec);

randomize;

for i:=1 to m do

CurDec:=random(100);

end;

procedure AddToDecUp(var CurDec:ConDec; NewElm:integer);

begin

for i:=AmtElmInDec(CurDec) downto 1 do

CurDec[i+1]:=CurDec;

CurDec:=NewElm;

end;

procedure AddToDecDown(var CurDec:ConDec; NewElm:integer);

begin

CurDec[AmtElmInDec(CurDec)+1]:=NewElm;

end;

procedure DelElmDecUp(var CurDec:ConDec);

begin

for i:=1 to AmtElmInDec(CurDec) do

CurDec:=CurDec[i+1];

{CurDec[AmtElmInDec(CurDec)]:=0;}

end;

procedure DelElmDecDown(var CurDec:ConDec);

begin

CurDec[AmtElmInDec(CurDec)]:=0;

end;

procedure DelDec(Var CurDec:ConDec);

begin

InitDec(CurDec);

end;

procedure WriteDec(CurDec:ConDec);

begin

for i:=1 to AmtElmInDec(CurDec) do

write(CurDec:4);

writeln;

end;

Begin

clrscr;

writeln('create dec');

CrtDec(Dec1);

WriteDec(Dec1);

readkey;

write('add element in top: new element: ');

read(elm);

AddToDecUp(Dec1,elm);

WriteDec(Dec1);

readkey;

write('add element in bottom: new element: ');

read(elm);

AddToDecDown(Dec1,elm);

WriteDec(Dec1);

readkey;

writeln('delete element from top');

DelElmDecUp(Dec1);

WriteDec(Dec1);

readkey;

writeln('delete element from bottom');

DelElmDecDown(Dec1);

WriteDec(Dec1);

readkey;

writeln('delete dec');

DelDec(Dec1);

WriteDec(Dec1);

readkey;

End.

Реализация дека связным способом:

uses crt;

const n=100;

m=10;

type PtrBoundDec=^TypeBoundDec;

TypeBoundDec=record

Data:integer;

Next:PtrBoundDec;

Prev:PtrBoundDec;

end;

var Top,Btm:PtrBoundDec;

elm:integer;

i:byte;

procedure AddElmDecTop(var CurTop,CurBtm:PtrBoundDec; NewElm:integer);

var TmpDec:PtrBoundDec;

begin

new(TmpDec);

TmpDec^.Data:=NewElm;

TmpDec^.Next:=nil;

TmpDec^.Prev:=nil;

if CurTop=nil then

CurBtm:=TmpDec

else

begin

TmpDec^.Next:=CurTop;

CurTop^.Next^.Prev:=TmpDec;

end;

CurTop:=TmpDec;

end;

procedure AddElmDecBtm(var CurTop,CurBtm:PtrBoundDec; NewElm:integer);

var TmpDec:PtrBoundDec;

begin

new(TmpDec);

TmpDec^.Data:=NewElm;

TmpDec^.Next:=nil;

TmpDec^.Prev:=nil;

if CurBtm=nil then

CurTop:=TmpDec

else

begin

TmpDec^.Prev:=CurBtm;

CurBtm^.Next:=TmpDec;

end;

CurBtm:=TmpDec;

end;

procedure CrtDec(var CurTop,CurBtm:PtrBoundDec);

begin

CurTop:=nil;

CurBtm:=nil;

randomize;

for i:=1 to m do

AddElmDecBtm(CurTop,CurBtm,random(100));

end;

procedure DelElmDecTop(var CurTop,CurBtm:PtrBoundDec);

var TmpDec:PtrBoundDec;

begin

TmpDec:=CurTop;

if CurTop^.Next=nil then

begin

CurTop:=nil;

CurBtm:=nil;

end

else

begin

CurTop:=CurTop^.Next;

CurTop^.Prev:=nil;

end;

Dispose(TmpDec);

end;

procedure DelElmDecBtm(var CurTop,CurBtm:PtrBoundDec);

var TmpDec:PtrBoundDec;

begin

TmpDec:=CurBtm;

if CurBtm^.Prev=nil then

begin

CurTop:=nil;

CurBtm:=nil;

end

else

begin

CurBtm:=CurBtm^.Prev;

CurBtm^.Next:=nil;

end;

Dispose(TmpDec);

end;

procedure WriteDec(CurTop:PtrBoundDec);

var TmpDec:PtrBoundDec;

begin

TmpDec:=CurTop;

while TmpDec<>nil do

begin

write(TmpDec^.Data:4);

TmpDec:=TmpDec^.Next;

end;

writeln;

end;

procedure DelDec(var CurTop,CurBtm:PtrBoundDec);

var TmpDec:PtrBoundDec;

begin

while CurTop<>nil do

DelElmDecTop(CurTop,CurBtm);

end;

Begin

clrscr;

CrtDec(Top,Btm);

WriteDec(Top);

readkey;

AddElmDecTop(Top,Btm,random(100));

WriteDec(Top);

readkey;

AddElmDecBtm(Top,Btm,random(100));

WriteDec(Top);

readkey;

DelElmDecTop(Top,Btm);

WriteDec(Top);

readkey;

DelElmDecBtm(Top,Btm);

WriteDec(Top);

readkey;

DelDec(Top,Btm);

WriteDec(Top);

readkey;

End.

[L0K1]

Оффтоп: Имхо google, это классические алгоритмы не умеете их писать - идите на эконом.

2Vanix, то что ты дал ему код 1 задачи, ему ну ничем не поможет...

[haha]

опять же, ОФФТОПно: а что такое дек? про массивы слышал, про списки слышал, даже про стек, а про дек - нет.

[Vanix]

haha

Дек это разновидность списка, доступ к эдементам котогого осушествляется как с конца(дна) так и с начала(вершины), те и в начало и в конец можно добавлять элементы и удалять элементы оттуда.

[martinges]

системы LIFO(стэк) FIFO(дек) вроде как азы алгоритмизации.....

гыыыы надо было часть кода дать)) остальное бы он сам додумал ИМХО

[Vanix]

martinges

системы LIFO(стек), а FIFO(очередь)

[martinges]

угу (first in first out), а разве дек это не двусторонняя очередь?) или я ошибся?)

[haha]

как бы там нибыло, сделав добавление и удаление из середины, Избранный был бы крут. однозначно =)

[Vanix]

martinges

ну в таком случае можно сказать что дек это двусторонний стек, и всё таки по моему дек это самостоятельная структура и не стал относить к той или иной.А что касается дисциплины обработки то здесь так же можно увидить и LIFO и FIFO.

Сделать удаление и добавление из середины с уже имеющимися процедурами сделать несложно

Вот собственно две необходимые процедуры:

procedure AddElmDecMed(var CurTop,CurBtm:PtrBoundDec; NewElm:integer;

CurNum:byte);

var TmpDec1,TmpDec2:PtrBoundDec;

TmpI:byte;

begin

if CurNum=1 then

begin

AddElmDecTop(CurTop,CurBtm,NewElm);

exit;

end;

TmpDec1:=CurTop;

TmpI:=1;

while(TmpDec1<>nil)and((TmpI+1)<>CurNum)do

begin

TmpDec1:=TmpDec1^.Next;

inc(TmpI);

end;

if (TmpI

begin

writeln('wrong number');

exit;

end;

if (TmpDec1=nil)then

AddElmDecBtm(CurTop,CurBtm,NewElm)

else

begin

new(TmpDec2);

TmpDec2^.Data:=NewElm;

TmpDec2^.Next:=TmpDec1^.Next;

TmpDec2^.Prev:=TmpDec1;

TmpDec1^.Next^.Prev:=TmpDec2;

TmpDec1^.Next:=TmpDec2;

end;

end;

procedure DelElmDecMed(var CurTop,CurBtm:PtrBoundDec; CurNum:byte);

var TmpDec1,TmpDec2,TmpDec3:PtrBoundDec;

TmpI:byte;

begin

if CurNum=1 then

begin

DelElmDecTop(CurTop,CurBtm);

exit;

end;

TmpDec1:=CurTop;

TmpI:=0;

while(TmpDec1<>nil)and((TmpI+1)<>CurNum)do

begin

TmpDec1:=TmpDec1^.Next;

inc(TmpI);

end;

if TmpDec1=nil then

begin

writeln('wrong number');

exit;

end;

if TmpDec1^.Next=nil then

DelElmDecBtm(CurTop,CurBtm)

else

begin

TmpDec2:=TmpDec1^.Prev;

TmpDec3:=TmpDec1^.Next;

Dispose(TmpDec1);

TmpDec2^.Next:=TmpDec3;

TmpDec3^.Prev:=TmpDec2;

end;

end;

если кто-нибудь сможет оптимизировать данные процедуры или написать элегантней похожие процедуры прошу выложить свои варианты здесь же

[martinges]

эх ты всех распугал

хмм а смысл удалять из середины? Просто задач такого рода не припомню.....

По теме: не могу сообразить как отослать потоковое видео/аудио с применением indy->udp компонент. Точнее пока не соображу с какой стороны подобраться к этому) Вещание только на локалку)

[Vanix]

martingesя тоже в принципе не вижу, тк дек не предусматривает доступ к элементам в середине, я просто показал haha что такое возможно ))))

[Po$amax@]

В чем тут баг?

Вообще квадратик должен перемещаться по полю, закрвшивая после себя пространство, а он сразу все делает =(

program game;
uses crt, Graph;
var
t: char;
pos: array [0..32, 0..32] of integer;
x, y, x1, y1: integer;
gm, gd: integer;
begin
writeln('Welcome to my game!');
writeln('Game by Pocamaxa');

{ wait }
delay(10000);
sound(555);
delay(10000);
nosound;
{ end of start }
{ start new part }

x1 := 0;
y1 := 0;
while x1<=32 do
begin
while y1<=32 do
begin
pos[x1,y1] :=0;
y1:=y1+1;
end;
x1:=x1+1;
end;

x:=5;
y:=5;

{ #32 = space }

gd:=0;
initgraph(gd ,gm, 'C:\BP\BGI');
while t<>#13 do
begin
t:=readkey;

{ left }
if t=#37 then
begin
if x>0 then
x:=x-1;
end;

{ right }
if t=#39 then
begin
if x<32 then
x:=x+1;
end;

{ up }
if t=#38 then
begin
if y>0 then
y:=y-1;
end;

{ down }
if t=#40 then
begin
if y<32 then
y:=y+1;
end;

{ draw pole }
x1:=0;
y1:=0;
while x1<=38 do
begin
while y1<=38 do
begin
if ((x1=x) and (y1=y)) then
begin
pos[x1,y1] := 1;
SetColor(11);
bar(x1*8, y1*8, x1*8+8, Y1*8+8);
end
else
begin
case pos[x1,y1] of
0: setcolor(8);
1: setcolor(12);
end;

bar(x1*8, y1*8, x1*8+8, Y1*8+8);
end;
y1:=y1+1;
end;
y1:=0;
x1:=x1+1;
end;
end;
closegraph;
end.

[Po$amax@]

проблема решена, неправильно сделал квадраты (не той процедурой) и # не так сделал.

итог : http://ftp.burnet.ru/incoming/users/f1rst.EXE

[haha]

до сих пор не разобрался, что идет раньше: компиляция или линкование.

По поводу графики в Паскале. Есть такая тема, что приходится компилировать библиотеку EGAVGA вместе со своей программкой. Уж точно не вспомню, как делалась библиотечка, а вот строчка, чтобы потом слинковалось вместе в программе, такая

if RegisterBGIDriver(@EGAVGADriverProc)<>0 then initgraph(gd,gm,'') else halt(10);

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

А к чему я это? Просто твой файлик не работает.

И еще про стек/дек/список: удаление/добавление в середину нужно было мне в курсовом, хехе, ВОТ

[L0K1]

Сначало , компиляция =)

Народ, епт... Не позорьтесь забейте на использование TP7.

FreePascal компилер, и никаких проблем.

плюсы:

1. Более продвинутый синтаксис.

2. Генерит 32 разрядный код.

3. Идет под лицензией GPL

4. Кросплатформеный, системно независимый - dos, win32, linux,bsd и так далее..

Или вообще учите C....

[Vanix]

L0K1 Здесь во первых не обсуждают приимущесто одного языка перед другими а выясняют проблеммы возникщие в процессе программирования на TP7 или Delphi, во вторых я читаю что переходить от ТР7 стоит к Delphi а не к FreePascal, но это уже совсем другая тема http://ulanovka.ru/forum/viewtopic.php?t=21876