[DELPHI+MAPX]专栏（只允许贴码跟贴）

希望大家能互相学习，共同进步。

[DELPHI+MAPX]专栏（只允许贴码跟贴）
var
s_sql:string;
rs:_RecordSet;
flds,fileds :CMapXFields;
dst:CMapxdataset;
//制作等级专题图的代码共享
s_sql='select filed1,filed2 from tablename';
  with ADOQuery1 do
    begin
      Close;
      sql.Clear;
      sql.add(s_sql);
      Open;
      rs:=ADOQuery1.Recordset;
      if rs.RecordCount<>0 then
       begin
         rs.MoveLast;
         fileds:= cofields.Create;
         flds := cofields.Create;
         flds.add('filed1','filed1',miAggregationAuto,0);
         flds.add('filed2','filed2',miAggregationAuto,3);
         dst:=w_gis_show.Map1.Datasets.Add(miDatasetADO,rs,emptyparam,'filed1',emptyparam,emptyparam,flds,false);
         fileds.add('filed2','filed2',miAggregationAuto, 3);
         dst.Themes.add(MiThemeGradSymbol,fileds,'filed2',emptyparam);
         dst.Themes.Item('filed2').Properties.SymbolStyle.SymbolFontShadow:=true;
         dst.Themes.Item('filed2').Properties.SymbolStyle.SymbolType:=miSymbolTypeBitmap;
         dst.Themes.Item('filed2').Properties.SymbolStyle.SymbolBitmapName:='bmpname.bmp';
         dst.Themes.Item(1).legend.title:='等级专题图';
         dst.Themes.Item(1).legend.subtitle:='图例';
         dst.Themes.Item(1).legend.ShowCount := false;
         dst.Themes.Item(1).legend.left:=1;
         dst.Themes.Item(1).legend.top:=0;
       end;
    end;

在 delphi 中紧缩表

//紧缩表
procedure PackTable(LayerName:string;SourceMap:TMap;PackMap:TMap);
var
  lyr:CMapXLayer;
  Ds:CMapXDataSet;
  LayerInfo:CMapXLayerInfo;
  TempLayerName,Path:String;
begin
Try
   TempLayerName := 'TempPackTable';
   Lyr := SourceMap.Layers.Item(LayerName);
   ds := SourceMap.Datasets.Item(LayerName);

   //选定图层的存放路径
   Path := SourceMap.Layers.Item(LayerName).Filespec;

   //创建临时表
   LayerInfo := CoLayerInfo.Create;
   LayerInfo.Type_ := miLayerInfoTypeTemp;
   LayerInfo.AddParameter ('filespec', path);
   LayerInfo.AddParameter ('Name', TempLayerName);
   LayerInfo.AddParameter ('Fields', ds.Fields);
   LayerInfo.AddParameter ('Features', lyr.AllFeatures);
   LayerInfo.AddParameter ('AutoCreateDataset', 1);
   LayerInfo.AddParameter ('datasetname', TempLayerName);

   PackMap.Layers.add (LayerInfo, 0);
   PackMap.Refresh;

   //移出图层
   SourceMap.Datasets.Remove (LayerName);
   SourceMap.Layers.Remove (LayerName);
   SourceMap.Refresh;

   //删除 Tab 表文件
   DeleteFile(Path);

   //重新绑定
   Lyr := PackMap.Layers.Item(TempLayerName);
   ds := PackMap.Datasets.Item(TempLayerName);

   //创建表
   LayerInfo := CoLayerInfo.Create;
   LayerInfo.Type_ := miLayerInfoTypeNewTable;
   LayerInfo.AddParameter ('filespec', path);
   LayerInfo.AddParameter ('Name', layername);
   LayerInfo.AddParameter ('Fields', ds.Fields);
   LayerInfo.AddParameter ('Features', lyr.AllFeatures);
   LayerInfo.AddParameter ('AutoCreateDataset', 1);
   LayerInfo.AddParameter ('datasetname', LayerName);

   SourceMap.Layers.add (LayerInfo, 0);
   SourceMap.Refresh;

   //移出图层
   PackMap.Datasets.Remove (TempLayerName);
   PackMap.Layers.Remove (TempLayerName);
   PackMap.Refresh;

except
   on E:Exception do ShowMessage(E.message);
end;

end;

[转载]
Delphi的鹰眼源码！[推荐]
unit MapNavigation;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
OleCtrls, MapXLib_TLB, ComObj, contnrs, extctrls;

type
TMapNavigation = class(TComponent)
private
FMainMap : TMap;
FNavigationMap : TMap;

FCurrentMainMapZoom : Double;

procedure SetMainMap(value : TMap);
procedure setNavigationMap(value : TMap);

procedure MapNavigationMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure MainMapViewChanged(Sender: TObject);
procedure DeleteAllFeatures(NavName : string);

protected
{ Protected declarations }
public
Constructor Create(AOwner : TComponent);override;
Destructor Destroy;Override;
Procedure Open;

published
{ Published declarations }
property MainMap : TMap read FMainMap write SetMainMap;
property Navigation : TMap read FNavigationMap write setNavigationMap ;


end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('HTGPS', [TMapNavigation]);
end;


constructor TMapNavigation.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
end;

destructor TMapNavigation.Destroy;
begin
inherited Destroy;
end;

Procedure TMapNavigation.Open;
var
newLayer : CMapXLayer;
i : integer;
flag : boolean;
begin
//如果必要，可以将导航图显示全图，主地图用默认配置显示
FCurrentMainMapZoom := MainMap.Zoom ; //主地图的初始化视野
FNavigationMap.onMouseUp := MapNavigationMouseUp;

//如果导航图层不存在则建立一个导航图层；
flag := False;
for i := 1 to Navigation.Layers.Count do
begin
if Navigation.Layers.Item(i).Name = 'NavLayer' then
flag := true;
end;
if not flag then
begin
newLayer := Navigation.Layers.CreateLayer('NavLayer',EmptyParam,EmptyParam,EmptyParam,EmptyParam);
end;
Navigation.Layers.AnimationLayer := FNavigationMap.Layers.Item('NavLayer');

//
MainMap.OnMapViewChanged := MainMapViewChanged;

end;

procedure TMapNavigation.SetMainMap(value : TMap);
begin
FMainMap := value ;
end;

procedure TMapNavigation.setNavigationMap(value : TMap);
begin
FNavigationMap := value ;
end;

procedure TMapNavigation.MapNavigationMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
X1,Y1 : single;
X_Position,Y_Position : double;
begin
//导航功能实现
X1 := X;
Y1 := Y;
FNavigationMap.ConvertCoord(X1, Y1, X_Position, Y_Position, miScreenToMap);

FMainMap.ZoomTo(FMainMap.Zoom, X_Position, Y_Position);
end;

procedure TMapNavigation.MainMapViewChanged(Sender: TObject);
var
rect: CMapXRectangle;
newPoint : CMapXpoint;
newPoints : CMapXpoints;
begin
Navigation.Layers.Item('NavLayer').Editable := False;
Navigation.Layers.AnimationLayer := Navigation.Layers.Item('NavLayer');
rect := MainMap.Bounds ;
newPoint := CoPoint.Create ;
newPoints := CoPoints.Create ;
newPoint.Set_(rect.XMin , rect.YMin );
newPoints.Add(newPoint,1);
newPoint.Set_(rect.XMax , rect.YMin );
newPoints.Add(newPoint,2);
newPoint.Set_(rect.XMax , rect.YMax );
newPoints.Add(newPoint,3);
newPoint.Set_(rect.XMin , rect.YMax );
newPoints.Add(newPoint,4);
newPoint.Set_(rect.XMin , rect.YMin );
newPoints.Add(newPoint,5);

DeleteAllFeatures('NavLayer');
Navigation.DefaultStyle.LineWidth := 2;
Navigation.DefaultStyle.LineColor := RGB(255,0,0);
Navigation.Layers.Item('NavLayer').AddFeature(Navigation.FeatureFactory.CreateLine(newPoints, Navigation.DefaultStyle), EmptyParam );

end;

procedure TMapNavigation.DeleteAllFeatures(NavName : string);
var
NewFeatures : CMapXFeatures;
i : integer;
begin
try
NewFeatures := Navigation.Layers.Item(NavName).AllFeatures;
except

end;
if NewFeatures.Count > 0 then
begin
for i := 1 to NewFeatures.Count do
Navigation.Layers.Item(NavName).DeleteFeature(NewFeatures.Item(i));
end;
end;


end.

在 delphi 中移动对象
Ftr := Lyr.Selection.Item(i);
  XE := X2 - Ftr.CenterX;
  YE := Y2 - Ftr.CenterY;
  //移动
  Ftr.Offset(XE, YE);
  Ftr.Update(EmptyParam, EmptyParam);
  Lyr.Refresh;

数据绑定的例子：(不全)
var
 BindLyr:BindLayer;
 flds :Fields ;
 rs :_RecordSet;

begin
 //生成的图层是一个点参照图层
  BindLyr:= CoBindLayer.Create;
  BindLyr.LayerType:=miBindLayerTypepointref;  
  BindLyr.RefColumn1:='mapid';
  BindLyr.ReferenceLayer:=ExtractFilePath(ParamStr(0)); //能够确定点对象的参照文件

Map1.Datasets.Add(miDatasetADO,rs,EmptyParam,'mapid',EmptyParam,BindLyr,EmptyParam,false);

end;

MAPX从ORACLE数据库中下载图层！
var     QueryString:string;
    LayerInfo:CMapxLayerInfo;
begin
 Layerinfo:=MapxLib_TLB.CoLayerInfo.Create ;
 Layerinfo.Type_:=miLayerInfoTypeServer;
 LayerInfo.AddParameter('Name','CNJSJCDXT_图层');
 LayerInfo.AddParameter('ConnectString','SRVR=superior;UID=mapx;PWD=secret');
 LayerInfo.AddParameter('Query','select * from A');
 LayerInfo.AddParameter('Toolkit','ORAINET');

 map1.Layers.Add(LayerInfo,map1.ControlInterface.Layers.Count+1);

在 delphi 中设置样式

var
   SetStyle:variant;
begin
   SetStyle:= MapStyleSetup.defaultstyle ;
   SetStyle.SymbolType:= miSymbolTypeTrueTypeFont;
   SetStyle.SymbolFont.Name:=CharacterName;
   SetStyle.SymbolCharacter:=index;
   SetStyle.SymbolFont.size:=36;
   SetStyle.SymbolFontOpaque := False;
end;

[转载]
用MapX实现Hint功能
由于程序是连的我的数据库，所以就不发整个程序了，把关键的代码贴出来给大家参考：
主窗体中的Map1MouseMove事件：
procedure TForm1.Map1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
ScreenX, ScreenY, MapX, MapY: OleVariant;
pt: Variant;
ftrs: CMapXFeatures;
Test: TPoint;
begin
ScreenX := X;
ScreenY := Y;
Map1.ConvertCoordV(ScreenX, ScreenY, MapX, MapY,miScreenToMap);
if BoolHINT then
begin
pt := CreateOleObject('MapX.Point.5');
pt.set(MapX, MapY);
Ftrs := map1.Layers[1].SearchAtPoint(pt, miSearchResultDefault);//查找地图物体
if Ftrs.count>0 then
begin
if stayinfo then
begin
if not assigned(FrmHint) then
begin
FrmHint := TFrmHint.Create(Self);//创建Hint窗体
Test.X := X;
Test.Y := Y;
Test := ClientToScreen(Test);
FrmHint.Left := Test.X ;//确定显示位置
FrmHint.Top := Test.Y-Round(frmHint.Height/2+10);
FrmHint.Show;
end;
end;
FrmHint.Label4.Caption:=Map1.DataSets['site'].value[Ftrs.Item[1],'sitename']+' ';
FrmHint.Label5.Caption:=Map1.DataSets['site'].value[Ftrs.Item[1],'siteid'];
FrmHint.Label7.Caption:=Map1.DataSets['site'].value[Ftrs.Item[1],'area']+' ';
FrmHint.Label10.Caption:=Map1.DataSets['site'].value[Ftrs.Item[1],'jd'];
FrmHint.Label11.Caption:=Map1.DataSets['site'].value[Ftrs.Item[1],'wd'];
SetFocus;
end
else if Ftrs.count=0 then
begin
if stayinfo then
begin
if assigned(FrmHint) then
begin
FrmHint.Free;
FrmHint:=nil;
end;
end;
end;
end;
end;


procedure TForm1.ToolButton1Click(Sender: TObject);
begin
if BoolHINT then
begin
ToolButton1.Down:=false;
BoolHINT:=false;
Map1.Cursor:= crDefault;
if assigned(FrmHint) then
begin
stayinfo:=true;
FrmHint.Free;
FrmHint:=nil;
end;
end
else
begin
Map1.Cursor:= crCross;
BoolHINT:=true;
ToolButton1.Down:=true
end;;
end;


以下是Hint窗体：
/author：JOJO
//Last UpDate Time: 2003/6/11
unit HintFrm;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Buttons;

type
TFrmHint = class(TForm)
Shape1: TShape;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
Panel1: TPanel;
Image1: TImage;
procedure FormShow(Sender: TObject);
procedure Image1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
procedure WMNCHittext(var M:twmnchittest);message wm_nchittest;
public
{ Public declarations }
end;

var
FrmHint: TFrmHint;
stay : boolean=true;
stayinfo:boolean=true;
oldx,oldy:integer;

implementation

{$R *.dfm}

{ TFrmHint }

procedure TFrmHint.WMNCHittext(var M: twmnchittest);
begin
inherited;
if m.Result =htclient then
begin
if stayinfo then
m.Result :=HTCAPTION
else
m.Result :=HTSYSMENU;
end;
end;

procedure TFrmHint.FormShow(Sender: TObject);
var
path:string;
begin
stay:=true;
path:=ExtractFilePath(Application.ExeName);
image1.Picture.LoadFromFile(path+'2.bmp');
stayinfo:=true;
end;

procedure TFrmHint.Image1Click(Sender: TObject);
var
path:string;
begin
path:=ExtractFilePath(Application.ExeName);
if stay then
begin
image1.Picture.LoadFromFile(path+'1.bmp');
stayinfo:=false;
end
else
begin
image1.Picture.LoadFromFile(path+'2.bmp');
stayinfo:=true;
end;
stay:=not stay;
end;

procedure TFrmHint.FormCreate(Sender: TObject);
begin
stayinfo:=true;
end;

procedure TFrmHint.FormClose(Sender: TObject; var Action: TCloseAction);
begin
stayinfo:=true;
FrmHint.Free;
FrmHint:=nil;
end;

end.

[转贴]
用Delphi实现MapX中类似AutoCAD的平滑移动的Pen工具

//类文件
unit TFlowPenClass;

interface
uses Controls,Classes,MapXLib_TLB;
type
  TFlowPen=Class(TObject)
  protected
    m_IriMouseMoveEvent:TMouseMoveEvent;
    m_IriMouseUpEvent:TMouseEvent;
    m_IriMouseDownEvent:TMouseEvent;
    m_pMap:Tmap;
    m_bMosueDown:Boolean;
    m_sPenInX:Single;
    m_sPenInY:Single;
  protected
    procedure MapMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure MapMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure MapMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  public
    Function CreateFlowPenTool(pMap:TMap):Integer;
    Function InstallFlowPenTool():Boolean;
    Function UnInstallFlowPenTool():Boolean;
    Function GetToolNum():Integer;
end;
const
  MAP_TOOL_FLOWPEN=1;
implementation

  procedure TFlowPen.MapMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  begin
    If (m_pMap.CurrentTool=MAP_TOOL_FLOWPEN) And (Not m_bMosueDown) Then
    begin
      m_bMosueDown:=True;
      m_sPenInX:=X;
      m_sPenInY:=Y;
    end;
    if @m_IriMouseDownEvent<>nil then
      m_IriMouseDownEvent(Sender,Button,Shift,X,Y);
  end;
  procedure TFlowPen.MapMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  begin
    If (m_pMap.CurrentTool=MAP_TOOL_FLOWPEN) And m_bMosueDown Then
      m_bMosueDown:=False;
    if @m_IriMouseUpEvent<>nil then
      m_IriMouseUpEvent(Sender,Button,Shift,X,Y);
  end;
procedure TFlowPen.MapMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  dX1,dX2,dY1,dY2ouble;
  sX,sY:Single;
begin
  If (m_pMap.CurrentTool=MAP_TOOL_FLOWPEN) And m_bMosueDown Then
  begin
    sX:=X;sY:=y;
    m_pMap.ConvertCoord(sX,sY,dX1,dY1,miScreenToMap);
    m_pMap.ConvertCoord(m_sPenInX,m_sPenInY,dX2,dY2,miScreenToMap);
    m_pMap.CenterX:=m_pMap.CenterX-(dX1-dX2);
    m_pMap.CenterY:=m_pMap.CenterY-(dY1-dY2);
    m_sPenInX:=X;
    m_sPenInY:=Y;
  End;
  if @m_IriMouseMoveEvent<>nil then
    m_IriMouseMoveEvent(Sender,Shift,X,Y);
end;
Function TFlowPen.CreateFlowPenTool(pMap:Tmap):Integer;
begin
    m_pMap:=pMap;
    if m_pMap<>nil then
    begin
      m_pMap.CreateCustomTool(MAP_TOOL_FLOWPEN,miToolTypePoint,miPanCursor,miPanCursor,miPanCursor);
      InstallFlowPenTool;
      result:=MAP_TOOL_FLOWPEN;
    end
    else
      result:=-1;
end;
Function TFlowPen.InstallFlowPenTool():boolean;
begin
    if m_pMap<>nil then
    begin
      m_IriMouseMoveEvent:=m_pMap.OnMouseMove;
      m_IriMouseUpEvent:=m_pMap.OnMouseUp;
      m_IriMouseDownEvent:=m_pMap.OnMouseDown;
      m_pMap.OnMouseMove:=MapMouseMove;
      m_pMap.OnMouseUp:=MapMouseUp;
      m_pMap.OnMouseDown:=MapMouseDown;
      m_bMosueDown:=False;
      result:=True;
    end
    else
      result:=False;
end;
Function TFlowPen.UnInstallFlowPenTool():Boolean;
begin
    if m_pMap<>nil then
    begin
      m_pMap.OnMouseMove:=m_IriMouseMoveEvent;
      m_pMap.OnMouseUp:=m_IriMouseUpEvent;
      m_pMap.OnMouseDown:=m_IriMouseDownEvent;
      m_IriMouseMoveEvent:=nil;
      m_IriMouseUpEvent:=nil;
      m_IriMouseDownEvent:=nil;
      m_pMap:=nil;
      result:=True;
    end
    else
      result:=False;
end;
Function TFlowPen.GetToolNum():Integer;
begin
  result:=MAP_TOOL_FLOWPEN;
end;
end.

//使用时初试化
  m_FlowPenTool:=TFlowPen.Create;
  m_FlowPenTool.CreateFlowPenTool(Map1);
//开始使用FlowPen
Map1.CurrentTool:=m_FlowPenTool.GetToolNum();

//MapX.RedrawInterval设置为30或更大效果会比较好