Подключение мыши, (программа Кроссворд) Опции

[-LOVE133-]

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

[volvo]

Обычно - просто компилируют PAS файл модуля, и компилятор создает TPU файл...

Или загружают в Паскаль основную программу (НЕ модуль), и в меню выбирают Compile -> Build, тогда Паскаль сам откомпилирует все необходимые PAS файлы в TPU (желательно, чтобы PAS файлы модулей при этом находились в той же папке, что и основная программа)...

[Гость]

а еще хотела спросить в вашем юните в МИККИ что обозначается, первый раз встречаю это слово...

[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]

все.... перепутала просто один юнит с другим все устраивает, а , кстати, для вывода графики обязательно мышь выключать надо? а еще все таки не могу вычертить окно , даже по этой процедуре... толи setviewport то ли window ?

Сообщение отредактировано: LOVE133 - 20.04.2006 1:40

[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 - 23.04.2006 23:00

[LOVE133]

скачала словарь существительных, теперь его пытаюсь отсортировать по количеству буквБ самые маленькие слова вверху и чтоб оставил сортировку по алфавиту внутри.Должно вроде работать правильно, хотя не уверенаю Хотелось бы узнать, правильно она будет работать или нет?

[Бродяжник]

Словарь скачивать пока влом, поэтому маленький вопрос. Файл словаря это действительно файл из записей с фиксированной длиной 26 байт? Это именно file of slova? А не простой текстовый?
И второе: может быть, стоило бы все же явно задать условие сортировки по алфавиту? Так, на всякий случай...

Сообщение отредактировано: Бродяжник - 27.04.2006 14:30

[LOVE133]

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

[Бродяжник]

ладно, уговорили. Скачаю Ваш словарь, отсортирую, выложу отсортированный. Короткие в начало, одинаковые - по алфавиту. Но в виде простого текстового файла.