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

📄 map.txt

📁 实现地图功能,放大
💻 TXT
字号:
unit U_map;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, MapObjects2_TLB, StdCtrls,ComObj, ExtCtrls;

type
  TForm1 = class(TForm)
    Map1: TMap;
    Button1: TButton;
    Edit3: TEdit;
    Panel1: TPanel;
    Label1: TLabel;
    Edit1: TEdit;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    B_quit: TButton;
    procedure Map1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure B_quitClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Map1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
 r : IMoRectangle;

begin
    //Map1.Extent := Map1.TrackRectangle;
    if (Button = mbLeft) then
        Map1.Extent := Map1.TrackRectangle
    else if (Button = mbRight) then
    begin
       r := IMoRectangle(CreateOleObject('MapObjects2.Rectangle'));
       r := Map1.Extent;
       r.ScaleRectangle(1.5);
       Map1.Extent :=r;
    end ;
    {else
        Map1.Pan;   }




end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    Map1.Extent := Map1.FullExtent;
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
var
  lys      : IMoLayers;
  layer   : IMoMapLayer;
  recs    : IMoRecordset;
  shp     : IMoPolygon;
  rect    : IMoRectangle;
  fields : IMoFields;
  exp    : string;
begin
  // check for the enter key
  if (Key = #13) then
    begin
    // build a search expression
    exp :='STATE_NAME =''' + Edit1.Text + '''';
    lys := Map1.Layers;
    layer := IMoMapLayer(CreateOleObject('MapObjects2.MapLayer'));
    layer := IMoMapLayer(lys.Item('STATES'));
    // perform the search on the STATES layer

    recs := layer.SearchExpression(exp);

    // show the results, if any
    if (not recs.EOF) then
      begin
        fields := recs.Fields;
        shp := IMoPolygon(CreateOleObject('MapObjects2.Polygon'));
        // get the shape geometry
        shp := IMoPolygon(IDispatch(fields.Item('Shape').Value));
        // create a rectangle based on the extent of the state
        rect:= IMoRectangle(CreateOleObject('MapObjects2.Rectangle'));
        rect:= shp.Extent;
        rect.ScaleRectangle((2.0));
        // zoom to the state
        Map1.Extent := rect;
        Map1.Refresh;
        // flash the state
        Map1.FlashShape(shp, 3);
      end;

    // suppress a beep
    Key := #0;
    end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
 r : IMoRectangle;
begin
  //Map1.MousePointer := moZoomOut;
  r := IMoRectangle(CreateOleObject('MapObjects2.Rectangle'));
  r := Map1.Extent;
  r.ScaleRectangle(1.5);
  Map1.Extent :=r;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
   
Map1.MousePointer := moZoomIn;

   //     Map1.Extent := Map1.TrackRectangle ;
//        Map1.Pan;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
    //Map1.Pan;
    Map1.MousePointer := moPan;
end;



procedure TForm1.B_quitClick(Sender: TObject);
begin
    close;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -