mapx.~pas

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

      miFeatureTypeLine   : Result:= Result+[atAlongLine];
      miFeatureTypeSymbol : if SourceFs.Count = 1 then
                              Result:= Result+[atAroundPoint] ;
    end;
  end;
end;

procedure TMapX.AnalyseSetting(AnalyseType: TAnalyseType);
var
  frmAnalyse: TfrmAnalyse;
begin
  frmAnalyse:= TfrmAnalyse.Create(nil);
  frmAnalyse.SetBuddyMap(Self);
  frmAnalyse.AnalyseType:= AnalyseType;
  frmAnalyse.SourceFs:= FMap.Layers.Item[FWorkLayer].Selection.Clone;
  try
    frmAnalyse.ShowModal;
  finally
    frmAnalyse.Free;
  end;
end;

function TMapX.GetLayerSelection(ALayer: string): CMapXFeatures;
begin
  Result:= nil;
  if LayerExist(ALayer) then
    Result:= FMap.Layers.Item[ALayer].Selection.Clone;
end;

function TMapX.GetMapHandle: HWND;
begin
  Result:= FMap.Handle;
end;

procedure TMapX.SetLayerKeyField(ALayer, AField: string);
begin
  FMap.Layers.Item[ALayer].KeyField:= AField;
end;

function TMapX.GetLayerByName(AName: string): CMapXLayer;
begin
  Result:= FMap.Layers.Item[AName];
end;

{ TMapXToolObject }

constructor TMapXToolObject.Create(const Sender: TMapX);
begin
  FMapX:= Sender;
end;

{ TMapXSelectToolObject }

procedure TMapXSelectToolObject.Execute;
begin
  inherited;
  if FMapX.LayerSelectable(FMapX.WorkLayer) then
    FEnable:= True
  else begin
    FEnable:= False;
    if not FMapX.FMap.Layers.Item[FMapX.WorkLayer].Visible then
      MessageDlg('请确认该图层处于可视状态！', mtInformation, [mbOk], 0)
    else
      MessageDlg('请确认该图层处于可选择状态！', mtInformation, [mbOk], 0);
  end;
end;

{ TMapXPointSelectToolObject }

procedure TMapXPointSelectToolObject.Execute(X1, Y1: Double);
var
  MyPoint: CMapXPoint;
begin
  inherited Execute;
  if FEnable then
  begin
    MyPoint:= CoPoint.Create;
    MyPoint.Set_(X1,Y1);
    FSelection:= FMapX.FMap.Layers.Item[FMapX.WorkLayer].SearchAtPoint(
                               MyPoint,miSearchResultDefault);
  end;
end;

{ TPointSelectTool }

constructor TPointSelectTool.Create(const Sender: TMapX);
begin
  inherited;
  FMapX.FMap.CreateCustomTool(Ord(mttPointSelectTool), miToolTypePoint, miSelectCursor);
  FToolType:= mttPointSelectTool;
end;

procedure TPointSelectTool.Execute(X1, Y1: Double; Shift, Ctrl: WordBool);
begin
  inherited Execute(X1,Y1);
  if FEnable then
    FMapX.SetLayerSelection(Shift, Ctrl, FSelection, FMapX.WorkLayer);
end;

{ TRadiusSelectTool }

constructor TRadiusSelectTool.Create(const Sender: TMapX);
begin
  inherited;
  FMapX.FMap.CreateCustomTool(Ord(mttRadiusSelectTool), miToolTypeCircle, miRadiusSelectCursor);
  FToolType:= mttRadiusSelectTool;
end;

procedure TRadiusSelectTool.Execute(X1, Y1, Distance: Double; Shift,
  Ctrl: WordBool);
var
  MyPoint: CMapXPoint;
begin
  inherited Execute;
  if FEnable then
  begin
    MyPoint:= CoPoint.Create;
    MyPoint.Set_(X1,Y1);
    FSelection:= FMapX.FMap.Layers.Item[FMapX.WorkLayer].SearchWithinDistance(
                  MyPoint,Distance,miUnitKilometer,miSearchTypeCentroidWithin);
    FMapX.SetLayerSelection(Shift, Ctrl, FSelection, FMapX.WorkLayer);
  end;
end;

{ TRectSelectTool }

constructor TRectSelectTool.Create(const Sender: TMapX);
begin
  inherited;
  FMapX.FMap.CreateCustomTool(Ord(mttRectSelectTool), miToolTypeMarquee, miRectSelectCursor);
  FToolType:= mttRectSelectTool;
end;

procedure TRectSelectTool.Execute(X1, Y1, X2, Y2: Double; Shift,
  Ctrl: WordBool);
var
  MyRect: CMapXRectangle;
begin
  inherited Execute;
  if FEnable then
  begin
    MyRect:= CoRectangle.Create;
    MyRect.Set_(X1,Y1,X2,Y2);
    FSelection:= FMapX.FMap.Layers.Item[FMapX.WorkLayer].SearchWithinRectangle(
                               MyRect,miSearchTypeCentroidWithin);
    FMapX.SetLayerSelection(Shift, Ctrl, FSelection, FMapX.WorkLayer);
  end;
end;

{ TPolygonSelectTool }

constructor TPolygonSelectTool.Create(const Sender: TMapX);
begin
  inherited;
  FMapX.FMap.CreateCustomTool(Ord(mttPolygonSelectTool), miToolTypePolygon, miRegionSelectCursor);
  FToolType:= mttPolygonSelectTool;
end;

procedure TPolygonSelectTool.Execute(const Points: IDispatch; Shift,
  Ctrl: WordBool);
var
  Region: CMapXFeature;
  Style: CMapXStyle;
begin
  Style := FMapX.FMap.DefaultStyle.Clone;
  Region:= FMapX.FMap.FeatureFactory.CreateRegion(Points, Style);
  FSelection:= FMapX.FMap.Layers.Item[FMapX.WorkLayer].SearchWithinFeature(
             Region, miSearchTypeCentroidWithin);
  FMapX.SetLayerSelection(Shift, Ctrl, FSelection, FMapX.WorkLayer);
end;

{ TRulerTool }

constructor TRulerTool.Create(const Sender: TMapX);
begin
  inherited;
  FMapX.FMap.CreateCustomTool(Ord(mttRulerTool), miToolTypePoly, miCrossCursor);
  FToolType:= mttRulerTool;
  FfrmRuler:= TfrmRuler.Create(nil);
end;

destructor TRulerTool.Destroy;
begin
  FfrmRuler.Free;
  inherited;
end;

procedure TRulerTool.Execute(X, Y: Integer; Button: TMouseButton;
  Mode: TMouseMode);
var
  X1,Y1: Single;
begin
  inherited;
  X1:= X/1.0; Y1:= Y/1.0;
  FMapX.FMap.MapUnit:= miUnitKilometer;
  if (Mode = mmDown) and (Button = mbLeft) then
  begin
    FMapX.FMap.ConvertCoord(X1,Y1,FXDown,FYDown,miScreenToMap);
    if FRulerMode = rmFinished then
      FRulePastDistance:=0;
    FRulerMode:= rmProcessing;
    FRulePastDistance:= FRulePastDistance+FRuleCurrDistance;
    FfrmRuler.Visible:= True;
  end;

  if (Mode = mmMove) and (FRulerMode = rmProcessing) then
  begin
    FMapX.FMap.ConvertCoord(X1,Y1,FXMove,FYMove,miScreenToMap);
    FRuleCurrDistance:= FMapX.FMap.Distance(FXDown, FYDown, FXMove,FYMove);
    FfrmRuler.Edit1.Text:= FloatToStr(FRuleCurrDistance);
    FfrmRuler.Edit2.Text:= FloatToStr(FRuleCurrDistance+FRulePastDistance);
  end;
end;

{ TAreaTool }

constructor TAreaTool.Create(const Sender: TMapX);
begin
  inherited;
  FMapX.FMap.CreateCustomTool(Ord(mttAreaTool), miToolTypePoly, miCrossCursor);
  FToolType:= mttAreaTool;
  FfrmArea:= TfrmArea.Create(nil);
end;

destructor TAreaTool.Destroy;
begin
  FfrmArea.Free;
  inherited;
end;

procedure TAreaTool.Execute(const Points: IDispatch);
var
  i: Integer;
  Region: CMapXFeature;
  Style: CMapXStyle;
  LastSec: Double; //周长中首尾点的长度。周长= FGirth+ LastSec。
begin
  inherited;
  FMapX.FMap.MapUnit:= miUnitKilometer;
  FMapX.FMap.AreaUnit:= miUnitSquareKilometer;
  //无周长，无面积
  if CMapxParts(Points).Count = 1 then
  begin
    FGirth:= 0;
    FArea:= 0;
  end;
  //有周长
  if CMapxPoints(Points).Count >= 2 then
  begin
    FGirth:= FGirth+FMapX.FMap.Distance(CMapxPoints(Points).Item[CMapxPoints(Points).Count].X,
                                  CMapxPoints(Points).Item[CMapxPoints(Points).Count].Y,
                                  CMapxPoints(Points).Item[CMapxPoints(Points).Count-1].X,
                                  CMapxPoints(Points).Item[CMapxPoints(Points).Count-1].Y);
    if CMapxPoints(Points).Count > 2 then
      LastSec:=     FMapX.FMap.Distance(CMapxPoints(Points).Item[CMapxPoints(Points).Count].X,
                                  CMapxPoints(Points).Item[CMapxPoints(Points).Count].Y,
                                  CMapxPoints(Points).Item[1].X,
                                  CMapxPoints(Points).Item[1].Y);
  end;
  //有面积
  if CMapxParts(Points).Count >= 3 then
  begin
    Style := FMapX.FMap.DefaultStyle.Clone;
    Region:= FMapX.FMap.FeatureFactory.CreateRegion(Points, Style);
    FArea:= Region.Area;
  end;
  FfrmArea.Edit1.Text:= FloatToStr(FGirth+LastSec);
  FfrmArea.Edit2.Text:= FloatToStr(FArea);
  FfrmArea.Visible:= True;
end;

{ TLabelTool }

constructor TLabelTool.Create(const Sender: TMapX);
begin
  inherited;
  FMapX.FMap.CreateCustomTool(Ord(mttLabelTool), miToolTypePoint, miCrossCursor);
  FToolType:= mttLabelTool;
end;

procedure TLabelTool.Execute(X1, Y1: Double);
begin
  inherited;
  if Assigned(FSelection) then
    if FSelection.Count > 0 then
      FMapX.FMap.Layers.Item[FMapX.WorkLayer].LabelAtPoint(X1,Y1);
end;

{ TInforTool }

constructor TInforTool.Create(const Sender: TMapX);
begin
  inherited;
  FMapX.FMap.CreateCustomTool(Ord(mttInforTool), miToolTypePoint, miCrossCursor);
  FToolType:= mttInforTool;
  FfrmInfor:= TfrmInfor.Create(nil);
end;

destructor TInforTool.Destroy;
begin
  FfrmInfor.Free;
  inherited;
end;

procedure TInforTool.Execute(X1, Y1: Double);
var
  i: Integer;
  FieldName, FieldValue: string;
begin
  inherited;
  if FEnable then
  begin
    FfrmInfor.ValueListEditor1.Strings.Clear;
    if FSelection.Count > 0 then
    begin
      FMapX.BindLayerData(FMapX.WorkLayer);
      for i:= 1 to FMapX.FMap.Datasets.Item[FMapX.WorkLayer].Fields.Count do
      begin
        FieldName:= FMapX.FMap.Datasets.Item[FMapX.WorkLayer].Fields.Item[i].Name;
        //只取第一个对象信息
        if FMapX.FMap.Datasets.Item[FMapX.WorkLayer].Value[FSelection.item[1],i] <> null then
          FieldValue:= string(FMapX.FMap.Datasets.Item[FMapX.WorkLayer].Value[FSelection.Item[1],i]);
        FfrmInfor.ValueListEditor1.InsertRow(FieldName,FieldValue,True);
      end; // for i
      FfrmInfor.Label1.Caption:= '1个对象';
    end  // if FSelection
    else FfrmInfor.Label1.Caption:= '0个对象';
    FfrmInfor.Visible:= True;
  end; // if FEnable
end;

{ TMapXTheme }

constructor TMapXTheme.Create(const Sender: TMapX);
begin
  FMapX:= Sender;
  FFeatureIDList:= TStringList.Create;
end;

destructor TMapXTheme.Destroy;
begin
  FFeatureIDList.Free;                
  inherited;
end;

procedure TMapXTheme.LoadFromStream(AStream: TStream);
begin

end;

procedure TMapXTheme.SaveToStream(var Stream);
begin

end;

procedure TMapXTheme.CreateLayerTheme(ALayer: string;
  FeatureIDs: TStringList);
begin

end;


{ THawkMap }

constructor THawkMap.Create(AOwner: TComponent);
begin
  inherited;
  CurrentTool:= mttRectSelectTool;
end;

procedure THawkMap.MapXOnToolUsed(ASender: TObject; ToolNum: Smallint; X1,
  Y1, X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
  var EnableDefault: WordBool);
var
  rcDrag: CMapxRectangle;
begin
  if ToolNum = Ord(mttRectSelectTool)then
  begin
    rcDrag:=CoRectangle.Create;
    rcDrag.Set_(X1, Y1, X2, Y2);
    if Assigned(FBuddyMapX) then
      FBuddyMapX.FMap.Bounds:= rcDrag;
  end;
end;

procedure THawkMap.MapXOnMapViewChanged(Sender: TObject);
var
  Style: CMapxStyle;
  Pts:CMapxPoints;
  Rect: CMapXRectangle;
begin
  if Not LayerExist('HawkLayer') then
  begin
    FMap.Layers.CreateLayer('HawkLayer',EmptyParam,EmptyParam,EmptyParam,EmptyParam);
    FMap.Layers.Item['HawkLayer'].Editable:= true;
  end;
  if FMap.Layers.Item['HawkLayer'].AllFeatures.Count > 0 then
    FMap.Layers.Item['HawkLayer'].DeleteFeature(FMap.Layers.Item['HawkLayer'].AllFeatures.Item[1]);
  Rect:= FBuddyMapX.FMap.Bounds;
  pts:= CoPoints.Create;
  pts.AddXY(Rect.XMin,Rect.YMin,Emptyparam);
  pts.AddXY(Rect.XMax,Rect.YMin,Emptyparam);
  pts.AddXY(Rect.XMax,Rect.YMax,Emptyparam);
  pts.AddXY(Rect.XMin,Rect.YMax,Emptyparam);
  Style:= coStyle.Create;
  with Style do
  begin
    RegionBorderWidth:=1;
    RegionBorderColor:= clRed;
    RegionTransparent:= True;
    RegionPattern:= miPatternNoFill;
  end;
  FMap.Layers.Item['HawkLayer'].AddFeature(FMap.FeatureFactory.CreateRegion(Pts,Style),EmptyParam);
end;

procedure THawkMap.SetBuddyMap(AMapX: TMapX);
begin
  if FBuddyMapX <> nil then
     FBuddyMapX.FMap.OnMapViewChanged:= nil;
  if FBuddyMapX <> AMapX then
  begin
    FBuddyMapX:= AMapX;
    FBuddyMapX.FMap.OnMapViewChanged:= MapXOnMapViewChanged;
    MapXOnMapViewChanged(FBuddyMapX);
  end;
end;

procedure THawkMap.SetFileName(const Value: string);
begin
  inherited;
  FMap.Title.Visible:= False;
end;






initialization


finalization
  if hToolTip <> 0 then
    DestroyWindow(hToolTip);
end.

end.