图形化割接方案制定软件.docx

1、图形化割接方案制定软件Const NAME_COLUMN = 0Const TYPE_COLUMN = 1Const SIZE_COLUMN = 2Const DATE_COLUMN = 3Private Declare Function OSWinHelp% Lib user32 Alias WinHelpA (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any) Dim mbMoving As BooleanConst sglSplitLimit = 500Private Sub AllQuery_Click()MapI

2、nfo.RunMenuCommand M_ANALYZE_SELECTALLEnd SubPrivate Sub AntiAllQuery_Click()MapInfo.RunMenuCommand 311End SubPrivate Sub CalStastics_Click()MapInfo.RunMenuCommand M_ANALYZE_CALC_STATISTICSEnd SubPrivate Sub Find_Selection_Click()MapInfo.RunMenuCommand M_ANALYZE_FIND_SELECTIONEnd SubPrivate Sub Find

3、Some_Click()MapInfo.RunMenuCommand M_ANALYZE_FINDEnd SubPrivate Sub Form_Load() Dim strSQL, strSQLad As String Dim rstbts, adRecordset As New ADODB.Recordset Set rstbts = New ADODB.Recordset Set adRecordset = New ADODB.Recordset Dim nodx As Node Dim theResponder1 As Object Me.Left = GetSetting(App.T

4、itle, 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 Set connaccess = New ADODB.Connection With connaccess .Connect

5、ionString = Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source= & App.Path & database.mdb .CommandTimeout = 0 .Open End With TheInstallPath = App.Path + MapInfo.do set window info parent & fMainForm.picMapFrame.hwnd MapInfo.do set window legend parent & fMainForm.picMapFrame.hw

6、nd MapInfo.do set window ruler parent & fMainForm.picMapFrame.hwnd MapInfo.do set window statistics parent & fMainForm.picMapFrame.hwnd Run Menu Command tvTreeView.LineStyle = tvwRootLines 在兄弟节点和父节点之间显示线 strSQL = SELECT distinct msc FROM bsc资源 rstbts.Open strSQL, connaccess, adOpenStatic, adLockOpti

7、mistic While Not (rstbts.EOF) tvTreeView.Nodes.Add , , msc & rstbts!msc, msc & rstbts!msc strSQLad = SELECT * FROM bsc资源 where msc= & rstbts!msc & order by bsc asc adRecordset.Open strSQLad, connaccess, adOpenStatic, adLockOptimistic While Not (adRecordset.EOF) Set nodx = tvTreeView.Nodes.Add(msc &

8、rstbts!msc, tvwChild, ConvertString(adRecordset!bsc, ), ConvertString(adRecordset!bsc, ) adRecordset.MoveNext Wend Set adRecordset = Nothing rstbts.MoveNext Wend Set rstbts = Nothing With fMainForm.tvTreeView .Nodes.Add , , msc & rstbts!msc, msc & rstbts!mscEnd With With fMainForm.tvTreeView * clear

9、 out any previous info tool hits .Nodes.Clear If nHits = 0 Then * there were no hits: disable the TreeView control .Nodes.Add , , noinfo, .Enabled = False Else End SubPrivate Sub Form_Paint() lvListView.View = Val(GetSetting(App.Title, Settings, ViewMode, 0) Select Case lvListView.View Case lvwIcon

10、tbToolBar.Buttons(LISTVIEW_MODE0).Value = tbrPressed Case lvwSmallIcon tbToolBar.Buttons(LISTVIEW_MODE1).Value = tbrPressed Case lvwList tbToolBar.Buttons(LISTVIEW_MODE2).Value = tbrPressed Case lvwReport tbToolBar.Buttons(LISTVIEW_MODE3).Value = tbrPressed End SelectEnd SubPrivate Sub Form_Unload(C

11、ancel As Integer)MapInfo.RunMenuCommand M_FILE_EXIT Dim I As Integer close all sub forms For I = Forms.Count - 1 To 1 Step -1 Unload Forms(I) Next If Me.WindowState vbMinimized Then SaveSetting App.Title, Settings, MainLeft, Me.Left SaveSetting App.Title, Settings, MainTop, Me.Top SaveSetting App.Ti

12、tle, Settings, MainWidth, Me.Width SaveSetting App.Title, Settings, MainHeight, Me.Height End If SaveSetting App.Title, Settings, ViewMode, lvListView.ViewShutdownMapInfoConnectionSet connaccess = NothingEnd SubPrivate Sub LayerQuery_Click()MapInfo.RunMenuCommand M_ANALYZE_SELECTEnd SubPrivate Sub m

13、enuMapCreateThematic_Click()MapInfo.RunMenuCommand M_MAP_THEMATICMapInfo.do Set Window Legend Parent & fMainForm.hwnd & ShowMapInfo.do Set Legend End SubPrivate Sub menuMapModifyThematic_Click()MapInfo.RunMenuCommand M_MAP_MODIFY_THEMATICEnd SubPrivate Sub menuMapPreviousView_Click()MapInfo.RunMenuC

14、ommand M_MAP_PREVIOUSEnd SubPrivate Sub menuOpenWor_Click() On Error Resume Next RightIndex = .WOR If (InStr(LeftRightIndex, RightIndex) 0 Then Err.Clear Exit Sub Else TheWorFile = fMainForm.dlgOpenTable.FileName * get the file selected by the user Call menuallclose_Click MapInfo.do Set Next Documen

15、t Parent & fMainForm.picMapFrame.hwnd & Style 1 MapInfo.do Run Application & TheWorFile & MapInfo.do Set Window Legend Parent & fMainForm.picMapFrame.hwnd & Position(6,5) Width 2 Height 2 hide MapInfo.do Set Legend winID = CLng(MapInfo.Eval(FrontWindow() mapHWnd = CLng(MapInfo.Eval(WindowInfo( & win

16、ID & , & WIN_INFO_WND & ) thereIsAMap = True mapWinID = CLng(MapInfo.Eval(FrontWindow() MapInfo.do Set CoordSys Earth Projection 1,0 Call UpdateMenuAndToolbar(True) fMainForm.Caption = Left(TabOrWor(1), Len(TabOrWor(1) - 4) + Map UpdateMenuAndToolbar EnabledMenuAndToolbar End If End SubPrivate Sub m

17、enuSaveAsWor_Click()MapInfo.RunMenuCommand M_FILE_SAVE_WORKSPACEEnd SubPrivate Sub menuTableColomnUpDate_Click()MapInfo.RunMenuCommand M_TABLE_UPDATE_COLUMNEnd SubPrivate Sub menuTableStruture_Click()MapInfo.RunMenuCommand M_TABLE_MODIFY_STRUCTUREEnd SubPrivate Sub mnucutBscCutCreate_Click()On Error

18、 GoTo On_Error在数据库中加入If thereIsAMap Then * theres already a map. Add this new layer to the existing map MapInfo.do Add Map Layer & tabName 查找conf表,是否存在 mapWinID = CLng(MapInfo.Eval(FrontWindow() nLayerName = CInt(MapInfo.Eval(MapperInfo( & mapWinID & ,9) For I = 1 To nLayerName layerName = MapInfo.E

19、val(LayerInfo( & mapWinID & , & I & ,1) If (InStr(layerName, 割接) 0) Then bExistTable = True Exit For End If Next I If bExistTable Then I = MsgBox(割接表已经打开,是否需要生成新的割接表, vbYesNo, 割接表 ) If I = 6 Then MapInfo.do Close Table 割接 关表表时,要考虑这时是否还有窗口 mapWinID = CLng(MapInfo.Eval(FrontWindow() If mapWinID = 0 Th

20、en MapInfo.do Set Next Document Parent & fMainForm.picMapFrame.hwnd & Style 1 MapInfo.do Create Table 割接 (bsc char(20) file & App.Path & tab割接.TAB TYPE NATIVE Charset WindowsSimpChinese MapInfo.do Create Map For 割接 CoordSys Earth Projection 1, 0 MapInfo.do map from 割接 MapInfo.do Set Map layer 割接 Edi

21、table On b = MsgBox(割接表已生成, vbInformation, 割接表 ) thereIsAMap = True Else MapInfo.do Create Table 割接 (bsc char(20) file & App.Path & tab割接.TAB TYPE NATIVE Charset WindowsSimpChinese MapInfo.do Create Map For 割接 CoordSys Earth Projection 1, 0 MapInfo.do Add Map Auto Layer 割接 MapInfo.do Set Map layer 割

22、接 Editable On b = MsgBox(割接表已生成, vbInformation, 割接表 ) thereIsAMap = True End If End If Else MapInfo.do Create Table 割接 (bsc char(20) file & App.Path & tab割接.TAB TYPE NATIVE Charset WindowsSimpChinese MapInfo.do Create Map For 割接 CoordSys Earth Projection 1, 0 MapInfo.do Add Map Auto Layer 割接 MapInfo

23、.do Set Map layer 割接 Editable On b = MsgBox(割接表已生成, vbInformation, 割接表 ) thereIsAMap = True End If Else MapInfo.do Set Next Document Parent & fMainForm.picMapFrame.hwnd & Style 1 MapInfo.do Create Table 割接 (bsc char(20) file & App.Path & tab割接.TAB TYPE NATIVE Charset WindowsSimpChinese MapInfo.do Cr

24、eate Map For 割接 CoordSys Earth Projection 1, 0 MapInfo.do map from 割接 MapInfo.do Set Map layer 割接 Editable On b = MsgBox(割接表已生成, vbInformation, 割接表 ) thereIsAMap = TrueEnd IfExit SubOn_Error: MsgBox Err.Description, vbCritical, 系统提示Exit SubEnd SubPrivate Sub mnucutBscCutOpen_Click() Dim theFile As S

25、tring * the full path to the file Dim tabName As String * the MapInfo table alias for the file* First, display a common file dialog to open a table On Error GoTo On_Error * hitting cancel in the dlg is handled as an error fMainForm.dlgOpenTable.Filter = MapInfo Tables (*.tab)|*.tab fMainForm.dlgOpen

26、Table.FilterIndex = 1 fMainForm.dlgOpenTable.ShowOpen * display the dialog theFile = fMainForm.dlgOpenTable.FileName * get the file selected by the user tabName = MapInfo.Eval(PathToTableName$( & theFile & ) * get table alias If tabName 割接 Then MsgBox 这个图层不是割接图层 Exit Sub Else mapWinID = CLng(MapInfo

27、.Eval(FrontWindow() nLayerName = CInt(MapInfo.Eval(MapperInfo( & mapWinID & ,9) For I = 1 To nLayerName layerName = MapInfo.Eval(LayerInfo( & mapWinID & , & I & ,1) If (InStr(layerName, 割接) 0) Then bExistTable = True Exit For End If Next I If bExistTable Then b = MsgBox(割接表已打成, vbInformation, 割接表 )

28、Exit Sub Else MapInfo.do Open Table & theFile & as & tabName * open the table MapInfo.do Set Table & tabName & ReadOnly * make it ReadOnly * now, make sure the table is mappable, otherwise, display a msg and close the table by bwt If MapInfo.Eval(TableInfo( & tabName & , & TAB_INFO_MAPPABLE & ) = F Then MsgBox This table is not mappable. I can only open mappable tables. MapInfo.Do Close Table & tabName