Обработчик события "по отпусканию кнопки мыши"

[ОлегV]

Доброго всем времени суток.
Прошу помочь знатоков разобраться, где у меня ошибка.

Задача следующая:
  Необходимо запрограммировать изменение цвета графического элемента в диалоге по отпусканию (или нажатию -не важно) кнопки мыши, т.е. при каждом клике на графический элемент, должен меняться (циклически) его цвет, в моем случае "синий" и "темно синий". Но у меня цвет не меняется.
  Помогите пожалуйста разобраться, где у меня ошибки.
  Вот код программы:

Код Выделить Развернуть

Option Explicit
Private oDlg      'Отображаемый диалог
Private oBlockImage  'Модель графического элемента ImageControl

Sub Main
Dim oDlgModel 'Модель диалога
Dim oModel    'Модель для элемента управления
Dim oListener 'Создаваемый объект обработчика
Dim oControl  'Ссылка на элемент управления
Dim iTabIndex As Integer 'Текущий индекс табуляции при создании элемента управления
 
  REM Создание модели диалога
    oDlgModel = CreateUnoService("com.sun.star.awt.UnoControlDialogModel")
    setProperties(oDlgModel, Array("PositionX", 150, "PositionY", 100, "Width", 150, "Height", 150, "Title", "Тест обработчика")) 
   
  REM Создаем модель графического элемента   
    createInsertControl(oDlgModel, iTabIndex, "BlockImage", "com.sun.star.awt.UnoControlImageControlModel",_
Array("PositionX", 50, "PositionY", 50, "Width", 50, "Height", 50))
 
  REM Создаем кнопку ОК
      createInsertControl(oDlgModel, iTabIndex, "OKButton", "com.sun.star.awt.UnoControlButtonModel",_
Array("PositionX", 50, "PositionY", 120, "Width", 50, "Height", 15, "Label", "OK", "PushButtonType", com.sun.star.awt.PushButtonType.OK))

  REM Создаем диалог и задаем модель
      oDlg = CreateUnoService("com.sun.star.awt.UnoControlDialog")
      oDlg.setModel(oDlgModel)
     


    REM Создаем обработчик событий по нажатию кнопки мыши и назначаем его графическому элементу
 
    oListener = CreateUnoListener("Block_", "com.sun.star.awt.XMouseListener")   
    oControl = oDlg.getControl("BlockImage")
    oControl.addEventListener(oListener)


REM зададим начальное состояние состояние графического элемента (цвет - синий)
         
    oDlg.getModel().getByName("BlockImage").BackgroundColor = 1000   
     
REM Создадим окно и затем укажем диалогу использовать созданное окно
    Dim oWindow
    oWindow = CreateUnoService("com.sun.star.awt.Toolkit")
    oDlg.createPeer(oWindow, null)
REM Выполним диалог
    oDlg.execute()
End Sub


REM ************************Создание модели элемента управления и вставка ее в модель диалога
Sub createInsertControl(oDlgModel, index%, sName$, sType$, props())
Dim oModel
oModel = oDlgModel.createInstance(sType$)
setProperties(oModel, props())
setProperties(oModel, Array("Name", sName$, "TabIndex", index%))
oDlgModel.insertByName(sName$, oModel)
index% = index% + 1
End Sub

REM************************ Установка свойств на основе массива пар имя/значение. 
Sub setProperties(oModel, props())
Dim i As Integer
For i=LBound(props()) To UBound(props()) Step 2
oModel.setPropertyValue(props(i), props(i+1))
Next
End Sub



REM *********************Обработка события "отпущена кнопка мыши" ***********************************
REM ****** при нажатии-отпускании кнопки мыши на графическом элементе должен меняться цвет
Sub Block_mouseReleased() 
    if oBlockImage.BackgroundColor = 1000 Then
          oBlockImage.BackgroundColor = 5000      'темно синий
        Else BlockImage.BackgroundColor = 1000  'синий
    End If
End Sub


[sokol92]

Здравствуйте!
Предположу, что Вы брали пример с замечательного макроса Inspect из книги Питоньяка OOME_4_1.odt.
Первое, на что нужно обратить внимание в Вашем примере - у Вас диалог не закрывается при нажатии на кнопку (а у Питоняька  - закрывается).

Опытным путем находим, что проблемы возникают после оператора

Код Выделить Развернуть

oControl.addEventListener(oListener)Если эту строку закомментировать, то диалог начинает закрываться при нажатии на кнопку (и при нажатии на "крестик" и при наборе на клавиатуре клавиши "Esc").

В книге есть много примеров работы со слушателями. Обратите внимание, что нужно обязательно создавать (в модуле LO Basic) процедуры обработки для всех событий слушателя, даже если Вы ничего в этих процедурах не делаете.
В частности, для интерфейса XMouseListener должны быть созданы процедуры для событий mousePressed, mouseReleased, mouseEntered, mouseExited, disposing.

Будьте внимательны и к типам слушателей. AddEventListener и AddMouseListener - разные методы.

Кстати, рекомендую вернуться к своему сообщению на форуме и оформить код с помощью соответствующей кнопки на инструментальной линейке (7-я справа).

[sokol92]

Кстати, когда-то написал код для генерации процедур обработки событий слушателей. Может быть, окажется кому-то полезным.

Код Выделить Развернуть

' Генерация процедур для слушателей (Listeners).
' В конце макроса выдается окно с заготовкой кода (из которого можно скопировать код).
Sub ListenerSubGen()
  Dim listN As String, title As String, def as String, pref as String, result as String, s as String, arr, arr2
  Dim oListener As Object
  title="Генерация макросов для обработки события"
  def="com.sun.star."
 
  Do While True
    listN=InputBox("Укажите имя слушателя", title, def)
    If listN="" Then Exit Sub
    oListener=CreateUnoListener("A_", listN)
    If oListener Is Nothing Then
      Msgbox "Ошибка при создании слушателя " & listN
      def=listN
    Else
      Exit Do
    End If   
  Loop 
 
  pref=InputBox("Укажите префикс для процедур обработки событий", title)
  If pref="" Then Exit Sub
  oListener=CreateUnoListener(Pref, listN)
  arr=Split(oListener.dbg_methods, ":")
  arr=Split(Replace(arr(1), Chr(10), ""), ";")

  result="oListener=CreateUnoListener(""" & pref & """,""" & listN & """)" & Chr(10)
  For Each s In arr
    arr2=Split(Trim(s), " ", 2)
    arr2(0)=Trim(arr2(0))
    arr2(1)=Replace(Trim(arr2(1)), " ( SbxOBJECT )", "(oEvent)")
   
    If arr2(0)="SbxVOID" Then
      result=result & Chr(10) & _
             "Sub " & pref & arr2(1) & Chr(10) & _
             "End Sub" & Chr(10)
            
    ElseIf arr2(0)="SbxBOOL" Then
      result=result & Chr(10) & _
             "Function " & pref & arr2(1) & " as Boolean"  & Chr(10) & _
             "End Function" & Chr(10)
    End If
  Next s 
 
  Msgbox result, "", title
End Sub