Ver Mensaje Individual
  #3  
Antiguo 10-01-2006
Avatar de marcoszorrilla
marcoszorrilla marcoszorrilla is offline
Capo
 
Registrado: may 2003
Ubicación: Cantabria - España
Posts: 11.221
Reputación: 10
marcoszorrilla Va por buen camino
He estado buscando un código que no recuerdo de dónde descargue y finalmente lo he encontrado, puesto que viene a proposito.

Código Delphi [-]

implementation

{$R *.dfm}

function PointToPointDist(Ax, Ay, Bx, By: double): double;
begin
  Result := sqrt(sqr(Bx - Ax) + sqr(By - Ay));
end;


function MinDistPointLine(Px, Py, Ax, Ay, Bx, By: double): double;
var
  q: double;
begin
  if (Ax = Bx) and (Ay = By) then
  begin
    {Point to point}
    Result := PointToPointDist(Px, Py, Ax, Ay);
  end
  else
  begin
    {Minimum}
    q := ((Px - Ax) * (Bx - Ax) + (Py - Ay) * (By - Ay)) / (sqr(Bx - Ax) + sqr(By - Ay));
    {Limit q to 0 <= q <= 1}
    if q < 0 then
      q := 0;
    if q > 1 then
      q := 1;
    {Distance}
    Result := PointToPointDist(Px, Py, (1 - q) * Ax + q * Bx, (1 - q) * Ay + q * By);
  end;
end;


procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var  a:double;
begin
 Label1.Caption:=inttostr(x)+'  '+inttostr(y);
 a:=MinDistPointLine(x, y, 100, 100, 200, 200);

 //Here you choice the width of line - if single use 0 .
 //In my case I use <2 ( mean 0 and 1 ) because I have a 3 pixels width .
 //This mean 1-0-1 . 0 is the line center .

 if a<2  then Label2.Caption:='The mouse is over the line' else
 Label2.Caption:='The mouse isn''t over the line';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Canvas.Pen.Width:=3;
  Canvas.MoveTo(100, 100);
  Canvas.LineTo(200, 200);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 {x1:=100;
 y2:=100;
 x2:=200;
 y2:=200; }
end;

end.

Un Saludo.
__________________
Guía de Estilo de los Foros
Cita:
- Ça c'est la caisse. Le mouton que tu veux est dedans.
Responder Con Cita