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

MapInfo, MapBasic
Ответить
Пашкин
Новоприбывший
Сообщения: 4
Зарегистрирован: 09 окт 2019, 16:05
Репутация: 0
Откуда: Москва

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

wasposa
Участник
Сообщения: 87
Зарегистрирован: 02 май 2017, 13:22
Репутация: 18
Откуда: Москва

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

Сообщение wasposa » 10 окт 2019, 12:22

Вы случаем Range не забыли после ProgressBar "Обработка информации..." Calling Sub_Run?

Пашкин
Новоприбывший
Сообщения: 4
Зарегистрирован: 09 окт 2019, 16:05
Репутация: 0
Откуда: Москва

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

Сообщение Пашкин » 10 окт 2019, 12:36

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

wasposa
Участник
Сообщения: 87
Зарегистрирован: 02 май 2017, 13:22
Репутация: 18
Откуда: Москва

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

Сообщение wasposa » 10 окт 2019, 12:46

Ну если VS2008, то тогда http://gis-lab.info/qa/mapinfo-smartpanels.html

Пашкин
Новоприбывший
Сообщения: 4
Зарегистрирован: 09 окт 2019, 16:05
Репутация: 0
Откуда: Москва

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

Сообщение Пашкин » 10 окт 2019, 13:42

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

Пашкин
Новоприбывший
Сообщения: 4
Зарегистрирован: 09 окт 2019, 16:05
Репутация: 0
Откуда: Москва

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

Сообщение Пашкин » 10 окт 2019, 13:50

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

Ответить

Вернуться в «MapInfo»

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и 1 гость