Как побороть мерцание?

@MallSerg · Регистрация: 16.11.2018

Студворк — интернет-сервис помощи студентам

Думаю проблема в вызове

Visual Basic
1
gHwnd = CreateWindowEx(0, "static", "OpengGL", WS_POPUP, 0, 0, gWidth, gHeight, GetUserFormHandle(pCtrl.Parent), PtrNull, PtrNull, ByVal PtrNull)

GetUserFormHandle(pCtrl.Parent) ничего не возвращает потому что контрол image не является окном с точки зрения WinApi т.е. возвращается нулевой указатель который является всем экраном и отрисовка происходит на нем что приводит к мерцанию.

Как побороть такую беду без добавления внешних зависимостей? Хочется обойтись тока VBA ну и ддлками доступными относительно на любой винде.

Возможно не на всех экселях заработает кто может протестировать будет не лишним =).

VBAOpenGLExcel.zip

@testuser2 · 13.05.2025, 16:00

Дефект исчез, после замены соответствующей функции на это

Visual Basic
1
2
3
4
5
6
7
Public Function GetUserFormHandle(pForm As Object, Optional ByVal pClientArea As Boolean)
    Dim ShHwnd As LongPtr
'    Stop
    ShHwnd = FindWindowEx(Application.hwnd, 0, "XLDESK", vbNullString)
    
    GetUserFormHandle = FindWindowEx(ShHwnd, 0, "EXCEL7", vbNullString)
End Function

Здесь тоже кое что правил, но не знаю, стоило ли.

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Public Function InitOpenGLImage(pCtrl As MsForms.Image) As Boolean
    Dim picX&, picY&
    Dim ShHwnd As LongPtr
    'Stop
    ShHwnd = FindWindowEx(Application.hwnd, 0, "XLDESK", vbNullString)
    ShHwnd = FindWindowEx(ShHwnd, 0, "EXCEL7", vbNullString)
    Set gImage = pCtrl
    Set gFrame = Nothing
    ' Taille contrфle
    gWidth = PointsToPixelsX(pCtrl.Width) - 1
    gHeight = PointsToPixelsY(pCtrl.Height) - 1
    With ActiveWindow
        picX = .PointsToScreenPixelsX(pCtrl.Left) 'PointsToPixelsX(pCtrl.Left)
        picY = .PointsToScreenPixelsX(pCtrl.Top) 'PointsToPixelsX(pCtrl.Top)
    End With
    ' Crйe une fenкtre invisible pour le rendu
'    gHwnd = CreateWindowEx(0, "static", "OpengGL", WS_POPUP, 0, 0, gWidth, gHeight, GetUserFormHandle(pCtrl.Parent), PtrNull, PtrNull, ByVal PtrNull)
    gHwnd = CreateWindowEx(0, "static", "OpengGL", WS_POPUP, picX, picY, gWidth, gHeight, ShHwnd, PtrNull, Application.hInstance, ByVal PtrNull)
'    gHwnd = CreateWindowEx(0, "static", "OpengGL", WS_POPUP, picX, picY, gWidth, gHeight, pCtrl.Picture.handle, PtrNull, Application.hInstance, ByVal PtrNull)
    ' Initialise opengl
    InitOpenGLImage = PrivInitOpenGL
End Function

Вообще код выглядит плоховато, в том плане что где-то нет отступов и слишком много ByRef-аргументов в функциях. Это похоже на переделку с кода на Си там аргументы по умолчанию "ByVal", а в VB по умолчанию ByRef, на VB аргументы простых типов лучше всегда объявлять ByVal, только если нет необходимости в ByRef.

Добавлено через 5 часов 7 минут

Сообщение от testuser2

Вообще код выглядит плоховато

ваще конечно код продвинутый, много там всего

@MallSerg · 14.05.2025, 08:16 **[ТС]**

Сообщение от testuser2

Дефект исчез, после замены соответствующей функции на это

У меня мерцание осталось но уже в клиентской области экселя которая перерисовыется вставкой изображения в контрал.

Замена функции InitOpenGLImage приводит к ошибке Run-time error '-2147418113 (8000ffff)':
Сам эксель 2013.

Обозреватель объектов рассказывает что контрол изображения объявлен как "Image22 As Image2" а не "As MsForms.Image"

В принципе уже можно рисовать 3D и печатать но мерцание неприятное =(.

@testuser2 · 14.05.2025, 08:33

Сообщение от MallSerg

Замена функции InitOpenGLImage приводит к ошибке

Да на x64, я заметил Application.Hinstanse лишнее, так работает, picX, picY не знаю меняют что-то или нет, просто оставил, может быть ни чего не меняют

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Public Function InitOpenGLImage(pCtrl As MsForms.Image) As Boolean
    Dim picX&, picY&
    Dim ShHwnd As LongPtr
'    Stop
    ShHwnd = FindWindowEx(Application.hwnd, 0, "XLDESK", vbNullString)
    ShHwnd = FindWindowEx(ShHwnd, 0, "EXCEL7", vbNullString)
    Set gImage = pCtrl
    Set gFrame = Nothing
    ' Taille contrфle
    gWidth = PointsToPixelsX(pCtrl.Width) - 1
    gHeight = PointsToPixelsY(pCtrl.Height) - 1
    picX = PointsToPixelsX(pCtrl.Left)
    picY = PointsToPixelsX(pCtrl.Top)
    ' Crйe une fenкtre invisible pour le rendu
'    gHwnd = CreateWindowEx(0, "static", "OpengGL", WS_POPUP, 0, 0, gWidth, gHeight, GetUserFormHandle(pCtrl.Parent), PtrNull, PtrNull, ByVal PtrNull)
    gHwnd = CreateWindowEx(0, "static", "OpengGL", WS_POPUP, picX, picY, gWidth, gHeight, ShHwnd, 0, 0, ByVal PtrNull)
    ' Initialise opengl
    InitOpenGLImage = PrivInitOpenGL
End Function

@testuser2 · 14.05.2025, 09:01

Добавил вложение

@testuser2 · 14.05.2025, 09:10

Кстати, я там ошибку допустил, у CopyMemory последний параметр должен быть LongPtr

Visual Basic
1
Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dst As Any, Src As Any, ByVal Sz As LongPtr)

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

@MallSerg · 14.05.2025, 21:09 **[ТС]**

Решил с помощью костыля убираю image контрол за экран.

Visual Basic
1
2
3
Feuil1.Image21.Left = Feuil1.Image21.Left + 2000
'отрисовка
Feuil1.Image21.Left = Feuil1.Image21.Left - 2000

Тогда все отрисовывает без мигания. но в случае ошибки контрал фик найдешь )).

@testuser2 · 15.05.2025, 01:51

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

Сообщение от MallSerg

Решил с помощью костыля убираю image контрол за экран.

Можно еще видимость отключать

Visual Basic
1
Feuil1.Image21.Visible = False

Но стоит учитывать, что на листе Эксель при любом изменении/перемещении контролов есть такая фишка - может произвольно изменяться их размер и пропорции, поэтому это лучше контролировать, заранее запоминать размеры, а потом возвращать.

Новые блоги и статьи Все статьи Все блоги /
Angular: Вопросы и ответы на собеседовании Reangularity 15.06.2025 Готовишься к техническому интервью по Angular? Я собрал самые распространенные вопросы, с которыми сталкиваются разработчики на собеседованиях в этом году. От базовых концепций до продвинутых. . .	Архитектура Onion в ASP.NET Core MVC stackOverflow 15.06.2025 Что такое эта "луковая" архитектура? Термин предложил Джеффри Палермо (Jeffrey Palermo) в 2008 году, и с тех пор подход только набирал обороты. Суть проста - представьте себе лук с его. . .	Unity 4D GameUnited 13.06.2025 Четырехмерное пространство. . . Звучит как что-то из научной фантастики, правда? Однако для меня, как разработчика со стажем в игровой индустрии, четвертое измерение давно перестало быть абстракцией из. . .	SSE (Server-Sent Events) в ASP.NET Core и .NET 10 UnmanagedCoder 13.06.2025 Кажется, Microsoft снова подкинула нам интересную фичу в новой версии фреймворка. Работая с превью . NET 10, я наткнулся на нативную поддержку Server-Sent Events (SSE) в ASP. NET Core Minimal APIs. Эта. . .	С днём независимости России! Hrethgir 13.06.2025 Решил побеседовать, с утра праздничного дня, с LM о завоеваниях. То что она написала о народе, представителем которого я являюсь сам сначала возмутило меня, но дальше только смешило. Это чисто. . .
Лето вокруг. kumehtar 13.06.2025 Лето вокруг. Наполненное бурями и ураганами событий. На фоне магии Жизни, священной и вечной, неумелой рукой человека рисуется панорама душевного непокоя. Странные серые краски проникают и. . .	Популярные LM модели ориентированы на увеличение затрат ресурсов пользователями сгенерированного кода (грязь -заслуги чистоплюев). Hrethgir 12.06.2025 Вообще обратил внимание, что они генерируют код (впрочем так-же ориентированы разработчики чипов даже), чтобы пользователь их использующий уходил в тот или иной убыток. Это достаточно опытные модели,. . .	Топ10 библиотек C для квантовых вычислений bytestream 12.06.2025 Квантовые вычисления - это та область, где теория встречается с практикой на границе наших знаний о физике. Пока большая часть шума вокруг квантовых компьютеров крутится вокруг языков высокого уровня. . .	Dispose и Finalize в C# stackOverflow 12.06.2025 Работая с C# больше десяти лет, я снова и снова наблюдаю одну и ту же историю: разработчики наивно полагаются на сборщик мусора, как на волшебную палочку, которая решит все проблемы с памятью. Да,. . .	Повышаем производительность игры на Unity 6 с GPU Resident Drawer GameUnited 11.06.2025 Недавно копался в новых фичах Unity 6 и наткнулся на GPU Resident Drawer - штуку, которая заставила меня присвистнуть от удивления. По сути, это внутренний механизм рендеринга, который автоматически. . .

Как побороть мерцание?

Решение