Страница 1 из 1

MapBasic. Не корректно работает ProgressBar

Добавлено: 09 окт 2019, 17:21
Пашкин
Добрый день!
Не удается корректно настроить 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
А вот в моем собственном коде ПрогрессБар появляется, но индикатор процесса не движется, пока вычисления не закончатся. Моя программа вычисляет число снимков, попадающих на каждую из трапеций. Число трапеций довольно велико - более 5000 и работа занимает более 4 минут, так что нормальная работа ПрогрессБар весьма желательна.
Код моей программы

Код: Выделить всё

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
Никак не могу понять работу правильно работающего кода (тестового). И никак не могу понять почему мой код не работает. (Это жалобы). Пожалуйста, помогите разобраться. Спасибо.

Re: MapBasic. Не корректно работает ProgressBar

Добавлено: 10 окт 2019, 12:22
wasposa
Вы случаем Range не забыли после ProgressBar "Обработка информации..." Calling Sub_Run?

Re: MapBasic. Не корректно работает ProgressBar

Добавлено: 10 окт 2019, 12:36
Пашкин
Range по умолчанию 100.
Сейчас пытаюсь понять, можно ли легкой кровью обойтись, написав свою библиотеку dll на VS2008, но т.к. я никогда такого не делал, то плаваю, пытаюсь найти в сети, но все не то. Может кто знает, как это сделать?

Re: MapBasic. Не корректно работает ProgressBar

Добавлено: 10 окт 2019, 12:46
wasposa
Ну если VS2008, то тогда http://gis-lab.info/qa/mapinfo-smartpanels.html

Re: MapBasic. Не корректно работает ProgressBar

Добавлено: 10 окт 2019, 13:42
Пашкин
Спасибо за ссылку. Дело в том, что в VS2008 я создавал приложения типа ДиалогБокс в MFC на с++. Изучать с# нет возможности. Задачу я ставлю такую - создать в с++ на базе MFC окно с ПрогрессБаром (ПрогрессКонтрол) в виде dll, в которую передавать один параметр - процент выполнения. И чтобы из МапБейсика вызывать эту dll с параметром процента выполнения задачи, который dll будет отображать в ПрогрессБаре. Вопросы, ответы на которые я не знаю:
  1. Какой тип проекта DLL выбрать?
  2. Каковы детали (параметры) проекта?
  3. Где нужно прописать передаваемый параметр (процент выполнения) в созданном проекте?

Re: MapBasic. Не корректно работает ProgressBar

Добавлено: 10 окт 2019, 13:50
Пашкин
И если кто знает, как обойтись без написания DLL средствами только МапБейсика, пишите. Это проще, автономнее, я бы сказал. Что в головном посте с кодом не так? Почему тестовый вариант работает, а рабочий - нет? Скажу честно - я не понимаю, почему и как работает тестовый вариант.

Re: MapBasic. Не корректно работает ProgressBar

Добавлено: 18 окт 2019, 12:48
Пашкин
Проблема решена. Удалось сделать нормальную работу ПрогрессБар.
Приведу пример из Справочника по МапБейсику.

Код: Выделить всё

Include "mapbasic.def"
Declare Sub Main
Declare Sub write_out
Global next_row As Integer

Sub Main
	next_row = 1
	ProgressBar "Запись данных..." Calling write_out Range 600
	If CommandInfo(CMD_INFO_STATUS) Then
		Note "Операция завершена! Спасибо за терпение."
	Else
		Note "Операция прервана."
	End If
End Sub

Sub write_out
	Dim start_time As Float
	start_time = Timer( )
' условия остановки: (a) все сделано
' или (б) некая итерация заняла более 2 секунд
	Do While next_row <= 600 And Timer( ) - start_time < 2
''''''''''''''''''''''''''''''''''''''''''
''' Здесь располагаются операторы '''
''' обработки файла. '''
''''''''''''''''''''''''''''''''''''''''''
		next_row = next_row + 1
	Loop
' Теперь надо выяснить, почему цикл прерван: либо
' все записи были обработаны, либо некая итерация
' заняла более двух секунд
	If next_row > 600 Then
		ProgressBar = -1 ' сообщить "Готово!"
	Else
		ProgressBar = next_row ' сообщить "Запись прервана."
	End If
End Sub
Чтобы добиться правильной работы ПрогрессБара пришлось перекроить всю программу. И вот что у меня получилось:

Код: Выделить всё

Include "MAPBASIC.DEF"

Declare Sub Main
Declare Sub Open_Trap
Declare Sub Open_Chema
Declare Sub Clear
Declare Sub Sub_Run
Declare Sub Sub_Progress

Global m_tab_trap, m_tab_chema As String
Global i_count, m_row As Integer
Global Time_start, Time_end 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_Run

	Open Table m_tab_trap As Tab_Trap Interactive
	m_row  =  TableInfo(Tab_Trap, TAB_INFO_NROWS)
	Close Table Tab_Trap
	
	If m_row>0 Then
		Note "Ждите, будет проанализировано " + m_row + " трапеций"
		Time_start = Timer() 
		i_count=1
		Print Chr$(12)
		While i_count<= m_row
			ProgressBar "Обработка информации..." Calling Sub_Progress Range m_row
			If CommandInfo(CMD_INFO_STATUS) Then
				Note "Обработка информации закончена!"
			Else
			'Если процесс прерван принудительно.
				Note "Обработка информации прервана!"
			End If
		Wend
		
		Note "Процесс выполнен за " + (Time_end -Time_start) +"c. Ознакомтесь с результатом в открытой таблице Tab_Trap"
	Else
		Note "Нет записей в таблице Номенклатур!"
	End If
	'Note "STOP Sub_Run"
End Sub

Sub Sub_Progress
	Dim start_time As Float
	Dim Obj_trap As Object 
	Dim   Direct As String
	Dim   Layer_tab_temp, Nom_trap, KS_trap  As   String
	Dim   n   As Integer
	start_time = Timer( )
	Open Table m_tab_trap As Tab_Trap Interactive
	Open Table m_tab_chema As Tab_Chema Interactive
' условия остановки: (a) все сделано
' или (б) некая итерация заняла более 2 секунд
	Do While i_count <= m_row And Timer( ) - start_time < 2
''''''''''''''''''''''''''''''''''''''''''
''' Здесь располагаются операторы обработки'''
''''''''''''''''''''''''''''''''''''''''''	
		Direct = "c:\Temp\"
		Layer_tab_temp = Direct + "Temp_tab.Tab"

		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	

			Fetch  Rec i_count   From   Tab_Trap
			Obj_trap = Tab_Trap.Obj
			Nom_trap = Tab_Trap.Название_НЛ
			KS_trap = Tab_Trap.Наличие_КС
		
			Insert Into Temp_tab
  				Values (Nom_trap, KS_trap)
			Update Temp_tab
  				Set Obj = Obj_trap
  					Where Rowid = 1 		

  			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_count
			Close  Table   QResult  Interactive
			Drop Table Temp_Tab
			i_count = i_count + 1
	Loop
' Теперь надо выяснить, почему цикл прерван: либо
' все записи были обработаны, либо некая итерация
' заняла более двух секунд
	If i_count > m_row Then
		ProgressBar = -1 ' сообщить "Готово!"
		Time_end = Timer()
	Else
		ProgressBar = i_count
	End If
End Sub