图形化割接方案制定软件.docx
《图形化割接方案制定软件.docx》由会员分享,可在线阅读,更多相关《图形化割接方案制定软件.docx(86页珍藏版)》请在冰豆网上搜索。
![图形化割接方案制定软件.docx](https://file1.bdocx.com/fileroot1/2023-1/31/064ffa69-d6f6-4eec-8f71-26deee447292/064ffa69-d6f6-4eec-8f71-26deee4472921.gif)
图形化割接方案制定软件
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