IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

4 страниц V  1 2 3 > »   
 Ответить  Открыть новую тему 
> Подключение мыши, (программа Кроссворд)
сообщение
Сообщение #1


Гость






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


Гость






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

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


Гость






а еще хотела спросить в вашем юните в МИККИ что обозначается, первый раз встречаю это слово... smile.gif
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






Там же написано:
Цитата
микки(шаг) - наименьшее расстояние, перемещение на которое мышь может зарегистрировать (т.е. расстояние регистрируемое датчиками мыши). Обычно 0.125 мм.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Гарцующая лошадка
**

Группа: Пользователи
Сообщений: 107
Пол: Женский
Реальное имя: Любовь

Репутация: -  0  +


пытаюсь реализовать такой алгоритм :
1) есть сетка с координатами
2) если в каком-то окне щелкнуть мышью, то подсветить эту клетку
3) если щелкнуть повторно , то снять выделение
не получается применить прцедуры, а так же в графическом режиме сделать отдельное выделение, типа процедуры window(x1,y1,x2,y2) в crt . Подскажите, как применять процедуры юнита mouse
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Бывалый
***

Группа: Пользователи
Сообщений: 206
Пол: Мужской

Репутация: -  3  +


Вот примитивная заготовка, чтобы понять основные моменты.
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.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Гарцующая лошадка
**

Группа: Пользователи
Сообщений: 107
Пол: Женский
Реальное имя: Любовь

Репутация: -  0  +


а нет процедуры. которая определяет, в каком месте экрана находится курсор?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Гость






Чем
Procedure GetMouseXY(VAR KoordX,KoordY:Word );
не устраивает? Она же возвращает координаты мыши...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Гарцующая лошадка
**

Группа: Пользователи
Сообщений: 107
Пол: Женский
Реальное имя: Любовь

Репутация: -  0  +


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

Сообщение отредактировано: LOVE133 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Гость






Если не хочешь получать после вывода графики и движения мышкой разные "артефакты" на экране - лучше отключать, тогда курсор мыши не мешает нормальному выводу графики.

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

Может, тебе подойдет простой Rectangle и функция MouseIn ?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Гарцующая лошадка
**

Группа: Пользователи
Сообщений: 107
Пол: Женский
Реальное имя: Любовь

Репутация: -  0  +


у меня есть сетка (line(x1,y1,x2,y2)) которые делят экран на сетку , мне надо чтобы после щелчка мышью по полю, ячейка выделялась другим цветом, а после второго щелчка снималось выделение.. подскажите, как хоть выделение организовать.. да. там еще проблема будет с определением координат выделения, потому что на сколько делить экран задает пользователь )))) то есть , при 10*10 нужно будет определить , сколько заливать , какой размер )))
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Гость






Пишу прямо здесь, так что могут быть мелкие помарки... Идея такая:
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;
...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Гарцующая лошадка
**

Группа: Пользователи
Сообщений: 107
Пол: Женский
Реальное имя: Любовь

Репутация: -  0  +


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


Гарцующая лошадка
**

Группа: Пользователи
Сообщений: 107
Пол: Женский
Реальное имя: Любовь

Репутация: -  0  +


вчера вечером посидела, вот что получилось
Код

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;


но почему-то работает только вправо и вниз, а мне нужно, чтоб она еще влево шла и вверх проверяла ..
показательный пример в файле


Прикрепленные файлы
Прикрепленный файл  INCREM.PAS ( 1.52 килобайт ) Кол-во скачиваний: 103
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15


Гость






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.

?

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

..
 К началу страницы 
+ Ответить 
сообщение
Сообщение #16


Гарцующая лошадка
**

Группа: Пользователи
Сообщений: 107
Пол: Женский
Реальное имя: Любовь

Репутация: -  0  +


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

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

Сообщение отредактировано: LOVE133 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #17


Гарцующая лошадка
**

Группа: Пользователи
Сообщений: 107
Пол: Женский
Реальное имя: Любовь

Репутация: -  0  +


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


Прикрепленные файлы
Прикрепленный файл  data.txt ( 591.61 килобайт ) Кол-во скачиваний: 583
Прикрепленный файл  FILE_SOR.PAS ( 580 байт ) Кол-во скачиваний: 113
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #18


Бывалый
***

Группа: Пользователи
Сообщений: 206
Пол: Мужской

Репутация: -  3  +


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

Сообщение отредактировано: Бродяжник -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #19


Гарцующая лошадка
**

Группа: Пользователи
Сообщений: 107
Пол: Женский
Реальное имя: Любовь

Репутация: -  0  +


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


Бывалый
***

Группа: Пользователи
Сообщений: 206
Пол: Мужской

Репутация: -  3  +


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

4 страниц V  1 2 3 > » 
 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 




- Текстовая версия 25.09.2017 4:02
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"