📄 locate.pas
字号:
unit locate;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, OleCtrls, ComObj,Sample, MapObjects2_TLB;
type
TForm1 = class(TForm)
Button1: TButton;
Map1: TMap;
Map2: TMap;
procedure Button1Click(Sender: TObject);
procedure Map1AfterLayerDraw(Sender: TObject; index: Smallint;
canceled: Wordbool; hDC: Cardinal);
procedure Map1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Map2AfterTrackingLayerDraw(Sender: TObject; hDC: Cardinal);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Sampl :Tsample;
implementation
{$R *.DFM}
{*****************************************************************************}
procedure TForm1.Button1Click(Sender: TObject);
begin
Map1.Extent := Map1.FullExtent;
end;
{*****************************************************************************}
procedure TForm1.Map1AfterLayerDraw(Sender: TObject; index: Smallint;
canceled: Wordbool; hDC: Cardinal);
var
v : Variant;
begin
if index =0 then
// after drawing the first layer, refresh the locater map
Map2.TrackingLayer.Refresh(True,v);
end;
{*****************************************************************************}
procedure TForm1.Map1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
r : IMoRectangle;
begin
// zoom in for mouseDowns with the left button
if (button = mbleft) and ( shift = [ssLeft] ) then
begin
r := IMoRectangle(CreateOleObject('MapObjects2.Rectangle'));
r :=Map1.TrackRectangle;
if r<>nil then Map1.Extent :=r;
end
else
Map1.Pan;
end;
{*****************************************************************************}
procedure TForm1.Map2AfterTrackingLayerDraw(Sender: TObject; hDC: Cardinal);
var
sym : IMoSymbol;
begin
sym := IMoSymbol(CreateOleObject('MapObjects2.Symbol'));
sym.OutlineColor := moRed; //$FF;
sym.Style := moTransparentFill; //1;
Map2.DrawShape(Map1.Extent,sym);
end;
{*****************************************************************************}
procedure TForm1.FormShow(Sender: TObject);
var
dc : IMoDataConnection;
layer : IMoMapLayer;
begin
dc := IMoDataConnection(CreateOleObject('MapObjects2.DataConnection'));
dc.database :=sampl.ReturnDatapath('usa');
if not dc.Connect then exit;
layer := IMoMapLayer(CreateOleObject('MapObjects2.MapLayer'));
layer.GeoDataset :=dc.FindGeoDataSet('states');
layer.Symbol.Color := moPaleYellow; //13697023;
Map1.Layers.Add(Layer);
layer := IMoMapLayer(CreateOleObject('MapObjects2.MapLayer'));
layer.GeoDataset :=dc.FindGeoDataSet('ushigh');
layer.Symbol.Color := moDarkGreen;//16384;
Map1.Layers.Add(Layer);
layer := IMoMapLayer(CreateOleObject('MapObjects2.MapLayer'));
layer.GeoDataset :=dc.FindGeoDataSet('uslakes');
layer.Symbol.Color := moBlue; //$FF0000;
Map1.Layers.Add(Layer);
layer := IMoMapLayer(CreateOleObject('MapObjects2.MapLayer'));
layer.GeoDataset :=dc.FindGeoDataSet('states');
layer.Symbol.Color := moPaleYellow; //13697023;
Map2.Layers.Add(Layer);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -