supermap.txt

delphi supermap 一段源代码

{=====================================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.xspm.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 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.