Список форумов Форум Libreoffice

Форум Libreoffice

Добро пожаловать на Форум Libreoffice!
 
 FAQFAQ   ПоискПоиск   ПользователиПользователи   ГруппыГруппы   РегистрацияРегистрация 
 ПрофильПрофиль   Войти и проверить личные сообщенияВойти и проверить личные сообщения   ВходВход 

English French German Italian Portuguese Russian Spanish
Координатные линии активной ячейки

 
Начать новую тему   Ответить на тему    Список форумов Форум Libreoffice -> Basic
Предыдущая тема :: Следующая тема  
Автор Сообщение
neft



Репутация: 0    

Зарегистрирован: 19.10.2011
Сообщения: 28

СообщениеДобавлено: Сб Фев 11, 2012 2:18 pm    Заголовок сообщения: Координатные линии активной ячейки Ответить с цитатой

Для выделения строки и столбца, содержащих активную ячейку, можно использовать рисование "координатных" линий
(вместо Подсвечивание строки с активной ячейкой или Подсвечивание границы строки с активной ячейкой).

1. Следующий макрос DrawX4 нужно выполнить только один раз для того, чтобы нарисовать координатные линии, если их нет
Код:
' Рисуем линии с именами (только в самый первый раз, потом их будем только двигать)

Sub DrawX4
   Dim Point As New com.sun.star.awt.Point
   Dim Size As New com.sun.star.awt.Size
   
oDoc=ThisComponent
oSheet=oDoc.Sheets.getByName("Лист1")
odrawpage = oSheet.DrawPage

oSelect = oDoc.CurrentSelection.getRangeAddress
oSelectAC = oSelect.StartColumn
oSelectAR = oSelect.StartRow
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
kx=2258.13
ky=451.6253
selcol=oSelectAC+1
selrow=oSelectAR+1
selcolend=1024
selrowend=1048576/100
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
'Горизонтальные линии
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
   Point.x = 0
   Point.y = ky*(selrow)
   
   Size.Width = kx*selcolend
   Size.Height = 0

   LineShape1 = ThisComponent.createInstance("com.sun.star.drawing.LineShape")
   LineShape1.Size = Size
   LineShape1.Position = Point
   LineShape1.setpropertyvalue("AnchorType", 0)
   LineShape1.LineColor = RGB(255, 0, 0)
      LineShape1.Name="line1"
   odrawpage.add(LineShape1)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
   Point.x = 0
   Point.y = ky*(selrow-1)
   
   Size.Width = kx*selcolend
   Size.Height = 0

   LineShape2 = ThisComponent.createInstance("com.sun.star.drawing.LineShape")
   LineShape2.Size = Size
   LineShape2.Position = Point
   LineShape2.setpropertyvalue("AnchorType", 0)
   LineShape2.LineColor = RGB(255, 0, 0)
      LineShape2.Name="line2"
   odrawpage.add(LineShape2)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Вертикальные линии
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   Point.x = kx*selcol
   Point.y = 0
   
   Size.Width = 0
   Size.Height = ky*selrowend

   LineShape3 = ThisComponent.createInstance("com.sun.star.drawing.LineShape")
   LineShape3.Size = Size
   LineShape3.Position = Point
   LineShape3.setpropertyvalue("AnchorType", 0)
   LineShape3.LineColor = RGB(255, 0, 0)
      LineShape3.Name="line3"
   odrawpage.add(LineShape3)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   Point.x = kx*(selcol-1)
   Point.y = 0
   
   Size.Width = 0
   Size.Height = ky*selrowend

   LineShape4 = ThisComponent.createInstance("com.sun.star.drawing.LineShape")
   LineShape4.Size = Size
   LineShape4.Position = Point
   LineShape4.setpropertyvalue("AnchorType", 0)
   LineShape4.LineColor = RGB(255, 0, 0)
      LineShape4.Name="line4"
   odrawpage.add(LineShape4)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub


2. Следующие макросы и выполняют основную работу: следят за изменением положения активной ячейки и соответственно ему передвигают координатные линии (за основу взят Listener из одной из указанных ссылок и добавлена часть кода, двигающая координатные линии):
Код:
' Передвигам линии вместе с активной ячейкой

Global oListener As Object
Global oDocView As Object

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Выполните этот макрос для начала перехвата событий !!!
Sub AddListener
  Dim sName$
  oDocView = ThisComponent.getCurrentController
   ' создайте перехватчик для перехвата события "изменение выделения"
   sName = "com.sun.star.view.XSelectionChangeListener"
  oListener = CreateUnoListener( "MyApp_", sName )
   
  ' зарегистрировать этот перехватчик в контроллере документа
  oDocView.addSelectionChangeListener(oListener)
  NN=0
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Выполните этот макрос для прекращения перехвата событий
Sub Remove_Listener
  ' удаляет перехватчик
  oDocView.removeSelectionChangeListener(oListener)
End Sub

' Все  перехватчики должны поддерживать это событие
Sub MyApp_disposing(oEvent)
  msgbox "Вывод перехватчика (disposing the listener)"
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub MyApp_selectionChanged(oEvent)
Dim Point As New com.sun.star.awt.Point
Dim Size As New com.sun.star.awt.Size
Dim lineindex As Object

oCell=oEvent.source

oDoc=ThisComponent
'oSheet = oDoc.CurrentController.getActiveSheet()
oSheet=oDoc.Sheets.getByName("Лист1")
Page = oSheet.DrawPage

oSelect = oDoc.CurrentSelection.getRangeAddress

oSelectAC = oSelect.StartColumn
oSelectAR = oSelect.StartRow   'используем только это, т.к. выделяем только одну ячейку
                        'остальные можно использовать для проверки на выбор не одной ячейки
oSelectZC = oSelect.EndColumn
oSelectZR = oSelect.EndRow

'''========================================================================
kx=2258.13
ky=451.6253
'''========================================================================
selcol=oSelectAC+1
selrow=oSelectAR+1
selcolend=1024
selrowend=1048576/100

For n=0 To Page.Count-1
lineindex=Page.getByIndex(n)
If lineindex.Name="line1" Then
   Point.x = 0
      Point.y = ky*selrow
      Size.Width = kx*selcolend
      Size.Height = 0
      lineindex.Size=Size
      lineindex.Position=Point
End If

If lineindex.Name="line2" Then
   Point.x = 0
      Point.y = ky*(selrow-1)
      Size.Width = kx*selcolend
      Size.Height = 0
      lineindex.Size=Size
      lineindex.Position=Point
End If

If lineindex.Name="line3" Then
   Point.x = kx*selcol
      Point.y = 0
      Size.Width = 0
      Size.Height = ky*selrowend
      lineindex.Size=Size
      lineindex.Position=Point
End If

If lineindex.Name="line4" Then
      Point.x = kx*(selcol-1)
      Point.y = 0
      Size.Width = 0
      Size.Height = ky*selrowend
      lineindex.Size=Size
      lineindex.Position=Point
End If
Next n
End Sub


Преимущества такого способа: нет никаких проблем с сохранением форматирования ячеек.

Скачать пример http://ifolder.ru/28644132



Коэффициенты kx=2258.13 и ky=451.6253 подобраны так, чтобы линии рисовались по границам строк и столбцов (для OpenOffice.org pro 3.3.0 - для LibreOffice могут быть другими!), фактически, kx - ширина одной колонки, kу - высота одной строки.
В каких единицах - ?

При изменении масштаба листа линии очень хорошо совпадают с границам строк и столбцов (для OpenOffice.org pro 3.3.0)

selcolend=1024 - определяет длину горизонтальных линий (число колонок)
selrowend=1048576/100 - определяет длину вертикальных линий (число строк)

PS. Замечания и доработки только приветствуются.
Вернуться к началу
Посмотреть профиль Отправить личное сообщение
mathnew



Репутация: 0    

Зарегистрирован: 20.08.2011
Сообщения: 24

СообщениеДобавлено: Сб Фев 11, 2012 6:38 pm    Заголовок сообщения: Ответить с цитатой

Цитата:
2. Следующие макросы ...
лучше заменить на

Код:
' Передвигам линии вместе с активной ячейкой

Global oListener As Object
Global oDocView As Object

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Выполните этот макрос для начала перехвата событий !!!
Sub AddListener
  Dim sName$
  oDocView = ThisComponent.getCurrentController
   ' создайте перехватчик для перехвата события "изменение выделения"
   sName = "com.sun.star.view.XSelectionChangeListener"
  oListener = CreateUnoListener( "MyApp_", sName )
   
  ' зарегистрировать этот перехватчик в контроллере документа
  oDocView.addSelectionChangeListener(oListener)
  NN=0
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Выполните этот макрос для прекращения перехвата событий
Sub Remove_Listener
  ' удаляет перехватчик
  oDocView.removeSelectionChangeListener(oListener)
End Sub

' Все  перехватчики должны поддерживать это событие
Sub MyApp_disposing(oEvent)
  msgbox "Вывод перехватчика (disposing the listener)"
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub MyApp_selectionChanged(oEvent)
Dim Point As New com.sun.star.awt.Point
Dim Size As New com.sun.star.awt.Size
Dim lineindex As Object

oCell=oEvent.source

oDoc=ThisComponent

'''=== Получаем адрес активной ячейки =====
aAdr = GetFocusedCell3(oDoc)
nSheet = aAdr(0)
selcol = aAdr(1)+1
selrow = aAdr(2)+1
'''========================================================================
oSheet=oDoc.Sheets.getByName("Лист1")
Page = oSheet.DrawPage
'''========================================================================
kx=2258.13
ky=451.6253
'''========================================================================

selcolend=1024
selrowend=1048576/100

For n=0 To Page.Count-1
lineindex=Page.getByIndex(n)
If lineindex.Name="line1" Then
   Point.x = 0
      Point.y = ky*selrow
      Size.Width = kx*selcolend
      Size.Height = 0
      lineindex.Size=Size
      lineindex.Position=Point
End If

If lineindex.Name="line2" Then
   Point.x = 0
      Point.y = ky*(selrow-1)
      Size.Width = kx*selcolend
      Size.Height = 0
      lineindex.Size=Size
      lineindex.Position=Point
End If

If lineindex.Name="line3" Then
   Point.x = kx*selcol
      Point.y = 0
      Size.Width = 0
      Size.Height = ky*selrowend
      lineindex.Size=Size
      lineindex.Position=Point
End If

If lineindex.Name="line4" Then
      Point.x = kx*(selcol-1)
      Point.y = 0
      Size.Width = 0
      Size.Height = ky*selrowend
      lineindex.Size=Size
   lineindex.Position=Point
End If
Next n
End Sub

'''===== Функция для определения адреса активной ячейки =====
Function GetFocusedCell3(oDoc as Object)
Dim as1, cell(2) As Long, sDum as String
   as1  = Split(oDoc.currentController.ViewData, ";")
   cell(0) = CLng(as1(1))
   sDum = as1(cell(0)+3)
   as1  = Split(sDum, "/")
   cell(1) = CLng(as1(0))
   cell(2) = CLng(as1(1))
   GetFocusedCell3 = cell()
End Function


добавив функцию для определения адреса активной ячейки GetFocusedCell3 (Адрес активной ячейки при выделении нескольких диапазонов).
Вернуться к началу
Посмотреть профиль Отправить личное сообщение
RFJ



Репутация: +1    

Зарегистрирован: 02.08.2011
Сообщения: 59

СообщениеДобавлено: Вс Фев 12, 2012 12:32 pm    Заголовок сообщения: Ответить с цитатой

Более правильно вместо kx, ky использовать вычисляемую позицию (X,Y) активной ячейки, т.е. нужно переписать следующие строки так
Код:

Point.y = oSheet.getCellByPosition(selcol,selrow).Position.Y   'вместо ky*selrow
...
Point.y = oSheet.getCellByPosition(selcol,selrow-1).Position.Y   'вместо ky*(selrow-1)
...
Point.x = oSheet.getCellByPosition(selcol,selrow).Position.X      'вместо kx*selcol
...
Point.x = oSheet.getCellByPosition(selcol-1,selrow).Position.X      'вместо kx*(selcol-1)


и тому подобные.

PS. Теперь ячейки могут быть разной ширины и высоты, но точность попадания линий на границы весьма невелика и нужна корректировка.
Вернуться к началу
Посмотреть профиль Отправить личное сообщение
neft



Репутация: 0    

Зарегистрирован: 19.10.2011
Сообщения: 28

СообщениеДобавлено: Вс Фев 12, 2012 1:34 pm    Заголовок сообщения: Ответить с цитатой

А можно и так:
Код:
selcol = aAdr(1)   
selrow = aAdr(2)
...
Point.y = oSheet.getCellByPosition(selcol1,selrow).Position.Y
...
Point.y = oSheet.getCellByPosition(selcol,selrow).Position.Y + oSheet.getCellByPosition(selcol,selrow).Size.Height
...
Point.x = oSheet.getCellByPosition(selcol,selrow).Position.X + oSheet.getCellByPosition(selcol,selrow).Size.Width
...
Point.x = oSheet.getCellByPosition(selcol,selrow).Position.X


Со столбцами более или менее в порядке, а вот границы строк вычисляет безобразно.
Вернуться к началу
Посмотреть профиль Отправить личное сообщение
Показать сообщения:   
Начать новую тему   Ответить на тему    Список форумов Форум Libreoffice -> Basic Часовой пояс: GMT
Страница 1 из 1

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


Powered by phpBB © 2001, 2005 phpBB Group
Вы можете бесплатно создать форум на MyBB2.ru, RSS