📄 basworkarea.~pas
字号:
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 + -