Список форумов www.integro.ru www.integro.ru
ЦСИ ИНТЕГРО
 
 FAQFAQ   ПоискПоиск   ПользователиПользователи   ГруппыГруппы   РегистрацияРегистрация 
 ПрофильПрофиль   Войти и проверить личные сообщенияВойти и проверить личные сообщения   ВходВход 

Программное копирование свойств проекта

 
Начать новую тему   Ответить на тему    Список форумов 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 работа с фильтрами (параметрами отображения).
Ещё не знаю где находится и как программно добраться до параметров "Направление осей координат" (и считать и изменить).

_________________
г. Тольятти, г. Самара, ОАО "КУЗНЕЦОВ"
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Отправить e-mail
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    Заголовок сообщения: Ответить с цитатой

Благодарю!
Много полезного для себя подчерпнул.

_________________
г. Тольятти, г. Самара, ОАО "КУЗНЕЦОВ"
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Отправить e-mail
Показать сообщения:   
Начать новую тему   Ответить на тему    Список форумов www.integro.ru -> Вопросы разработчиков Часовой пояс: GMT + 5
Страница 1 из 1

 
Перейти:  
Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете голосовать в опросах
Вы не можете добавлять приложения в этом форуме
Вы можете скачивать файлы в этом форуме


© phpBB Group
Русская поддержка phpBB