Счётчик нажатий мышки

Автор Tigrik, 6 декабря 2021, 19:05

0 Пользователи и 1 гость просматривают эту тему.

Tigrik

Здравствуйте.

Появилась задача, которую, по всей видимости, возможно решить только с помощью макроса.
Есть некий диапазон ячеек, который задается количеством столбцов (число в ячейке B1) и строк (число в C1), а сам диапазон начинается определенно с ячейки А2.
Кликая левой кнопкой мыши на какую-нибудь ячейку в заданном диапазоне в данную ячейку заносится число соответствующему счётчику кликов: первый клик на какой-то ячейке - в эту ячейку заносится 1, в следующую "кликнутую" ячейку - 2 и т.д. Если будет клик на ячейку с уже записанным числом, то оно переписывается на текущий показатель счётчика.
Выход из макроса по клику на ячейку A1, при этом, в эту ячейку заносится показание счётчика, то есть, сколько было кликов по ячейкам.

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

Подскажите, пожалуйста, возможное решение для этой задачи.

sokol92

#1
Попробуйте сделать по образцу этой темы.

Можно, например, так:

Option Explicit

' Глобальные переменные.
Global oMouseClickHandler As Object
Global MouseClickCount As Long

' Начать слушать события от мышки.
Sub RegisterMouseClickHandler
   If Not (oMouseClickHandler Is Nothing) Then Exit Sub
   oMouseClickHandler =  createUnoListener("MouseOnClick_", "com.sun.star.awt.XMouseClickHandler")
   ThisComponent.CurrentController.addMouseClickHandler(oMouseClickHandler)
   MouseClickCount=0
End Sub

' Остановить слушание.
Sub UnregisterMouseClickHandler
   If oMouseClickHandler Is Nothing Then Exit Sub
   ThisComponent.CurrentController.removeMouseClickHandler(oMouseClickHandler)
   oMouseClickHandler=Nothing
End Sub

' Хоть эта процедура ничего не делает, но реализацию метода предоставить обязаны.
Sub MouseOnClick_disposing(oEvt)
End Sub

' Кнопка нажата
Function MouseOnClick_mousePressed(oEvt) As Boolean
   MouseOnClick_mousePressed = False
End Function

' Кнопка отпущена.
' Заносим счетчик кликов мыши в прямоугольник c левым верхним углом A2,
' число столбцов которого указано в B1, число строк в C1.
' При щелчке по A1 останавливаем слушатель и заносим счетчик в A1.
Function MouseOnClick_mouseReleased(oEvt as object) As Boolean
   Dim oCell, oSheet, rAdr
   MouseOnClick_mouseReleased = False    ' Разрешить офису другие обработки этого события
   oCell = ThisComponent.CurrentSelection
   If Not oCell.supportsService("com.sun.star.sheet.SheetCell") Then Exit Function
   oSheet=oCell.SpreadSheet
   rAdr=oCell.CellAddress 
   With rAdr
     If .Row=0 And .Column=0 Then
       oCell.setValue MouseClickCount     
       UnregisterMouseClickHandler
       Exit Function
     End If 
     
     If .row>0 And .row<=oSheet.getCellByPosition(2, 0).Value And .Column<oSheet.getCellByPosition(1, 0).Value Then
       MouseClickCount=MouseClickCount+1
       oCell.setValue MouseClickCount
     End If
   End With
End Function
Владимир.

Tigrik

Цитата: sokol92 от  6 декабря 2021, 20:01Попробуйте сделать по образцу этой темы.

Можно, например, так:

Сердечно благодарю, попробую.

Tigrik

sokol92, ещё раз Благодарю - всё работает ОТЛИЧНО!

eeigor

#4
Global oMouseClickHandler As Object
Sub RegisterMouseClickHandler
   If Not (oMouseClickHandler Is Nothing) Then Exit Sub

@sokol92, эта проверка выше равнозначна следующей:
   If Not IsNull(oMouseClickHandler) Then Exit Sub

Во всяком случае при инициализации объектной переменной или присвоении ей значения Nothing (oMouseClickHandler = Nothing) она получает значение Null.
Какая проверка всё-таки выглядит корректнее?

Null. Это значение используется для подтипа данных Variant без разрешённого содержимого.
IsNull(Var) принимает аргумент типа Variant.
Почему проверка с объектной переменной также работает?

Sub TestIsNull()
Dim oSomeObj As Object
Print IsObject(oSomeObj), TypeName(oSomeObj), VarType(oSomeObj), IsNull(oSomeObj), oSomeObj Is Nothing  '>> True Object 9 True True
End Sub



UPDATED:
Проверка в VBA показала, что IsNull(oSomeObj) возвращает False.
Что это: баг? Или особенность StarBasic?
Я в VBA, естественно, делал так, как здесь поступил @sokol92 (а по другому не работает). Но на форумах LibreOffice предпочитают проверку с IsNull (ссылка).
https://forumooo.ru/index.php/topic,8901.msg60309.html#msg60309
Ubuntu 18.04 LTS • LibreOffice 7.5.1.2 Community

mikekaganski

#5
Цитата: eeigor от  8 декабря 2021, 07:42
UPDATED:
Проверка в VBA показала, что IsNull(oSomeObj) возвращает False.
Что это: баг? Или особенность StarBasic?

Это особенность StarBasic (баг документации) (и баг в режиме VBASupport 1, поскольку должно бы возвращать False).
С уважением,
Михаил Каганский

eeigor

Михаил, спасибо за разъяснение.
И таким образом, какой способ проверки объектной переменной лучше использовать: IsNull(oSomeObj) или oSomeObj Is Nothing?
Ubuntu 18.04 LTS • LibreOffice 7.5.1.2 Community

mikekaganski

Лучше использовать то, что лучше отражает Ваши намерения / стиль программирования, и не затрудняет понимание программы. Если Вы пишите в режиме VBASupport 1, то лучше не полагаться на имеющийся баг совместимости. Если Вы пишите без режима совместимости, то зависит от задачи. Если Вы хотите проверить на Null, то надо ещё проверить, что это не объектная переменная. В случае если поведение фиксировано (как это в любом случае всегда было и будет для данной особенности в StarBasic), нет "правильного" или "неправильного", лучшего или худшего способа, если только код делает то, что задумано.
С уважением,
Михаил Каганский

eeigor

#8
Ну вот, всё прочитал. Михаилу – респект, в том числе за два созданных оперативно баг-репорта. Убеждаюсь, что нигде, кроме как на форуме, этих знаний не почерпнуть.
Ubuntu 18.04 LTS • LibreOffice 7.5.1.2 Community

Tigrik

Здравствуйте!

Макрос, который любезно предоставил sokol92 я очень активно модифицирую для своих задач.
Многие вопросы удалось решить самостоятельно или по найденным решениям на этом форуме.
На текущий момент некоторые вопросы остались открытыми.
1. Есть ли возможность объединить диапазоны в одну переменную?
2. Как установить Цвет фона "Без заливки". Конечно, можно закрасить в белый цвет (что, сейчас, и делается), но хотелось бы полностью убрать расцветку.

sokol92

Добрый день!
Я не вполне понимаю Ваши вопросы. Например, макрос из #1 не меняет фона ячейки.
Может быть, Вы выгрузите файл и на примере покажете, что хотелось бы сделать?
Владимир.

Tigrik

sokol92, Спасибо Большое, что обратили на мои вопросы.
Возможно, что нужно было бы создать новую тему для этих своих вопросов, так как они самой темы касаются только частично - только как некоторое развитие предложенного макроса.
sokol92, Ваш макрос это основное ядро моего макроса, где, в том числе, используются и различные изменения каких-то ячеек (по нажатию или по другому сценарию): меняется фон ячеек и шрифт в них.
Некоторые задачи я решил, но есть и не решеные на данный момент. Они не принципиальные - можно использовать более длинные решения, как например с диапазонами - все, что необходимо решить с одним диапазоном, затем, перейти к другому, но если изменения для двух и более разных диапазонов однотипные, то, мне думается, логичнее объединить эти диапазоны и проводить над ними одни и те же действия - если это конечно возможно в рамках макроса на Basic.
Можно привести пример того что я хотел бы решить.
Определяются два диапазона:
oRange1 = ThisComponent.CurrentSelection.SpreadSheet.getCellRangeByPosition(0, 2, 2, 2)
oRange2 = ThisComponent.CurrentSelection.SpreadSheet.getCellRangeByPosition(13, 15, 15, 15)

Есть ли возможность свести эти две переменные в одну или, допустим, в момент определения диапазонов уже задать эти две области?

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

eeigor

#12
Цитата: Tigrik от 27 декабря 2021, 20:43Есть ли возможность свести эти две переменные в одну
oRanges = ThisComponent.createInstance("com.sun.star.sheet.SheetCellRanges")

oRanges.addRangeAddress(oRange1.RangeAddress, False)
oRanges.addRangeAddress(oRange2.RangeAddress, False)

Или:
oRanges.addRangeAddresses(Array(oRange1.RangeAddress, oRange2.RangeAddress), False)
Ubuntu 18.04 LTS • LibreOffice 7.5.1.2 Community

Tigrik


Tigrik

Всех с Наступившим 2022 Годом, с пожеланием Здоровья и Всех Благ!

Есть некоторая модификация этого макроса, но, скорее всего, здесь нужен будет другой алгоритм и другие функции и методы.
Почти два года назад я занимался фигурами, но в Draw и даже не знаю - можно ли такое делать в Calc.
А задача, на самом деле, совсем не сложная - кликать мышкой на какую-нибудь фигуру, распознать и записать её имя в ячейку B1.
Для наглядности прилагается файл - небольшая матрица различных фигур.
Сначала, я думал, что когда какую-либо фигуру, которая привязана к конкретной ячейке, выбираешь мышкой, то может "отзываться" и сама ячейка, но прогадал - выделяется только сама фигура.
Подскажите, пожалуйста, как в Calc "выйти" на фигуры - какой используется сервис и методы?

Спасибо.