50楼#
发布于:2004-05-13 14:06
<P>在delphi中怎么样实现gis中的i功能呀?</P>
|
|
|
51楼#
发布于:2004-03-17 15:44
真是爽,让俺少走了弯路,常来!!!!!!!!
|
|
52楼#
发布于:2004-03-12 15:33
thanks
|
|
53楼#
发布于:2004-02-16 20:43
目前我还没有得到MapX只能陪大家走了
|
|
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或更大效果会比较好 |
|
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. |
|
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; |
|
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); |
|
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; |
|
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; |
|