📄 main.~pas
字号:
procedure TMainFrm.MnOpenEmageFileClick(Sender: TObject);
var
ThisLayer:imoImageLayer;
begin
ThisLayer:=coImagelayer.Create;
Opendialog1.Title:=' 打开影像文件 ';
Opendialog1.Filter:='影像文件(*.jpg)|*.jpg|tif|*.tif';
if Opendialog1.execute then
if Opendialog1.FileName<>''then
begin
ThisLayer.File_:=Opendialog1.FileName;
MainMap.Layers.Add(ThisLayer);
end;
MainMap.Refresh;
end;
{*****************************************************************************}
procedure TMainFrm.SbZoomInClick(Sender: TObject);
begin
if Sender is TSpeedButton then
//控制MainMap的鼠标显示
case (sender as TSpeedButton).Tag of
1:
begin
MainMap.MousePointer:=MoZoomIn;
StatusBar1.Panels[0].Text:='当前状态: '+ '图形放大';
end;
2:
begin
MainMap.MousePointer:=MoZoomOut;
StatusBar1.Panels[0].Text:='当前状态: '+ '图形缩小';
end;
3:
begin
MainMap.MousePointer:=MoPan;
StatusBar1.Panels[0].Text:='当前状态: '+ '图形平移';
end;
4:
if MainMap.Layers.Count > 0 then
begin
MainMap.MousePointer:=MoCross;
StatusBar1.Panels[0].Text:='当前状态: '+ '测距';
end
else
begin
Sbmeasure.Down:=false;
Application.MessageBox('请添加图层', '提示', MB_OK);
end;
5:
begin
MainMap.MousePointer:=MoCross;
StatusBar1.Panels[0].Text:='当前状态: '+ '准备';
end;
6:
begin
//地图1:1显示
MainMap.Extent:=MainMap.FullExtent;
end;
7:
begin
MnSbyDistance.OnClick(sender);
end;
8:
MnFlashGet.Click;
end;
end;
{*****************************************************************************}
procedure TMainFrm.MainmapMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
ThisPoint: imoPoint;
CurrentX,CurrentY:single;
begin
ThisPoint:=coPoint.Create;
ThisPoint:=MainMap.ToMapPoint(X,Y);
//showmessage(floattostr(ThisPoint.X)+floattostr(ThisPoint.Y));
CurrentX:=ThisPoint.X;
CurrentY:=ThisPoint.Y;
StatusBar1.Panels[1].Text:='坐标'+ floattostr(Round(CurrentX*100)/100)
+' , '+floattostr(Round(CurrentY*100)/100);
//获取地图坐标,并在状态栏显示
if SbFlashGet.Down then
MapTps2.MouseMove(x,y);
end;
{*****************************************************************************}
procedure TMainFrm.MainmapMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
rectangle: imorectangle;
ThisPoint: imoPoint;
Sdrawshape: variant;
Selectedlayer:ImoMaplayer;
BaseLayer: ImoMaplayer;
v : Variant;
begin
if MainMap.Layers.Count>0 then
begin
if Button=MbLeft then
begin
if SbZoomIn.Down then
//地图放大
begin
MainMap.Extent:=MainMap.TrackRectangle;
exit;
end;
if SbZoomOut.Down then
//地图缩小
begin
rectangle := mainmap.Extent;
rectangle.ScaleRectangle(variant(1.5));
mainmap.Extent := rectangle;
exit;
end;
if SbPan.Down then
//地图平移
begin
MainMap.Pan;
MainMap.MousePointer:=MoPanning;
exit;
end;
//空间查询
if KaiGuang=true then
begin
Selectedlayer:=CoMaplayer.Create;
BaseLayer:=CoMaplayer.Create;
Selectedlayer:=ImoMaplayer(MainMap.Layers.Item(CbbLayers.text));
Baselayer:=ImoMaplayer(MainMap.Layers.Item(Cbbuse.text));
if SbPoint.Down then Sdrawshape:=MainMap.ToMapPoint(X,Y);
if SbRec.Down then Sdrawshape:=MainMap.TrackRectangle;
if Sbpolygon.Down then Sdrawshape:=MainMap.TrackPolygon;
if Cbbuse.Text='TOOLS'then
begin
MyRecordSet:= Selectedlayer.SearchShape(Sdrawshape,CbbRelation.ItemIndex,'');
end
else begin
if Sbpoint.Down then
BaseRecordSet:=BaseLayer.SearchByDistance(Sdrawshape,0.05,'')
else
begin
BaseRecordSet:=Baselayer.SearchShape(Sdrawshape,moContaining,'');
MyRecordSet:=SelectedLayer.SearchShape(BaseRecordSet,CbbRelation.ItemIndex,'');
end;
MainMap.Refresh;
end;
end;
//提取属性
if SbIdentify.Down then
begin
Currentlayer:=ImoMaplayer(MainFrm.MainMap.Layers.Item(0));
ThisPoint:=CoPoint.Create;
ThisPoint:=MainFrm.MainMap.ToMapPoint(X,Y);
FindRecord:=CurrentLayer.SearchByDistance(ThisPoint,strTofloat(n),'');
//Showmessage(intToStr(MainFrm.FindRecord.Count));
if not FindRecord.EOF then
begin
MainMap.Refresh;
ShowZl();
AttrShow();
FindRecord:=nil;
end//IdentifyFrm.ShowModal;
else
begin
showmessage('没有记录,请重试');
exit;
end;
end;
end;
{**********测距*****************}
if SbMeasure.Down then
begin
if Button= mbleft then
begin
if g_line=nil then g_line:=CoLine.Create;
if Pts=nil then Pts:=CoPoints.Create;
Thispoint := coPoint.Create;
Thispoint := MainMap.ToMapPoint(x, y);
//画线
pts.Add(ThisPoint);
g_line.Parts.Add(Pts);
MainMap.TrackingLayer.Refresh(true,v);
i:=i+1; //计下点数
if i=1 then
begin
//showmessage('1');
X1:=round(Thispoint.X);
Y1:=round(Thispoint.Y);
//showmessage(floatTostr(X1)+' '+floatTostr(Y1));
end;
if i >1 then
begin
//showmessage('>1');
if i mod 2 = 0 then
begin
X2:=round(Thispoint.X);
Y2:=round(Thispoint.Y);
//showmessage(intToStr(i)+':'+floatTostr(X2)+' '+floatTostr(Y2));
end
else
begin
X1:=round(Thispoint.X);
Y1:=round(Thispoint.Y);
// showmessage(intToStr(i)+':'+ floatTostr(X1)+' '+floatTostr(Y1));
end ;
s:= s + sqrt((X2-X1)*(X2-X1)+(Y2-Y1)*(Y2-Y1));
s:=round(s*100)/100;
//showmessage('距离为:'+floatToStr(s));
end;
end
else
begin
showmessage('距离为:'+floatToStr(s)+'米!');
i:=0;
s:=0;
X1:=0;
X2:=0;
Y1:=0;
Y2:=0;
g_line:=nil;
pts:=nil;
MainMap.Refresh;
exit;
end;
end;
{***********以上为测距***********************}
end;
end;
{*****************************************************************************}
procedure TMainFrm.LocalmapAfterTrackingLayerDraw(Sender: TObject;
hDC: Cardinal);
var
sym : IMoSymbol;
begin
sym := CoSymbol.Create;
sym.OutlineColor := moRed;
sym.Style := moTransparentFill;
LocalMap.DrawShape(MainMap.Extent,sym);
end;
{*****************************************************************************}
procedure TMainFrm.LocalmapMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
MyPoint:ImoPoint;
begin
MyPoint:=CoPoint.Create;
MyPoint:=LocalMap.ToMapPoint(X,Y);
MainMap.CenterAt(MyPoint.X,MyPoint.Y);
if MainMap.Extent.IsPointIn(MyPoint) then
begin
MyDragFeedback.DragStart(MainMap.Extent,LocalMap,X,Y);
end;
end;
{*****************************************************************************}
procedure TMainFrm.LocalmapMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if not (MyDragFeedback =NIL) then
MyDragfeedback.DragMove(x,y);
end;
{*****************************************************************************}
procedure TMainFrm.MainmapAfterLayerDraw(Sender: TObject; index: Smallint;
canceled: WordBool; hDC: Cardinal);
var
MySymbol:imoSymbol;
v : Variant;
begin
MySymbol:=CoSymbol.Create;
MySymbol.Color:=ClYellow;
if Assigned(FindRecord)then
MainMap.DrawShape(FindRecord,MySymbol);
MainMap.Refresh;
{////////////////////////////////////////}
if index =0 then
// after drawing the first layer, refresh the locater map
LocalMap.TrackingLayer.Refresh(True,v);
if KaiGuang=true then
begin
MySymbol.Color:=clRed;
if assigned(Baserecordset)then
MainMap.DrawShape(Baserecordset,MySymbol);
MySymbol.Color:=clyellow;
if assigned(Myrecordset)then
MainMap.DrawShape(Myrecordset,MySymbol);
MainMap.Refresh;
Baserecordset:=nil;
Myrecordset:=nil;
end;
//end;
end;
{*****************************************************************************}
procedure TMainFrm.LocalmapMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if not (Mydragfeedback = NIL) then
begin
LocalMap.Refresh;
MainMap.extent := IMoRectangle(MyDragFeedback.DragFinish(x,y));
end;
end;
{*****************************************************************************}
procedure TMainFrm.MnLayerManaClick(Sender: TObject);
begin
LayerManaFrm.ShowModal;
end;
{*****************************************************************************}
procedure TMainFrm.MnRendererClick(Sender: TObject);
begin
if MainMap.Layers.Count > 0 then
RendererFrm.Show
else
Application.MessageBox('请添加图层', '提示', MB_OK);
end;
{*****************************************************************************}
procedure TMainFrm.MnLayerSetClick(Sender: TObject);
begin
if MainMap.Layers.Count > 0 then
LayerSetFrm.ShowModal
else
Application.MessageBox('请添加图层', '提示', MB_OK);
end;
{*****************************************************************************}
procedure TMainFrm.MnLabelClick(Sender: TObject);
begin
if MainMap.Layers.Count > 0 then
LabelFrm.ShowModal
else
Application.MessageBox('请添加图层', '提示', MB_OK);
end;
{*****************************************************************************}
procedure TMainFrm.PmZoomInClick(Sender: TObject);
begin
if sender is TMenuItem then
begin
case(sender as TMenuItem).Tag of
1:
begin
SbZoomIn.Click;
SbZoomIn.Down:=true ;
end;
2:
begin
SbZoomOut.Click;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -