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

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()MapInfo.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 FindSome_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.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 Set connaccess = New ADODB.Connection With connaccess .ConnectionString = 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.hwnd 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, adLockOptimistic 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 & 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 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 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(Cancel 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.Title, 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 menuMapCreateThematic_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.RunMenuCommand 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 Document 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( & winID & , & 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 menuSaveAsWor_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 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.Eval(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 Then 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 割接 Editable 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 割接 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.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 Create 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 String * 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.dlgOpenTable.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.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, 割接表 ) 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 Exit Sub End If by bwt * if the table is mappable, add it to the current map OR create a new map If thereIsAMap Then * theres already a map. Add this new layer to the existing map MapInfo.do Add Map Layer & tabName Else * no map yet. Create a new one, reparented into our picture box MapInfo.do Set Next Document Parent & fMainForm.picMapFrame.hwnd & Style 1 MapInfo.do Map From & tabName mapWinID = CLng(MapInfo.Eval(FrontWindow() thereIsAMap = True End If End If End If* we dont need to include UpdateLayerList or UpdateMenuAndToolbar here because they will* get called by the WindowContentsChanged() method in the MIResponder object which was set* with MapInfos SetCallback method in the InitializeMapInfoConnection subroutine. UpdateInfoClearExit SubOn_Error: MsgBox Err.Description, vbCritical, 系统提示Exit SubEnd SubPrivate Sub mnucutBscCutSta_Click()On Error GoTo On_ErrorDim rst As New ADODB.RecordsetDim Item As ListItemrst.Open delete from cutover, connaccess, adOpenStatic, adLockOptimisticDim str_record As Stringfrmscheme.Grid_scheme.Rows = 1MapInfo.do Select conf.cell_id, 割接.bsc from 割接, conf where 割接.Obj Contains conf.Obj and 割接.bscconf.bsc group by conf.cell_id, 割接.bsc into cutover MapInfo.do fetch first from cutover Do While F = MapInfo.Eval(EOT(cutover) sql1 = insert into cutover values ( & MapInfo.Eval(cutover.cell_id) & , & MapInfo.Eval(cutover.bsc) & ) rst.Open sql1, connaccess, adOpenStatic, adLockOptimisticMapInfo.do fetch next from cutoverLooprst.Open select * from lasttrx和et变化, connaccess, adOpenStatic, adLockOptimisticLoad frmschemeDo While Not rst.EOF str_record = rst!msc & vbTab & rst!bsc & vbTab & rst!额定trx & vbTab & rst!现网trx & vbTab & rst!trx变化 & vbTab & rst!lasttrx & vbTab & rst!额定et & vbTab & rst!现网et & vbTab & rst!et变化 & vbTab & rst!lastet frmscheme.Grid_scheme.AddItem str_record rst.MoveNextLoop While Not rst.EOFSet Item = frmscheme.lvFindResult.ListItems.Add(, , rst!msc)Item.SubItems(1) = ConvertString(rst!bsc, )Item.SubItems(2) = ConvertString(rst!额定trx, )Item.SubItems(3) = ConvertString(rst!现网trx, )Item.SubItems(4) = ConvertString(rst!trx变化, )Item.SubItems(5) = ConvertString(rst!lasttrx, )Item.SubItems(6) = ConvertString(rst!额定et, )Item.SubItems(7) = ConvertString(rst!现网et, )Item.SubItems(8) = ConvertString(rst!et变化, )Item.SubItems(9) = ConvertString(rst!lastet, ) rst.MoveNext Wendfrmscheme.Show 1Exit SubOn_Error: MsgBox Err.Description, vbCritical, 系统提示Exit SubEnd SubPrivate Sub mnucutCreateNew_Click()On Error GoTo On_ErrorDim sql1 As StringDim maxtime1 As StringDim rst As New ADODB.RecordsetDim mapWinID As LongDim nLayerName As IntegerDim layerName As StringDim bExistTable As Booleansql1 = SELECT max(时间) AS maxtime FROM NPMDB_V_P_无线性能合计_halfrst.Open sql1, connaccess, adOpenStatic, adLockOptimisticmaxtime1 = rst!maxtimerst.CloseIf 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.Eval(LayerInfo( & mapWinID & , & I & ,1) If (InStr(layerName, conf) 0) Then bExistTable = True Exit For End If Next I If bExistTable Then I = MsgBox(基站表已经打开,是否需要生成新的基站表, vbYesNo, 基站表 ) If I = 6 Then MapInfo.do Close Table conf 关表表时,要考虑这时是否还有窗口 mapWinID = CLng(MapInfo.Eval(FrontWindow() If mapWinID = 0 Then MapInfo.do Set Next Document Parent & fMainForm.picMapFrame.hwnd & Style 1 MapInfo.Do Register Table D:vb窗体活动窗体database.mdb Type ACCESS Table conf Into D:vb窗体活动窗体conf.TAB MapInfo.do Register Table & App.Path & database.mdb Type ACCESS Table conf Into & App.Path & conf.TAB MapInfo.do Open Table & App.Path & conf.TAB Interactive MapInfo.do Create Map For conf CoordSys Earth Projection 1, 104 MapInfo.do update conf set obj=createpoint(经度,纬度) MapInfo.do Commit Table conf Interactive MapInfo.do map from conf MapInfo.do Set Map Zoom Entire b = MsgBox(基站表已生成, vbInformation, 基站表 ) thereIsAMap = True Else MapInfo.Do Register Table D:vb窗体活动窗体database.mdb Type ACCESS Table conf Into D:vb窗体活动窗体conf.TAB MapInfo.do Register Table & App.Path & database.mdb Type ACCESS Table conf Into & App.Path & conf.TAB MapInfo.Do Open Table D:vb窗体活动窗体conf.TAB Interactive MapInfo.do Open Table & App.Path & conf.TAB Interactive MapInfo.do Create Map For conf CoordSys Earth Projection 1, 104 MapInfo.do update conf set obj=createpoint(经度,纬度) MapInfo.do Commit Table conf Interactive MapInfo.do Add Map Auto Layer conf MapInfo.do Set Map Zoom Entire b = MsgBox(基站表已生成, vbInformation, 基站表 ) thereIsAMap = True End If End If Else MapInfo.Do Register Table D:vb窗体活动窗体database.mdb Type ACCESS Table conf Into D:vb窗体活动窗体conf.TAB MapInfo.do Register Table & App.Path & database.mdb Type ACCESS Table conf Into & App.Path & conf.TAB MapInfo.Do Open Table D:vb窗体活动窗体conf.TAB Interactive MapInfo.do Open Table & App.Path & conf.TAB Interactive MapInfo.do Create Map For conf CoordSys Earth Projection 1, 10