Прозрачность в WinApi, применительно к VBA

[EUGY]

fyedor, ну что же это такое
Вот у Вас фон на форме. Это значит, что форма имеет контекст, у контекста есть битмэп, на битмэпе нарисован карта.
Идея заключается в следующем. Создать контекст в памяти и нарисовать на нем.

Pie hMemDC, ...
А потом сделать наложение:
AlphaBlend hdc,... ..., hMemDC

А у Вас получается, что контекст создали, а рисуете почему-то не на нем.

[fyedor]

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

fyedor, ну что же это такое
Вот у Вас фон на форме. Это значит, что форма имеет контекст, у контекста есть битмэп, на битмэпе нарисован карта.
Идея заключается в следующем. Создать контекст в памяти и нарисовать на нем.

Pie hMemDC, ...
А потом сделать наложение:
AlphaBlend hdc,... ..., hMemDC

Ну делаю вот так:

    deskDC = apiGetDC(0) 
    hMemDC = apiCreateCompatibleDC(deskDC)
    
    CompatibleBitmap = CreateCompatibleBitmap(deskDC, 1000, 1000)
    Call apiSelectObject(deskDC, CompatibleBitmap)
    
    MyPen = apigetPen(5, 2, RGB(255, 0, 0))
    Call apiSelectObject(hMemDC, MyPen)

    MyBrash = ApiGetBrush(4, RGB(255, 0, 0))
    Call apiSelectObject(hMemDC, MyBrash)

    With bfn
        .BlendOp = AC_SRC_OVER
        .BlendFlags = 0
        .SourceConstantAlpha = 200
        .AlphaFormat = 0
    End With

    RtlMoveMemory LBF, BF, 4

    Call apiPie(hMemDC, X1, Y1, X2, Y2, 4500, 250, 130, 150)
    Call apiAlphaBlend(hdc, 0, 0, 100, 100, hMemDC, 0, 0, 100, 100, LBF)

Он вооще не выводит фигуру.. В чем проблема не понимаю...

[EUGY]

Вот прямо сейчас проверил минимум, все работает:

Option Explicit

Private Type MyBlendType
  blenfunc As Long
End Type

Private Sub Click()
    Dim deskDC As Long
    Dim hmemDC As Long
    Dim compBMP As Long
    Dim prevBMP As Long
    
    
    deskDC = GetDC(0)
    hmemDC = CreateCompatibleDC(deskDC)
    compBMP = CreateCompatibleBitmap(deskDC, 300, 300)
    prevBMP = SelectObject(hmemDC, compBMP)
    
    ' что-то рисуем в hmemDC
    Dim rc As RECT
    rc.Right = 50
    rc.Top = 70
    FillRect hmemDC, rc, GetSysColorBrush(COLOR_ACTIVECAPTION)
    
    Dim bfn As BLENDFUNCTION
    With bfn
      .BlendOp = AC_SRC_OVER
      .BlendFlags = 0
      .SourceConstantAlpha = 64
      .AlphaFormat = 0
    End With
    
     
    Dim f As MyBlendType
    LSet f = bfn
    AlphaBlend hDC, 0, 0, 300, 300, hmemDC, 0, 0, 300, 300, f.blenfunc
    
    SelectObject hmemDC, prevBMP
    DeleteDC hmemDC
    DeleteObject compBMP
    ReleaseDC 0, deskDC
End Sub

Проверяйте.


PS. Долго втыкал, что делает у Вас RtlMoveMemory

[fyedor]

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

Проверяйте.

Да, проверил, теперь хоть как-то работает

Только жаль, что данная фигура не стабильная... Что-то меняешь в окне (например, прокручиваешь окно вниз) - она начинает исчезать, можно сделать так, чтобы фигура была стабильной. Я так понимаю, нужно реагировать на изменение окна и производить обновление?

[fyedor]

А еще Вы однажды писали:

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

Конечно это дело хозяйское, но я бы все апи-декларации забил бы в TLB c помощью midl, и подключал бы через References в VB/VBA.

Можете подробнее описать, что значит забить в TLB с помощью midl?

[EUGY]

. Что-то меняешь в окне (например, прокручиваешь окно вниз) - она начинает исчезать, можно сделать так, чтобы фигура была стабильной.

У любого окна, имеющего хендл есть оконная процедура, в которой обрабатываются сообщения типа WM_.
В частности WM_PAINT. Событие происходит, когда винда определяет, что окно нуждается в прорисовке. Это бывает при появлении окна, при скролинге, при перекрытии других окон, итд.
Я не знаю, генерируют ли формы Access'а событие типа Paint, но если все же нет, то это решается сабклассингом окна. То есть подменой текущей оконной процедуры на свою при помощи / SetWindowLong GWL_WNDPROC /.
И в этой подменной процедуре ловить WM_PAINT и рисовать. Тогда при любом изменении (скроллинге итп) автоматически будет прорисовываться нужный вид.

забить в TLB с помощью midl

Создать текстовый документ с расширением *.idl
Примерно такого содержания:

[uuid(90000000-4000-4000-8000-0c4bdf600000), version(1.00),  helpstring("My super-puper API_WIN_32"),]
library API_WIN_32
{
        typedef long BOOL;
	typedef long DWORD;	
        typedef long HDC;

        [dllname("Msimg32.dll")]
	module msimg32
	{
		[entry("AlphaBlend")] 
                BOOL AlphaBlend(HDC hdcDest,  int xoriginDest,  int yoriginDest, int wDest,  int hDest,  
                        HDC hdcSrc,  int xoriginSrc,  int yoriginSrc, int wSrc, int hSrc,  DWORD dwBlendStruct);
	};
        // И прочие gdi, kernel, user

};

Создать батник :

@set FrameworkDir=%FrameworkDir32%
@set FrameworkVersion=%FrameworkVersion32%
@set "PATH=%WindowsSdkDir%bin\NETFX 4.0 Tools;%WindowsSdkDir%bin;%PATH%"
@set "INCLUDE=%WindowsSdkDir%include;%INCLUDE%"
@set "LIB=%WindowsSdkDir%lib;%LIB%"
@set DevEnvDir=%VSINSTALLDIR%Common7\IDE\
@set "PATH=%VSINSTALLDIR%Team Tools\Performance Tools;%PATH%"
@set PATH=%VCINSTALLDIR%VCPackages;%PATH%
@set PATH=%FrameworkDir%%Framework35Version%;%PATH%
@set PATH=%FrameworkDir%%FrameworkVersion%;%PATH%
@set PATH=%VSINSTALLDIR%Common7\Tools;%PATH%
@set PATH=%VCINSTALLDIR%BIN;%PATH%
@set PATH=%DevEnvDir%;%PATH%
@set "PATH=%VSINSTALLDIR%VSTSDB\Deploy;%PATH%"
@set "PATH=%FSHARPINSTALLDIR%;%PATH%"
@set INCLUDE=%VCINSTALLDIR%ATLMFC\INCLUDE;%INCLUDE%
@set INCLUDE=%VCINSTALLDIR%INCLUDE;%INCLUDE%
@set LIB=%VCINSTALLDIR%ATLMFC\LIB;%LIB%
@set LIB=%VCINSTALLDIR%LIB;%LIB%
@LIBPATH=%VCINSTALLDIR%ATLMFC\LIB;%LIBPATH%
@set LIBPATH=%VCINSTALLDIR%LIB;%LIBPATH%
@set LIBPATH=%FrameworkDir%%Framework35Version%;%LIBPATH%
@set LIBPATH=%FrameworkDir%%FrameworkVersion%;%LIBPATH%

midl /mktyplib203 /tlb D:\API\API_WIN_32.tlb D:\API\API_WIN_32.idl

И должна стоять какая-нибудь майкрософтовская студия от 2003-2010гг

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

[fyedor]

EUGY, спасибо Вам огромное за объяснение!

Построение идет. Жаль только еще сам битмэп виден... Можно как-нибудь битмэп сделать полностью прозрачным, а фигуре присвоить свою прозрачность?

[EUGY]

Жаль только еще сам битмэп виден

Речь идет о черном фоне, который вместе с рисунком разумеется выводится при наложении? Есть несколько способов.
Навскидку: регион отсечения , маска , альфа-канал.
У Вас графический примитив типа сектора, поэтому рекомендую первый, как самый простой.
Принцип такой: перед выводом AlphaBlend создать путь

BeginPath hdc
Pie hdc,.... 
EndPath hdc
PathToRegion hdc

Все графические функции внутри [BeginPath....EndPath] не рисуют, а только создают путь. При вызове PathToRegion в контексте формы будет создан регион отсечения. То есть любые графические функции будут способны рисовать только внутри него.
И так же AlphaBlend создаст наложение только в области этого региона, который совпадает очертаниями с рисунком в hmemDC.
После рисования в этом регионе нужно восстановить дефолтный регион в контексте , иначе потом даже серый фон формы не будет способен отобразиться.
Советую вообще сохранять контекст /SaveDC/ и при окончании рисования восстанавливать /RestoreDC/.
При работе с GDI открывайте диспетчер задач, сделайте видимым столбец "объекты GDI" и наблюдайте, если их количество постоянно увеличивается, значит в коде ошибки. Не освобождаются контексты, не удаляются битмэпы, пути, регионы и т.п.

[fyedor]

А BeginPath - это вообще откуда? У меня в редакторе не видит его...

[EUGY]

Обычная функция из Gdi32.lib

BOOL BeginPath(
  HDC hdc   // handle to DC
);

Public Declare Function BeginPath Lib "gdi32" Alias "BeginPath" (ByVal hdc As Long) As Long