Вопрос следуюший, как сделать редактор карт с возможностью рисования мышью и удомным для пользователя меню.
Автор: volvo 29.04.2006 22:22
Ну, это смотря какими средствами тебе можно пользоваться, смотря какой компилятор, опять же... ООП? Встроенный ASM? Внешние процедуры на ассемблере?
Автор: Гость 30.04.2006 1:29
Цитата(volvo @ 29.04.2006 18:22)
Ну, это смотря какими средствами тебе можно пользоваться, смотря какой компилятор, опять же... ООП? Встроенный ASM? Внешние процедуры на ассемблере?
Была мысль использовать ООП но с реализацией не задалось, так-как я знаю только основы Паскаля. А вобше эта работа курсовик, пользоватся можно всем (ООП,ASM). Правда на серьезную реализацию времени нет, 10 мая сдача работы а пока только оболочка и меню готовы. Если можеш помоги.
Автор: volvo 30.04.2006 1:50
Нет, до 10-го мая я ничего серьезного сделать не успею, а что-то недоделанное выкладывать не буду... Надо было раньше обращаться. Чего тянул?
Автор: Гость 30.04.2006 20:22
Цитата(volvo @ 29.04.2006 21:50)
Нет, до 10-го мая я ничего серьезного сделать не успею, а что-то недоделанное выкладывать не буду... Надо было раньше обращаться. Чего тянул?
Я курсовик 26 апреля взял. А можно все сделать но только на Graph'e?
Автор: Гость 30.04.2006 21:06
Да кстати 10 мая промежуточная сдача, основная будет 25-27 мая.
Автор: lapp 1.05.2006 19:02
Гость, ты много всего перечислил, и не совсем понятно, насколько тебя волнует основной алгоритм - процесс раскрашивания. Если волнует, то могу помочь с этим. Задача очень любопытная, меня заинтересовало уже то, что проблема четырех красок как раз не так давно была решена теоретически (с помощью компьютера, это как бы наглядный пример, как комп помогает в чистой математике), и захотелось самому прикоснуться..
Я тут набросал прогу, которая производит правильную (то есть соседние области - разноцветные) раскраску, не гарантируя минимальности количества цветов. Основной принцип - рекуррентная окраска областей. Написано без ООП, да и вообще довольно просто. Надеюсь, разберешься. А уж минимальность обеспечивай сам.. (можешь задавать вопросы)
const Nx=100; {максимальное число областей}
var N, {реальное число областей} i,j:integer; Col:array[1..Nx]of byte; {массив цветов} Nn:array[1..Nx]of byte; {сколько соседей у каждой области} Nei:array[1..Nx,1..Nx]of byte; {массив соседей} Trace:array[1..Nx]of boolean; {для отметки пройденных областей} Empty:set of byte; {для очистки списка цветов} f:text;
const MaxCol:byte=0;
function Paint(m:byte):byte; var i:integer; Used:set of byte; begin Used:=Empty; {очищаем список использованных цветов} if Col[m]=0 then begin {если область еще не покрашена..} Trace[m]:=false; {отмечаем пройденные области} for i:=1 to Nn[m] do if Trace[Nei[m,i]] then Include(Used,Paint(Nei[m,i])); {опрашиваем цвета соседей} i:=1; while i in Used do Inc(i); {выбираем первый цвет из свободных} if i>MaxCol then MaxCol:=i; {запоминаем максимальный цвет (несущественно)} Col[m]:=i; {заполняем массив цветов областей} Paint:=i; Trace[m]:=true {необязательно} end else Paint:=Col[m] {если область уже покращена, просто возвращаем ее цвет} end;
begin for i:=0 to 255 do Exclude(Empty,i); for i:=1 to Nx do begin Col[i]:=0; Trace[i]:=true end; {формат данных:} {число строк равно чилу областей} {первое число в строке - количество соседей области} {затем перечисляются соседи} {пустых строк не должно быть ни внутри, ни в конце} Assign(f,'reg_nei.dat'); Reset(f); N:=0; while not EoF(f) do begin Inc(N); Read(f,Nn[N]); for i:=1 to Nn[N] do Read(f,Nei[N,i]); ReadLn(f) end; Close(f);
Paint(1); {красим область 1} WriteLn('MaxCol = ',MaxCol); for i:=1 to N do Write(' ',Col[i]); WriteLn; ReadLn; end.
Это расположение представляет собой пятилепестковую ромашку . На нем (и на более простых) я проверял прогу. Вроде, не врет..
Автор: strangerfx 1.05.2006 21:55
Попробовал сделать основную программу для раскраски карты:
Вот код:(Показать/Скрыть)
{$D+} uses crt; type gh=array[1..20] of string; map=record land:string; col:byte; sos:gh; color:byte; end; mapptr=^mappt; mappt=record dat:map; next:mapptr; end;
var fmap:file of map; first:mapptr; mp:map; q,n:integer; mas:array[1..50] of pointer;
procedure upcase(var s:string); var g:char; i,h:integer; begin h:=length(s); for i:=1 to h do begin g:=s[i]; if g<>' ' then case ord(g) of 97..122: s[i]:=chr(ord(g)-32); 160..175: s[i]:=chr(ord(g)-32); 224..239: s[i]:=chr(ord(g)-80); end; end; end;
procedure Create_file; var i,j:integer; mp:map; begin write('Введите количество стран в регионе -> '); readln(n); for j:=1 to n do begin write('Введите страну №',j,' -> '); readln(mp.land); upcase(mp.land); write('Введите количество соседей -> '); readln(mp.col); for i:=1 to mp.col do begin write('Введите соседа №',i,' '); readln(mp.sos[i]); upcase(mp.sos[i]); end; mp.color:=0; clrscr; reset(fmap); i:=filesize(fmap); seek(fmap,i); write(fmap,mp); close(fmap); end; end;
procedure Create_list(var first:mapptr); var tec,tec1,pred:mapptr; begin reset(fmap); first:=nil; while not eof(fmap) do begin new(tec); read(fmap,tec^.dat); tec^.next:=nil; if first=nil then first:=tec else begin tec1:=first; pred:=nil; while (tec1<>nil) and (tec^.dat.col>tec1^.dat.col) do begin pred:=tec1; tec1:=tec1^.next; end; if tec1=first then begin tec^.next:=first; first:=tec; end else begin tec^.next:=pred^.next; pred^.next:=tec; end; end; end; end;
procedure Move_list(first:mapptr); var i:integer; tec:mapptr; begin clrscr; fillchar(mas,sizeof(mas),0); tec:=first; i:=0; while tec<>nil do begin with tec^.dat do begin inc(i); mas[i]:=tec; end; tec:=tec^.next; end; q:=i; readln; end;
procedure clin(var mas:array of string); var i:byte; begin for i:=1 to 20 do mas[i]:=''; end;
procedure rasshet; var tec:mapptr; x,i,j,k,b:integer; g:byte; mas_s:array[1..20] of string; begin tec:=mas[q]; g:=1; with tec^.dat do begin tec^.dat.color:=g; x:=1; mas_s[x]:=tec^.dat.land; end; while x<>q do begin inc(g); for i:=1 to q-1 do begin tec:=mas[i]; with tec^.dat do begin if tec^.dat.color=0 then begin b:=0; for j:=1 to x do begin for k:=1 to tec^.dat.col do begin if mas_s[j]=tec^.dat.sos[k] then inc(b); end; end; if b=0 then begin tec^.dat.color:=g; inc(x); mas_s[x]:=tec^.dat.land; end; end; end; end; clin(mas_s); end; end;
procedure Mov_list(first:mapptr); var tec:mapptr; begin clrscr; tec:=first; while tec<>nil do begin with tec^.dat do begin writeln(land,' ',col,' ',color); end; tec:=tec^.next; end; readln; end;
begin assign(fmap,'map.dat'); { create_file;} create_list(first); move_list(first); rasshet; mov_list(first); end.
но она не работает. В чем проблема?
Автор: volvo 1.05.2006 22:03
Во-первых, что значит "не работает"? Вылетает, или не выполняет того, что требуется?
Ну, и на всякий случай присоедини твой файл map.dat... Чтоб можно было прогнать при таких же данных...
Автор: strangerfx 1.05.2006 22:24
Провел поиск багов и получил следующее:(Показать/Скрыть)
{$D+} uses crt; type gh=array[1..20] of string; map=record land:string; col:byte; sos:gh; color:byte; end; mapptr=^mappt; mappt=record dat:map; next:mapptr; end;
var fmap:file of map; first:mapptr; mp:map; q,n:integer; mas:array[1..50] of pointer;
procedure upcase(var s:string); var g:char; i,h:integer; begin h:=length(s); for i:=1 to h do begin g:=s[i]; if g<>' ' then case ord(g) of 97..122: s[i]:=chr(ord(g)-32); 160..175: s[i]:=chr(ord(g)-32); 224..239: s[i]:=chr(ord(g)-80); end; end; end;
procedure Create_file; var i,j:integer; mp:map; begin clrscr; write('Введите количество стран в регионе -> '); readln(n); for j:=1 to n do begin write('Введите страну №',j,' -> '); readln(mp.land); upcase(mp.land); write('Введите количество соседей -> '); readln(mp.col); for i:=1 to mp.col do begin write('Введите соседа №',i,' '); readln(mp.sos[i]); upcase(mp.sos[i]); end; mp.color:=0; clrscr; reset(fmap); i:=filesize(fmap); seek(fmap,i); write(fmap,mp); close(fmap); end; end;
procedure Create_list(var first:mapptr); var tec,tec1,pred:mapptr; begin reset(fmap); first:=nil; while not eof(fmap) do begin new(tec); read(fmap,tec^.dat); tec^.next:=nil; if first=nil then first:=tec else begin tec1:=first; pred:=nil; while (tec1<>nil) and (tec^.dat.col>tec1^.dat.col) do begin pred:=tec1; tec1:=tec1^.next; end; if tec1=first then begin tec^.next:=first; first:=tec; end else begin tec^.next:=pred^.next; pred^.next:=tec; end; end; end; end;
procedure Move_list(first:mapptr); var i:integer; tec:mapptr; begin clrscr; fillchar(mas,sizeof(mas),0); tec:=first; i:=0; while tec<>nil do begin with tec^.dat do begin inc(i); mas[i]:=tec; end; tec:=tec^.next; end; q:=i; readln; end;
procedure rasshet; var tec:mapptr; x,i,j,k,b:integer; g:byte; mas_s:array[1..20] of string; begin tec:=mas[q]; g:=1; with tec^.dat do begin tec^.dat.color:=g; x:=1; mas_s[x]:=tec^.dat.land; end; while x<>q do begin writeln('x= ',x,' q= ',q); readln; for i:=1 to q-1 do begin tec:=mas[i]; with tec^.dat do begin if tec^.dat.color=0 then begin b:=0; writeln(land); for j:=1 to x do begin for k:=1 to tec^.dat.col do begin writeln('mas_s[j] = ',mas_s[j],' tec^.dat.sos[k] = ',tec^.dat.sos[k]); if mas_s[j]=tec^.dat.sos[k] then inc(b); end; end; writeln('b= ',b); if (b=0) and (tec^.dat.color=0) then begin tec^.dat.color:=g; writeln(tec^.dat.land,' ',tec^.dat.color); readln; inc(x); mas_s[x]:=tec^.dat.land; end; end; end; end; inc(g); for i:=1 to 20 do mas_s[i]:=''; end; end;
procedure Mov_list(first:mapptr); var tec:mapptr; begin clrscr; tec:=first; while tec<>nil do begin with tec^.dat do begin writeln(land,' ',col,' ',color); end; tec:=tec^.next; end; readln; end;
begin assign(fmap,'map.dat'); {create_file;} create_list(first); move_list(first); rasshet; mov_list(first); end.
. Теперь все работает . Осталось только все в графическом виде представить.
Автор: lapp 2.05.2006 7:10
Цитата(strangerfx @ 1.05.2006 18:24)
Теперь все работает . Осталось только все в графическом виде представить.
Немного странная манера: попросить о помощи, а потом даже не замечать постов с той самой помощью. И если уж постишь свою прогу (кстати, без единого комментария), то по крайней мере прилагай файл данных, как просил тебя volvo, или хотя бы опиши его формат. Или ты считаешь мы должны просто распечатать, повестить твое бессмертное творение на стену и восхищаться?..
Автор: strangerfx 7.05.2006 23:18
Цитата(lapp @ 2.05.2006 4:10)
Немного странная манера: попросить о помощи, а потом даже не замечать постов с той самой помощью. И если уж постишь свою прогу (кстати, без единого комментария), то по крайней мере прилагай файл данных, как просил тебя volvo, или хотя бы опиши его формат. Или ты считаешь мы должны просто распечатать, повестить твое бессмертное творение на стену и восхищаться?..
1. За помощь спасибо(кстати я ее всегда замечаю), но рекурентное решение задачи неподходит по условию написания работы (обязательно использование списков и/или деревьев). 2. Я бы приложил фаил если бы знал как это сделать. 3. Коментариев к проге неписал по причине нехватки времени, и распечатывать ее совершенно необязательно!. 4. Вопрос: где можно скачать TPU фаил для работы с мышью?
Автор: lapp 8.05.2006 16:46
> 1. За помощь спасибо(кстати я ее всегда замечаю), Я не зрение твое имел в виду. Замечать - значит "реагировать". Игнорировать в разговоре = не замечать. Или я неправильно трактую русский язык? Спасибо, вытянуте клещами, звучит странновато.. но ничего, принимаю.
> но рекурентное решение задачи неподходит по условию написания > работы (обязательно использование списков и/или деревьев). Неплохо было бы это упомянуть с самого начала..
> 2. Я бы приложил фаил если бы знал как это сделать. Кнопочки "Browse" и "Добавить файл" настолько малозаметны?.. Ну, в таком случае можно было бы спросить..
> 3. Коментариев к проге неписал по причине нехватки времени, Комментарии - твой личный вопрос, но только пока ты не показываешь прогу другим. Простая вежливость требует писать их, если ты передаешь программу, особенно с целью поиска ошибок. Не верю, что на написание нескольких слов уходит много времени. В качестве примера можешь посмотреть мой код (выше).
> и распечатывать ее совершенно необязательно!. Но что тогда с ней делать? Никакого вопроса с ней задано не было..
> 4. Вопрос: где можно скачать TPU фаил для работы с мышью? Это отдельный вопрос, отдельная тема..
Автор: strangerfx 8.05.2006 20:29
Цитата(lapp @ 8.05.2006 12:46)
> 1. За помощь спасибо(кстати я ее всегда замечаю), Я не зрение твое имел в виду. Замечать - значит "реагировать". Игнорировать в разговоре = не замечать. Или я неправильно трактую русский язык? Спасибо, вытянуте клещами, звучит странновато.. но ничего, принимаю.
> но рекурентное решение задачи неподходит по условию написания > работы (обязательно использование списков и/или деревьев). Неплохо было бы это упомянуть с самого начала..
> 2. Я бы приложил фаил если бы знал как это сделать. Кнопочки "Browse" и "Добавить файл" настолько малозаметны?.. Ну, в таком случае можно было бы спросить..
> 3. Коментариев к проге неписал по причине нехватки времени, Комментарии - твой личный вопрос, но только пока ты не показываешь прогу другим. Простая вежливость требует писать их, если ты передаешь программу, особенно с целью поиска ошибок. Не верю, что на написание нескольких слов уходит много времени. В качестве примера можешь посмотреть мой код (выше).
> и распечатывать ее совершенно необязательно!. Но что тогда с ней делать? Никакого вопроса с ней задано не было..
> 4. Вопрос: где можно скачать TPU фаил для работы с мышью? Это отдельный вопрос, отдельная тема..
>1 Критиковать других каждый может, "Игнорировать в разговоре = не замечать" странная формула помоему , твои код я просмотрел и кое что из него подчерпнул для себя, но не больше. >2 Без коментариев. >3 Код моей программы ненастолько сложен для человека разбирающегося в Pascal, я считаю что именно такие люди отвечают здесь на вопросы. >4 Вопрос неотдельный, если бы ты посмотрел требования к функциональности программы то заметил бы следующее - Опционально редактор карт(с возможностью рисовать мышью)., а это означает что мыш надо сначала подключить . Вопрос по теме: Как создать меню на ООП и подключить к нему мою программу?