靴
靴子
Unregistered / Unconfirmed
GUEST, unregistred user!
我在用d7+mapx时,为了当鼠标移出地图界面时能够相应的移动地图我做了如下实验:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, MapXLib_TLB;
type
TForm1 = class(TForm)
Map1: TMap;
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
procedure Button1Click(Sender: TObject);
procedure Map1MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
showmessage(floattostr(map1.Height));
showmessage(floattostr(form1.Height))
end;
procedure TForm1.Map1MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
begin
edit1.Text:=inttostr(x);
edit2.Text:=inttostr;
if (x>
map1.Width)and (y>0) and (y<map1.Height)then
begin
map1.CenterX:=map1.CenterX+0.1;
end
else
if (x>map1.Width)and (y>map1.Height) then
begin
map1.CenterX:=map1.CenterX+0.1;
map1.CenterY:=map1.CenterY-0.1;
end
else
if (x>0) and (x<map1.Width) and (y>map1.Height) then
begin
//map1.CenterX:=map1.CenterX+0.1;
map1.CenterY:=map1.CenterY-0.1;
end
else
if (x<0) and (y>map1.Height) then
begin
map1.CenterX:=map1.CenterX-0.1;
map1.CenterY:=map1.CenterY-0.1;
end
else
if (x<0) and (y>0) and (y<map1.Height) then
begin
map1.CenterX:=map1.CenterX-0.1;
end
else
if (x<0) and (y<0) then
begin
map1.CenterX:=map1.CenterX-0.1;
map1.CenterY:=map1.CenterY+0.1;
end
else
if (y<0) and (x>0) and (x<map1.Width) then
begin
map1.CenterY:=map1.CenterY+0.1;
end
else
if (x>map1.Width) and (y<0) then
begin
map1.CenterX:=map1.CenterX+0.1;
map1.CenterY:=map1.CenterY+0.1;
end;
end;
procedure nitificationwndproc(var message:tMessage);
var
p:Tpoint;
begin
case message.LParam of
wm_LBUTTONDBLCLK:
begin
getcursorpos(p);
end;
end;
end;
end.
但是当要滚动图层时,地图会抖动,而且有些操作,比如测量距离的线就不是预想的样子了。如何除去抖动呢?
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, MapXLib_TLB;
type
TForm1 = class(TForm)
Map1: TMap;
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
procedure Button1Click(Sender: TObject);
procedure Map1MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
showmessage(floattostr(map1.Height));
showmessage(floattostr(form1.Height))
end;
procedure TForm1.Map1MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
begin
edit1.Text:=inttostr(x);
edit2.Text:=inttostr;
if (x>
map1.Width)and (y>0) and (y<map1.Height)then
begin
map1.CenterX:=map1.CenterX+0.1;
end
else
if (x>map1.Width)and (y>map1.Height) then
begin
map1.CenterX:=map1.CenterX+0.1;
map1.CenterY:=map1.CenterY-0.1;
end
else
if (x>0) and (x<map1.Width) and (y>map1.Height) then
begin
//map1.CenterX:=map1.CenterX+0.1;
map1.CenterY:=map1.CenterY-0.1;
end
else
if (x<0) and (y>map1.Height) then
begin
map1.CenterX:=map1.CenterX-0.1;
map1.CenterY:=map1.CenterY-0.1;
end
else
if (x<0) and (y>0) and (y<map1.Height) then
begin
map1.CenterX:=map1.CenterX-0.1;
end
else
if (x<0) and (y<0) then
begin
map1.CenterX:=map1.CenterX-0.1;
map1.CenterY:=map1.CenterY+0.1;
end
else
if (y<0) and (x>0) and (x<map1.Width) then
begin
map1.CenterY:=map1.CenterY+0.1;
end
else
if (x>map1.Width) and (y<0) then
begin
map1.CenterX:=map1.CenterX+0.1;
map1.CenterY:=map1.CenterY+0.1;
end;
end;
procedure nitificationwndproc(var message:tMessage);
var
p:Tpoint;
begin
case message.LParam of
wm_LBUTTONDBLCLK:
begin
getcursorpos(p);
end;
end;
end;
end.
但是当要滚动图层时,地图会抖动,而且有些操作,比如测量距离的线就不是预想的样子了。如何除去抖动呢?