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

📄 untmain.pas

📁 利用SuperMap object控件实现GPS导航功能
💻 PAS
字号:
{=====================================SuperMap Objects 示范工程说明=======================================
功能简介:示范SuperMap中的跟踪功能。
所用控件:SuperMap控件和SuperWorkspace控件。
所用数据:当前目录下的Data.sdb和Data.sdd文件
操作说明:
        点击"跟踪"按钮,程序会在当前地图窗口坐标范围内生成随机坐标值,动态目标
        移动到随机计算的坐标位置上。
===================================SuperMap Objects 示范工程说明结束===================================== }

unit untMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  SuperMapLib_TLB, StdCtrls, OleCtrls, ExtCtrls;

type
  TfrmMain = class(TForm)
    SuperMap1: TSuperMap;
    btnZoomin: TButton;
    btnZoomout: TButton;
    btnViewentire: TButton;
    btnPan: TButton;
    btnSelect: TButton;
    btnGPS: TButton;
    SuperWorkspace1: TSuperWorkspace;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure btnZoominClick(Sender: TObject);
    procedure btnZoomoutClick(Sender: TObject);
    procedure btnViewentireClick(Sender: TObject);
    procedure btnPanClick(Sender: TObject);
    procedure btnSelectClick(Sender: TObject);
    procedure btnGPSClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation
 const scl: Integer = 50;

{$R *.DFM}

procedure TfrmMain.FormCreate(Sender: TObject);
var
  objds:sodatasource;
  objdt:sodataset;
begin
  frmMain.SuperMap1.Connect(frmMain.SuperWorkspace1.Handle);
  objds:=frmMain.SuperWorkspace1.OpenDataSource('..\data\world\world.sdb','world',scesdbplus,false);
  if objds=nil then
     begin
       showmessage('打开数据源出错!');
       exit;
     end;
  objdt:=objds.Datasets[1];
  if objdt=nil then
     begin
       showmessage('打开数据集出错!');
       exit;
     end;
  frmMain.SuperMap1.Layers.AddDataset(objdt,true);
  frmMain.SuperMap1.Refresh;
  
  //释放变量
  objds:=nil;
  objdt:=nil;
end;

procedure TfrmMain.btnZoominClick(Sender: TObject);
begin
  frmMain.SuperMap1.Action:=scazoomin;
end;

procedure TfrmMain.btnZoomoutClick(Sender: TObject);
begin
  frmMain.SuperMap1.Action:=scazoomout;
end;

procedure TfrmMain.btnViewentireClick(Sender: TObject);
begin
  frmMain.SuperMap1.ViewEntire;
end;

procedure TfrmMain.btnPanClick(Sender: TObject);
begin
  frmMain.SuperMap1.Action:=scapan;
end;

procedure TfrmMain.btnSelectClick(Sender: TObject);
begin
  frmMain.SuperMap1.Action:=scaselect;
end;

procedure TfrmMain.btnGPSClick(Sender: TObject);
begin
  if frmMain.btnGPS.Caption='GPS跟踪' then
     begin
       Timer1.Enabled := True;
       frmMain.btnGPS.Caption:='停止跟踪';
     end
  else
     begin
       frmMain.btnGPS.Caption:='GPS跟踪';
       Timer1.Enabled := false;
     end;
end;

procedure location(x:double;y:double;spm:Tsupermap);
var
  pnt:sogeopoint;
  style:sostyle;
begin
  spm.TrackingLayer.ClearEvents;
  pnt:=cosogeopoint.Create;
  style:=cosostyle.create;
  pnt.x:=x;
  pnt.y:=y;
  style.pencolor:=clRed;
  style.SymbolSize:=40;
  style.SymbolStyle:=1110;
  if pnt.x<spm.ViewBounds.Left then spm.Pan2(pnt.x-spm.ViewBounds.CenterPoint.x,0)
  else if pnt.x>spm.ViewBounds.Right then spm.Pan2(pnt.x-spm.ViewBounds.CenterPoint.x,0)
  else if pnt.y>spm.ViewBounds.Top then spm.Pan2(0,pnt.y-spm.ViewBounds.CenterPoint.y)
  else if pnt.y<spm.ViewBounds.Bottom then spm.Pan2(0,pnt.y-spm.ViewBounds.CenterPoint.y);
  spm.TrackingLayer.AddEvent(pnt as sogeometry,style,'');
  spm.TrackingLayer.Refresh;
  //释放变量
  pnt:=nil;
  style:=nil;
end;

function coordinateX(dt:sodataset;spm:Tsupermap):double;
var
  left:double;
  right:double;
  i:extended;
  value1:double;
  {$j+}
  const midd1:double=100;
  {$j-}
begin
  Randomize;
  i:=1 + Int(Random(2));// x轴方向的随机数获取
  Left:= dt.Bounds.Left;
  Right:=dt.Bounds.Right;
  If i= 1 Then
     begin
       CoordinateX:= midd1 + ((Right - Left) / Scl)*Random(2); // x轴方向加操作
       value1:=midd1 + ((Right - Left) / Scl)*Random(2);
     end;
  If i= 2 Then
     begin
       CoordinateX := midd1 - ((Right - Left) / Scl)*random(2);  // x轴方向减操作
       value1:=midd1 - ((Right - Left) / Scl)*Random(2);
     end;
  If value1 > Right Then CoordinateX := Right;
  If value1 < Left Then CoordinateX := Left;
  midd1:= value1;
end;

function coordinateY(dt:sodataset;spm:Tsupermap):double;
var
  Top:Double;
  Bottom:Double;
  i:extended;
  value2:double;
  {$j+}
  const midd:double=100;
  {$j-}
begin
  Randomize;
  i:= 1 + Int(random(2));    // y轴方向的随机据获取
  Top := dt.Bounds.Top;
  Bottom := dt.Bounds.Bottom;
  If i= 1 Then
     begin
       CoordinateY := midd + ((Bottom - Top) / Scl)*random(2);  // y轴方向加操作
       value2:=midd + ((Bottom - Top) / Scl)*random(2);
     end;
  If i= 2 Then
     begin
       CoordinateY := midd - ((Bottom - Top) / Scl)*random(2);  // y轴方向减操作
       value2:=midd - ((Bottom - Top) / Scl)*random(2);
     end;
  If value2 > Top Then CoordinateY := Top;
  If value2 < Bottom Then CoordinateY := Bottom;
  midd := value2;
end;

procedure TfrmMain.Timer1Timer(Sender: TObject);
var
  objdt:sodataset;
begin
  objdt:=frmMain.SuperMap1.Layers[1].Dataset;
  location(coordinateX(objdt,frmMain.supermap1),coordinateY(objdt,frmMain.supermap1),supermap1);
  objdt:=nil;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  frmMain.SuperMap1.Close;
  frmMain.SuperMap1.Disconnect;
  frmMain.SuperWorkspace1.Close;
end;

end.

⌨️ 快捷键说明

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