Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

прицел [D7, WinXP]


Весёлый ©   (2005-07-03 23:55:00) 

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


Просто Джо   (2005-07-04 01:30:00) [1]

> [5] alex-drob   (04.07.05 00:58)
Тогда уж как-то так:


 TForm1 = class(TForm)
   procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
     Y: Integer);
 private
   OldX,
   OldY: Integer;
 public
 end;

...
implementation
...

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
 procedure DrawTarget (AtX,AtY: Integer);
 const
   Radius = 10;
 begin
  Canvas.Pen.Mode := pmNot;
   Canvas.MoveTo (AtX,0);
   Canvas.LineTo (AtX,Height);
   Canvas.MoveTo (0,AtY);
   Canvas.LineTo (Width,AtY);
   Canvas.Brush.Style := bsClear;
   Canvas.Ellipse(
     AtX-Radius,
     AtY-Radius,
     AtX+Radius,
     AtY+Radius
   );
 end;
 function NeedsErasing: Boolean;
 begin
   Result := (OldX<>0) and (OldY<>0)
 end;
 procedure StoreCoordinates (AtX,AtY: Integer);
 begin
   OldX := AtX;
   OldY := AtY
 end;
 procedure EraseIfNeeded;
 begin
   if NeedsErasing then
     DrawTarget(OldX,OldY)
 end;
begin
 EraseIfNeeded;
 DrawTarget(X,Y);
 StoreCoordinates(X,Y);
end;



> [6] Весёлый   (04.07.05 01:02)
В сантиметрах экранные координаты (и расстояния) не меряют.


alex-drob   (2005-07-04 01:21:00) [2]

Или так:

canvas.Brush.Color:=clBtnFace;
canvas.Pen.Color:=clBlack;
canvas.Rectangle(ClientRect);
canvas.Ellipse(x-10,y-10,x+10,y+10);
canvas.MoveTo(x,0);
canvas.LineTo(x,height);
canvas.MoveTo(0,y);
canvas.LineTo(width,y);


alex-drob   (2005-07-04 01:11:00) [3]

20 px

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
begin
canvas.Rectangle(ClientRect);
canvas.Brush.Color:=clblack;
canvas.MoveTo(x,0);
canvas.LineTo(x,height);
canvas.MoveTo(0,y);
canvas.LineTo(width,y);
canvas.Brush.Color:=clBtnFace;
canvas.Ellipse(x-10,y-10,x+10,y+10);
end;


Весёлый   (2005-07-04 01:02:00) [4]

alex-drob, если не трудно, напиши ещё как обвести вотруг курсора окружность радиусом 1 см.


alex-drob   (2005-07-04 00:58:00) [5]

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
begin
canvas.Brush.Color:=clBtnFace;
canvas.Rectangle(ClientRect);
canvas.Brush.Color:=clblack;
canvas.MoveTo(x,0);
canvas.LineTo(x,height);
canvas.MoveTo(0,y);
canvas.LineTo(width,y);
end;


Eraser   (2005-07-04 00:52:00) [6]

Весёлый   (04.07.05 00:32) [3]

TCanvas.LineTo,
-//-MoveTo.


Весёлый   (2005-07-04 00:32:00) [7]

Да нет, дело не в курсоре, надо программно нарисовать две линии центр пересечения которых находился бы в кончике курсора, и при перемещении линии тоже должны сдвигаться, напоминает прицел, а линии должны идти от краёв формы


Юрий Зотов   (2005-07-04 00:17:00) [8]

> Весёлый   (03.07.05 23:55)

А в чем проблема? Сделайте свой курсор, вот и все.
См. в справке - TScreen.Cursors. Там и пример есть.


KilkennyCat   (2005-07-04 00:05:00) [9]


> Кто ни будь знаеть как это можно программно реализовать?


Вполне возможно, что Кто Ни Будь знает, но он сюда не заходит - здесь китайский не отображается...


Наверх

Титульная страница Поиск, карта сайта Написать письмо