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 + -
显示快捷键?