gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15947
  • QQ554730525
  • 铜币25339枚
  • 威望15364点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
阅读:1657回复:2

用dephi新建图层编辑代码[讨论]

楼主#
更多 发布于:2003-09-17 10:54

建立一个点的 shape file.

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Splitter1: TSplitter;
    Panel2: TPanel;
    Map1: TMap;
    BitBtn1: TBitBtn;
    SaveDialog: TSaveDialog;
    Memo1: TMemo;
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
    procedure deleteShape(fPath,lName:string; var status:Integer);
    procedure makeShape(fPath,lName:string);

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.BitBtn1Click(Sender: TObject);
var
   sName, sPath, lName, str :String;
   i :Integer;
begin
     if SaveDialog.Execute then begin
        sName := ExtractFileName(SaveDialog.FileName);
        sPath := ExtractFileDir(SaveDialog.FileName);
        i := AnsiPos('.',sName)-1;
        if i=0 then Exit;
        if i>0 then lName := Copy(sName,0,i)
        else        lName := sName;

        Memo1.Lines.Add('');
        Memo1.Lines.Add('-----------------------');
        Memo1.Lines.Add('Path:'+sPath);
        Memo1.Lines.Add('File:'+sName);
        Memo1.Lines.Add('Layer:'+lName);
        Memo1.Lines.Add('-----------------------');
        deleteShape(sPath,lName,i);
        if i=1 then makeShape(sPath,lName);
     end;
end;

procedure TForm1.deleteShape(fPath,lName:string; var status:Integer);
var
   i,j    :Integer;
   dc     :IMoDataConnection;
   mLayer :IMoMapLayer;
   gds    :IMoGeoDatasets;
begin
   status := 0;
   Memo1.Lines.Add('deleteShape()');

   dc := IMoDataConnection(CreateOleObject('MapObjects2.DataConnection'));
   dc.Database := fPath;
   if Not dc.Connect then begin
      Memo1.Lines.Add('ERROR: Path Not Found.');
      Beep();
      Sleep(100);
      Beep();
      Sleep(100);
      Beep();
      Sleep(100);
      Exit;
   end;

   // Set the GeoDataset to the destination directory
   gds := IMoGeoDataSets(dc.geodatasets);

   // -----------------------------------------------------------
   // Loop through the shape files in the GeoDataset
   // to see if this one already exists.  If it does, remove it.
   // -----------------------------------------------------------
   for i:=0 to gds.count-1 do begin
       if (IMoGeoDataset(gds.item(i)).name = lName) then begin
 // Get rid of the existing layer
 for j:=0 to (Map1.Layers.Count-1) do begin
     if( IMoField(Map1.Layers.Item(j)).name = lName) then begin
         Memo1.Lines.Add('Removing Layer: '+lName);
                Map1.Layers.Remove(j);
 break;
              end;
 end;
 // Get rid of the shape files
          Memo1.Lines.Add('Deleting GeoDataset: '+lName);
          dc.DeleteGeoDataset(lName);
          Map1.Refresh;
       end;
   end;
   status := 1;
end;

//**********************************************************
// Procedure: Example of Creating a Shape File.
// Author: Joe Wolter and Al Laframboise (ESRI)
// Credits: Ship Analytics, North Stonington, CT
// ESRI
//**********************************************************
procedure TForm1.makeShape(fPath,lName:string);
var
   i,j    :Integer;
   dc     :IMoDataConnection;
   tDesc  :IMoTableDesc;
   mLayer :IMoMapLayer;
   gd     :IMoGeoDataset;
   p      :IMoPoint;
   recs   :IMoRecordset;
   tmp    :String;
begin
   Memo1.Lines.Add('makeShape()');

   dc := IMoDataConnection(CreateOleObject('MapObjects2.DataConnection'));
   dc.Database := fPath;
   if Not dc.Connect then begin
      Memo1.Lines.Add('ERROR: Path Not Found.');
      Beep();
      Sleep(100);
      Beep();
      Sleep(100);
      Beep();
      Sleep(100);
      Exit;
   end;

   // Get the table Descriptor
   tDesc := IMoTableDesc(CreateOleObject('MapObjects2.TableDesc'));

   // Create some bogus feilds.  No Spaces in the field names and the
   // Field Names must be less than 11 characters.
   tDesc.FieldCount := 10;
   for i:=0 to 9 do begin
       tDesc.FieldName   := 'Field'+IntToStr(i);
       tDesc.FieldType   := moString;
       tDesc.FieldLength := 16;
   end;

   // Create the new GeoDataset
   gd := dc.AddGeoDataset(WideString(lName),moShapeTypePoint,tDesc,false,false);
   if varisempty(gd) then begin
      Memo1.Lines.Add('ERROR: GeoDataset is Empty.');
      Beep();
      Sleep(100);
      Beep();
      Sleep(100);
      Beep();
      Sleep(100);
      Exit;
   end;

   // Create the New Layer and Build the Shape file.
   mLayer := IMoMapLayer(CreateOleObject('MapObjects2.MapLayer'));
   mLayer.GeoDataset := gd;

   Map1.Layers.Add(mLayer);
   Map1.Refresh;

   // Set a pointer to the Records of the New Layer.
   recs := mLayer.Records;

   // Set the end point locations
   for i:=1 to 10 do begin
       with recs do begin
            p   := nil;
            p   := IMoPoint(CreateOleObject('MapObjects2.Point'));
            p.X := -100.0+i;
            p.Y := 35.0+i;
            Map1.FlashShape(IDispatch(p), 1);
            AddNew;
            Fields.Item('Shape').Value  := p;
            for j:=0 to 9 do
                begin
                   Fields.Item('Field'+IntToStr(j)).Value := 'Point '+IntToStr(i);
                end;
            Update;
       end;
   end;

   // Conclude the layer editing.
   recs.stopediting;

   // Add the new Layer to your Map.
   Map1.Layers.Add(mLayer);
   Map1.Refresh;
end;

end.

  
喜欢0 评分0
flytosky
路人甲
路人甲
  • 注册日期2005-01-15
  • 发帖数35
  • QQ
  • 铜币202枚
  • 威望0点
  • 贡献值0点
  • 银元0个
1楼#
发布于:2005-01-17 16:16
<P>wo ding </P>
举报 回复(0) 喜欢(0)     评分
happyboy75
路人甲
路人甲
  • 注册日期2003-07-27
  • 发帖数89
  • QQ
  • 铜币667枚
  • 威望0点
  • 贡献值0点
  • 银元0个
2楼#
发布于:2005-01-19 13:30
我收下有时间再看一下
想换工作:现在的工作有点偏离GIS 求职意向:GIS应用与开发(mo、mapx、mapengine) 开发语言:vb、delphi 数据库:SQL server、DB2 happyboy075@163.com qq:122761955
举报 回复(0) 喜欢(0)     评分
游客

返回顶部