mapxcontainer.pas

此代码是关于mapgis的在

  Shift: TShiftState; X, Y: Integer);
var
  i:Integer;
  pProc:TMouseEvent;
begin
  for i:=0 to FMouseUpEventProces.Count-1 do
  begin
    pProc:=TMouseEvent(FMouseUpEventProces.Items[i].Method);
    pProc(Sender, Button, Shift, X, Y);
  end;
end;

procedure TMapManager.DoMouseWheel(ASender: TObject; Flags: Integer;
  zDelta: Smallint; var X, Y: Single; var EnableDefault: WordBool);
var
  i:Integer;
  pProc:TMapXObjectMouseWheel;
begin
  for i:=0 to FMouseWheelEventProces.Count-1 do
  begin
    pProc:=TMapXObjectMouseWheel(FMouseWheelEventProces.Items[i].Method);
    pProc(ASender, Flags, zDelta, X, Y, EnableDefault);
  end;
end;

procedure TMapManager.DoRequestData(ASender: TObject;
  const DataSetName: WideString; Row: Integer; Field: Smallint;
  var Value: OleVariant; var Done: WordBool);
var
  i:Integer;
  pProc:TMapXObjectRequestData;
begin
  for i:=0 to FRequestDataEventProces.Count-1 do
  begin
    pProc:=TMapXObjectRequestData(FRequestDataEventProces.Items[i].Method);
    pProc(ASender, DataSetName, Row, Field, Value, Done);
  end;
end;

procedure TMapManager.DoResolveDataBind(ASender: TObject; Flag,
  NumMatches: Smallint; Matches: OleVariant; var Choice: Smallint;
  var Cancel: WordBool);
var
  i:Integer;
  pProc:TMapXObjectResolveDataBind;
begin
  for i:=0 to FResolveDataBindEventProces.Count-1 do
  begin
    pProc:=TMapXObjectResolveDataBind(FResolveDataBindEventProces.Items[i].Method);
    pProc(ASender, Flag, NumMatches, Matches, Choice, Cancel);
  end;
end;

procedure TMapManager.DoResolveDataBindEx(ASender: TObject; Flag,
  NumMatches: Smallint; Matches: OleVariant; var Choice: Smallint;
  var Cancel: WordBool);
var
  i:Integer;
  pProc:TMapXObjectResolveDataBindEx;
begin
  for i:=0 to FResolveDataBindExEventProces.Count-1 do
  begin
    pProc:=TMapXObjectResolveDataBindEx(FResolveDataBindExEventProces.Items[i].Method);
    pProc(ASender, Flag, NumMatches, Matches, Choice, Cancel);
  end;
end;

procedure TMapManager.DoSelectionChanged(Sender: TObject);
var
  i:Integer;
  pProc:TNotifyEvent;
begin
  for i:=0 to FSelectionChangedEventProces.Count-1 do
  begin
    pProc:=TNotifyEvent(FSelectionChangedEventProces.Items[i].Method);
    pProc(Sender);
  end;
end;

procedure TMapManager.DoThemeModifyRequested(ASender: TObject;
  const Theme: IDispatch);
var
  i:Integer;
  pProc:TMapXObjectThemeModifyRequested;
begin
  for i:=0 to FThemeModifyRequestedEventProces.Count-1 do
  begin
    pProc:=TMapXObjectThemeModifyRequested(FThemeModifyRequestedEventProces.Items[i].Method);
    pProc(ASender, Theme);
  end;
end;

procedure TMapManager.DoToolUsed(ASender: TObject; ToolNum: Smallint; X1,
  Y1, X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
  var EnableDefault: WordBool);
var
  i:Integer;
  pProc:TMapXObjectToolUsed;
begin
  for i:=0 to FToolUsedEventProces.Count-1 do
  begin
    pProc:=TMapXObjectToolUsed(FToolUsedEventProces.Items[i].Method);
    pProc(ASender, ToolNum, X1, Y1, X2, Y2, Distance, Shift, Ctrl, EnableDefault);
  end;
end;

procedure TMapManager.DoStartDrag(Sender: TObject;
  var DragObject: TDragObject);
var
  i:Integer;
  pProc:TStartDragEvent;
begin
  for i:=0 to FStartDragEventProces.Count-1 do
  begin
    pProc:=TStartDragEvent(FStartDragEventProces.Items[i].Method);
    pProc(Sender, DragObject);
  end;
end;

procedure TMapManager.RegisterEventProc(Obj:TObject; const P: Pointer;
  const TypeId:Integer);
var
  aMethodList:TObjectMethodList;
begin
  aMethodList:=TypeIdToListInstance(TypeId);
  if aMethodList<>nil then
    aMethodList.AddAndInit(TypeId, Obj, P);
end;

procedure TMapManager.UnRegisterEventProc(Obj:TObject; const P: Pointer;
  const TypeId:Integer);
var
  Index:Integer;
  aMethodList:TObjectMethodList;
begin
  aMethodList:=TypeIdToListInstance(TypeId);
  if aMethodList<>nil then
  begin                  
    Index:=aMethodList.IndexOf(Obj, P);
    aMethodList.Delete(Index);
  end;
end;

procedure TMapManager.ViewLayerMap(aLayer:CMapXLayer);
begin
  GoToLayer(MapX, aLayer);
end;

procedure TMapManager.DoAddFeatureToolUsed(ASender: TObject;
  ToolNum: Smallint; Flags: Integer; const Feature: IDispatch; bShift,
  bCtrl: WordBool; var EnableDefault: WordBool);
var
  i:Integer;
  pProc:TMapXObjectAddFeatureToolUsed;
begin
  for i:=0 to FAddFeatureToolUsedEventProces.Count-1 do
  begin
    pProc:=TMapXObjectAddFeatureToolUsed(FAddFeatureToolUsedEventProces.Items[i].Method);
    pProc(ASender, ToolNum, Flags, Feature, bShift, bCtrl, EnableDefault);
  end;
end;

procedure TMapManager.DoAnnotationAdded(ASender: TObject;
  const Annotation: IDispatch);
var
  i:Integer;
  pProc:TMapXObjectAnnotationAdded;
begin
  for i:=0 to FAnnotationAddedEventProces.Count-1 do
  begin
    pProc:=TMapXObjectAnnotationAdded(FAnnotationAddedEventProces.Items[i].Method);
    pProc(ASender, Annotation);
  end;
end;

procedure TMapManager.DoAnnotationChanged(ASender: TObject;
  ChangeType: Smallint; const Annotation: IDispatch;
  var EnableDefault: WordBool);
var
  i:Integer;
  pProc:TMapXObjectAnnotationChanged;
begin
  for i:=0 to FAnnotationChangedEventProces.Count-1 do
  begin
    pProc:=TMapXObjectAnnotationChanged(FAnnotationChangedEventProces.Items[i].Method);
    pProc(ASender, ChangeType, Annotation, EnableDefault);
  end;
end;

procedure TMapManager.DoClick(Sender: TObject);
begin
  FClickEventProces.Free;
end;

procedure TMapManager.DoDataMismatch(ASender: TObject;
  const DataSetName: WideString; Row: Integer;
  var GeoFieldValue: WideString);
var
  i:Integer;
  pProc:TMapXObjectDataMismatch;
begin
  for i:=0 to FDataMismatchEventProces.Count-1 do
  begin
    pProc:=TMapXObjectDataMismatch(FDataMismatchEventProces.Items[i].Method);
    pProc(ASender, DataSetName, Row, GeoFieldValue);
  end;
end;

procedure TMapManager.DoDblClick(Sender: TObject);
var
  i:Integer;
  pProc:TNotifyEvent;
begin
  for i:=0 to FDblClickEventProces.Count-1 do
  begin
    pProc:=TNotifyEvent(FDblClickEventProces.Items[i].Method);
    pProc(Sender);
  end;
end;

function TMapManager.TypeIdToListInstance(
  const TypeId: Integer): TObjectMethodList;
begin
  case TypeId of
    PROC_DRAWUSERLAYER:     Result:=FDrawUserLayerEventProces;
    PROC_MOUSEDOWN:         Result:=FMouseDownEventProces;
    PROC_MOUSEMOVE:         Result:=FMouseMoveEventProces;
    PROC_MOUSEUP:           Result:=FMouseUpEventProces;
    PROC_TOOLUSED:          Result:=FToolUsedEventProces;
    PROC_DBLCLICK:          Result:=FDblClickEventProces;
    PROC_SELECTIONCHANGED:  Result:=FSelectionChangedEventProces;
    else                    Result:=nil;
  end;
end;

procedure TMapManager.ToMapPoint(const vX, vY: Integer; var mX,
  mY: Double);
var
  ScreenX:Single;
  ScreenY:Single;
begin
  ScreenX:=vX;
  ScreenY:=vY;
  MapX.ConvertCoord(ScreenX, ScreenY, mX, mY, miScreenToMap);
end;

procedure TMapManager.ToViewPoint(const mX, mY: Double; var vX,
  vY: Integer);
var
  Map_X:Double;
  Map_Y:Double;
  ScreenX:Single;
  ScreenY:Single;
begin
  Map_X:=mX;
  Map_Y:=mY;
  MapX.ConvertCoord(ScreenX, ScreenY, Map_X, Map_Y, miMapToScreen);
  vX:=Round(ScreenX);
  vY:=Round(ScreenY);
end;

function TMapManager.GetStyleByUserId(UserId: Integer): Style;
var
  aItem:TBaseStyleInfo;
begin
  if UserId<0 then begin
    case UserId of
      STYLE_MAPDEFAULTSTYLE: Result := MapX.Defaultstyle;
      STYLE_TRACKLINGLINE,
      STYLE_WHOLELINE:   Result := SysStyles.FindByUserID(UserId).CreateStyleInterfaceObject;
      else                   Result := nil;
    end;
  end
  else begin
    aItem := UserStyles.FindByUserID(UserId);
    if aItem<>nil then
      Result := aItem.CreateStyleInterfaceObject
    else
      Result := MapX.Defaultstyle;
  end;
end;

procedure TMapManager.ClearClipboard;
begin
  
end;

procedure TMapManager.SaveMapAsGeoset(const FileName: string);
begin
  if Trim(FileName)='' then
    raise Exception.Create('无法保存Geoset，为文件名不能为空！');
  try
    FMapX.SaveMapAsGeoset('', FileName);
  except
  end;
end;

function TMapManager.GetFeatureEditMode: TFeatureEditMode;
begin
  case FMapX.FeatureEditMode of
    miEditModeFeature:        Result:=emFeature;
    miEditModeNode:           Result:=emNode;
    miMoveDuplicateNodes:     Result:=emMoveDuplicateNodes;
    miDeleteDuplicateNodes:   Result:=emDeleteDuplicateNodes;
    miEditModeAddNode:        Result:=emEditModeAddNode;
    else                      Result:=emFeature;
  end;
end;

procedure TMapManager.SetFeatureEditMode(const Value: TFeatureEditMode);
begin
  case Value of
    emFeature:                FMapX.FeatureEditMode:=miEditModeFeature;
    emNode:                   FMapX.FeatureEditMode:=miEditModeNode;
    emMoveDuplicateNodes:     FMapX.FeatureEditMode:=miMoveDuplicateNodes;
    emDeleteDuplicateNodes:   FMapX.FeatureEditMode:=miDeleteDuplicateNodes;
    emEditModeAddNode:        FMapX.FeatureEditMode:=miEditModeAddNode;
  end;
end;

function TMapManager.InSelectMode: Boolean;
begin
  case FMapX.CurrentTool of
    miSelectTool, miRadiusSelectTool,
    miRectSelectTool, miPolygonSelectTool:begin
      Result:=True;
    end;
    else begin
      Result:=False;
    end;
  end;
end;

procedure TMapManager.ViewGlobalMap;
begin
  GoToLayers(MapX);
end;

procedure TMapManager.ViewInitMap;
begin
//  MapX.ZoomTo(IniMapZoom, IniMapZoomPosX, IniMapZoomPosY);
end;

procedure TMapManager.ViewBeforeMap;
begin
//  MapX.ZoomTo(PrevMapZoom, PrevMapZoomPosX, PrevMapZoomPosY);
end;

procedure TMapManager.DoDrawUserLayer(ASender: TObject;
  const Layer: IDispatch; hOutputDC, hAttributeDC: Cardinal;
  const RectFull, RectInvalid: IDispatch);
var
  i:Integer;
  pProc:TMapXObjectDrawUserLayer;
begin
  for i:=0 to FDrawUserLayerEventProces.Count-1 do
  begin
    pProc:=TMapXObjectDrawUserLayer(FDrawUserLayerEventProces.Items[i].Method);
    pProc(ASender, Layer, hOutputDC, hAttributeDC, RectFull, RectInvalid);
  end;
end;

procedure TMapManager.ViewFeatureClass(AGroup: TFeatureClass);
begin

end;

procedure TMapManager.ClearSelection;
begin
  MapXAPIs.ClearSelection(MapX);
end;

procedure TMapManager.SelectAll;
begin
  MapXAPIs.SelectAll(MapX);
end;

procedure TMapManager.InvertSelection;
begin
  MapXAPIs.InvertSelection(MapX);
end;

procedure TMapManager.SaveMapAsImage(ImageCfg:TMapImageConfig);
begin
  MapX.PaperUnit:=ImageCfg.PaperUnit;
  MapX.ExportMap(ImageCfg.FileName, Ord(ImageCfg.Format), ImageCfg.Width, ImageCfg.Height);
end;

procedure TMapManager.LoadMapFromGeoset(const FileName: string);
begin
  FMapX.GeoSet:=FileName;
end;

function TMapManager.ToMapLength(const Len:Integer): Double;
var
  X1, Y1, X2, Y2:Double;
begin
  ToMapPoint(MapX.ClientOrigin.X, MapX.ClientOrigin.Y, X1, Y1);
  ToMapPoint(MapX.ClientOrigin.X+Len, MapX.ClientOrigin.Y, X2, Y2);
  Result:=MapX.Distance(X1, Y1, X2, Y2);
end;

function TMapManager.GetToolObjectByToolId(
  const aToolId: Integer): TBaseMapTool;
begin
  Result:=Self.SysTools.FindByToolId(aToolId);
  if Result=nil then
    Result:=Self.UserTools.FindByToolId(aToolId);