Помощь - Поиск - Пользователи - Календарь
Полная версия: Подключение мыши
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Страницы: 1, 2
-LOVE133-
скачала несколько юнитов для работы с мышью, но при запуске программы требует файл типа TPU , а все юниты просто с расширение PAS. что в этих ситуациях обычно делают?
volvo
Обычно - просто компилируют PAS файл модуля, и компилятор создает TPU файл...

Или загружают в Паскаль основную программу (НЕ модуль), и в меню выбирают Compile -> Build, тогда Паскаль сам откомпилирует все необходимые PAS файлы в TPU (желательно, чтобы PAS файлы модулей при этом находились в той же папке, что и основная программа)...
Гость
а еще хотела спросить в вашем юните в МИККИ что обозначается, первый раз встречаю это слово... smile.gif
volvo
Там же написано:
Цитата
микки(шаг) - наименьшее расстояние, перемещение на которое мышь может зарегистрировать (т.е. расстояние регистрируемое датчиками мыши). Обычно 0.125 мм.
LOVE133
пытаюсь реализовать такой алгоритм :
1) есть сетка с координатами
2) если в каком-то окне щелкнуть мышью, то подсветить эту клетку
3) если щелкнуть повторно , то снять выделение
не получается применить прцедуры, а так же в графическом режиме сделать отдельное выделение, типа процедуры window(x1,y1,x2,y2) в crt . Подскажите, как применять процедуры юнита mouse
Бродяжник
Вот примитивная заготовка, чтобы понять основные моменты.
program test;
uses graph, crt, mouse;

var d,m: integer;
c: char;
mx,my: word;

begin
d:=vga;
m:=vgahi;

initgraph(d,m,''); // не забудьте скопировать EGAVGA.BGI в папку с программой

if not initmouse then
begin
restorecrtmode;
halt;
end;

showmouse;

repeat

if mousepressed then
begin
getmousexy(mx,my);
hidemouse;
lineto(mx,my);
showmouse;
end;

until keypressed;

while keypressed do c:=readkey;

hidemouse;

restorecrtmode;
end.
LOVE133
а нет процедуры. которая определяет, в каком месте экрана находится курсор?
volvo
Чем
Procedure GetMouseXY(VAR KoordX,KoordY:Word );
не устраивает? Она же возвращает координаты мыши...
LOVE133
все.... перепутала просто один юнит с другим smile.gif все устраивает, а , кстати, для вывода графики обязательно мышь выключать надо? а еще все таки не могу вычертить окно , даже по этой процедуре... толи setviewport то ли window ?
volvo
Если не хочешь получать после вывода графики и движения мышкой разные "артефакты" на экране - лучше отключать, тогда курсор мыши не мешает нормальному выводу графики.

А насчет окна - Window не получится однозначно - у тебя графический режим, а не текстовый. SetViewPort только устанавливает ViewPort, но никак не отчерчивает ничего... Объясни подробнее, что именно ты хочешь нарисовать и что выделять?

Может, тебе подойдет простой Rectangle и функция MouseIn ?
LOVE133
у меня есть сетка (line(x1,y1,x2,y2)) которые делят экран на сетку , мне надо чтобы после щелчка мышью по полю, ячейка выделялась другим цветом, а после второго щелчка снималось выделение.. подскажите, как хоть выделение организовать.. да. там еще проблема будет с определением координат выделения, потому что на сколько делить экран задает пользователь )))) то есть , при 10*10 нужно будет определить , сколько заливать , какой размер )))
volvo
Пишу прямо здесь, так что могут быть мелкие помарки... Идея такая:
const
size_x = 10;
size_y = 10;
var
selected: array[1 .. size_y, 1 .. size_x] of boolean;
{ изначально присвоить все элементы False }

...
len_x := getmaxx div size_x; { это если поле должно быть на весь экран }
len_y := getmaxy div size_y;

{ Отрисовываем начальную сетку... }
setcolor(white);
for i := 1 to size_y do
for j := 1 to size_x do begin
rectangle((j - 1)*len_x, (i - 1)*len_y, j*len_x, i*len_y);
selected[i, j] := false;
end;

{ после нажатия на кнопку мыши проверяем: }
for i := 1 to size_y do
for j := 1 to size_x do
if mouseIn((j - 1)*len_x, (i - 1)*len_y, j*len_x, i*len_y) then begin
selected[i, j] := not selected[i, j];
if selected[i, j] then setfillstyle(solidfill, lightgray)
else setfillstyle(solidfill, getbkcolor);
bar((j - 1)*len_x, (i - 1)*len_y, j*len_x, i*len_y);
setcolor(white);
rectangle((j - 1)*len_x, (i - 1)*len_y, j*len_x, i*len_y);

{ в принципе, все - из For-ов можно выходить... }
end;
...
LOVE133
Немного доработала.Теперь в процессе создаю матрицу, в которой если клетка выделена, то будет единица, если нет, то ноль.Вроде работает.Для кроссворда теперь нужно чтобы не было отдельно стоящих единиц, чтобы все были связаны между собой .Предложили алгоритм "киселя". Разливать, как кисель ))
Смысл такой : берем первую единицу, которая встречается, если у нее есть соседние по горизонтали и вертикали, то добавляем к ним по единице, дальше проверяем соседей у соседей (может рекурсия пройдет, не знаю ), и опять по единице добавляем. К концу прохода должна остаться всего одна единица. то есть если кроссворд был такой
0100
0100
1111
0100
то после прохода должно получиться что-то типа этого
0100
0200
4345
0400
и проверяем, есть ли еще единицы, если есть, то нужно вернуться и опять заполнять кроссворд, пока все не будет на месте. Пробовала через цикл, но что-то не то получается...
LOVE133
вчера вечером посидела, вот что получилось
Код

procedure increm(i,j:integer;n:integer;  var a:array [1..10,1..10] of byte);
begin                
if a[i,j]=0  
  then

  begin
   if (i<n) and (j<n) then
     begin
      increm(i+1,j,n,a);
      increm(i,j+1,n,a);
     end;
  end

else

if  a[i+1,j]=0 then
begin
  if (i<n) and (j<n) then
  increm(i+1,j,n,a) ;
  end

else
begin
a[i+1,j]:=a[i,j]+1;
if (i<n) and (j<n) then
increm(i+1,j,n,a);
end;
if  a[i,j+1]=0 then
begin
  if (i<n) and (j<n) then
  increm(i,j+1,n,a) ;
  end

else
begin
a[i,j+1]:=a[i,j]+1;
if (i<n) and (j<n) then
increm(i,j+1,n,a);
end;
end;


но почему-то работает только вправо и вниз, а мне нужно, чтоб она еще влево шла и вверх проверяла ..
показательный пример в файле
volvo
program IncMassive;
type
setArray = array[1..10, 1..10] of integer;
var
a,b:setarray;
i,j:integer;
n:integer;

procedure print(const a: setarray);
var i, j: integer;
begin
writeln;
for i := 1 to n do begin
for j := 1 to n do write(a[i,j]:3);
writeln;
end;
end;

procedure increm(i_start, j_start: integer;
n: integer; value: integer; var a: setarray);
begin
a[i_start, j_start] := value;

if (i_start > 1) and (a[i_start - 1, j_start] > value)
then increm(i_start - 1, j_start, n, value + 1, a);

if (i_start < n) and (a[i_start + 1, j_start] > value)
then increm(i_start + 1, j_start, n, value + 1, a);

if (j_start > 1) and (a[i_start, j_start - 1] > value)
then increm(i_start, j_start - 1, n, value + 1, a);

if (j_start < n) and (a[i_start, j_start + 1] > value)
then increm(i_start, j_start + 1, n, value + 1, a);
end;


begin
randomize;
write('input N:'); readln(n);

for i := 1 to n do
for j := 1 to n do a[i, j] := random(2);

print(a);

b := a;
for i := 1 to n do
for j := 1 to n do
if b[i, j] = 1 then inc(b[i, j], n*n);

for i := 1 to n do
for j := 1 to n do
if b[i, j] = n*n + 1 then Increm(i, j, n, 2, b);

for i := 1 to n do
for j := 1 to n do
if b[i, j] <> 0 then dec(b[i, j]);

print(b);
readln;
end.

?

Так тебе нужно, чтобы было в результате?

..
LOVE133
в данном случае мне нужно, что б он проверил матрицу кроссворда. можно ли из заданной пользователем сетки составить кроссворд , нет ли там отдельно стоящих ячеек или не связанных между собой. Так удобне. то есть если есть более одной единицы в сетке , значит составить нельзя . А это тестовая прога была, посмотреть как работает.

все, работает классно, подпрыгиваю и пританцовываю... так может скоро запостю здесь программу полностью, для составления кроссвордов, интересная задача, кстати, странно, что никто до этого этим не занимался.А как название тему поменять, чтоб в поиске находил, как про кроссворд?
LOVE133
скачала словарь существительных, теперь его пытаюсь отсортировать по количеству буквБ самые маленькие слова вверху и чтоб оставил сортировку по алфавиту внутри.Должно вроде работать правильно, хотя не уверенаю Хотелось бы узнать, правильно она будет работать или нет?
Бродяжник
Словарь скачивать пока влом, поэтому маленький вопрос. Файл словаря это действительно файл из записей с фиксированной длиной 26 байт? Это именно file of slova? А не простой текстовый?
И второе: может быть, стоило бы все же явно задать условие сортировки по алфавиту? Так, на всякий случай...
LOVE133
да, я его специально переделывала из текстового в файл записей, вручную так сказать ))) только вот по времени он мне обещает сортировать всю базу примерно дней 5 , на моей машине... так что даже проверить не могу, ка кэто будет работать ..
Бродяжник
ладно, уговорили. Скачаю Ваш словарь, отсортирую, выложу отсортированный. Короткие в начало, одинаковые - по алфавиту. Но в виде простого текстового файла.
LOVE133
так это и надо было, просто для того чтобы это сделать пришлось вот так вот извратиться.. переделать в файл записей, потом отсортировать.А идея у меня была вначале такая - создать еще массив в котором будет храниться такая информация
1 поле - количество букв
2 поле - номер с какого по порядку начинаются слова с заданным количеством букв(1 поле )
3 поле - номер, на каком заканчиваются слова с таким количеством букв.
все это для того чтобы было удобнее перемещаться по файлу, посмотрел сколько букв, перешел на нужное количество шагов и начинай подбирать подходит слово , не подходит.

только вот абсолютно пока не представляю, как там будет рекурсия работать.Нам что-то сказали, типа вставляешь слова, вставляешь, потом когда доходишь до того места , когда боьлше ни одно слово не подходит, вернуться на шаг назад, поменять какое-то другое слово, и опять вставлять, только вот как это делать, никто толкьом объяснить не может...
Бродяжник
Это типа словарь
LOVE133
пасибки )) то что нужно и даже больше ))
я где-то здесь на форуме находила, вы решали уже задачу про кроссворд, только там его решить надо было и проверить , а мне составить, но там наверно тоже нужно было его составлять.ТОлько вот с делфи мы еще не работали, может посоветуете с чего хоть начинать слова забивать в кроссворд ?
Бродяжник
Ох...
Это очень сильно зависит от того, какой будет окончательная схема работы.
Если бы я стал это делать, я делал бы так:
1. Строим сетку кроссворда и проверяем ее на правильность.
2. По имеющейся сетке строим список "гнезд" с указанием начальных координат слов, их длины и направления. Нужен для организации рекурсии.
3. Желательно отсортировать этот список по убыванию длины слова. Мне кажется, что вначале нужно впихивать самые длинные слова.
4. Далее:
- берем очередное "гнездо" и ищем такое слово, которое туда подойдет;
- если нашли, вписываем его в сетку и рекурсивно переходим к следующему "гнезду";
- если не нашли, возвращаемся на предыдущий шаг рекурсии и ищем для этого шага другое слово.
Если следовать этой схеме, то нужно начинать со списка гнезд. То есть нужно на готовой сетке найти все клетки, у которых есть либо только сосед справа, либо только сосед снизу. Это точки начала слов. Для каждой такой точки определить направление слова и его длину. И занести все это в массив. Круче было бы использовать динамический список... но зачем? И так возни хватит.
Удачи!
LOVE133
смысл понятен, только как проверять подходит слово или нет, я не совсем уловила структуру "гнезда" , это массив или что-то еще? допустим. нашли слово, 5 букв, вертикально , на пересечении буква е, как дальше впихивать с учетом этой самой буквы е?
Бродяжник
Структура самого гнезда очень простая - координаты начала, длина слова и направление.
Нечто вроде
type
TGnezdo = record
x,y: byte;
len: byte;
horizontal: boolean;
end;

var
Gnezdo: array[1..100] od TGnezdo;

Первым делом заполняем этот массив - когда еще никаких букв нет. Потом берем первое найденное гнездо. Пусть будет, как у Вас: 5 букв, вертикально. Выбираем из словаря первое попавшееся слово из пяти букв (обозначим его, как slovo). Гнездо у нас вертикальное. Поэтому организовываем нечто такое:
ok := true;
i:=0;
while (ok) and (i<Gnezdo[1].len) do
begin
if (Setka[Gnezdo[1].x][Gnezdo[1].y+i] <> ' ') and (Setka[Gnezdo[1].x][Gnezdo[1].y+i] <> Slovo[i+1])
then ok := false
else inc(i);
end;

Если после выхода из этого цикла ok = true, значит, слово подходит. Тогда вписываем его в сетку:
for i=0 to Gnezdo[1].len-1 do
begin
Setka[Gnezdo[1].x][Gnezdo[1].y+i] := Slovo[i+1];
end;

Если слово не вертикальное, а горизонтальное, тогда работаем с Setka[Gnezdo[1].x+i][Gnezdo[1].y].
(Gnezdo[1] - это просто для примера, т.е. первое гнездо, а так-то должно быть что-то вида Gnezdo[k].)
Если слово не подошло, берем следующее.
Правка: исправил struct на record. Что-то меня проглючило...
LOVE133
Setka[Gnezdo[1].x][Gnezdo[1].y+i] := Slovo[i+1];

тут сначала координаты сетки [x][y] , а потом что? Slovo{i+1} ?
Бродяжник
Slovo - это слово из словаря, которое мы сейчас проверяем. Это строка. А Slovo[i+1] - это его очередной проверяемый символ. i+1 - потому что i отсчитывается от нуля, а символы в строке нумеруются с 1.
LOVE133
понятно, теперь сижу втыкаюсь ... вот еще косяк объявился. не хочет repeat заботать ...
Код

begin

Window(25,25,100,100);
writeln('Input the size of the crossvord:') ;
readln(n);
driver:=detect;
initgraph(driver,mode,'');
setcolor(white);
settextstyle(4,0,4);
outTextXY(490,60,'New');
outTextXY(490,100,'Make!');
outTextXY(490,140,'EXIT');
initmouse;
showmouse;
c:=0;
Repeat
  repeat
   if  ( mousein (490,55,600,90) ) and mousepressed then  c:=1;
   if (mousein (490,100,600,150)) and mousepressed then c:=2;
   if (mousein (490,160,600,210)) and mousepressed  then c:=3;
   until c>0;
repeat
case c of
1: begin
  setviewport(1,1,479,479,clipoff);
  clearviewport;
  setka(n,selected,a);
  zapolnyaem(selected,n,a);


  outtextXY(490,300,'enter!');
  if proverka(a,n) then
  begin
    settextstyle(2,0,2);
    outtextXY(490,180,'VSE V NORME!');
    c:=5;
  end
   else c:=1;
   end;

   2:begin
   c:=5;
     readln;
     end;
   3:begin
     outtextXY(490,300,'Bolwoe spasibo!');
     readln;
     c:=5;
     end;
   end;
   until c=5;
until c=5;
readln;
end.


после выполнения один раз просто выкидывает и все...
вроде должен подождать пока я на выход нажму..
volvo
Цитата
не хочет repeat заботать ...
Какой именно? У тебя их 3...
LOVE133
они по моему все не работают, один общий, то есть выполнять все, пока не выход, то есть c:=5;
второй на case работает, то есть пока c<>5, выполнять по case и третий ждет пока клавишу не нажмут , а потом работать начать .Вроде должно работать, но после одного прохода. как только я заканчиваю сетку рисовать , он меня тихонько выкидывает....Там файл, модуль ваш, с мышкой
LOVE133
Вот что у меня получилось . структура данных
Код

Tgnezdo=record
     x,y:integer;                  - координаты ячейки, где начинается слово
     len:byte;                      -длина слова
     horizontal:boolean;    - горизонтально или вертикально расположено слово
     end;

Дальше я бы хотела сделать так 1) берем первое гнездо из массива гнезд , смотрим, как расположено слово , сколько букв в нем
2) смотрим на сетку-массив символов, где если есть буква , то стоит пробел, если буквы нет в этом месте, то стоит 0
Код

for i:=1 to n do
   for j:=1 to n do
    begin
     if a[i,j]=1 then bukv[i,j]:=' ' else bukv[i,j]:='0';
     end;    - где a[I,j] – исходный массив нулей и единиц(сетка кроссворда)


3) считываем из файла слово нужной длины, кидаем в массив , дальше идем так:
Код

for w:=1 to q do      {q-количество слов , счетчик}    

for j:=1 to b[gnezdo[q].len].first do readln(f,s);
{здесь b-массив записей, обозначающих начало и конец слов в текстовом файле заданной длины, то есть  B[3].first=576, потому что слова длиной 3 начинаются с 576 строки в словаре}

  with gnezdo[w] do
  begin
  
{после прохода следующего блока если ок истина, то слово подходит и его можно запихнуть в сетку по горизонтали  }  

if horizontal then
    begin
    okgor:=true;
    i:=0;
     while okgor and ( i <len) do
     begin
     if (bukv[x,y+i]=' ') then
       begin
        okgor:=true;
        ok:=true;
        inc(i);
        end
       else if  (bukv[x,y+i]<>s[i])
     then
     begin
      okgor:=false
     end
     else inc(i);
     end;

  
{все верно, запихиваем в сетку }

  if okgor then
      for i:=0 to len-1 do
       begin
       bukv[x,y+i]:=s[i+1];
       end

  

  {все то же самое , но для вертикали }
    okgor:=true;
    i:=0;
     while okgor and ( i <len) do
     begin
     if   (bukv[x+i,y]=' ')   then
     begin
      okgor :=true;
      inc(i);
      end
      else if  (bukv[x+i,y]<>s[i])
     then
     begin
           okgor:=false
      end
       else inc(i);

     end;

     if okgor then
      for i:=0 to len-1 do
       begin
       bukv[x+i,y]:=s[i+1];
       end



   end;

        end;
        end;

У меня теперь проблема, все это работает для одного слова. То есть как считали его , так одно и гоняем, он не считывает нигде больше. Как это можно загнать в рекурсию, то есть что б он считывал, прогонял, проверял, смотрел, если подходит, считываем еще одно слово, если не подходит , возвращаемся на шаг назад и считываем другое слово . Можно как-нибудь из этого организовать рекурсию?то есть считывать слова. пока весь кроссворд не заоплнится ?
Бродяжник
if horizontal then
begin
okgor:=true;
i:=0;
while okgor and ( i <len) do
begin
if (bukv[x,y+i]=' ') then
begin
okgor:=true;
ok:=true;
inc(i);
end
else if (bukv[x,y+i]<>s[i])
then
begin
okgor:=false
end
else inc(i);
end;
В этом фрагменте
          if (bukv[x,y+i]=' ') then
begin
okgor:=true; { ВОТ ЭТО ЛИШНЕЕ }
ok:=true;
inc(i);
end
Лишнее, потому что okgor перед входом в цикл уже true, а как только оно станет не трю, цикл завершается, поэтому внутри цикла делать его трю не имеет смысла.
По поводу репитов-антилов Вы разобрались? Как только Вы заполнили сетку и нажали клавишу, автоматически выполняется проверка, и если все ОК, тогда с:=5, и тут же происходит выход из всех циклов и завершение программы. Так и должно быть по Вашей программе.
Я посмотрел выложенный код... если Вы не против, я бы немного изменил подход к работе с мышью. Если Вам интересно, я выложу подправленный вариант. В текущем варианте мне не всегда удавалось сбросить помеченную клетку.
По поводу рекурсии... можно ли оформить поиск слова в словаре и проверку по гнезду в отдельные функции такого вида:
function NewWord(dlina: integer): string;
begin
{возвращает слово заданной длины.
при этом надо как-то учитывать те слова,
что уже были выбраны ранее.}
end;

function GoodWord(s: string; i: integer): boolean;
begin
{возвращает true, если слово, заданное строкой s,
можно вписать в гнездо с номером i}
end;

Тогда рекурсивная функция могла бы выглядеть как-то так:
function CheckNext(i: integer): boolean;
var s: string;
begin
if i > числа_гнезд then {все гнезда проверены}
begin
CheckNext := true; {шабаш}
exit;
end;

repeat

s := NewWord(Gnezdo[i].len); {выбираем слово из словаря}

if GoodWord(s,i) {слово хорошее}
then
begin
if CheckNext(i+1) then {вызываем рекурсию}
begin
CheckNext := true;
exit;
end;
end;
until больше_нет_слов_такой_длины;

CheckNext := false; {заполнить гнездо так и не удалось}
end;

Сложность будет с проверкой условия больше_нет_слов_такой_длины и организацией работы с функцией NewWord. Добрые у вас преподаватели...
LOVE133
конечно, интересно мне все.С мышью я тоже мучалась ))) а с циклами что делать тогда? Больше надеяться не на кого , потому что все только открывают рот удивленно " И это на первом курсе??". Тем более проблемы будут с проверкой это точно... Можно словарь разбить на файлы по длине слов...еще есть такие идеи:

Для очередного слова в сетке (желательно начинать с длинных)

фаза Do
* определяешь маску (какие буквы уже определены)
* получаешь курсор выборки из словаря по данной маске и запоминаешь его значение
* если обломились производишь откат к предыдущему слову
* вставляешь выбранное из словаря слово и переходишь к следующему

фаза Redo (когда был откат)
* переводишь курсор вперед
* если обломились (или вернулись на первое запомненное значение) производишь откат к предыдущему слову
* вставляешь выбранное из словаря слово и переходишь к следующему



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

Также можно ввести проверку для каждой позиции буквы в слове собрать множество доступных букв и фильтровать запросы к словарю на основе этих данных.
Например, буква Ъ не встречается в начале слова так что незачем сканировать словарь.
Бродяжник
Я позволил себе
1) сделать так, чтобы клетки меняли состояние не просто, когда мышь нажата, а именно по факту нажатия (т.е. не было нажато - стало нажато);
2) заменить операторы типа
if a < 1 then f:=false else f:=true
на эквивалентные им
f:=(a>=1);

3) выровнять текст, чтобы было удобнее читать.
Расскажите, как должны работать циклы, и я подумаю.
LOVE133
циклы должны работать так
1) New- создать новую сетку , то етсь совсем новую , пустую, нажал - заполнил
2) Make - составить кроссворд , рекурсивно заполнить словами (здесь буду работать, что получится сегодня, покажу )
3) Exit _ когда пользователь нажмет на эту "кнопку" - выход из программы
тоесть нажал на new - новую сетку сделал , нажал потом на make - заполнил кроссворд, дальше еще подумаю , над сохранением ... но это если основную часть выполню и останется время. ТО есть пользователь может составить несколько кроссвордов , переходя по кнопкам.ПОка не нажмется Exit . Задумка была такая.
LOVE133
Уважаемый Бродяжник , посидели вчера , покумекали, вот что получили , осталось забить это в код....
Вот данная рекурсивная процедура . Будем использовать как мне их обозвали «дырки», то есть места выхода из процедуры, через которые будет проскакивать рекурсия не выполняя никаких функций.
Выглядит это так (должно по крайней мере)
«гнезда» - упорядоченный массив записей содержащий вот такую структуру

Tgnezdo=record
x,y:integer; - координаты ячейки, где начинается слово
len:byte; -длина слова
horizontal:boolean; - горизонтально или вертикально расположено слово

вот данная процедура
Код

Функция ARBEIT ( передаем текстовое поле, где пробелами обозначены места где есть или должна быть  буква, и номер «гнезда» ) :Boolean;

N слова:=0; retValue:=0;(retValue – метка для прохождения процедур без выполнения)


Процедура Mask(текстовое поле, «гнездо» ):string;
(процедура получает строку типа такой “_А_ _ Л”)
Получение очередного слова из
Файла


                        Сравнение с маской            
                                                                 не подходит
                                                                  ( Inc(номер слова))
                                                              
Подходит




Если номер гнезда равен
                            максимальному номеру гнезд

                  нет                                              да

клонируем текстовое поле                                           забиваем слово в текстовое поле
забиваем слово в клон                                                      retValue:=2 ( то есть True)
(*первый выход из рекурсии)




If     ARBEIT (копия текстового поля; N гнезда +1)


False                                                            True  
(переход к получения
нового слова  
                                            
                                             Присваиваем полю значение копии
                                             retValue:=2 ( то есть True)



ТО есть теперь все циклы и условия нужно будет проверять с условием if RetValue =2 или нет . Осталось только реализовать это в код… я все-таки не до конца понимаю рекурсию. Может чем поможете, Алгоритм в принципе понятен и мелкие процедурки типа получения слова осилила. Но вот все это собрать без продлем не могу … эх.. жаль н еработают рисунки, прикрепила текстовый файл, елси что там все понятне. но смысл тут уловить можно .
Бродяжник
Уважаемая Love (можно без 133?),
я тем временем немного поправил циклы, так что меню уже почти работает. Единственное, что накладываются друг на друга сообщения, так что их надо как-то очищать, когда они уже не нужны. Я обвел кнопки рамочками по размеру области для MouseIn, чтобы четко видеть, где отлавливается щелчок.
И я уже почти закончил рекурсивную модельку, которая по заданной сетке подбирает гнезда и заполняет их, следя за пересечениями. Думаю, что сегодня и закончу. Она с массой ограничений, но схема там работает.
А уже завтра гляну на Ваш материал.
Бродяжник
Хотя бы в какой-то степени оно работает!
(Я составил 4 простеньких кроссворда. Дальше тестить поленился).
Читайте ридми.
Воть.
LOVE133
Вчера посидела с реализацией своей рекурсивной модели (см.выше) , вроде все должно работать , но есть какие-то непонятки, не могу найти где. В файле несколько процедур добавлено, основная ARBEIT , должна возвращать истину, елси все так и все работает, а так же текстовое поле , в котором все должно быть расставлено по местам , но почему-то этого не происходит.... mega_chok.gif может как-нибудь подправить можно. А в вашем кроссворде я так поняла можно модель рекурсивную взять, и вставить в прогу основную)). Может к вечеру что-то прояснится ....


в 11.30 началось переполнение стека.... (*паника и старх*)
Бродяжник
Когда сдавать-то? smile.gif
LOVE133
сдавать демо-версию завтра, а у меня кроме веселого меню и пары кнопок ничего нет )))) даже левого какого вывода слов на экран ...
Бродяжник
Сочувствую...
В том файле, который Вы прикрепили последним, я нашел пару ошибок.
1) это то, что я ведь в своей проге не случайно сделал функцию IsLetter. Вот представьте себе, что Вы пытаетесь узнать, есть ли сосед слева у самой левой клетки? Или сосед сверху у самой верхней? Что будет? Range Check Error, вот что.
2) Когда Вы первый раз вызываете функцию ARBEIT, Вы передаете ей переменную Ng, которая не определена. Перед первым вызовом надо поставить Ng := 1.
Больше я ничего не смог выяснить, из-за отсутствия файла словаря. Мой-то словарь не подходит!
Сегодня буду в сети еще часов до 4 по Москве, а дальше все... каникулы до среды.
LOVE133
а так , если пользоваться вашей программой. как е в мой интерфейс загнать? а в принципе , будет работать такая рекурсия или надо все в принципе переделывать? а словарь вот....
Бродяжник
ща посмотрим...
Правка:
Жаль, но чтобы привести это все в чувство, нужно больше времени.
И словарь кстати не тот совсем... ведь это простой текстовый файл, а в программе у Вас стоит FSTR=file of string, что вовсе не то же самое.
К сожалению, в ближайших несколько дней я уже не смогу быть Вам полезным...
Удачи!
LOVE133
завтра как-нибудь еще отверчусь, скажу, что все в процессе, постараюсь отладить, может чего и получится...Огромное спасибо за неоценимую помощь ))) give_rose.gif
LOVE133
вот... только теперь выясняется, что память в паскале не резиновая и словарь в 50000 слов обработать трудновато, даже не знаю, что тут можно сделать ... может подскажете, потому что замучала ошибка выхода за диапазон, и словарь пришлось урезать , теперь слова длинне 5 букв использовать нельзя. В файле словарь и код.МОжет можно как-нибудь решить проблему нехватки памятики и выхода за диапазоны?
Бродяжник
Привет!
В последнем выложенном файле есть как минимум следующие ошибки:
1. Еще раз возвращаюсь к разнице между text и file of string. Ваш словарь - это text, а не file of string. Поэтому к нему нельзя обращаться, как к file of string. В частности, нельзя использовать процедуру seek. Сделайте следующую вещь: напишите маленькую программу такого вида:
program test;
var f1: text;
f2: file of string;
p,m: string;
begin
p := 'Preved';
m := 'Medved';
assign(f1,'f1.txt');
rewrite(f1);
assign(f2,'f2.txt');
rewrite(f2);
writeln(f1,p);
writeln(f1,m);
write(f2,p);
write(f2,m);
close(f1);
close(f2);
end;
А потом сравните файлы f1.txt и f2.txt. И найдите 10 отличий.
Поэтому считывание слова из словаря (GEt_word_from_sl) не работает.
2. Теперь к функции Maska_Slova, конкретно вот к этому фрагменту:
with gnezdo do            
begin
i:=0;
if horizontal then
begin
while i<len do
begin
inc(i);
str:=str +text[x,y];
inc(y);
end;
end
Если if horizontal, то почему увеличивается игрек? Ведь это вертикальная координата?
3. Процедура Get_Gnezda (я уже об этом упоминал).
for i:=1 to n do
for j:=1 to n do
begin
if (a[i,j]=1) and (a[i-1,j]<>1 )and (a[i+1,j]=1 )then

Если индекс i отсчитывается от единицы, это значит, что будет обращение к ячейке a[i-1,j] то есть a[0,j]. А такой ячейки нет. Поэтому такое обращение даст ошибку. Значит, надо учитывать эту особенность - если клетка находится в 1 столбце, у нее не может быть соседей слева. То же самое касается клеток первой строки: у них не может быть соседей сверху. Чтобы это учесть, я в своих экспериментах написал функцию, которая при обращении к несуществующим ячейкам ведет себя так, как если бы там были "небуквенные" ячейки. Вы можете обойти это по-другому, но эту проблему надо решить.
4. Вы вставили в функцию ARBEIT присваивание
ng := 1;

Это не совсем то, что требовалось, потому что это напрочь убило рекурсию. Это нужно было прописать перед первым вызовом ARBEIT:
if a[i,j]=1 then bukv[i,j]:=' ' else bukv[i,j]:='0';
Get_gnezda(a, gnezdo,n, q);
ng := 1;
if ARBEIT( bukv,Ng) then ok:=true ;

Или просто
if ARBEIT( bukv,1) then ok:=true ;

Для начала разберитесь с этим.
LOVE133
Доброго времени суток ))
все координально переделала, вроде работает... теперь начались косяки с интерфейсом
1) не могу повторно задать сетку и создать кроссворд, то есть когда ошибочно введена сетка, повторное нажатие на NEW вызывает сетку, но кроссворд на MAKE уже не получается
2) как быть с выводом готового кроссворда на экран ? в графическом режиме не отображаются русские буквы (((, выключать графику?
3) можно конечно попробовать в транслите. но тогда начинаются проблемы с перекодированием - в русском 33 буквы, в английском всего 26 )))
тут демо-версия, выводит кроссворд в графическом режиме...
Бродяжник
Вот, сыскал в сети... русские фонты для BGI.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.