robbies
路人甲
路人甲
  • 注册日期2004-05-11
  • 发帖数16
  • QQ
  • 铜币210枚
  • 威望0点
  • 贡献值0点
  • 银元0个
50楼#
发布于:2004-05-13 14:06
<P>在delphi中怎么样实现gis中的i功能呀?</P>
刚刚接触gis,还请各位多多指教!
举报 回复(0) 喜欢(0)     评分
gmc78
路人甲
路人甲
  • 注册日期2003-08-17
  • 发帖数25
  • QQ
  • 铜币234枚
  • 威望0点
  • 贡献值0点
  • 银元0个
51楼#
发布于:2004-03-17 15:44
真是爽,让俺少走了弯路,常来!!!!!!!!
举报 回复(0) 喜欢(0)     评分
frankmei
路人甲
路人甲
  • 注册日期2004-02-02
  • 发帖数149
  • QQ
  • 铜币402枚
  • 威望0点
  • 贡献值0点
  • 银元0个
52楼#
发布于:2004-03-12 15:33
thanks
举报 回复(0) 喜欢(0)     评分
glwshch
路人甲
路人甲
  • 注册日期2004-01-04
  • 发帖数67
  • QQ
  • 铜币299枚
  • 威望0点
  • 贡献值0点
  • 银元0个
53楼#
发布于:2004-02-16 20:43
目前我还没有得到MapX只能陪大家走了
举报 回复(0) 喜欢(0)     评分
echo2003
点子王
点子王
  • 注册日期2003-07-28
  • 发帖数2453
  • QQ76947571
  • 铜币5473枚
  • 威望1点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
54楼#
发布于:2003-12-29 15:43
用Delphi实现MapX中类似AutoCAD的平滑移动的Pen工具
[转贴]
用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或更大效果会比较好
举报 回复(0) 喜欢(0)     评分
echo2003
点子王
点子王
  • 注册日期2003-07-28
  • 发帖数2453
  • QQ76947571
  • 铜币5473枚
  • 威望1点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
55楼#
发布于:2003-12-29 14:16
[转载]
用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.
举报 回复(0) 喜欢(0)     评分
xiaonai
路人甲
路人甲
  • 注册日期2003-11-27
  • 发帖数87
  • QQ
  • 铜币418枚
  • 威望0点
  • 贡献值0点
  • 银元0个
56楼#
发布于:2003-12-29 11:51
在 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;
举报 回复(0) 喜欢(0)     评分
echo2003
点子王
点子王
  • 注册日期2003-07-28
  • 发帖数2453
  • QQ76947571
  • 铜币5473枚
  • 威望1点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
57楼#
发布于:2003-12-24 16:43
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);
举报 回复(0) 喜欢(0)     评分
xiaonai
路人甲
路人甲
  • 注册日期2003-11-27
  • 发帖数87
  • QQ
  • 铜币418枚
  • 威望0点
  • 贡献值0点
  • 银元0个
58楼#
发布于:2003-12-23 13:16
数据绑定的例子:(不全)
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;

举报 回复(0) 喜欢(0)     评分
xiaonai
路人甲
路人甲
  • 注册日期2003-11-27
  • 发帖数87
  • QQ
  • 铜币418枚
  • 威望0点
  • 贡献值0点
  • 银元0个
59楼#
发布于:2003-12-23 12:55
在 delphi 中移动对象
Ftr := Lyr.Selection.Item(i);
  XE := X2 - Ftr.CenterX;
  YE := Y2 - Ftr.CenterY;
  //移动
  Ftr.Offset(XE, YE);
  Ftr.Update(EmptyParam, EmptyParam);
  Lyr.Refresh;


举报 回复(0) 喜欢(0)     评分
游客

返回顶部