searchunit.pas

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

// This sample application and corresponding sample code is provided
// for example purposes only.  It has not undergone rigorous testing
// and as such should not be shipped as part of a final application
// without extensive testing on the part of the organization releasing
// the end-user product.

unit searchUnit;

interface

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

type
  TMainForm = class(TForm)
    MainMenu1: TMainMenu;
    fileMenuItem: TMenuItem;
    layerCntrlMenuItem: TMenuItem;
    exitMenuItem: TMenuItem;
    toolMenuItem: TMenuItem;
    zoomInToolMenuItem: TMenuItem;
    zoomOutToolMenuItem: TMenuItem;
    panToolMenuItem: TMenuItem;
    searchToolsMenuItem: TMenuItem;
    searchWithingDistanceMenuItem: TMenuItem;
    SearchWithinRectangleMenuItem: TMenuItem;
    SearchWithinFeatureMenuItem: TMenuItem;
    SearchAtPointMenuItem: TMenuItem;
    Add2SelectionmenuItem: TMenuItem;
    searchLayerLabel: TLabel;
    searchLayerCombo: TComboBox;
    featureListLabel: TLabel;
    featureSearchLayerCombo: TComboBox;
    searchResultsLabel: TLabel;
    searchResultsList: TListBox;
    Map1: TMap;
    procedure layerCntrlMenuItemClick(Sender: TObject);
    procedure exitMenuItemClick(Sender: TObject);
    procedure zoomInToolMenuItemClick(Sender: TObject);
    procedure zoomOutToolMenuItemClick(Sender: TObject);
    procedure panToolMenuItemClick(Sender: TObject);
    procedure searchWithingDistanceMenuItemClick(Sender: TObject);
    procedure SearchWithinRectangleMenuItemClick(Sender: TObject);
    procedure SearchWithinFeatureMenuItemClick(Sender: TObject);
    procedure SearchAtPointMenuItemClick(Sender: TObject);
    procedure Add2SelectionmenuItemClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure searchLayerComboClick(Sender: TObject);
    procedure Map1ToolUsed(Sender: TObject; ToolNum: Smallint; X1, Y1, X2,
      Y2, Distance: Double; Shift, Ctrl: Wordbool;
      var EnableDefault: Wordbool);
  private
    { Private declarations }
    procedure updateControls;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;
  searchLayer : Variant;

Const
     // Constants to be used for search tools
     SEARCH_DISTANCE_TOOL = 1;
     SEARCH_RECTANGLE_TOOL = 2;
     SEARCH_FEATURE_TOOL = 3;
     SEARCH_POINT_TOOL = 4;
     
implementation

{$R *.DFM}

procedure TMainForm.layerCntrlMenuItemClick(Sender: TObject);
var
   unusedParam: OleVariant;
begin
     TVarData(unusedParam).vType := varError;
     TVarData(unusedParam).vError := 2147614724; // DISP_E_PARAMNOTFOUND;
     Map1.Layers.LayersDlg(unusedParam, unusedParam);
     updateControls;
end;

procedure TMainForm.exitMenuItemClick(Sender: TObject);
begin
     close;
end;

procedure TMainForm.zoomInToolMenuItemClick(Sender: TObject);
begin
     // Set zoomIn tool to be active tool
     Map1.CurrentTool := miZoomInTool;
end;

procedure TMainForm.zoomOutToolMenuItemClick(Sender: TObject);
begin
     // Set zoomOut tool to be active tool
     Map1.CurrentTool := miZoomOutTool;
end;

procedure TMainForm.panToolMenuItemClick(Sender: TObject);
begin
     // Set pan tool to be active tool
     Map1.CurrentTool := miPanTool;
end;

procedure TMainForm.searchWithingDistanceMenuItemClick(Sender: TObject);
begin
     // Set Distance Search tool to be active tool
     Map1.CurrentTool := SEARCH_DISTANCE_TOOL;
end;

procedure TMainForm.SearchWithinRectangleMenuItemClick(Sender: TObject);
begin
     // Set Rectangle Search tool to be active tool
     Map1.CurrentTool := SEARCH_RECTANGLE_TOOL;
end;

procedure TMainForm.SearchWithinFeatureMenuItemClick(Sender: TObject);
begin
     // Set Feature Search tool to be active tool
     Map1.CurrentTool := SEARCH_FEATURE_TOOL;
end;

procedure TMainForm.SearchAtPointMenuItemClick(Sender: TObject);
begin
     // Set Point Search tool to be active tool
     Map1.CurrentTool := SEARCH_POINT_TOOL;
end;

procedure TMainForm.Add2SelectionmenuItemClick(Sender: TObject);
begin
     // Reset Menu Item each time it is chosen
     if Add2SelectionMenuItem.checked = True then
         Add2SelectionMenuItem.checked := False
     else
         Add2SelectionMenuItem.checked := True;
end;

procedure TMainForm.updateControls;
var
   i : integer;
begin
     If Map1.Layers.Count > 0 Then
        begin
             searchLayerCombo.Clear;
             featureSearchLayerCombo.Clear;
             for i := 1 to Map1.Layers.Count do
                begin
                   searchLayerCombo.Items.Add(Map1.Layers.Item[i].Name);
                   featureSearchLayerCombo.Items.Add(Map1.Layers.Item[i].Name);
                end;
             searchLayerCombo.ItemIndex := 0;
             featureSearchLayerCombo.ItemIndex := 0;
        end;
end;

procedure TMainForm.FormActivate(Sender: TObject);
var
   unusedParam: OleVariant;
begin
     TVarData(unusedParam).vType := varError;
     TVarData(unusedParam).vError := 2147614724; // DISP_E_PARAMNOTFOUND;
     Map1.CreateCustomTool(SEARCH_DISTANCE_TOOL, miToolTypeCircle, miRadiusSelectCursor, miArrowToolCursor, miArrowToolCursor, unusedParam);
     Map1.CreateCustomTool(SEARCH_RECTANGLE_TOOL, miToolTypeMarquee, miRectSelectCursor,miArrowToolCursor, miArrowToolCursor, unusedParam);
     Map1.CreateCustomTool(SEARCH_FEATURE_TOOL, miToolTypePoint, miRegionSelectCursor, miArrowToolCursor, miArrowToolCursor, unusedParam);
     Map1.CreateCustomTool(SEARCH_POINT_TOOL, miToolTypePoint, miSelectCursor, miArrowToolCursor, miArrowToolCursor, unusedParam);
     updateControls;
     searchLayer := Map1.Layers.Item[searchLayerCombo.text];
end;

procedure TMainForm.searchLayerComboClick(Sender: TObject);
begin
     searchLayer := Map1.Layers.Item[searchLayerCombo.text];
end;

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

Var
   i : Integer;
   fID : String;
   searchType : Integer;
   dist : OleVariant;
   pt : Variant;
   curFeatures : Variant;
   rc : Variant;
   obj : Variant;
   featureSearchLayer : Variant;
begin
     pt := CreateOleObject('MapX.Point.5');
     // Clear Search Results list
     searchResultsList.Clear;
     if ToolNum <> SEARCH_POINT_TOOL then
        begin
           // Set SearchType based on what key user may have down
           if (Shift And Not Ctrl) then
              searchType := miSearchTypePartiallyWithin
           else if (Ctrl And Not Shift) then
              searchType := miSearchTypeEntirelyWithin
           else
              searchType := miSearchTypeCentroidWithin;
        end;
     Case ToolNum of
        SEARCH_DISTANCE_TOOL :
           begin
              dist := Map1.OleObject.Distance(X1, Y1, X2, Y2);
              pt.Set(X1,Y1);
              curFeatures := searchLayer.SearchWithinDistance(pt, dist, miUnitMile, searchType);
              for i := 1 to curFeatures.Count do
                 begin
                    obj := curFeatures.Item[i];
                    Str(obj.FeatureID:4:0, fID);
                    searchResultsList.Items.Add(obj.Name + ' id: ' + fID);
                 end;
              if Add2SelectionMenuItem.Checked = True then
                 searchLayer.Selection.Replace(curFeatures);
           end;
        SEARCH_RECTANGLE_TOOL :
           begin
              rc := CreateOleObject('MapX.Rectangle.5');
              rc.Set(X1, Y1, X2, Y2);
              curFeatures := searchLayer.SearchWithinRectangle(rc, searchType);
              for i := 1 to curFeatures.Count do
                 begin
                    obj := curFeatures.Item[i];
                    Str(obj.FeatureID:4:0, fID);
                    searchResultsList.Items.Add(obj.Name + ' id: ' + fID);
                 end;
              if Add2SelectionMenuItem.Checked = True then
                 searchLayer.Selection.Replace(curFeatures);
           end;
        SEARCH_FEATURE_TOOL :
           begin
              featureSearchLayer := Map1.Layers.Item[featureSearchLayerCombo.Text];
              pt.Set(X1,Y1);
              curFeatures := featureSearchLayer.SearchAtPoint(pt);
              if curFeatures.Count > 0 then
                 obj := curFeatures.Item[1]
              else
                 exit;
              curFeatures := searchLayer.SearchWithinFeature(obj, searchType);
              for i := 1 to curFeatures.Count do
                 begin
                    obj := curFeatures.Item[i];
                    Str(obj.FeatureID:4:0, fID);
                    searchResultsList.Items.Add(obj.Name + ' id: ' + fID);
                 end;
              if Add2SelectionMenuItem.Checked = True then
                 searchLayer.Selection.Replace(curFeatures);
           end;
        SEARCH_POINT_TOOL :
           begin
              pt.Set(X1,Y1);
              curFeatures := SearchLayer.SearchAtPoint(pt);
              for i := 1 to curFeatures.Count do
                 begin
                    obj := curFeatures.Item[i];
                    Str(obj.FeatureID:4:0, fID);
                    searchResultsList.Items.Add(obj.Name + ' id: ' + fID);
                 end;
              if Add2SelectionMenuItem.Checked = True then
                 searchLayer.Selection.Replace(curFeatures);
           end;
     end;

end;

end.