| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Привязка мыши к точке [D5, Win2k, WinXP]
jack128 © (2004-06-24 16:55:00)День добрый.
Многие наверно видели в AutoCAD'e привязку курсора к мыши точке экрана (команда Osnap off/on)
Пытаюсь сделать, что то похоже. Вот что у меня получается:
type
TForm1 = class(TForm)
PaintBox: TPaintBox;
Memo1: TMemo;
procedure PaintBoxPaint(Sender: TObject);
procedure PaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
// виртуальные координаты курсора относительно точки привязки, если бы мы не привязывали курсор
dX, dY: Integer;
// центр PaintBox'a - та точка к которой привязываемся
function GetCenter: TPoint;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
const
CrossLen = 5;
procedure TForm1.PaintBoxPaint(Sender: TObject);
begin
// Ресуем крест в центре пайнтбокса
with PaintBox.Canvas, GetCenter do
begin
MoveTo(x - CrossLen, y);
LineTo(x + CrossLen + 1, y);
MoveTo(x, y - CrossLen);
LineTo(x, y + CrossLen + 1);
end;
end;
procedure TForm1.PaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
c: TPoint;
r: TRect;
begin
c := GetCenter;
if (c.x = x) and (c.y = y) then exit;
// если курсов внутри небольшой области рядом с точкой привязки
if (abs(X - c.x) <= CrossLen) and (abs(Y - c.y) <= CrossLen) then
begin
inc(dX, x - c.x);
inc(dY, y - c.y);
if (abs(dX) > CrossLen) or (abs(dY) > CrossLen) then
begin
with PaintBox.ClientToScreen(Point(c.x + dx, c.y + dY)) do
SetCursorPos(x, y);
dX := 0; dY := 0;
end
else
with PaintBox.ClientToScreen(c) do
SetCursorPos(x, y);
end;
end;
function TForm1.GetCenter: TPoint;
begin
with PaintBox do
begin
Result.x := Width div 2;
Result.y := Height div 2;
end;
end;
Проблема в том, если курсор медленно перемещать в области привязки, то он мигает. Может у кого есть мысли как этого избежать?
Романов Р.В. (2004-06-25 08:17:00) [1]Свойства: Экран -> Настройка -> Дополнительно -> Устранение неполадок -> Отключить ускорение курсора и точечных рисунков. Используйте такую настройку при проблемах с курсором или при просмотре поврежденных файлов изображений.
jack128 (2004-06-25 05:47:00) [2]
> GuAV © (24.06.04 23:43)
ну вот, вспомнил былое... Тогда я был молодым и глупым :-)
MIGUR (2004-06-25 03:33:00) [3]Воспользуйся лучше компонентом LMD-Tools 7.0
В нем есть такой компонент как приязка крысы к любой точке монитора, и нетолько, короче чтобы увидеть качай весит 20mb, и crack скачать незабуть. Кстати неодин мой проект необходится без этого компонента. (*_*)
GuAV (2004-06-24 23:43:00) [4]Из архива...
jack128 © (06.06.04 15:32) [41]
> Есть идея такая-скрыть нафиг курсор. рисовать самому курсор
> вместе с линеей и юзер нифига не заподозрит.
Слушай - я тебя боюсь ;-)) С такими приколами юзер у тя инфаркт может схватить..
:-))
jack128 (2004-06-24 23:27:00) [5]
> Собственно что мешает скрыть курсор и отрисовывать самому
> в какой угодно позиции как душе угодно...
угу. Это FX предложил, я попробую..
Palladin (2004-06-24 23:14:00) [6]
> jack128 ©
Собственно что мешает скрыть курсор и отрисовывать самому в какой угодно позиции как душе угодно...
GuAV (2004-06-24 22:56:00) [7]
> Конструктивно. Сенкс.
Хм. Я то же самое написал в ветке про линию (только словамии), а ты сказал, что меня боишься :)
Кстати, наверное знаешь - Electronic Workbench - так она осуществляет snap-to-grid при отпускании, а таскаешь объект и водишь курсор без этого.
jack128 (2004-06-24 20:06:00) [8]
> [11] FX © (24.06.04 19:39)
Конструктивно. Сенкс.
> А не пробовал делать двойную буферизацию?
курсор отрисововается аппаратно, на него такие вещи не влияют.
> Имхо snap-to-grid не для мыши обычно делают а для объекта.
> см. drag-drop в IDE Delphi.
ну естественно. Это так, я пример накидал. Реально мышкой переносятся элементы схемы.
> если это все та же прога, в которой линии проводишь, то
> я тебе сочувствую
угу, она же. А что так? Туго идет? ;-) Ну так не забывай - у мя экзамены, в июле дела быстрее пойдут..
GuAV (2004-06-24 20:05:00) [9]кстати, насчет глючности виндового mousemove - пригрузив комп можно добиться чтоб окно "ShowMessage" таскалось с запозданием!
GuAV (2004-06-24 19:56:00) [10]
> есть. AFAIK любой обработчик соообщения - суть дин метод
Не знал. Тогда в OnMouseMove таких вызовов аж два.
Имхо snap-to-grid не для мыши обычно делают а для объекта. см. drag-drop в IDE Delphi.
зы - если это все та же прога, в которой линии проводишь, то я тебе сочувствую
QuasiLamo (2004-06-24 19:45:00) [11]
> jack128 © (24.06.04 16:55)
А попробуй сделать чтобы курсов вообще на промежуточные позиции... то есть при перемещении мыши указатель прыгал сразу на соседнюю точку сетки... Строго говоря, в автокаде так и сделано кажется...
А не пробовал делать двойную буферизацию?
FX (2004-06-24 19:39:00) [12]type
TForm1 = class(TForm)
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure DrawCursor(X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
var
CurPt: TPoint;
Grid: Byte = 12;
{$R *.DFM}
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
dX, dY: Integer;
NewPt: TPoint;
begin
if X mod Grid <= Grid div 2 then dX:=0 else dX:=Grid;
if Y mod Grid <= Grid div 2 then dY:=0 else dY:=Grid;
NewPt:=Point(X div Grid *Grid + dX, Y div Grid *Grid + dY);
Caption:=Format('%d, %d', [NewPt.x, NewPt.y]);
if (NewPt.x = CurPt.x) and (NewPt.y = CurPt.y)then Exit;
DrawCursor(CurPt.x, CurPt.y);
CurPt:=NewPt;
DrawCursor(NewPt.x, NewPt.y);
end;
procedure TForm1.DrawCursor(X, Y: Integer);
begin
with Canvas do begin
Pen.Mode:=pmNotXor;
MoveTo(X, Y-15);
LineTo(X, Y+16);
MoveTo(X-15, Y);
LineTo(X+16, Y);
Brush.Style:=bsClear;
Rectangle(X-3, Y-3, X+4, Y+4);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Cursor:=-1;
end;
procedure TForm1.FormPaint(Sender: TObject);
var
X, Y: Integer;
begin
for X:=0 to Width do
if X mod Grid = 0 then
for Y:=0 to Height do
if Y mod Grid = 0 then
Canvas.Pixels[X, Y]:=clBlack;
end;
end.
jack128 (2004-06-24 19:31:00) [13]
> Вызова динамического метода нет и
есть. AFAIK любой обработчик соообщения - суть дин метод
> Ещё можно дизассемблить ClipCursor - у меня опыта в этом
> нет
у меня еще меньше. Я вообще с асмом на Вы..
Ладно, к черту, забыли про эту привязку - сделаю опцию, кому нравится - пусть включает, кому не нравиться - пусть сам до пикселя курсор позиционирует ;-)
GuAV (2004-06-24 18:50:00) [14]Мыслишка такая, что как ни крути, MouseMove - вечный гемморой.
> OnMouseMove
можно попробовать WM_MOUSEMOVE. Чем может ускорить?... Вызова динамического метода нет и вроде там какие то ещё лишине поверки...
Ещё +совсем-чуть-чуть FCenter заместо GetCenter.
Ещё можно дизассемблить ClipCursor - у меня опыта в этом нет, но может ты сможешь. Хотя работает ли она без глюков - вопрос.
jack128 (2004-06-24 17:59:00) [15]Может все же у кого мыслишки появились?
У мя duron800/256/WinXP-Home
то ли особенности линейки NT, то ли черт его знает.. Ненавижу!!!!
default (2004-06-24 17:54:00) [16]чудо техника не правда-ли?
пентиум 3, RAM 256, ОС - ME
Sandman25 (2004-06-24 17:53:00) [17]PIV-2GHz, 510MB, Win2000 Server
jack128 (2004-06-24 17:51:00) [18]гм... Хз.. А проц/память/ОС не могли бы указать?
default (2004-06-24 17:41:00) [19]у меня вообще не мелькает
jack128 (2004-06-24 17:40:00) [20]
> с другой стороны, если поставить
> with PaintBox.ClientToScreen(c) do
> SetCursorPos(x, y);
> exit;
> в самое начало, то мелькания не будет. Почему, не понимаю.
? Наверно от машины зависит.. У мя и в этом случае мелькает..
| |
Страницы: 