mainunit.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 MainUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Comobj, OleCtrls, Menus, lyrCntrl, MapXLib_TLB;

type
  TMapForm = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    Tools1: TMenuItem;
    Select1: TMenuItem;
    ZoomIn1: TMenuItem;
    ZoomOut1: TMenuItem;
    Datasets1: TMenuItem;
    ODBC1: TMenuItem;
    UnBound1: TMenuItem;
    Layers1: TMenuItem;
    LayerControl1: TMenuItem;
    Pan1: TMenuItem;
    RemoveDataset1: TMenuItem;
    Custom1: TMenuItem;
    Ruler1: TMenuItem;
    Map1: TMap;
    procedure Exit1Click(Sender: TObject);
    procedure ODBC1Click(Sender: TObject);
    procedure UnBound1Click(Sender: TObject);
    procedure LayerControl1Click(Sender: TObject);
    procedure Select1Click(Sender: TObject);
    procedure ZoomIn1Click(Sender: TObject);
    procedure ZoomOut1Click(Sender: TObject);
    procedure Pan1Click(Sender: TObject);
    procedure RadiusSelect1Click(Sender: TObject);
    procedure RectangleSelect1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure RemoveDataset1Click(Sender: TObject);
    procedure Ruler1Click(Sender: TObject);
    procedure Map1ToolUsed(Sender: TObject; ToolNum: Smallint; X1, Y1, X2,
      Y2, Distance: Double; Shift, Ctrl: Wordbool;
      var EnableDefault: Wordbool);
    procedure Map1RequestData(Sender: TObject;
      const DataSetName: WideString; Row: Integer; Field: Smallint;
      var Value: OleVariant; var Done: WordBool);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MapForm: TMapForm;
  {Array used for unbound data}
  dataArr: array[1..3,1..3] of OleVariant;

implementation

{$R *.DFM}

procedure TMapForm.Exit1Click(Sender: TObject);
begin
     close;
end;

procedure TMapForm.ODBC1Click(Sender: TObject);
var
   param, ds: variant;
   unusedParam: OleVariant;
   fields: Variant;
begin
     TVarData(unusedParam).vType := varError;
     TVarData(unusedParam).vError := 2147614724; // DISP_E_PARAMNOTFOUND;
  {Create the QueryInfo object and then set its properties}
     param := CreateOleObject('MapX.ODBCQueryInfo.5');
     param.SqlQuery := 'select * from USA';
     param.DataSource := 'MapStats';
     param.ConnectString := 'ODBC;';

     fields := CoFields.Create;
     fields.Add('GEOABBR','GEOABBR', miAggregationAuto,miTypeString);
     fields.Add('GEONAME','GEONAME', miAggregationAuto,miTypeString);
     fields.Add('TOTPOP','TOTPOP', miAggregationAuto,miTypeNumeric);

  {Add a dataset passing in the QueryInfo object}
     ds := Map1.Datasets.Add(miDataSetODBC, param, unusedParam, unusedParam, unusedParam, 'USA', fields, unusedParam);
  {Add a Ranged Theme}
     ds.Themes.Add(miThemeRanged, 'TOTPOP', 'HomesByState');
     ODBC1.Enabled := False;
end;

procedure TMapForm.UnBound1Click(Sender: TObject);
var
   flds: variant;
   ds: variant;
   unusedParam: OleVariant;
begin
     TVarData(unusedParam).vType := varError;
     TVarData(unusedParam).vError := 2147614724; // DISP_E_PARAMNOTFOUND;
  {Create the Fields object and then add Fields for unbound dataset}
     flds := CreateOleObject('MapX.Fields.5');
     flds.add('State', 'State', miAggregationIndividual, miTypeString);
     flds.add('Pop80', 'Pop80', miAggregationSum, miTypeNumeric);
     flds.add('Pop90', 'Pop90', miAggregationSum, miTypeNumeric);
  {Add a dataset passing in the Fields object}
     ds := map1.datasets.add(miDatasetUnbound, unusedParam, unusedParam, 'State', unusedParam, 'USA', flds, unusedParam);
   {Add an Individual Theme}
     ds.Themes.Add(miThemeIndividualValue, 'State', 'StateByState');

     UnBound1.Enabled := False;
end;

{MapX Event}


procedure TMapForm.LayerControl1Click(Sender: TObject);
begin
     lyrcntrl.Form1.ShowModal
end;

procedure TMapForm.Select1Click(Sender: TObject);
begin
     Map1.CurrentTool := miSelectTool;
end;

procedure TMapForm.ZoomIn1Click(Sender: TObject);
begin
     Map1.CurrentTool := miZoomInTool;
end;

procedure TMapForm.ZoomOut1Click(Sender: TObject);
begin
     Map1.CurrentTool := miZoomOutTool;
end;

procedure TMapForm.Pan1Click(Sender: TObject);
begin
     Map1.CurrentTool := miPanTool;
end;

procedure TMapForm.RadiusSelect1Click(Sender: TObject);
begin
     Map1.CurrentTool := miRadiusSelectTool;
end;

procedure TMapForm.RectangleSelect1Click(Sender: TObject);
begin
     Map1.CurrentTool := miRectSelectTool;
end;

procedure TMapForm.FormActivate(Sender: TObject);
var
   unusedParam: OleVariant;
begin
  {Fill array with data for unbound data set}
     dataArr[1,1] := 'OK';
     dataArr[1,2] := 807769;
     dataArr[1,3] := 851783;

     dataArr[2,1] := 'TX';
     dataArr[2,2] := 129017;
     dataArr[2,3] := 143196;

     dataArr[3,1] := 'NM';
     dataArr[3,2] := 92313;
     dataArr[3,3] := 102525;

     TVarData(unusedParam).vType := varError;
     TVarData(unusedParam).vError := 2147614724; // DISP_E_PARAMNOTFOUND;
     {Create custom line tool for ruler implementation}
     Map1.CreateCustomTool(1, miToolTypeLine, miSizeCursor, miSizeCursor, miSizeCursor, unusedParam);
end;

procedure TMapForm.RemoveDataset1Click(Sender: TObject);
var
   i,dsCount: integer;
begin
     dsCount := Map1.Datasets.Count;
     for i := 1 to dsCount do
         Map1.Datasets.Remove(1);
     ODBC1.Enabled := True;
     UnBound1.Enabled := True;
end;

procedure TMapForm.Ruler1Click(Sender: TObject);
begin
     Map1.Currenttool := 1;
end;

{MapX Event}
procedure TMapForm.Map1ToolUsed(Sender: TObject; ToolNum: Smallint; X1, Y1,
  X2, Y2, Distance: Double; Shift, Ctrl: Wordbool;
  var EnableDefault: Wordbool);

var
   distStr: string;
begin
     case toolnum of
          1:
            begin
              if Distance > 1 then
                 distStr := FloatToStrF(Distance, ffFixed, 12, 1)
              else
                 distStr := FloatToStrF(Distance, ffFixed, 12, 4);
              showmessage(distStr + ' miles');
            end;
     end;
end;

procedure TMapForm.Map1RequestData(Sender: TObject;
  const DataSetName: WideString; Row: Integer; Field: Smallint;
  var Value: OleVariant; var Done: WordBool);
begin
    Done := False;
    If (Row > 3) Then
        Done := True
    Else
        Value := dataArr[Row, Field];
end;

end.