 |
www.integro.ru
ЦСИ ИНТЕГРО
|
| Предыдущая тема :: Следующая тема |
| Автор |
Сообщение |
Сергей Попов
Зарегистрирован: 05.03.2005
Сообщения: 299
Откуда: г. Тольятти - Самара - Копейск
|
 Добавлено: Чт 24 Май 2012 10:44 Заголовок сообщения: Программное копирование свойств проекта |
 |
|
В упрощённом понимании ПРОЕКТ - это набор карт.
IngeoApplication\ActiveDb\Areas\Item[]\Projects\Item[] - Contents (список карт включённых в проект)
В ИнГЕО есть ещё IngeoProjectView - персональные (для текущего пользователя) настройки в текущем проекте.
Обращаю внимание: доступны не для всех пользователей и всех проектов, а только для текущего пользователя в текущем проекте.
Перечислю настройки:
1. Последовательность карт, видимость включена, выключена, развёрнут список слоёв или нет.
2. Последовательность слоёв, видимость, развёрнут список стилей или нет.
3. Вкл./выкл. видимость стилей.
4. Активная карта, слой.
5. Выделенные карта, слой, стиль.
6. Текущий масштаб, и координаты центра отображённой карты на экране.
Эти настройки очень важны в момент формирования макета печати, так как при повторном использовании макета, результат может отличаться от ожидаемого только из-за этих параметров: изменилась последовательность карт или видимость некоторых из них.
Ещё одна задача: скопировать эти настройки от одного пользователя другому, чтобы исключить рутинную работу и ошибки.
Вроде всё просто:
1. Запустить модуль в сеансе нужного пользователя в нужном проекте (или перейти в нужный проект).
2. Запомнить в некоторой структуре в памяти или файле настройки проекта.
3. Выйти из базы данных, но не из ИнГЕО (IngeoApplication - CloseActiveDb).
4. Войти в базу данных под другим пользователем в нужный проект.
5. Заменить настройки проекта данными из структуры.
У меня сложности с пунктом 4. Понятно что надо вызывать IngeoApplication\OpenDb(const Server: WideString; const DbID: WideString; const UserName: WideString; const Password: WideString);
Где брать значения передаваемых параметров: Server и DbID?
Допустим оба пользователя находится в одной базе, тогда DbID = IngeoApplication\IngeoDb.ID сеанса первоначального пользователя.
Само ИнГЕО вероятно во всю пользуется файлом InGeo.cfg в котором есть разделы:
<logon id="{A9714FEA-910F-4D40-840E-4A830F45BE4D}" user="Попов" server="192.168.0.XXX"><![CDATA[]]></logon>
и
<database id="{CC0233F3-B958-4E9F-916B-3DD398D54D40}" caption="TEST" use-server-semparams="1"><![CDATA[]]></database>
Возможно это и есть то, что требуется, но правильнее будет иметь нужную функцию в API.
Ещё нужны в API работа с фильтрами (параметрами отображения).
Ещё не знаю где находится и как программно добраться до параметров "Направление осей координат" (и считать и изменить).
_________________
г. Тольятти, г. Самара, ОАО "КУЗНЕЦОВ" |
|
| Вернуться к началу |
|
 |
APopov
Зарегистрирован: 19.06.2006
Сообщения: 347
Откуда: Самара
|
| Добавлено: Сб 26 Май 2012 19:54 Заголовок сообщения: |
|
|
У нас есть модуль который серелизует/десерелизует текущее состояние карты в/из xml-файл.
видимо это, то что вам нужно (там и запоминание направление осей есть).
ща выложу код.
_________________
ОАО "Самара-Информспутник",
инженер-программист Попов Артем
Последний раз редактировалось: APopov (Сб 26 Май 2012 20:09), всего редактировалось 1 раз |
|
| Вернуться к началу |
|
|
APopov
Зарегистрирован: 19.06.2006
Сообщения: 347
Откуда: Самара
|
| Добавлено: Сб 26 Май 2012 20:08 Заголовок сообщения: |
|
|
Это все куски из большого inm с разными улилитами
| Код: | option explicit
dim supStyleView ' boolean is style view supported in curr version
'---------------------------------
'| Initalization & finalization of Util Objects
'---------------------------------
sub Init
on error resume next
supStyleView = strcomp("4.4", Left(Application.Version,3)) >= 0
if err.number<>0 then supStyleView = false
on error goto 0
end sub
sub UnInit
end sub
'---------------------------------
'----------------для записи/чтения настроек в БД-----------------
'---------------------------------
sub SaveDBOptionStr (aOptionName, aOptionValue, GlobalOrUser)
if not sysUtils.IsValidObject(Application.ActiveDB) then exit sub
dim scorpe
if GlobalOrUser then scorpe = inupGlobal else scorpe = inupUser
Application.UserProfile.Put scorpe, "", aOptionName, aOptionValue
end sub
sub SaveDBOptionBool (aOptionName, aOptionValue, GlobalOrUser)
SaveDBOptionStr aOptionName, sysUtils.CStrB(aOptionValue), GlobalOrUser
end sub
function GetDBOptionStr (aOptionName, aDefValue, GlobalOrUser)
if not sysUtils.IsValidObject(Application.ActiveDB) then GetDBOptionStr = "" : exit function
dim scorpe
if GlobalOrUser then scorpe = inupGlobal else scorpe = inupUser
GetDBOptionStr = Application.UserProfile.Get(scorpe, "", aOptionName, aDefValue)
end function
function GetDBOptionBool (aOptionName, aDefValue, GlobalOrUser)
'GetDBOptionBool = CBool(GetDBOptionStr (aOptionName, aDefValue, GlobalOrUser))
GetDBOptionBool = sysUtils.CBool_Def(GetDBOptionStr (aOptionName, sysUtils.CStrB(aDefValue), GlobalOrUser), aDefValue)
end function
'---------------------------------
'----------------------------Тематические закладки----------------
'---------------------------------
sub SaveStyleView (byref aStyleView, byref xDoc, byref xRoot)
dim xElm
set xElm = xDoc.createElement("StyleView")
with xElm
.setAttribute "ID", inUtils.Loc2Glob( aStyleView.Style.ID )
.setAttribute "Name", aStyleView.Style.Name
.setAttribute "Visible", sysUtils.CStrB(aStyleView.Visible)
end with
xRoot.appendChild xElm
set xElm = nothing
end sub
sub SaveLayerView (byref aLayerView, byref xDoc, byref xRoot)
dim xElm, aStyleView
set xElm = xDoc.createElement("LayerView")
with xElm
.setAttribute "ID", inUtils.Loc2Glob( aLayerView.Layer.ID )
.setAttribute "Name", aLayerView.Layer.Name
.setAttribute "Index", aLayerView.Index
.setAttribute "Visible", sysUtils.CStrB(aLayerView.Visible)
if supStyleView then .setAttribute "Expanded", sysUtils.CStrB(aLayerView.Expanded)
end with
if supStyleView then
for each aStyleView in aLayerView.StyleViews
SaveStyleView aStyleView, xDoc, xElm
next
end if
xRoot.appendChild xElm
set xElm = nothing : set aStyleView = nothing
end sub
sub SaveMapView (byref aMapView, byref xDoc, byref xRoot)
dim xElm, aLayerView
set xElm = xDoc.createElement("MapView")
with xElm
.setAttribute "ID", inUtils.Loc2Glob( aMapView.Map.ID )
.setAttribute "Name", aMapView.Map.Name
.setAttribute "Index", aMapView.Index
.setAttribute "Visible", sysUtils.CStrB( aMapView.Visible)
.setAttribute "Expanded", sysUtils.CStrB( aMapView.Expanded)
end with
for each aLayerView in aMapView.LayerViews
SaveLayerView aLayerView, xDoc, xElm
next
xRoot.appendChild xElm
set xElm = nothing : set aLayerView = nothing
end sub
sub SaveProjectView
if not sysUtils.IsValidObject(Application.ActiveProjectView) then exit sub
dim xmlFN
if not sysUtils.PromptForFileName(xmlFN, sysUtils.dlgXMLFilter, "xml", "Сохранить тематическую закладку в файл :", true ) then exit sub
if trim(xmlFN) = "" then exit sub
dim xDoc, xRoot, xElm, APV, Navig, aMapView
set APV = Application.ActiveProjectView
set Navig = Application.MainWindow.MapWindow.Navigator
set xDoc = sysUtils.CreateNewXMLDocRus
set xRoot = xDoc.createElement("IngeoProjectViews")
xRoot.setAttribute "xml-builder-skin", "IngeoProjectViewsSkin"
set xDoc.documentElement = xRoot
set xElm = xDoc.createElement("IngeoProjectView")
with xElm
.setAttribute "Name","Current"
.setAttribute "Caption",APV.Project.Name
.setAttribute "ProjectGUID", inUtils.Loc2Glob( APV.Project.ID )
.setAttribute "YMirror", sysUtils.CStrB(Navig.YMirror)
.setAttribute "XAngle", sysUtils.Rad2Deg (Navig.XAngle)
.setAttribute "Scale", CStr(Round(1/Navig.ZoomScale))
.setAttribute "XCenter", CStr( Navig.CenterX)
.setAttribute "YCenter", CStr( Navig.CenterY)
end with
set Navig = nothing
for each aMapView in APV.MapViews
SaveMapView aMapView, xDoc, xElm
next
xRoot.AppendChild xElm
set aMapView = nothing : set APV = nothing
xDoc.Save xmlFN
set xElm = nothing : set xRoot = nothing : set xDoc = nothing
MsgBox "Тематическая закладка успешно сохранена в файл " &vbCr& xmlFN, vbInformation, "Сообщение"
end sub
sub LoadStyleView (byref xStyleElm, byref aLayerView)
dim aID, Visible
dim aStyleView
with xStyleElm
aID = inUtils.Glob2Loc(.getAttribute("ID"))
Visible = .getAttribute("Visible")
end with
set aStyleView = aLayerView.FindStyleView(aID)
if not sysUtils.IsValidObject(aStyleView) then exit sub
if isNumeric(Visible) then aStyleView.Visible = Visible
Set aStyleView = nothing
end sub
sub LoadLayerView (byref xLyrElm, byref aMapView)
dim aID, Index, Visible, Expanded
dim aLayerView, xSElm
with xLyrElm
aID = inUtils.Glob2Loc(.getAttribute("ID"))
Index = .getAttribute("Index")
Visible = .getAttribute("Visible")
Expanded = .getAttribute("Expanded")
end with
set aLayerView = aMapView.FindLayerView(aID)
if not sysUtils.IsValidObject(aLayerView) then exit sub
if isNumeric(Index) then aLayerView.Index = Index
if isNumeric(Visible) then aLayerView.Visible = Visible
if supStyleView and isNumeric(Expanded) then aLayerView.Expanded = Expanded
if supStyleView then
for each xSElm in xLyrElm.SelectNodes("StyleView")
LoadStyleView xSElm, aLayerView
next
end if
Set aLayerView = nothing : Set xSElm = nothing
end sub
sub LoadMapView (byref xMapElm, byref APV)
dim aID, Index, Visible, Expanded
dim aMapView, xLElm
with xMapElm
aID = inUtils.Glob2Loc(.getAttribute("ID"))
Index = .getAttribute("Index")
Visible = .getAttribute("Visible")
Expanded = .getAttribute("Expanded")
end with
set aMapView = APV.FindMapView(aID)
if not sysUtils.IsValidObject(aMapView) then exit sub
if isNumeric(Index) then aMapView.Index = Index
if isNumeric(Visible) then aMapView.Visible = Visible
if isNumeric(Expanded) then aMapView.Expanded = Expanded
for each xLElm in xMapElm.SelectNodes("LayerView")
LoadLayerView xLElm, aMapView
next
Set aMapView = nothing : Set xLElm = nothing
end sub
sub LoadProjectView (loadMapPosition)
dim xmlFN, XCenter, YCenter, ZoomScale, a
if not sysUtils.PromptForFileName(xmlFN, sysUtils.dlgXMLFilter, "xml", "Загрузить тематическую закладку из файла :", false ) then exit sub
if trim(xmlFN) = "" then exit sub
dim xDoc, xElm, xMElm, APV, Navig
set APV = Application.ActiveProjectView
set xDoc = sysUtils.OpenXML( xmlFN )
If xDoc.parseError.errorCode <> 0 Then
MsgBox "Не удалось загрузить [" & xmlFN & "] :"&vbCR& xDoc.parseError.reason, vbCritical, "Ошибка"
exit sub
End If
set xElm = xDoc.documentElement.SelectSingleNode ("IngeoProjectView")
if not sysUtils.IsValidObject(APV) then ' попытаемся загрузить проект
a = inUtils.Glob2Loc( xElm.getAttribute("ProjectGUID") )
if a="" then msgbox "Для загрузки закладки необходимо открыть текущий проект", vbExclamation, "Ошибка" : exit sub
Application.OpenProject a
set APV = Application.ActiveProjectView
end if
set Navig = Application.MainWindow.MapWindow.Navigator
if loadMapPosition then
ZoomScale = 1/sysUtils.CDbl_Def( xElm.getAttribute("Scale"), 1 )
XCenter = sysUtils.CDbl_Def( xElm.getAttribute("XCenter"), 0 )
YCenter = sysUtils.CDbl_Def( xElm.getAttribute("YCenter"), 0 )
Navig.Navigate XCenter, YCenter, ZoomScale
end if
Navig.YMirror = sysUtils.CBool_Def( xElm.getAttribute("YMirror"), Navig.YMirror )
a = xElm.getAttribute("XAngle")
if isNumeric(a) then Navig.XAngle = sysUtils.Deg2Rad( a )
set Navig = nothing
for each xMElm in xElm.SelectNodes ("MapView")
LoadMapView xMElm, APV
next
set xElm = nothing : set xMElm = nothing : set APV = nothing
set xDoc = nothing ': set xRoot = nothing
MsgBox "Тематическая закладка успешно воостановлены из файла", vbInformation, "Сообщение"
end sub
|
и несколько функций из подмодуля sysUtils, которые используются кодом выше
| Код: |
function IsValidObject(byref aObj)
if IsObject(aObj) then IsValidObject = not(aObj is Nothing) else IsValidObject = false
end function
'---------------------------------
'| Conv Ulils
'---------------------------------
dim DecSepar, WrongDecSepar 'DecimalSeparator
function CDblEx(byval s)
'if inStr(s, WrongDecSepar) then
s=replace(s, WrongDecSepar, DecSepar)
CDblEx = CDbl(s)
end function
Function CStrF(byref aValue) 'float to str
CStrF = FormatNumber(aValue, 2, -1, 0, -1)
End Function
Function CStrB(byref aValue) 'bool to str
if aValue then CStrB = "1" else CStrB = "0"
End Function
Function CDbl_Def(byref aValue, aDefVal) 'something to dbl with default value
On Error Resume Next
CDbl_Def = CDbl(aValue)
if err.number<>0 then CDbl_Def = aDefVal : err.Clear
On Error goto 0
End Function
Function CBool_Def(byref aValue, aDefVal) 'something to bool with default value
On Error Resume Next
CBool_Def = CBool(aValue)
if err.number<>0 then CBool_Def = aDefVal : err.Clear
On Error goto 0
End Function
function CStrFDot(d)
CStrFDot = CStr(d)
CStrFDot = replace(CStrFDot, ",", ".")
end function
function PromptForFileName(byref aFN, aFilter, aDefExt, adlgTitle, SaveDlg )'bool
dim dlgUtil
set dlgUtil = createObject("GetIngeoObjectsIDs.DialogUtils") 'наш вспомогательный COM-объектик
'QueryFileName([in, out] VARIANT * strFileName, [in] BSTR fileFilters, [in] BSTR defExt, [in] BSTR dlgTitle, [in] BSTR startDir, [in] VARIANT_BOOL SaveOrOpen, [out, retval] VARIANT_BOOL * success );
PromptForFileName = dlgUtil.QueryFileName(aFN, aFilter, aDefExt, adlgTitle, "", SaveDlg)
end function
public const dlgXMLFilter = "XML файлы (*.xml)|*.xml|Все Файлы (*.*)|*.*|"
function CreateNewXMLDocRus
dim xDoc, xPI
set xDoc = CreateObject("Msxml.DOMDocument")
set xPI = xDoc.createProcessingInstruction("xml", "version=""1.0"" encoding=""windows-1251""")
xDoc.appendChild xPI
set xPI = nothing
set CreateNewXMLDocRus = xDoc
end function
function OpenXML(byval aName)
set OpenXML = CreateObject("MSXML.DOMDocument")
OpenXML.async = False
OpenXML.load aName
end function
sub Init
on error resume next
dim t : t = CDbl("7.8")
if err.number=0 then DecSepar="." : WrongDecSepar="," else DecSepar="," : WrongDecSepar="."
on error goto 0
end sub
|
_________________
ОАО "Самара-Информспутник",
инженер-программист Попов Артем |
|
| Вернуться к началу |
|
|
Сергей Попов
Зарегистрирован: 05.03.2005
Сообщения: 299
Откуда: г. Тольятти - Самара - Копейск
|
| Добавлено: Вт 29 Май 2012 00:22 Заголовок сообщения: |
|
|
Благодарю!
Много полезного для себя подчерпнул.
_________________
г. Тольятти, г. Самара, ОАО "КУЗНЕЦОВ" |
|
| Вернуться к началу |
|
|
|
|
Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете голосовать в опросах
Вы не можете добавлять приложения в этом форуме
Вы можете скачивать файлы в этом форуме
|
|
FAQ
Поиск
Пользователи
Группы
Регистрация
Профиль
Войти и проверить личные сообщения
Вход
