mapx.~pas

Delphi + MapX程序框架(地图)源码程序

  I: Integer;
begin
  if AList <> nil then
  begin
    AList.Clear;
    for I:= 1 to FMap.Layers.Count do
      AList.Add(FMap.Layers.Item[I].Name);
  end;
end;

procedure TMapX.Get_VisibleLayers(AList: TStringList);
var
  I: Integer;
begin
  if AList <> nil then
  begin
    AList.Clear;
    for I:= 1 to FMap.Layers.Count do
      if FMap.Layers.Item[I].Visible then
        AList.Add(FMap.Layers.Item[I].Name);
  end;
end;

procedure TMapX.Get_LayerFields(ALayer: string; AList: TStringList);
var
  I: Integer;
begin
  if (LayerExist(ALayer)) and (AList <> nil) then
  begin
    AList.Clear;
    BindLayerData(ALayer);
    for I:= 1 to FMap.DataSets.Item[ALayer].Fields.Count do
      AList.Add(FMap.DataSets.Item[ALayer].Fields.Item[I].Name);
  end;
end;

function TMapX.LayerExist(ALayer: string): Boolean;
var
  I: Integer;
begin
  Result:= False;
  for I:= 1 to FMap.Layers.Count do
    if FMap.Layers.Item[I].Name = ALayer then
    begin
      Result:= True;
      Break;
    end;
end;

function TMapX.LayerSelectable(ALayer: string): Boolean;
begin
  Result:=
    LayerExist(ALayer) and FMap.Layers.Item[ALayer].Visible and FMap.Layers.Item[ALayer].Selectable;
end;

function TMapX.LayerVisible(ALayer: string): Boolean;
var
  I: Integer;
begin
  Result:= False;
  for I:= 1 to FMap.Layers.Count do
    if FMap.Layers.Item[I].Name = ALayer then
    begin
      Result:= FMap.Layers.Item[I].Visible;
      Break;
    end;
end;

function TMapX.DataExist(AData: string): Boolean;
var
  i: Integer;
begin
  Result:= False;
  for i:= 1 to FMap.DataSets.Count do
    if FMap.DataSets.Item[i].Name = AData then
    begin
      Result:= True;
      Break;
    end;
end;

procedure TMapX.BindLayerData(ALayer: string);
begin
  if not DataExist(ALayer) then
    FMap.Datasets.Add(miDataSetLayer,FMap.Layers.Item[ALayer], ALayer, EmptyParam,
                  EmptyParam, EmptyParam, EmptyParam, EmptyParam);
end;

procedure TMapX.MapXOnMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if FCurrentTool = mttRulerTool then
    FRulerTool.Execute(X,Y,Button,mmDown);
end;




procedure TMapX.MapXOnMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  MyPoint: CMapXPoint;
  X1,Y1: Single;
  Fs: CMapXFeatures;

begin
  FMouseScreenX:= X;
  FMouseScreenY:= Y;
  X1:= X/1.0; Y1:= Y/1.0;
  FMap.MapUnit:= 1; //miUnitKilometer
  FMap.ConvertCoord(X1,Y1,FMouseX,FMouseY,1); //miScreenToMap
  MyPoint:= CoPoint.Create;
  MyPoint.Set_(FMouseX,FMouseY);
  if LayerVisible(FWorkLayer) then
    Fs:= FMap.Layers.Item[FWorkLayer].SearchAtPoint(MyPoint,miSearchResultDefault)
  else
    Fs:= nil;
  if (Fs <> nil) and (Fs.Count > 0) then
    FFeatureUnderMouse:= Fs.Item[1]
  else
    FFeatureUnderMouse:= nil;

  if (FeatureUnderMouse <> nil) and (FCurrentTool in [mttPointSelectTool, mttLabelTool, mttInforTool]) then
    Screen.Cursor:= crHandPoint
  else
    Screen.Cursor:= crDefault;

  if FCurrentTool = mttRulerTool then
    FRulerTool.Execute(X,Y,mbLeft,mmMove);//mbLeft没有实际意义,只是作为参数
end;

procedure TMapX.MapXOnMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
end;

procedure TMapX.MapXOnPolyToolUsed(ASender: TObject; ToolNum: Smallint;
  Flags: Integer; const Points: IDispatch; bShift, bCtrl: WordBool;
  var EnableDefault: WordBool);
begin
  case ToolNum of
    Ord(mttPolygonSelectTool): if flags = 1 then FPolygonSelectTool.Execute(Points,bShift,bCtrl);
    Ord(mttRulerTool): if flags = 1 then FRulerTool.FRulerMode:= rmFinished;
    Ord(mttAreaTool): FAreaTool.Execute(Points);
  end;
  {
  if (ToolNum = 121) and (Flags = 0) then
    FAddPolyLineTool.Timer.Enabled:= True;
  if (ToolNum = 121) and (Flags = 1) then
  begin
    FAddPolyLineTool.Execute(Points);
    FAddPolyLineTool.Timer.Enabled:= False;
  end;
  }
  {
  if (ToolNum = 122) and (Flags = 1) then
    FAddPolygonTool.Execute(Points);
  }
end;

procedure TMapX.MapXOnToolUsed(ASender: TObject; ToolNum: Smallint; X1, Y1,
  X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
  var EnableDefault: WordBool);
begin
  case ToolNum of
    Ord(mttPointSelectTool): FPointSelectTool.Execute(X1,Y1,Shift,Ctrl);
    Ord(mttRadiusSelectTool): FRadiusSelectTool.Execute(X1,Y1,Distance,Shift,Ctrl);
    Ord(mttRectSelectTool): FRectSelectTool.Execute(X1,Y1,X2,Y2,Shift,Ctrl);
    Ord(mttInforTool): FInforTool.Execute(X1,Y1);
    Ord(mttLabelTool): FLabelTool.Execute(X1,Y1);
    //120: FAddPointTool.Execute(X1, Y1);
  end; //  case
end;

procedure TMapX.OpenFile(AFileName: string);
begin
  if AFileName <> FFileName then
  begin
    FMap.GeoSet:= AFileName;
    FFileName:= AFileName;
  end;
end;

procedure TMapX.SetCurrentTool(const Value: TMapXToolType);
begin
  if FCurrentTool <> Value then
  begin
    FCurrentTool := Value;
    FMap.CurrentTool:= Ord(FCurrentTool);
    if Assigned(FOnCurrentToolChanged) then
      FOnCurrentToolChanged(Self, FCurrentTool);
  end;
end;

procedure TMapX.SetFileName(const Value: string);
begin
  OpenFile(Value);
end;

procedure TMapX.SetLayerSelection(Shift, Ctrl: boolean; Fs: CMapxFeatures;
  ALayer: String);
begin
  if (not(Ctrl)) and (not(Shift)) then
  begin
    FMap.Layers.ClearSelection;
    FMap.Layers.Item[ALayer].Selection.Add(Fs);
  end
  else if (Ctrl) and (not(Shift)) then
    FMap.Layers.Item[ALayer].Selection.Add(Fs)
  else if (not(Ctrl)) and (Shift) then
    FMap.Layers.Item[ALayer].Selection.Remove(Fs);
end;

procedure TMapX.SetLayerVisible(ALayer: string; IsVisible: Boolean);
var
  I: Integer;
begin
  for I:= 1 to FMap.Layers.Count do
    if FMap.Layers.Item[I].Name = ALayer then
    begin
      FMap.Layers.Item[I].Visible:= IsVisible;
      Break;
    end;
end;

procedure TMapX.SetWorkLayer(const Value: string);
begin
  if FWorkLayer <> Value then
  begin
    if LayerExist(Value) then
      FWorkLayer:= Value
    else
      FWorkLayer:= '';
    if Assigned(FOnWorkLayerChanged) then
      FOnWorkLayerChanged(Self, FWorkLayer);
  end;
end;

procedure TMapX.TitleSetting;
var
  frmTitle: TfrmTitle;
begin
  frmTitle:= TfrmTitle.Create(nil);
  frmTitle.SetMap(FMap);
  frmTitle.SetTitle(FMap.Title.Caption);
  frmTitle.setTitleVisible(FMap.Title.Visible);
  frmTitle.SetTitleBorder(FMap.Title.Border);
  frmTitle.ShowModal;
  if frmTitle.ModalResult = mrOK then
  begin
    FMap.Title.Caption:= frmTitle.GetTitle;
    FMap.Title.Visible:= frmTitle.GetTitleVisible;
    FMap.Title.Border:= frmTitle.GetTitleBorder;
  end;
  frmTitle.Free;
end;

procedure TMapX.LayerSetting;
var
  I: Integer;
begin
  for I:= 1 to FMap.Layers.Count do
    BindLayerData(FMap.Layers.Item[I].Name);
  FMap.Layers.LayersDlg(EmptyParam, EmptyParam);
end;

procedure TMapX.ThemeSetting;
var
  frmTheme: TfrmTheme;
begin
  frmTheme:= TfrmTheme.Create(nil);
  frmTheme.SetMapXTheme(FMapXTheme);
  frmTheme.ShowModal;
  if frmTheme.ModalResult = mrOK then
  begin

  end;
  frmTheme.Free;
end;

procedure TMapX.SaveAsGstFile;
const
  Filter = 'GST|*.gst';
var
  SaveDialog: TSaveDialog;
  FileName: string;
begin
  SaveDialog:= TSaveDialog.Create(nil);
  SaveDialog.Filter:= Filter;
  if SaveDialog.Execute then
  begin
    FileName:= SaveDialog.FileName;
    FileName:= FileName+'.gst';
    FMap.SaveMapAsGeoset(ExtractFileName(FileName),FileName);
  end;
  SaveDialog.Free;
end;

function TMapX.GetLayerCount: Integer;
begin
  Result:= FMap.Layers.Count;
end;

procedure TMapX.SaveAsGraph;
const
  Filter = 'JPG|*.jpg|BMP|*.bmp|TIF|*.tif|GIF|*.gif';
var
  SaveDialog: TSaveDialog;
  frmSave: TfrmSave;
  Ext: Integer;
  FileName: string;
begin
  SaveDialog:= TSaveDialog.Create(nil);
  SaveDialog.Filter:= Filter;
  if SaveDialog.Execute then
  begin
    FileName:= SaveDialog.FileName;
    case SaveDialog.FilterIndex of
      1: begin
           Ext:= 3;
           if Pos('.jpg', FileName) = 0 then
             FileName:= FileName+'.jpg';
         end;
      2: begin
           Ext:= 1;
           if Pos('.bmp', FileName) = 0 then
             FileName:= FileName+'.bmp';
         end;
      3: begin
           Ext:= 4;
           if Pos('.tif', FileName) = 0 then
             FileName:= FileName+'.tif';
         end;
      4: begin
           Ext:= 2;
           if Pos('.gif', FileName) = 0 then
             FileName:= FileName+'.gif';
         end;
    end;
    frmSave:= TfrmSave.Create(nil);
    frmSave.SetMap(FMap);
    frmSave.ShowModal;
    if frmSave.ModalResult = mrOK then
      FMap.ExportMap(FileName, Ext, StrToFloat(frmSave.Edit1.Text), StrToFloat(frmSave.Edit2.Text));
    frmSave.Free;
  end;
  SaveDialog.Free;
end;

procedure TMapX.PrintMap;
var
  frmPrint: TfrmPrint;
begin
  frmPrint:= TfrmPrint.Create(nil);
  frmPrint.SetMap(FMap);
  frmPrint.ShowModal;
  if frmPrint.ModalResult = mrOK then
  begin
    Printer.BeginDoc;
    FMap.PrintMap(Printer.Handle, 0, 0, StrToInt(frmPrint.Edit1.Text), StrToInt(frmPrint.Edit2.Text));
    Printer.EndDoc;
  end;
  frmPrint.Free;
end;

procedure TMapX.SearchSetting;
var
  frmSearch: TfrmSearch;
begin
  frmSearch:= TfrmSearch.Create(nil);
  frmSearch.SetBuddyMap(Self);
  try
    frmSearch.ShowModal;
  finally
    frmSearch.Free;
  end;
end;

function TMapX.GetDataSetCount: Integer;
begin
  Result:= FMap.DataSets.Count;
end;

function TMapX.GetDataSetByName(AName: string): CMapXDataSet;
begin
  Result:= FMap.DataSets.Item[AName];
end;

function TMapX.GetSearchResult(ALayer, AField, AText: string;
  SearchType: TSearchType): CMapxfeatures;
var
  SearchSQL: string;
begin
  case SearchType of
    stExact:        begin
                      AText:= '"'+AText+'"';
                      SearchSQL:= AField+' = '+AText;
                    end;
    stRightDim:     begin
                      AText:= '"'+'%'+AText+'"';
                      SearchSQL:= AField+' like '+AText;
                    end;
    stLeftDim:      begin
                      AText:= '"'+AText+'%'+'"';
                      SearchSQL:= AField+' like '+AText;
                    end;
    stArbitraryDim: begin
                      AText:= '"'+'%'+AText+'%'+'"';
                      SearchSQL:= AField+' like '+AText;
                    end;
  end; //case
  Result:= FMap.Layers.Item[ALayer].Search(SearchSQL,EmptyParam);
end;

function TMapX.GetCombinedFeature(Fs: CMapXFeatures): CMapXFeature;
var
  i: Integer;
begin
  if (Fs.Count <> 0) then
    if (Fs.Item[1].type_ = 0) or (Fs.Item[1].type_ = 1)  then
      if Fs.Count = 1 then result:= Fs.Item[1]
      else
      begin
        result:= Fs.Item[1];
        for i:= 2 to Fs.Count do
          Result:= FMap.FeatureFactory.CombineFeatures(Result,Fs.Item[i]);
      end;
end;

function TMapX.GetAnalyseResult(AnalyseType: TAnalyseType;
  SourceF: CMapXFeature; DesLyr: string; Dis: Double): CMapXFeatures;
begin
  case AnalyseType of
    atSelected:   Result:= FMap.Layers.Item[DesLyr].Selection.Clone;
    atInRegion:   Result:= FMap.Layers.Item[DesLyr].SearchWithinFeature(
                    SourceF,0);
    atAroundPoint,
    atAlongLine:  Result:= FMap.Layers.Item[DesLyr].SearchWithinDistance(
                    SourceF,Dis,0,0);
  end;
end;

function TMapX.GetAnalyseTypes(SourceFs: CMapXFeatures): TAnalyseTypes;
begin
  Result:= [];
  if (SourceFs <> nil) and (SourceFs.Count > 0) then
  begin
    Result:= Result+[atSelected];
    case SourceFs.Item[1].type_ of
      miFeatureTypeRegion : Result:= Result+[atInRegion];