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

📄 basworkarea.~pas

📁 mapgis二次开发delphi实例Del_basWorkArea
💻 ~PAS
📖 第 1 页 / 共 3 页
字号:
unit basWorkArea;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus,MAPGISBASCOM1Lib_TLB,ComObj,message;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    LoadSavePntFile: TMenuItem;
    AddUptDelPnt: TMenuItem;
    GetSetPntInfo: TMenuItem;
    CopyPntArea: TMenuItem;
    QueryNearPnt: TMenuItem;
    PartToList: TMenuItem;
    TicDotMethod: TMenuItem;
    N7: TMenuItem;
    AddUptDeLin: TMenuItem;
    GetDatLen: TMenuItem;
    QueryNearLin: TMenuItem;
    N11: TMenuItem;
    GetorCalMethod: TMenuItem;
    RegQuery: TMenuItem;
    AddUptDelReg: TMenuItem;
    GetAreaInf: TMenuItem;
    UnionSplitMath: TMenuItem;
    N16: TMenuItem;
    AddUptDelNet: TMenuItem;
    AllocArcprj: TMenuItem;
    NetPathOper: TMenuItem;
    N20: TMenuItem;
    N21: TMenuItem;
    AttStruOper: TMenuItem;
    AttOperMethod: TMenuItem;
    RcdOperMethod: TMenuItem;
    FieldOperMethod: TMenuItem;
    ModAllMethod: TMenuItem;
    CopyRecord: TMenuItem;
    procedure AddUptDeLinClick(Sender: TObject);
    procedure AddUptDelNetClick(Sender: TObject);
    procedure AddUptDelPntClick(Sender: TObject);
    procedure AddUptDelRegClick(Sender: TObject);
    procedure AllocArcprjClick(Sender: TObject);
    procedure AttOperMethodClick(Sender: TObject);
    procedure AttStruOperClick(Sender: TObject);
    procedure CopyPntAreaClick(Sender: TObject);
    procedure CopyRecordClick(Sender: TObject);
    procedure LoadSavePntFileClick(Sender: TObject);
    procedure RcdOperMethodClick(Sender: TObject);
    procedure QueryNearPntClick(Sender: TObject);
    procedure GetSetPntInfoClick(Sender: TObject);
    procedure NetPathOperClick(Sender: TObject);
    procedure GetAreaInfClick(Sender: TObject);
    procedure GetDatLenClick(Sender: TObject);
    procedure QueryNearLinClick(Sender: TObject);
    procedure GetorCalMethodClick(Sender: TObject);
    procedure TicDotMethodClick(Sender: TObject);
    procedure ModAllMethodClick(Sender: TObject);
    procedure FieldOperMethodClick(Sender: TObject);
    procedure UnionSplitMathClick(Sender: TObject);
    procedure PartToListClick(Sender: TObject);
    procedure RegQueryClick(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  bRes:Boolean;
  lRes:Longint;
  nRes:Integer;

implementation

{$R *.dfm}


{
















  }




//添加,更新,删除线
procedure TForm1.AddUptDeLinClick(Sender: TObject);
var
 LinAi:iLinArea;
 pos:iD_DotSet;
 pos3d:iD_3DotSet;
 inf:iLin_Info;
 dimen:Integer;
begin
  linai:=createcomobject(class_linarea) as Ilinarea;
  pos:=createcomobject(class_d_dotset) as id_dotset;
  pos3d:=createcomobject(class_d_3dotset) as id_3dotset;
//打开一个线文件
if not LinAi.Load('','','','') then
Exit;

//初始化要添加的2D线
pos.Append( 50, 50);
pos.Append (150, 150);
//取得第一条线的信息,先判断是否存在
if LinAi.GetExistFlag(1) <> 1 then
Exit;

if LinAi.GetInfo(1, inf) then
//1. 添加一条线
lRes := LinAi.Append(pos, inf);

//返回最后的线号
form2.Panel1.Caption:='当前工作区有'+inttostr(lRes)+'条线!';
form2.ShowModal;

//初始化要添加的3D线
pos3d.Append (100, 100, 0);
pos3d.Append (200, 200, 0);
//仅为方便,线信息不变,
//2. 添加一条线
lRes := LinAi.Append3D(pos3d, inf);

//这里假设把线颜色号改变一下
inf.lclr := 10;
//3. 更新第一条线的线信息,忽略返回值
bRes := LinAi.UpdateInfo(1, inf);

//改变线位置
pos[1].x := 80;
pos[1].y := 80;
pos[1].x := 180;
pos[1].y := 180;
pos3d[0].x := 20;
pos3d[0].y := 20;
pos3d[1].x := 120;
pos3d[1].y := 120;

//以下更新前面添加的线实体
//4. 更新线实体(2D)
bRes := LinAi.Update(lRes - 1, pos, inf);
//5. 更新线实体(3D)
bRes := LinAi.Update3D(lRes, pos3d, inf);

//6. 删除线实体
LinAi.Del (lRes - 1);
LinAi.Del (lRes);

//7.撤消删除的线实体
if LinAi.GetExistFlag(lRes - 1) = -1 then
LinAi.UnDel (lRes - 1);

 inf:=nil;
 pos:=nil;
 pos3d:=nil;
 LinAi:=nil;
end;

//网实体操作
procedure TForm1.AddUptDelNetClick(Sender: TObject);
var
  NetAi:iNetArea;
  ndat:LONGList;
  pos:iD_DotSet;
  NetInfo:iNet_Info;
  LinDat:iLinData;
  LinInfo:iLin_Info;
  ni:Longint;
begin
 netai:=createcomobject(class_netarea) as inetarea;
//打开网文件
if not NetAi.Load('','','','') then
Exit;

//1. 取网络,ndat得到网段号集合
if NetAi.GetExistFlag(1)<>0 then
nRes := NetAi.Get(1, ndat, NetInfo);

if nRes <> 1 then
Exit;

//2. 更新网络实体图形信息
nRes := NetAi.GetInfo(1, NetInfo);

//3. 添加网络实体
//取得线数据
 LinDat := NetAi.Lin;

//构造一个网络(此处为相交的两条线)
 pos :=createcomobject(class_D_DotSet) as id_dotset;
pos.Append( 50, 50 );
pos.Append (50, 100 );
//假设取第一条线的信息为添加的线信息
bRes := LinDat.GetInfo(1, LinInfo);
//添加一条网段
if bRes then
lRes := LinDat.Append(pos, LinInfo);

pos.RemoveAll;
pos.Append (25, 75 );
pos.Append (75, 75 );
lRes := LinDat.Append(pos, LinInfo);
//添加上面的网段号
ndat.Append (lRes - 1);
ndat.Append (lRes );

//添加一个网,返回网络号
//为方便,跟第一个网络实体的网络信息相同
ni := NetAi.Append(ndat, NetInfo);

//4. 更新网络实体
//再添加一条线
pos.RemoveAll;
pos.Append (25, 25);
pos.Append (100, 100);
lRes := LinDat.Append(pos, LinInfo);
ndat.Append( lRes);

//为方便,假设NetInfo只改变颜色
NetInfo.lclr := 50;
nRes := NetAi.Update(ni, ndat, NetInfo);

//5. 若只更新网信息,则使用以下方法:
nRes := NetAi.UpdateInfo(ni, NetInfo);

//6. 删除网络实体
if NetAi.GetExistFlag(ni) = 1 then
 bRes := NetAi.Del(ni);

if bRes then
//7. 恢复被删除的网络实体
NetAi.UnDel( ni);
NetAi.SaveAs;

 pos:=nil;
 ndat:=nil;
 NetAi:=nil;
 LinDat:=nil;
 NetInfo:=nil;
 LinInfo:=nil;
end;

//添加,更新,删除点实体
procedure TForm1.AddUptDelPntClick(Sender: TObject);
var
 PntAi:iPntArea;
 xy:iD_Dot;
 PntInfo:Pnt_Info;
 xyz:iD_3Dot;
 szStr:wideString;
begin
 pntai:=createcomobject(class_pntarea) as ipntarea;
 xyz:=createcomobject(class_d_3dot) as id_3dot;
//打开一个点文件
if not PntAi.Load('','','','') then
Exit;

//取第一个点的详细信息
nRes := PntAi.Get(1, xy, szStr, PntInfo);
//坐标平移,仅是为了方便
xy.x := xy.x + 100;
xy.y := xy.y + 100;
//1. 添加一个二维点
lRes := PntAi.Append(xy, '二维注释点', PntInfo);
form2.Panel1.Caption:='最后一个点实体号为:'+inttostr(lRes);
form2.ShowModal;

//坐标平移,仅是为了方便
xyz.x := xy.x - 100;
xyz.y := xy.y - 100;
xyz.z := 0;
//2. 添加一个三维点
lRes := PntAi.Append3D(xyz, '三维注释点', PntInfo);
form2.Panel1.Caption:='最后一个点实体号为:'+inttostr(lRes);
form2.ShowModal;

//3.1 添加文件到工作区(方法一)
//添加网络数据文件China.wt到工作区
bRes := PntAi.AppendFile('China.wt', 'MSDB', 'sa', '');
//3.2 添加文件到工作区(方法二)
bRes := PntAi.AppendFile('','','',''); //此处弹出文件对话框选择
//省略返回值的处理

//4 更新二维点实体(同时更新点坐标和点信息)
//为方便,此处只是变换一下坐标位置
xy.x := xy.x + 50;
xy.y := xy.y + 50;
//4.1 更新点坐标
//注意前面lRes返回的值为当时最后一个点的点号
bRes := PntAi.UpdatePos(lRes - 1, xy);
//点信息只改变一项,如下改变点的颜色
PntInfo.iclr := 100;
//'4.2 同时更新点坐标和点信息
bRes := PntAi.Update(lRes - 1, xy, '更新的二维注释点', PntInfo);

//5 更新三维点实体(同时更新点坐标和点信息)
//为方便,此处只是变换一下坐标位置
xyz.x := xyz.x - 50;
xyz.y := xyz.y - 50;
xyz.z := xyz.z - 50;
//5.1 更新点坐标
bRes := PntAi.UpdatePos3D(lRes, xyz);
//5.2 更新前面添加的点实体
bRes := PntAi.Update3D(lRes, xyz, '更新的三维注释点', PntInfo);

//6 更新三维点信息,只改变颜色信息
PntInfo.iclr := 32;
//1=成功 0=失败  -1=以被删除
nRes := PntAi.UpdateInfo(lRes, PntInfo);

//7 删除最后一个点实体(省略返回值)
 PntAi.Del(lRes);
//可查看是否存在返回:1/0/-1=存在/不存在/被删除
 Case PntAi.GetExistFlag(lRes) of
 1 :begin
    form2.Panel1.Caption:='此点仍然存在!';
    form2.ShowModal;
    end;
 0 :begin
    form2.Panel1.Caption:='此点不存在!';
    form2.ShowModal;
    end;
 -1 :begin
    form2.Panel1.Caption:='此点存在但被删除了!';
    form2.ShowModal;
    end;
end;

 //7 取消删除pi点
 if PntAi.UnDel(lRes) then
 begin
 form2.Panel1.Caption:='已经取消了删除!';
 form2.ShowModal;
 end;

//另存文件
PntAi.SaveAs;
 xy:=nil;
 xyz:=nil;
 PntAi:=nil;
 PntInfo:=nil;
end;

//添加,更新,删除区
procedure TForm1.AddUptDelRegClick(Sender: TObject);
var
 RegAi:iRegArea;
 LinInfo:iLin_Info;
 pos:iD_DotSet;
 RegInfo:iReg_Info;
 LinDat:iLinData;
 rdat:iLONGList;
 ri:Longint;
begin
regai:=createcomobject(class_regarea) as iregarea;
pos:=createcomobject(class_d_dotset) as id_dotset;
rdat:=createcomobject(class_longlist) as ilonglist;
//打开一个区文件
if not RegAi.Load('','','','') then
Exit;

//取线数据
 LinDat := RegAi.Lin;
//为方便,使用第一条弧段的线信息
bRes := LinDat.GetInfo(1, LinInfo);
//为方便,使用第一个区的区信息
if RegAi.GetExistFlag(1) = 1 then
 RegAi.GetInfo(1, RegInfo);

//造一个区(如下构造一个矩型),一般是你自己的数据
pos.Append (50, 50);
pos.Append (100, 50);
//添加区弧段
lRes := LinDat.Append(pos, LinInfo);
//删除第一个点坐标
pos.Remove (0, 1);
pos.Append (100, 100);
//添加区弧段
lRes := LinDat.Append(pos, LinInfo);
//删除第一个点坐标
pos.Remove (0, 1);
pos.Append (50, 100);
//添加区弧段
lRes := LinDat.Append(pos, LinInfo);
//删除第一个点坐标
pos.Remove (0, 1);
pos.Append (50, 50);
//添加区弧段
lRes := LinDat.Append(pos, LinInfo);
//构造完毕

//共添加了四条弧段
rdat.Append (lRes - 3);
rdat.Append (lRes - 2);
rdat.Append (lRes - 1);
rdat.Append (lRes );

//添加区域 成功返回区号(>0) 失败返回0
ri := RegAi.Append(rdat, RegInfo);
if ri<>0 then
 begin
 form2.Panel1.Caption:='添加的区号为'+inttostr(lRes);
 form2.ShowModal;
 end;
RegAi.SaveAs;
//更新区实体
//改变区为三角形(仅为方便)
rdat.Remove(3, 1);
pos.Remove (0, 1);
pos.Append (100, 100 );
lRes := LinDat.Append(pos, LinInfo);

//假设改变区信息的区域填充色
RegInfo.clr := 8;
//更新前面添加的区域
nRes := RegAi.Update(ri, rdat, RegInfo);

//如果只改变区信息,使用如下方法更方便
nRes := RegAi.UpdateInfo(ri, RegInfo);

//删除区
nRes := RegAi.Del(ri);
if nRes = 1 then
//撤消对区的删除
 nRes := RegAi.UnDel(ri);

RegAi.SaveAs;

 pos:=nil;
 rdat:=nil;
 RegAi:=nil;
 LinDat:=nil;
 LinInfo:=nil;
 RegInfo:=nil;
end;

//弧段分配方案
procedure TForm1.AllocArcprjClick(Sender: TObject);
var
 NetAi:iNetArea;
 arcLst:iLONGList;
 AllocInf:iArc_Alloc_Info;
 NetInfo:Net_Info;
 ArcLin:iD_DotSet;
 LinDat:iLinData;
 LinInfo:iLin_Info;
begin
 netai:=createcomobject(class_netarea) as inetarea;
 arclin:=createcomobject(class_d_dotset) as id_dotset;
//打开网文件
if not NetAi.Load('','','','') then
Exit;

//1. 取所有弧段数
lRes := NetAi.GetAllocatedArcsNum;
form2.Panel1.Caption:='弧段分配数为:'+inttostr(lRes);
form2.ShowModal;

//2. 取弧段分配方案,arcLst为弧段分配列表
bRes := NetAi.GetAllocatedArcs(arcLst);

//3. 取弧段分配信息(此处取弧段1的分配信息)
bRes := NetAi.GetArcAllocInfo(1, AllocInf);

//4.设置弧段分配方案
//首先增加一条弧段
ArcLin.Append (10, 10);
ArcLin.Append (20, 20);
 LinDat := NetAi.Lin;
//为方便,假设其线信息同弧段1的相同
if LinDat.GetInfo(1, LinInfo) then
lRes := LinDat.Append(ArcLin, LinInfo);
//添加到弧段分配列表
 arcLst :=createcomobject(class_LONGList) as ilonglist;
 arcLst.Append (lRes);
//设置弧段分配方案
bRes := NetAi.SetAllocatedArcs(arcLst);

//5.设置弧段分配信息(此处设置添加弧段的分配信息)
//假设其余信息不变,只是前一弧段属性改变
AllocInf.preArc := lRes - 1;

//设置分配信息,省略返回值处理
bRes := NetAi.SetArcAllocInfo(lRes, AllocInf);

NetAi.SaveAs;

 NetAi:=nil;
 arcLst:=nil;
 LinDat:=nil;
 ArcLin:=nil;
 NetInfo:=nil;
 LinInfo:=nil;
 AllocInf:=nil;
end;

procedure TForm1.AttOperMethodClick(Sender: TObject);
var
 TblAi:TblArea;
 FieldNum:Integer;
 ATT:iRecord;
 i:Longint;
 j:Integer;
 val:Variant;
begin
 tblai:=createcomobject(class_tblarea) as itblarea;

//打开一个表文件
if not TblAi.Load('','','','') then
Exit;

//取属性(取某条记录)
//注意:字段数是Integer,从0到numbfield-1排列
//记录数是Long,从1到numbrecord - 1条记录
for i := 1 to TblAi.nCount do
    begin
    nRes := TblAi.Get(i - 1, ATT);
    for j := 0 to TblAi.nCount  do
        begin
        val := ATT.Item[j].Value;
        form2.Panel1.Caption:=val;
        form2.ShowModal;
        end;
     ATT :=nil;
    end;

//写属性值
for i := 1 to TblAi.nCount do
    begin
    nRes := TblAi.Get(i, ATT);
    ATT.Value[0] := i;        //写整形值
    //或者根据字段名赋值
    ATT.Value['ID'] := i;       //写整形值
    //.......省略其余字段赋值,由开发者自己决定
    //写某条属性
    bRes := TblAi.Write(i, ATT);
    ATT:=nil;
    end;

//可以取得缺省的属性记录
bRes := TblAi.GetDef(ATT);
//也可以设置缺省属性
//这里省略属性字段的赋值
bRes := TblAi.WriteDef(ATT);

TblAi.SaveAs;
 ATT:=nil;

⌨️ 快捷键说明

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