mainmapform.pas

GIS地理信息系统开发。 大名鼎鼎的MAPX＋DELPHI7.0软件开发

unit mainMapForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  OleCtrls, Menus, StdCtrls, ComObj, MapXLib_TLB;

type
  TMainMap = class(TForm)
    MainMenu1: TMainMenu;
    FileMenuItem: TMenuItem;
    exitMenuItem: TMenuItem;
    layersMenuItem: TMenuItem;
    layerControlMenuItem: TMenuItem;
    addNewLayerMenuItem: TMenuItem;
    toolsMenuItem: TMenuItem;
    panToolMenuItem: TMenuItem;
    zoomInToolMenuItem: TMenuItem;
    selectToolMenuItem: TMenuItem;
    editLyrCombo: TComboBox;
    editLayerLabel: TLabel;
    drawToolsMenuItem: TMenuItem;
    lineSubMenuItem: TMenuItem;
    pointSubMenuItem: TMenuItem;
    polygonSubMenuItem: TMenuItem;
    polylineSubMenuItem: TMenuItem;
    stylesMenuItem: TMenuItem;
    symbolStyleMenuItem: TMenuItem;
    lineStyleMenuItem: TMenuItem;
    regionStyleMenuItem: TMenuItem;
    infoMenuItem: TMenuItem;
    Objects1: TMenuItem;
    DeleteSelection1: TMenuItem;
    zoomOutToolMenuItem: TMenuItem;
    BufferSelection1: TMenuItem;
    ftrLayerCombo: TComboBox;
    lblFtrLayer: TLabel;
    CombineSelection1: TMenuItem;
    Map1: TMap;
    procedure layerControlMenuItemClick(Sender: TObject);
    procedure exitMenuItemClick(Sender: TObject);
    procedure addNewLayerMenuItemClick(Sender: TObject);
    procedure panToolMenuItemClick(Sender: TObject);
    procedure zoomInToolMenuItemClick(Sender: TObject);
    procedure selectToolMenuItemClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure editLyrComboChange(Sender: TObject);
    procedure pointSubMenuItemClick(Sender: TObject);
    procedure lineSubMenuItemClick(Sender: TObject);
    procedure polylineSubMenuItemClick(Sender: TObject);
    procedure polygonSubMenuItemClick(Sender: TObject);
    procedure symbolStyleMenuItemClick(Sender: TObject);
    procedure lineStyleMenuItemClick(Sender: TObject);
    procedure regionStyleMenuItemClick(Sender: TObject);
    procedure Map1ToolUsed(Sender: TObject; ToolNum: Smallint; X1, Y1, X2,
      Y2, Distance: Double; Shift, Ctrl: Wordbool;
      var EnableDefault: Wordbool);
    procedure infoMenuItemClick(Sender: TObject);
    procedure DeleteSelection1Click(Sender: TObject);
    procedure zoomOutToolMenuItemClick(Sender: TObject);
    procedure BufferSelection1Click(Sender: TObject);
    procedure ftrLayerComboChange(Sender: TObject);
    procedure CombineSelection1Click(Sender: TObject);
    procedure Map1PolyToolUsed(Sender: TObject; ToolNum: Smallint;
      Flags: Integer; Points: IDispatch; bShift, bCtrl: WordBool;
      var EnableDefault: WordBool);
  private
    { Private declarations }
    procedure upDate_EditCombo;
  public
    { Public declarations }
  end;

var
  MainMap: TMainMap;
  // Layer variable to hold current edit layer
  EditLayer : Variant;
  // Global value to hold selected feature for Info Tool
  infoFeature : Variant;
  // Layer variable to hold current feature layer
  ftrLayer : Variant;

Const
     // Custom Tool Constants
     CUSTOM_POINT_TOOL = 1;
     CUSTOM_LINE_TOOL = 2;
     CUSTOM_POLYGON_TOOL = 3;
     CUSTOM_POLYLINE_TOOL = 4;

     CUSTOM_INFO_TOOL = 9;
     CUSTOM_SELECT_TOOL = 10;

implementation

uses newLayerDialog, featureInfo;

{$R *.DFM}

procedure TMainMap.layerControlMenuItemClick(Sender: TObject);
var
   unusedParam: OleVariant;
begin
     TVarData(unusedParam).vType := varError;
     TVarData(unusedParam).vError := 2147614724; // DISP_E_PARAMNOTFOUND;
     // Display the Stock MapX Layer Control Dialog
     Map1.Layers.LayersDlg(unusedParam, unusedParam);
     upDate_EditCombo;
end;

procedure TMainMap.exitMenuItemClick(Sender: TObject);
begin
     Close;
end;

procedure TMainMap.addNewLayerMenuItemClick(Sender: TObject);
begin
     // Display form to add a new layer
     newLayerForm.ShowModal;
     upDate_EditCombo;
end;

procedure TMainMap.panToolMenuItemClick(Sender: TObject);
begin
     // Make Pan tool the current tool
     map1.currentTool := miPanTool;
end;

procedure TMainMap.zoomInToolMenuItemClick(Sender: TObject);
begin
     // Make Zoom In tool current Tool
     map1.currentTool := miZoomInTool;
end;

procedure TMainMap.selectToolMenuItemClick(Sender: TObject);
begin
     // Make Selection Tool the current tool
     map1.currentTool := miSelectTool;
end;

procedure TMainMap.FormActivate(Sender: TObject);
var empty: Variant;
begin
     // Create custom tools and update combo box control
     upDate_EditCombo;
     TVarData(empty).vType := varError;
     TVarData(empty).vError := 2147614724; // DISP_E_PARAMNOTFOUND;
     Map1.CreateCustomTool(CUSTOM_POINT_TOOL, miToolTypePoint, miSymbolCursor, miArrowCursor, miArrowCursor, empty);
     Map1.CreateCustomTool(CUSTOM_LINE_TOOL, miToolTypeLine, miCrossCursor, miArrowCursor, miArrowCursor, empty);
     Map1.CreateCustomTool(CUSTOM_POLYGON_TOOL, miToolTypePoly, miCrossCursor, miArrowCursor, miArrowCursor, empty);
     Map1.CreateCustomTool(CUSTOM_POLYLINE_TOOL, miToolTypePoly, miCrossCursor, miArrowCursor, miArrowCursor, empty);
     Map1.CreateCustomTool(CUSTOM_INFO_TOOL, miToolTypePoint, miCrossCursor, miArrowCursor, miArrowCursor, empty);
end;

procedure TMainMap.upDate_EditCombo;
var i : integer;
begin
     // Loop through all layers and put their names in the combo box
     // Set editing layer to be first layer in list
     editLyrCombo.Clear;
     ftrLayerCombo.Clear;
     for i := 1 to Map1.Layers.Count do
       begin
         editLyrCombo.Items.Add(Map1.Layers.Item[i].Name);
         ftrLayerCombo.Items.Add(Map1.Layers.Item[i].Name);
       end;
     EditLyrCombo.ItemIndex := 0;
     ftrLayerCombo.ItemIndex := 0;
     EditLayer := Map1.Layers.Item[editLyrCombo.Text];
     ftrLayer := Map1.Layers.Item[ftrLayerCombo.Text];
end;

procedure TMainMap.editLyrComboChange(Sender: TObject);
begin
     //Reset edit layer after change
     EditLayer := Map1.Layers.Item[editLyrCombo.Text];
end;

procedure TMainMap.pointSubMenuItemClick(Sender: TObject);
begin
     // Set current tool to be point tool
     Map1.CurrentTool := CUSTOM_POINT_TOOL;
end;

procedure TMainMap.lineSubMenuItemClick(Sender: TObject);
begin
     // Set current tool to be line tool
     Map1.CurrentTool := CUSTOM_LINE_TOOL;
end;

procedure TMainMap.polylineSubMenuItemClick(Sender: TObject);
begin
     // Set current tool to be polyLine tool
     Map1.CurrentTool := CUSTOM_POLYLINE_TOOL;
end;

procedure TMainMap.polygonSubMenuItemClick(Sender: TObject);
begin
     // Set current tool to be polygon tool
     Map1.CurrentTool := CUSTOM_POLYGON_TOOL;
end;

procedure TMainMap.symbolStyleMenuItemClick(Sender: TObject);
begin
     Map1.DefaultStyle.PickSymbol;
end;

procedure TMainMap.lineStyleMenuItemClick(Sender: TObject);
begin
     Map1.DefaultStyle.PickLine;
end;

procedure TMainMap.regionStyleMenuItemClick(Sender: TObject);
begin
     Map1.DefaultStyle.PickRegion;
end;

procedure TMainMap.Map1ToolUsed(Sender: TObject; ToolNum: Smallint; X1, Y1,
  X2, Y2, Distance: Double; Shift, Ctrl: Wordbool;
  var EnableDefault: Wordbool);

var
    newObj : Variant; // Used for storing new feature object
    pt : Variant;     // Used for storing point of click
    pts : Variant;    // Used for storing collection of points
    ftrs : Variant;   // Used for storing collection of features
begin
     Case ToolNum of
        CUSTOM_POINT_TOOL :
        // Set feature type to be a symbol, set its style & XY values.
        // Add it to editing layer
           begin
              pt := CreateOleObject('MapX.Point.5');
              pt.Set(X1, Y1);

              newObj := Map1.FeatureFactory.CreateSymbol(pt, Map1.DefaultStyle);
              EditLayer.AddFeature(newObj);
           end;
        CUSTOM_LINE_TOOL :
           begin
           // Create new point object and points collection object
              pts := CreateOleObject('MapX.Points.5');
           // set Point obect to click 1 and add it to collection
              pts.AddXY(X1, Y1);
           // set Point obect to click 2 and add it to collection
              pts.AddXY(X2, Y2);
           // Create the line & add feature to layer
              newObj := Map1.FeatureFactory.CreateLine(pts, Map1.DefaultStyle);
              EditLayer.AddFeature(newObj);
           // UnAssign Variant Variables
              VarClear(pts);
           end;
        CUSTOM_INFO_TOOL :
           begin
           // Create point object and set it to click XY
              pt := CreateOleObject('MapX.Point.5');
              pt.Set(X1,Y1);
           // Perform a search at click point
              Ftrs := EditLayer.SearchAtPoint(pt);
           // If one feature selected, assign it to infoFeature and call the
           // Information form
              if Ftrs.Count = 1 Then
                 begin
                    infoFeature := Ftrs.Item[1];
                    featureInfoForm.ShowModal;
                 end;
           // UnAssign Variant Variable
              VarClear(pt);
           end;
        CUSTOM_SELECT_TOOL :
           //Make selection on feature layer
             if (ctrl) then
               ftrLayer.Selection.SelectByPoint(X1, Y1, miSelectionAppend)
             else if (Shift) then
               ftrLayer.Selection.SelectByPoint(X1, Y1, miSelectionRemove)
             else
               ftrLayer.Selection.SelectByPoint(X1, Y1, miSelectionNew);
     end;//Case
     // UnAssign Variant Variable
     VarClear(newObj);
end;

procedure TMainMap.infoMenuItemClick(Sender: TObject);
begin
     // Set current tool to be Information Tool
     Map1.CurrentTool := CUSTOM_INFO_TOOL;
end;

procedure TMainMap.DeleteSelection1Click(Sender: TObject);
begin
     try
        if editLayer.selection.count = 1 then
           begin
              editLayer.deleteFeature(editLayer.selection.item[1]);
              editLayer.selection.clearSelection;
           end;
     Except on E:Exception do ShowMessage(E.message);
     end;
end;

procedure TMainMap.zoomOutToolMenuItemClick(Sender: TObject);
begin
     // Set active tool to be the zoom Out tool
     Map1.CurrentTool := miZoomOutTool;
end;

procedure TMainMap.BufferSelection1Click(Sender: TObject);
Var
   selItems : Variant;
   newFeature : Variant;
begin
     selItems := ftrLayer.Selection;
     case selItems.Count of
       0:  Exit;
       1:  newFeature := Map1.FeatureFactory.BufferFeatures(selItems.Item[1], 10, miUnitMile, 20);
       else
           newFeature := Map1.FeatureFactory.BufferFeatures(selItems, 10, miUnitMile, 20);
     end;
     editLayer.AddFeature(newFeature);
end;

procedure TMainMap.ftrLayerComboChange(Sender: TObject);
begin
     //Reset Feature layer after change
     ftrLayer := Map1.Layers.Item[ftrLayerCombo.Text];
end;

procedure TMainMap.CombineSelection1Click(Sender: TObject);
Var
   selItems : Variant;
   newFeature : Variant;
begin
     selItems := ftrLayer.Selection;
     if selItems.Count > 1 then
       begin
         newFeature := Map1.FeatureFactory.CombineFeatures(selItems.Item[1], selItems.Item[2]);
         editLayer.AddFeature(newFeature);
       end;
end;

procedure TMainMap.Map1PolyToolUsed(Sender: TObject; ToolNum: Smallint;
  Flags: Integer; Points: IDispatch; bShift, bCtrl: WordBool;
  var EnableDefault: WordBool);
var newObj : Variant;

begin
    {***********************************************
     Due to an apparent bug in Delphi 2.0, the double
     click event is not be sent properly to the OCX.
     The SpaceBar or Enter key can be used as a double
     click replacement
    ************************************************}
    If Not (editLayer.Type = miLayerTypeUserDraw) Then
       If Flags = miPolyToolBegin Then
          //Someone's beginning the use of a PolyTool...
       Else
          If Flags = miPolyToolEnd Then
             begin
                //The user finished using a PolyTool by double clicking
                Case ToolNum of
                   CUSTOM_POLYGON_TOOL :
                      begin
                         // Make a new
                         // region feature and add it to the first layer!
                         newObj := Map1.FeatureFactory.CreateRegion(points, Map1.DefaultStyle);
                         EditLayer.AddFeature(newObj);
                      end;
                   CUSTOM_POLYLINE_TOOL :
                      begin
                         // They used MY_POLYLINE_TOOL! Make a new
                         // line feature and add it to the first layer!
                         newObj := Map1.FeatureFactory.CreateLine(points, Map1.DefaultStyle);
                         EditLayer.AddFeature(newObj);
                      end;
                end;//Case
             end
          Else If Flags = miPolyToolEndEscaped then
               // The users hit 'Esc' or backspaced all the nodes
               // away... don't add anything in.

end;

end.