mainform.pas
来自「GIS中用mapx侧距离」· PAS 代码 · 共 602 行 · 第 1/2 页
PAS
602 行
pnt4 : Variant;
pnts : Variant;
styLine : Variant;
ftrObj : Variant;
AllFtrs : Features;
unusedParam: OleVariant;
begin
MapViewRect := Map1.Bounds;
pnt1 := CreateOleObject('MapX.Point.5');
pnt1.Set( MapViewRect.XMin, MapViewRect.YMax );
pnt2 := CreateOleObject('MapX.Point.5');
pnt2.Set( MapViewRect.XMax, MapViewRect.YMax );
pnt3 := CreateOleObject('MapX.Point.5');
pnt3.Set( MapViewRect.XMax, MapViewRect.YMin );
pnt4 := CreateOleObject('MapX.Point.5');
pnt4.Set( MapViewRect.XMin, MapViewRect.YMin );
pnts := CreateOleObject('MapX.Points.5');
pnts.Add( pnt1 );
pnts.Add( pnt2 );
pnts.Add( pnt3 );
pnts.Add( pnt4 );
pnts.Add( pnt1 );
styLine := CreateOleObject('MapX.Style.5');
styLine.LineColor := clRed;
styLine.LineWidth := 1;
AllFtrs := Map2.Layers[1].AllFeatures;
for I := 1 to AllFtrs.Count do // Iterate
begin
Map2.Layers[1].DeleteFeature( AllFtrs[i].FeatureKey );
end; // for
ftrObj := CreateOleObject('MapX.Feature.5');
ftrObj := Map2.FeatureFactory.CreateLine( pnts, styline );
TVarData(unusedParam).vType := varError;
TVarData(unusedParam).vError := DISP_E_PARAMNOTFOUND;
Map2.Layers[1].AddFeature( ftrObj, unusedParam );
VarClear( pnt1 );
VarClear( pnt2 );
VarClear( pnt3 );
VarClear( pnt4 );
VarClear( pnts );
VarClear( StyLine );
VarClear( ftrObj );
end;
procedure TForm1.Map2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
G_MouseDownFlag := 'Begin';
G_MouseDownMapX := X;
G_MouseDownMapY := Y;
end;
end;
procedure TForm1.Map2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
I: Integer;
//ViewMapRect : CMapXRectangle;
pntMaps : Variant;
pntMap1 : Variant;
pntMap2 : Variant;
pntMap3 : Variant;
pntMap4 : Variant;
StyLine : Variant;
Ftrs : Features;
ftr1 : Feature;
ftr : Variant;
sngX : single;
sngY : single;
TmpX : single;
TmpY : single;
unusedParam: OleVariant;
begin
if not ( ssLeft in Shift ) then
begin
G_MouseDownFlag := 'End';
G_MouseDownMapX := 0;
G_MouseDownMapY := 0;
Exit;
end;
Map2.AutoRedraw := False;
sngX := G_MouseDownMapX;
sngY := G_MouseDownMapY;
TmpX := X;
TmpY := Y;
// 得到按下鼠标时点的地理坐标
Map2.ConvertCoord( sngX, sngY, G_dblMouseDownMapX, G_dblMouseDownMapY, miScreenToMap );
// 得到鼠标当前点的地理坐标
Map2.ConvertCoord( TmpX, TmpY, G_dblMouseDownMapX1, G_dblMouseDownMapY1, miScreenToMap );
pntMap1 := CreateOleObject('MapX.Point.5');
pntMap1.Set( G_dblMouseDownMapX, G_dblMouseDownMapY1 );
pntMap2 := CreateOleObject('MapX.Point.5');
pntMap2.Set( G_dblMouseDownMapX1, G_dblMouseDownMapY1 );
pntMap3 := CreateOleObject('MapX.Point.5');
pntMap3.Set( G_dblMouseDownMapX1, G_dblMouseDownMapY );
pntMap4 := CreateOleObject('MapX.Point.5');
pntMap4.Set( G_dblMouseDownMapX, G_dblMouseDownMapY );
pntMaps := CreateOleObject('MapX.Points.5');
pntMaps.Add( pntMap1 );
pntMaps.Add( pntMap2 );
pntMaps.Add( pntMap3 );
pntMaps.Add( pntMap4 );
pntMaps.Add( pntMap1 );
styLine := CreateOleObject('MapX.Style.5');
styLine.LineColor := clBlack;
styLine.LineWidth := 1;
styLine.LineStyle := 3; //虚线
ftrs := Map2.Layers[1].AllFeatures;
for I := 1 to ftrs.Count do // Iterate
begin
Map2.Layers[1].DeleteFeature( Ftrs[i].FeatureKey );
end; // for
ftr := CreateOleObject('MapX.Feature.5');
TVarData(unusedParam).vType := varError;
TVarData(unusedParam).vError := DISP_E_PARAMNOTFOUND;
//ftr := Map2.FeatureFactory.CreateLine( pntMaps, styline );
ftr1 := Map2.FeatureFactory.CreateRegion( pntMaps, Map2.DefaultStyle );
Map2.Layers[1].AddFeature( ftr1, unusedParam );
Map1.Bounds := ftr1.Bounds;
G_MouseDownFlag := 'Move';
VarClear( pntMap1 );
VarClear( pntMap2 );
VarClear( pntMap3 );
VarClear( pntMap4 );
VarClear( pntMaps );
VarClear( StyLine );
end;
procedure TForm1.Map2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
dblMapX1 : Double;
dblMapY1 : Double;
TmpX : integer;
TmpY : integer;
sng1: single;
sng2: single;
sngXMax : single;
sngXMin : single;
sngYMax : single;
sngYMin : single;
dblXMax : Double;
dblXMin : Double;
dblYMax : Double;
dblYMin : Double;
//MainMapRect : CMapXRectangle;
//MainMapRect : Variant;
//MainMapRect : TRect;
begin
Map2.AutoRedraw := True;
TmpX := X;
TmpY := Y;
sng1 := TmpX;
sng2 := TmpY;
// 当用户只是单击鹰眼图上的某点时
if G_MouseDownFlag = 'Begin' then
begin
// 求出该点的地理坐标
Map2.ConvertCoord( sng1, sng2, dblMapX1, dblMapY1, miScreenToMap );
// 将主视图中的中心点设置为单击点
Map1.CenterX := dblMapX1;
Map1.CenterY := dblMapY1;
end;
if G_MouseDownFlag = 'Move' then
begin
if G_MouseDownMapX < X then
begin
sngXMax := sng1;
sngXMin := G_MouseDownMapX;
end
else
begin
sngXMax := G_MouseDownMapX;
sngXMin := sng1;
end;
if G_MouseDownMapY < Y then
begin
sngYMax := sng2;
sngYMin := G_MouseDownMapY;
end
else
begin
sngYMax := G_MouseDownMapY;
sngYMin := sng2;
end;
Map2.ConvertCoord( sngXMin, sngYMin, dblXMin, dblYMin, miScreenToMap );
Map2.ConvertCoord( sngXMax, sngYMax, dblXMax, dblYMax, miScreenToMap );
// MainMapRect := CreateOleObject('MapX.Rectangle.5');
//MainMapRect.Set( );
//MainMapRect.Set_(dblXMin, dblYMin, dblXMax, dblYMax);
// MainMapRect.XMin := dblXMin;
// MainMapRect.YMin := dblYMin;
// mainMapRect.XMax := dblXMax;
// MainMapRect.YMax := dblYMax;
// MainMapRect.
//Map1.Bounds := MainMapRect
//Map1.Bounds.Set_(round(dblXMin), round(dblYMin), round(dblXMax), round(dblYMax) );
end;
G_MouseDownFlag := 'End';
end;
procedure TForm1.Map2AddNewLayer;
var
//path, fileName : String;
empty: Variant;
lyrMyLayer : Variant;
begin
try
TVarData(empty).vType := varError;
TVarData(empty).vError := DISP_E_PARAMNOTFOUND;
// path := pathEdit.Text;
// fileName := nameEdit.Text;
// if tempTableCheckBox.checked = True then
// Map1.Layers.CreateLayer('tmp', empty, 1, empty, empty);
lyrMyLayer := Map2.Layers.CreateLayer('Cars', empty, 1, empty, empty); // 生成一个新的图层
Map2.Layers.AnimationLayer := Map2.Layers.Item[lyrMyLayer.name]; // 定义为动态图层
// else
// MainMap.Map1.Layers.CreateLayer(fileName,path + '\' + fileName, 1, empty, empty);
except on E:Exception Do showMessage('File Creation Failed.');
end; //Try
end;
procedure TForm1.N14Click(Sender: TObject);
begin
Map1.DefaultStyle.PickSymbol;
end;
procedure TForm1.N21Click(Sender: TObject);
begin
Map1.DefaultStyle.PickLine;
end;
procedure TForm1.N31Click(Sender: TObject);
begin
Map1.DefaultStyle.PickRegion;
end;
procedure TForm1.N15Click(Sender: TObject);
begin
// Map1.Bounds := Map1.Layers.Bounds; // 这个办法不行
end;
procedure TForm1.N16Click(Sender: TObject);
begin
Map1.CurrentTool := miLabelTool;
end;
end.
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?