Не удается корректно настроить ProgressBar в работе с программой на MAPBASIC версии 10.0 и MapInfo 11.5
В приведенном ниже тестовом коде все работает. Эту программу я позаимствовал из книги В.Овчинникова "Программирование для MapInfo в примерах".
Код корректно работающей программы:
Код: Выделить всё
Include "MAPBASIC.DEF"
Declare Sub Main
Declare Sub ProgressBarDemo
Declare Sub Sub_Run
dim ProgressStart,ProgressEnd as integer
dim dt,ProgressD as integer
Sub Main
Call ProgressBarDemo
End Sub
Sub ProgressBarDemo
ProgressStart = 1
ProgressEnd = 1000000
ProgressD=1
'Параметр гладкости процесса (регулируется по необходимости).
dt=ProgressEnd/10+1
ProgressBar "Обработка информации..." Calling Sub_Run
Range ProgressEnd
If CommandInfo(CMD_INFO_STATUS) Then
Note "Обработка информации закончена!"
Else
'Если процесс прерван принудительно.
Note "Обработка информации прервана на строке "
& Str$(ProgressStart)
End If
end sub
Sub Sub_Run
Do While ProgressStart<=ProgressEnd And ProgressStart<ProgressEnd/dt*ProgressD
ProgressStart=ProgressStart +1
Loop
ProgressD=ProgressD+1
If ProgressStart>ProgressEnd Then
ProgressBar=-1
Else
ProgressBar=ProgressStart
End If
end sub
Код моей программы
Код: Выделить всё
Include "MAPBASIC.DEF"
Declare Sub Main
Declare Sub Open_Trap
Declare Sub Open_Chema
Declare Sub Clear
Declare Sub Sub_Progress
Declare Sub Sub_Run
Global m_tab_trap, m_tab_chema As String
Global m_count As Integer
Sub Main
Include "Dialog_Interface.mb"
End Sub
Sub Open_Trap
Note "Таблица должна иметь поля Название_НЛ, Наличие_КС и Число_фрагментов"
If Ask("Вы уверены, что таблица имеет такие поля?", "Да", "Нет") Then
m_tab_trap = FileOpenDlg("","","TAB","Open Table")
Alter Control 110
Value m_tab_trap
Else
Note "Создайте необходимые поля"
End If
End Sub
Sub Open_Chema
m_tab_chema = FileOpenDlg("","","TAB","Open Table")
If Len(m_tab_chema)>0 Then
Alter Control 111
Value m_tab_chema
End If
End Sub
Sub Clear
m_tab_trap = "Выбрать файл схемы трапеций"
m_tab_chema = "Выбрать файл схемы покрытия материалами КС"
Alter Control 110
Value m_tab_trap
Alter Control 111
Value m_tab_chema
End Sub
Sub Sub_Progress
ProgressBar "Обработка информации..." Calling Sub_Run
If CommandInfo(CMD_INFO_STATUS) Then
Note "Обработка информации закончена!"
Else
'Если процесс прерван принудительно.
Note "Обработка информации прервана!"
End If
'Note "STOP Sub_Progress"
End Sub
Sub Sub_Run
Dim Time_start, Time_end As Integer
Dim Obj_trap As Object
Dim Direct As String
Dim Layer_tab_temp, Nom_trap, KS_trap, w_str As String
Dim row, col As Integer
Dim i, n As Integer
Dim proc, proc1 As Float
Direct = "c:\Temp\"
Layer_tab_temp = Direct + "Temp_tab.Tab"
Open Table m_tab_trap As Tab_Trap Interactive
Open Table m_tab_chema As Tab_Chema Interactive
row = TableInfo(Tab_Trap, TAB_INFO_NROWS)
Time_start = Timer()
Create Table Temp_tab
(
Название_НЛ Char(15),
Наличие_КС Char(250)
)
File "C:\TEMP\Temp_tab"
Version 300
Type NATIVE
Set Table Temp_tab
FastEdit On
Seamless Off Preserve
Undo Off
UserMap Off
UserEdit Off
UserDisplayMap Off
Create Map For Temp_tab
If row>0 Then
Note "Ждите, будет проанализировано " + row + " трапеций"
m_count = 0
Fetch First From Tab_Trap
i=1
proc =0
Print Chr$(12)
While i<= row
Obj_trap = Tab_Trap.Obj
Nom_trap = Tab_Trap.Название_НЛ
KS_trap = Tab_Trap.Наличие_КС
If i=1 Then
Insert Into Temp_tab
Values (Nom_trap, KS_trap)
Update Temp_tab
Set Obj = Obj_trap
Where Rowid = 1
Else
Update Temp_tab
Set Название_НЛ = Nom_trap, Наличие_КС = KS_trap, Obj = Obj_trap
Where Rowid = 1
End If
Commit Table Temp_tab
Select * From Temp_tab, Tab_Chema Where temp_tab.Obj Intersects Tab_Chema.Obj Into QResult
n = TableInfo(QResult,TAB_INFO_NROWS)
Update Tab_Trap
Set Число_фрагментов = n
Where Rowid = i
Close Table QResult Interactive
Fetch Next From Tab_Trap
proc1 = i/row
m_count = proc1*100
If m_count>=100 Then
ProgressBar = -1
Else
ProgressBar = m_count
End If
if (proc1-proc) > 0.05 Then
'Print Chr$(12) 'Очистка окна сообщений - плохо работает
Print "Выполнено " + Format$(proc1,"#.%")
proc = proc1
End If
i = i + 1
Wend
Drop Table Temp_tab
Print "Выполнено " + Format$(proc1,"#.##%")
Time_end = Timer()
Note "Процесс выполнен за " + (Time_end -Time_start) +"c. Ознакомтесь с результатом в открытой таблице Tab_Trap"
Else
Note "Нет записей в таблице Номенклатур!"
End If
'Note "m_count = " + m_count
'Note "STOP Sub_Run"
End Sub