如何捕捉网格上的点坐标 ( 积分: 100 )

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;

type
TForm1 = class(TForm)
Image1: TImage;
procedure FormCreate(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

var
IFW,IFH:integer;
IGridCntX,IGridCntY:Integer;
IDeltaX,IDeltaY:integer;
Ix1,Ix2,Iy1,Iy2,i,j:Integer;

procedure TForm1.FormCreate(Sender: TObject);
begin

IFW:=200;//棋盘宽
IFH:=200;//棋盘高
IGridCntX:=5;//水平格数
IGridCntY:=5;//垂直格数
IDeltaX:=IFW div IGridCntX;//水平格宽
IDeltaY:=IFH div IGridCntY;//垂直格高

IFW:=IDeltaX * IGridCntX;//重整棋盘宽
IFH:=IDeltaY * IGridCntY;//重整棋盘高
Image1.Canvas.Pen.Color:=clRed;//线条颜色
Iy1:=0;
Iy2:=IFH;
for i:=0 to IGridCntX do
begin
Ix1:=i*IDeltaX;
Ix2:=Ix1;
Image1.Canvas.MoveTo(Ix1,Iy1);
Image1.Canvas.LineTo(Ix2,Iy2);
end;
Ix1:=0;
Ix2:=IFW;
for j:=0 to IGridCntY do
begin
Iy1:=j*IDeltaY;
Iy2:=Iy1;
Image1.Canvas.MoveTo(Ix1,Iy1);
Image1.Canvas.LineTo(Ix2,Iy2);

end;

end;

var
pts:array [0..1] of TPoint;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin

Image1.Canvas.Pen.Style:= psDot;//线型
Image1.Canvas.Pen.Color:= clGray;//颜色
Image1.Canvas.Pen.Mode := pmNotXor;
pts[0]:=Point(X, Y);
Image1.Canvas.MoveTo(pts[0].X, pts[0].Y);
Image1.Canvas.LineTo(pts[1].X, pts[1].Y);
pts[1] := Point(X, Y);

end;

end.
为什么运行后第一个点是从网格起点开始的，若要起点是鼠标点下的第一个点开始怎么改程序？怎么编程序使鼠标每次点下的点都能捕捉到网格的交点？请高人指点，谢谢！

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Math;

type
TForm1 = class(TForm)
Image1: TImage;
procedure FormCreate(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
FFirstDown: Boolean;
public
function FindNearestPoint(APoint: TPoint; AGridSize: TSize): TPoint;
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

var
IFW,IFH:integer;
IGridCntX,IGridCntY:Integer;
IDeltaX,IDeltaY:integer;
Ix1,Ix2,Iy1,Iy2,i,j:Integer;



{-----------------------------------------------------------------------------
Procedure: FindNearestPoint
Author: liaj 2007.03.22
Purpose: 查找最相近的点
-----------------------------------------------------------------------------}
function TForm1.FindNearestPoint(APoint: TPoint; AGridSize: TSize): TPoint;
var
nW, nH: Integer;
begin
nW := Max(AGridSize.cx, 2);
nH := Max(AGridSize.cy, 2);

Result.X := (APoint.X div nW) * nW + Round((APoint.X mod nW)/nW) * nW;
Result.Y := (APoint.Y div nH) * nH + Round((APoint.Y mod nH)/nH) * nH;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
IFW:=200;//棋盘宽
IFH:=200;//棋盘高
IGridCntX:=5;//水平格数
IGridCntY:=5;//垂直格数
IDeltaX:=IFW div IGridCntX;//水平格宽
IDeltaY:=IFH div IGridCntY;//垂直格高

IFW:=IDeltaX * IGridCntX;//重整棋盘宽
IFH:=IDeltaY * IGridCntY;//重整棋盘高
Image1.Canvas.Pen.Color:=clRed;//线条颜色
Iy1:=0;
Iy2:=IFH;
for i:=0 to IGridCntX do
begin
Ix1:=i*IDeltaX;
Ix2:=Ix1;
Image1.Canvas.MoveTo(Ix1,Iy1);
Image1.Canvas.LineTo(Ix2,Iy2);
end;
Ix1:=0;
Ix2:=IFW;
for j:=0 to IGridCntY do
begin
Iy1:=j*IDeltaY;
Iy2:=Iy1;
Image1.Canvas.MoveTo(Ix1,Iy1);
Image1.Canvas.LineTo(Ix2,Iy2);

end;

FFirstDown := True;
end;

var
pts:array [0..1] of TPoint;


procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
pt: TPoint;
Size: TSize;
begin
Size.cx := IDeltaX;
SIze.cy := IDeltaY;
pt := Point(X, Y);
pt := FindNearestPoint(pt, Size);

Image1.Canvas.Pen.Style:= psDot;//线型
Image1.Canvas.Pen.Color:= clGray;//颜色
Image1.Canvas.Pen.Mode := pmNotXor;
pts[0]:=pt;

if FFirstDown then
begin
pts[1] := pt;
FFirstDown := False;
end;

Image1.Canvas.MoveTo(pts[0].X, pts[0].Y);
Image1.Canvas.LineTo(pts[1].X, pts[1].Y);
pts[1] := pt;
end;

end.

有疑问可联系我:QQ:9863231

谢谢解答！