图形化割接方案制定软件.docx
《图形化割接方案制定软件.docx》由会员分享，可在线阅读，更多相关《图形化割接方案制定软件.docx（86页珍藏版）》请在冰豆网上搜索。
图形化割接方案制定软件
ConstNAME_COLUMN=0
ConstTYPE_COLUMN=1
ConstSIZE_COLUMN=2
ConstDATE_COLUMN=3
PrivateDeclareFunctionOSWinHelp%Lib"user32"Alias"WinHelpA"（ByValhwnd&,ByValHelpFile$,ByValwCommand%,dwDataAsAny）
DimmbMovingAsBoolean
ConstsglSplitLimit=500
PrivateSubAllQuery_Click（）
MapInfo.RunMenuCommandM_ANALYZE_SELECTALL
EndSub
PrivateSubAntiAllQuery_Click（）
MapInfo.RunMenuCommand311
EndSub
PrivateSubCalStastics_Click（）
MapInfo.RunMenuCommandM_ANALYZE_CALC_STATISTICS
EndSub
PrivateSubFind_Selection_Click（）
MapInfo.RunMenuCommandM_ANALYZE_FIND_SELECTION
EndSub
PrivateSubFindSome_Click（）
MapInfo.RunMenuCommandM_ANALYZE_FIND
EndSub
PrivateSubForm_Load（）
DimstrSQL,strSQLadAsString
Dimrstbts,adRecordsetAsNewADODB.Recordset
Setrstbts=NewADODB.Recordset
SetadRecordset=NewADODB.Recordset
DimnodxAsNode
'DimtheResponder1AsObject
Me.Left=GetSetting（App.Title,"Settings","MainLeft",1000）
Me.Top=GetSetting（App.Title,"Settings","MainTop",1000）
Me.Width=GetSetting（App.Title,"Settings","MainWidth",6500）
Me.Height=GetSetting（App.Title,"Settings","MainHeight",6500）
InitializeMapInfoConnection
Setconnaccess=NewADODB.Connection
Withconnaccess
.ConnectionString="Provider=Microsoft.Jet.OLEDB.4.0;PersistSecurityInfo=False;DataSource="&App.Path&"\database.mdb"
.CommandTimeout=0
.Open
EndWith
TheInstallPath=App.Path+"\"
MapInfo.do"setwindowinfoparent"&fMainForm.picMapFrame.hwnd
MapInfo.do"setwindowlegendparent"&fMainForm.picMapFrame.hwnd
MapInfo.do"setwindowrulerparent"&fMainForm.picMapFrame.hwnd
MapInfo.do"setwindowstatisticsparent"&fMainForm.picMapFrame.hwnd
'RunMenuCommand
tvTreeView.LineStyle=tvwRootLines'在兄弟节点和父节点之间显示线
strSQL="SELECTdistinctmscFROMbsc资源"
rstbts.OpenstrSQL,connaccess,adOpenStatic,adLockOptimistic
WhileNot（rstbts.EOF）
tvTreeView.Nodes.Add,,"msc"&rstbts!
msc,"msc"&rstbts!
msc
strSQLad="SELECT*FROMbsc资源wheremsc="&rstbts!
msc&"orderbybscasc"
adRecordset.OpenstrSQLad,connaccess,adOpenStatic,adLockOptimistic
WhileNot（adRecordset.EOF）
Setnodx=tvTreeView.Nodes.Add（"msc"&rstbts!
msc,tvwChild,ConvertString（adRecordset!
bsc,""）,ConvertString（adRecordset!
bsc,""））
adRecordset.MoveNext
Wend
SetadRecordset=Nothing
rstbts.MoveNext
Wend
Setrstbts=Nothing
'WithfMainForm.tvTreeView
'
'.Nodes.Add,,"msc"&rstbts!
msc,"msc"&rstbts!
msc
'
'EndWith
'WithfMainForm.tvTreeView
''*clearoutanypreviousinfotoolhits
'.Nodes.Clear
'IfnHits=0Then
''*therewerenohits:
disabletheTreeViewcontrol
'.Nodes.Add,,"noinfo",""
'.Enabled=False
'Else
EndSub
PrivateSubForm_Paint（）
'lvListView.View=Val（GetSetting（App.Title,"Settings","ViewMode","0"））
'SelectCaselvListView.View
'CaselvwIcon
'tbToolBar.Buttons（LISTVIEW_MODE0）.Value=tbrPressed
'CaselvwSmallIcon
'tbToolBar.Buttons（LISTVIEW_MODE1）.Value=tbrPressed
'CaselvwList
'tbToolBar.Buttons（LISTVIEW_MODE2）.Value=tbrPressed
'CaselvwReport
'tbToolBar.Buttons（LISTVIEW_MODE3）.Value=tbrPressed
'EndSelect
EndSub
PrivateSubForm_Unload（CancelAsInteger）
MapInfo.RunMenuCommandM_FILE_EXIT
DimIAsInteger
'closeallsubforms
ForI=Forms.Count-1To1Step-1
UnloadForms（I）
Next
IfMe.WindowState<>vbMinimizedThen
SaveSettingApp.Title,"Settings","MainLeft",Me.Left
SaveSettingApp.Title,"Settings","MainTop",Me.Top
SaveSettingApp.Title,"Settings","MainWidth",Me.Width
SaveSettingApp.Title,"Settings","MainHeight",Me.Height
EndIf
'SaveSettingApp.Title,"Settings","ViewMode",lvListView.View
ShutdownMapInfoConnection
Setconnaccess=Nothing
EndSub
PrivateSubLayerQuery_Click（）
MapInfo.RunMenuCommandM_ANALYZE_SELECT
EndSub
PrivateSubmenuMapCreateThematic_Click（）
MapInfo.RunMenuCommandM_MAP_THEMATIC
MapInfo.do"SetWindowLegendParent"&fMainForm.hwnd&"Show"
MapInfo.do"SetLegend"
EndSub
PrivateSubmenuMapModifyThematic_Click（）
MapInfo.RunMenuCommandM_MAP_MODIFY_THEMATIC
EndSub
PrivateSubmenuMapPreviousView_Click（）
MapInfo.RunMenuCommandM_MAP_PREVIOUS
EndSub
PrivateSubmenuOpenWor_Click（）
OnErrorResumeNext
'RightIndex=".WOR"
'
'If（InStr（LeftRightIndex,RightIndex）<=0）Then
'LeftRightIndex="*.WOR"
'EndIf
'If（TheInPathTabOrWor=""）Then
'TheInPathTabOrWor=TheInstallPath+"tab\"
'EndIf
'FrmTAB.Show1
fMainForm.dlgOpenTable.CancelError=True
fMainForm.dlgOpenTable.Filter="MapInfoTables（*.wor）|*.wor"
fMainForm.dlgOpenTable.FilterIndex=1
fMainForm.dlgOpenTable.ShowOpen'*displaythedialog
IfErr.Number>0Then
Err.Clear
ExitSub
Else
TheWorFile=fMainForm.dlgOpenTable.FileName'*getthefileselectedbytheuser
Callmenuallclose_Click
MapInfo.do"SetNextDocumentParent"&fMainForm.picMapFrame.hwnd&"Style1"
MapInfo.do"RunApplication"""&TheWorFile&""""
'MapInfo.do"SetWindowLegendParent"&fMainForm.picMapFrame.hwnd&"Position（6,5）Width2Height2hide"
'MapInfo.do"SetLegend"
'winID=CLng（MapInfo.Eval（"FrontWindow（）"））
'mapHWnd=CLng（MapInfo.Eval（"WindowInfo（"&winID&","&WIN_INFO_WND&"）"））
thereIsAMap=True
mapWinID=CLng（MapInfo.Eval（"FrontWindow（）"））
MapInfo.do"SetCoordSysEarthProjection1,0"
'CallUpdateMenuAndToolbar（True）
'fMainForm.Caption=Left（TabOrWor
（1）,Len（TabOrWor
（1））-4）+"Map"
UpdateMenuAndToolbar
EnabledMenuAndToolbar
EndIf
EndSub
PrivateSubmenuSaveAsWor_Click（）
MapInfo.RunMenuCommandM_FILE_SAVE_WORKSPACE
EndSub
PrivateSubmenuTableColomnUpDate_Click（）
MapInfo.RunMenuCommandM_TABLE_UPDATE_COLUMN
EndSub
PrivateSubmenuTableStruture_Click（）
MapInfo.RunMenuCommandM_TABLE_MODIFY_STRUCTURE
EndSub
PrivateSubmnucutBscCutCreate_Click（）
OnErrorGoToOn_Error
'在数据库中加入
IfthereIsAMapThen
'*there'salreadyamap.Addthisnewlayertotheexistingmap
'MapInfo.do"AddMapLayer"&tabName
'查找conf表,是否存在
mapWinID=CLng（MapInfo.Eval（"FrontWindow（）"））
nLayerName=CInt（MapInfo.Eval（"MapperInfo（"&mapWinID&",9）"））
ForI=1TonLayerName
layerName=MapInfo.Eval（"LayerInfo（"&mapWinID&","&I&",1）"）
If（InStr（layerName,"割接"）>0）Then
bExistTable=True
ExitFor
EndIf
NextI
IfbExistTableThen
I=MsgBox（"割接表已经打开,是否需要生成新的割接表",vbYesNo,"割接表"）
IfI=6Then
MapInfo.do"CloseTable割接"
'关表表时,要考虑这时是否还有窗口
mapWinID=CLng（MapInfo.Eval（"FrontWindow（）"））
IfmapWinID=0Then
MapInfo.do"SetNextDocumentParent"&fMainForm.picMapFrame.hwnd&"Style1"
MapInfo.do"CreateTable""割接""（bscchar（20））file"""&App.Path&"\tab\割接.TAB""TYPENATIVECharset""WindowsSimpChinese"""
MapInfo.do"CreateMapFor割接CoordSysEarthProjection1,0"
MapInfo.do"mapfrom割接"
MapInfo.do"SetMaplayer割接EditableOn"
b=MsgBox（"割接表已生成",vbInformation,"割接表"）
thereIsAMap=True
Else
MapInfo.do"CreateTable""割接""（bscchar（20））file"""&App.Path&"\tab\割接.TAB""TYPENATIVECharset""WindowsSimpChinese"""
MapInfo.do"CreateMapFor割接CoordSysEarthProjection1,0"
MapInfo.do"AddMapAutoLayer割接"
MapInfo.do"SetMaplayer割接EditableOn"
b=MsgBox（"割接表已生成",vbInformation,"割接表"）
thereIsAMap=True
EndIf
EndIf
Else
MapInfo.do"CreateTable""割接""（bscchar（20））file"""&App.Path&"\tab\割接.TAB""TYPENATIVECharset""WindowsSimpChinese"""
MapInfo.do"CreateMapFor割接CoordSysEarthProjection1,0"
MapInfo.do"AddMapAutoLayer割接"
MapInfo.do"SetMaplayer割接EditableOn"
b=MsgBox（"割接表已生成",vbInformation,"割接表"）
thereIsAMap=True
EndIf
Else
MapInfo.do"SetNextDocumentParent"&fMainForm.picMapFrame.hwnd&"Style1"
MapInfo.do"CreateTable""割接""（bscchar（20））file"""&App.Path&"\tab\割接.TAB""TYPENATIVECharset""WindowsSimpChinese"""
MapInfo.do"CreateMapFor割接CoordSysEarthProjection1,0"
MapInfo.do"mapfrom割接"
MapInfo.do"SetMaplayer割接EditableOn"
b=MsgBox（"割接表已生成",vbInformation,"割接表"）
thereIsAMap=True
EndIf
ExitSub
On_Error:
MsgBoxErr.Description,vbCritical,"系统提示"
ExitSub
EndSub
PrivateSubmnucutBscCutOpen_Click（）
DimtheFileAsString'*thefullpathtothefile
DimtabNameAsString'*theMapInfotablealiasforthefile
'*First,displayacommonfiledialogtoopenatable
OnErrorGoToOn_Error'*hittingcancelinthedlgishandledasanerror
fMainForm.dlgOpenTable.Filter="MapInfoTables（*.tab）|*.tab"
fMainForm.dlgOpenTable.FilterIndex=1
fMainForm.dlgOpenTable.ShowOpen'*displaythedialog
theFile=fMainForm.dlgOpenTable.FileName'*getthefileselectedbytheuser
tabName=MapInfo.Eval（"PathToTableName$（"""&theFile&"""）"）'*gettablealias
IftabName<>"割接"Then
MsgBox"这个图层不是割接图层"
ExitSub
Else
mapWinID=CLng（MapInfo.Eval（"FrontWindow（）"））
nLayerName=CInt（MapInfo.Eval（"MapperInfo（"&mapWinID&",9）"））
ForI=1TonLayerName
layerName=MapInfo.Eval（"LayerInfo（"&mapWinID&","&I&",1）"）
If（InStr（layerName,"割接"）>0）Then
bExistTable=True
ExitFor
EndIf
NextI
IfbExistTableThen
b=MsgBox（"割接表已打成",vbInformation,"割接表"）
ExitSub
Else
MapInfo.do"OpenTable"""&theFile&"""as"&tabName'*openthetable
'MapInfo.do"SetTable"&tabName&"ReadOnly"'*makeitReadOnly
'*now,makesurethetableismappable,otherwise,displayamsgandclosethetable
''bybwt
'IfMapInfo.Eval（"TableInfo（"&tabName&","&TAB_INFO_MAPPABLE&"）"）="F"Then
'MsgBox"Thistableisnotmappable.Icanonlyopenmappabletables."
'MapInfo.Do"CloseTable"&tabName
升级会员 