⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 locate.pas

📁 完成delphi下面对mapobject的引用
💻 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 + -