GSM网优 mapinfo程序.docx

GSM网优 mapinfo程序.docx

《GSM网优 mapinfo程序.docx》由会员分享，可在线阅读，更多相关《GSM网优 mapinfo程序.docx（22页珍藏版）》请在冰豆网上搜索。

GSM网优mapinfo程序

include"mapbasic.def"

include"icons.def"

declaresubmain

declaresubtool_sub

DeclareSubToolHandler

DeclareFunctionExecuteLib"TestDllCdd.dll"（strpicasstring）Asinteger

'添加菜单功能

declaresubsearchmapinfoXY

declaresubendapp

declaresubnewmap

declaresubAddLayer

declaresubSearchRoad

declaresubBindBasic

declaresubZhuanTiTu

declaresubCoverPoint

declaresubQuantitypoint

declaresubExcelPoint

DeclaresubCallTDF

DeclareFunctionXLS_ImportTab（ByValsXLSAsString,ByValsTabAsString）AsLogical

DeclareFunctionXLS_A1Cell（ByValnColAsInteger,ByValnRowAsInteger）AsString

Dims_searchforasstring

Dima（10）asinteger

'-------------------------------------------------------------------------

submain

createbuttonpad"查询工具"as

toolbuttoncallingtool_subid1

iconmi_icon_arrow

cursormi_cursor_arrow

'drawmodedm_custon_point

helpmsg"地图窗口中单击\n单击一位置"

separator

toolbuttoncallingtool_subid2

iconmi_icon_search_rect

cursormi_cursor_finger_left

drawmodedm_custom_rect

helpmsg"在地图窗口中绘制一矩形\n绘制一矩形"

width3

IfButtonPadInfo（"查询工具",BTNPAD_INFO_FLOATING）Then

AlterButtonPad"查询工具"ToolbarPosition（1,5）Fixed

endif

altermenubaradd"新增功能"

altermenu"新增功能"add"（-"

"查找道路"callingSearchRoad

"导入Excel文件创建点"callingExcelPoint

"一键创建扫频专题图功能"callingZhuanTiTu

"一键创建质量专题图功能"callingQuantitypoint

"一键创建覆盖专题图功能"callingCoverPoint

"查找TD频点"callingCallTDF

endsub

subCallTDF

Dimstr,strinsertasstring

DimIpinasinteger

DimMyObj,myobj2asobject

Dimbasbrush

DimP,pbaspen

Dimn,iasinteger

Dimx,yasFloat

onerrorgotoerror_trap

dialog

title"查找同频频点"

controledittext

intoIpin

width100

height10

Controlokbutton

title"确定"

ifCommandinfo（CMD_INFO_DLG_OK）then

myobj2=tdcellinfo.obj

pB=makepen（4,2,blue）

alterobjectmyobj2infoobj_info_pen,pb

b=makebrush（2,red,cyan）

p=makepen（4,2,red）

Select*fromTDCellInfowhere主频=Ipinintoactive

fetchfirstfromactive

dowhilenoteot（active）

n=n+1

fetchrecnfromactive

x=active.x2

y=active.y2

myobj=active.obj

alterobjectmyobjinfoobj_info_pen,p

updateactivesetobj=myobjwhererowid=n

insertintocosmetic1（obj）values（createtext（FrontWindow（）,x,y,"同"+Ipin,0,3,0））

loop

endif

'****************************************************************************

done:

exitFunction

Error_trap:

noteerror$（）

resumedone

endsub

'---------------------------------------------

SubToolHandler

dimstrasstring

dimobjs,vpointasobject

dimx,yasfloat

'分行符chr$（10）制表符chr$（9）

OnErrorGotoERROR_TRAP

IFWindowInfo（Frontwindow（）,win_Info_type）=win_mapperthen

str=Format$（CommandInfo（CMD_Info_X）,",#.######"）+""+Format$（CommandInfo（CMD_Info_Y）,",#.######"）

x=commandinfo（cmd_info_x）

y=commandinfo（cmd_info_y）

objs=createpoint（x,y）

insertinto道路（obj）values（objs）

dialog

title"显示坐标"

controledittext

valuestr

width100

height10

ENDif

Done:

ExitSub

Error_Trap:

NoteError$（）

ResumeDONE

ENDSub

subtool_sub

Dimx,y,x2,y2asfloat

Dimi,i_found,i_row_id,i_win_id,fanhui,SelectIDasinteger

Dims_tableasalias

Dimstrpic,strcname,strallname,strpicpath,s_searchforasstring

DimCNames（）asString

onerrorgotoerror_trap

i_win_id=frontwindow（）

ifwindowinfo（i_win_id,win_info_type）<>win_mapperthen

note"只能在地图窗口使用该工具！

"

exitsub

endif

x=commandinfo（cmd_info_x）

y=commandinfo（cmd_info_y）

ifcommandinfo（cmd_info_toolbtn）=1then

i_found=searchpoint（i_win_id,x,y）

else

x2=commandinfo（cmd_info_x2）

y2=commandinfo（cmd_info_y2）

i_found=searchrect（i_win_id,x,y,x2,y2）

endif

ifi_found=0then

beep

exitsub

else

strcname=""

fori=1toi_found

s_table=searchinfo（i,search_info_table）

i_row_id=searchinfo（i,search_info_row）

ifleft$（s_table,8）="cosmetic"then

print"点对象在装饰图层中!

"

else

fetchreci_row_idfroms_table

s_table=s_table+".col2"

'---------------我增加的---------

i=ubound（cnames）+1

redimcnames（i）

cnames（i）=str$（s_table）

strcname=strcname+str$（s_table）+";"

'--------------------------------

endif

next

strallname=left$（strcname,len（strcname）-1）

ifstrallname=""then

exitsub

endif

dialog

title"查找显示CDD数据"

controllistbox

titlestrallname

ID3

Value1

intos_searchfor

position15,10width60height100

ControlOkButton

Title"确定"

ifcommandinfo（cmd_info_dlg_ok）then

fanhui=Execute（cnames（s_searchfor））

endif

endif

done:

exitsub

error_trap:

noteerror$（）

resumedone

endsub

FunctionXLS_ImportTab（ByValsXLSAsString,'Fullpath/nameofspreadsheetfile

ByValsTabAsString）'Fullpath/nameoftablefile

AsLogical

'ImportsanExcelspreadsheetasatableassumingthatthefirst

'rowcontainsthefieldnames.

DimnRows,nColsAsInteger

DimsRange,sCellAsString

OnErrorGotoXit

RegisterTablesXLSTYPEXLSIntosTab

OpenTablesTabAs~XLS

'Determinethesizeofthetable

nCols=TableInfo（~XLS,TAB_INFO_NCOLS）

nRows=TableInfo（~XLS,TAB_INFO_NROWS）

CloseTable~XLS

'ConvertrowandcolumnofendofrangetoA1-typereference

sCell=XLS_A1Cell（nCols,nRows）

IfsCell=""Then

Note"Spreadsheet"&PathToTablename$（sTab）&"notimported."

ExitFunction

EndIf

'Importthespreadsheetasatable

sRange="A2:

"&sCell

RegisterTablesXLSTYPEXLSTitlesRangesRangeIntosTab

XLS_ImportTab=TRUE

ExitFunction

Xit:

Note"XLS_ImportTaberror:

"&Chr$（10）&Error$（）

EndFunction

FunctionXLS_A1Cell（

ByValnColAsInteger,'Columnreference:

0

ByValnRowAsInteger）'Rowreference:

0

AsString'ReturnedA1-typecellreference,orNULLiferror

'CreatesanExcelA1-typereferenceforacellfromarowandcolumn

DimsCellRangeAsString

Dimi,jAsInteger

'Errorcheck

IfnCol<0ORnCol>256Then

Note"XLS_A1CellError:

Invalidcolumnreference="&nCol

ExitFunction

EndIf

IfnRow<0ORnRow>65536Then

Note"XLS_A1CellError:

Invalidrowreference="&nRow

ExitFunction

EndIf

'Columnsare1=A,2=B,...26=Z,27=AA,28=AB,...256=IV

'Note:

theyarenotregular（i.e27is"AA",not"A"or"A0"）

i=nCol-1

Ifi>25then

j=i\26

sCellRange=Chr$（64+j）

endif

j=imod26

sCellRange=sCellRange+Chr$（65+j）&nRow

XLS_A1Cell=sCellRange

EndFunction

'-----------------------覆盖图-----------------------

subCoverPoint

dimrange_limits（）asfloat,brush_styles（）asbrush

dimcol_nameasalias

dimsampledatapath,s_filename,path_name,path_dir,colname,arrnumasstring

dimwin_idasinteger

onerrorgotoerror_trap

win_id=frontwindow（）

s_filename=fileopendlg（"","","tab","打开文件"）

ifs_filename<>""then

path_name=pathtotablename$（s_filename）'文件名要加.tab后缀

path_dir=pathtodirectory$（s_filename）'路径名

sampledatapath=path_dir&path_name&".tab"

opentablepath_dir&path_name&".tab"

addmapwindowwin_idautolayerpath_name

col_name="RxLevSubdBm"

shadepath_name

withcol_name

rangesApplyall

-70:

-30Brush（13,65280,16777215）Pen（0,1,13697023）Symbol（35,green,9,"MapInfoSymbols",0,0）,

-75:

-70Brush（13,65280,16777215）Pen（0,1,13697023）Symbol（35,cyan,9,"MapInfoSymbols",0,0）,

-80:

-75Brush（13,65280,16777215）Pen（0,1,13697023）Symbol（35,blue,9,"MapInfoSymbols",0,0）,

-85:

-80Brush（13,65280,16777215）Pen（0,1,13697023）Symbol（35,magenta,9,"MapInfoSymbols",0,0）,

-90:

-85Brush（13,65280,16777215）Pen（0,1,13697023）Symbol（35,yellow,9,"MapInfoSymbols",0,0）,

-94:

-90Brush（13,65280,16777215）Pen（0,1,13697023）Symbol（35,9306883,9,"MapInfoSymbols",0,0）,

-110:

-94Brush（13,65280,16777215）Pen（0,1,13697023）Symbol（35,red,9,"MapInfoSymbols",0,0）

openwindowlegend

setlegendwindowwin_idlayerprev

DisplayoncountonrangesFont（"Arial",0,11,0）autodisplayon,autodisplayon,autodisplayon,

autodisplayon,autodisplayon,autodisplayon,autodisplayon,autodisplayon

endif

done:

exitFunction

Error_trap:

note"请将要导出的数据字段改成RxLevSubdBm"

resumedone

endsub

'-----------------------质量图-----------------------

subQuantitypoint

dimrange_limits（）asfloat,brush_styles（）asbrush

dimcol_nameasalias

dimsampledatapath,s_filename,path_name,path_dir,colname,arrnumasstring

dimwin_idasinteger

onerrorgotoerror_trap

win_id=frontwindow（）

s_filename=fileopendlg（"","","tab","打开文件"）

ifs_filename<>""then

path_name=pathtotablename$（s_filename）'文件名要加.tab后缀

path_dir=pathtodirectory$（s_filename）'路径名

sampledatapath=path_dir&path_name&".tab"

opentablepath_dir&path_name&".tab"

addmapwindowwin_idautolayerpath_name

col_name="RXQUAL_SUB"

shadepath_name

withcol_name

rangesApplyall

'usesizesymbol（34,Red,24）'使用红色的圆

0:

1Brush（13,65280,16777215）Pen（0,1,13697023）Symbol（35,green,9,"MapInfoSymbols",0,0）,

1:

2Brush（13,65280,16777215）Pen（0,1,13697023）Symbol（35,cyan,9,"MapInfoSymbols",0,0）,

2:

3Brush（13,65280,16777215）Pen（0,1,13697023）Symbol（35,blue,9,"MapInfoSymbols",0,0）,

3:

4Brush（13,65280,16777215）Pen（0,1,13697023）Symbol（35,magenta,9,"MapInfoSymbols",0,0）,

4:

5Brush（13,65280,16777215）Pen（0,1,13697023）Symbol（35,yellow,9,"MapInfoSymbols",0,0）,

5:

6Brush（13,65280,16777215）Pen（0,1,13697023）Symbol（35,9306883,9,"MapInfoSymbols",0,0）,

6:

7Brush（13,65280,167772