[реклама вместо картинки]
недавно понадобилось мне создать шкурку из png картинки, но с поддержкой альфа канала, а не такую, что получается при использовании стандартной пуриковской WinSkin. и, удивительное дело, гугл отказался мне помочь. для пурика решения не нашлось. пришлось курить WinAPI и рожать самому.
думаю, надо поделиться с народом, вдруг еще кто-то захочет написать виджет или просто красиво ошкурить своё окошко, но ему будет лениво самому изобретать велосипед.
вот код модуля "wndSkin.pb" с необходимыми функциями:
; ©barsunduk© 10/2011
EnableExplicit
UsePNGImageDecoder()
;#ULW_ALPHA = 2
;#AC_SRC_ALPHA = 1
Structure TPoint
x.l
y.l
EndStructure
Structure TBlendFunction
BlendOp.b
BlendFlags.b
SourceConstantAlpha.b
AlphaFormat.b
EndStructure
Structure TArgb
b.b
g.b
r.b
a.b
EndStructure
Global Dim acol(256, 256)
Global xy.TPoint
Global dx = 0
Global dy = 0
Global Moving = #False
; создание копии картинки, но с другими размерами
Procedure imgResize(hImg, newW, newH)
Protected hImgNew = GrabImage(hImg, #PB_Any, 0, 0, ImageWidth(hImg), ImageHeight(hImg))
ResizeImage(hImgNew, newW, newH, #PB_Image_Raw)
ProcedureReturn hImgNew
EndProcedure
; создание битовой карты для ошкуривания
; обработка каналов, изменение размеров битмапа
; если размеры менять не надо, то newW и newH = #PB_Ignore
; hBmp можно не указывать (т.е. = #PB_Any),
; в любом случае будет создан новый битмап,
; а старый будет уничтожен
Procedure png2bmp(hPng, hBmp, newW, newH)
Protected w = ImageWidth(hPng)
Protected h = ImageHeight(hPng)
Dim pix(w, h)
If hBmp <> #PB_Any
FreeImage(hBmp)
EndIf
hBmp = CreateImage(#PB_Any, w, h, 32)
StartDrawing(ImageOutput(hPng))
DrawingMode(#PB_2DDrawing_AlphaChannel)
Protected p, x, y, a
For y = 0 To h - 1
For x = 0 To w - 1
p = Point(x, y)
a = Alpha(p)
pix(x, y) = RGBA(acol(a, Red(p)), acol(a, Green(p)), acol(a, Blue(p)), a)
Next
Next
StopDrawing()
x = 0
y = h - 1
StartDrawing(ImageOutput(hBmp))
DrawingMode(#PB_2DDrawing_AlphaChannel)
Protected *pixel.TArgb = DrawingBuffer()
Protected *ends = *pixel + (w * h * 4)
While (*pixel < *ends)
p = pix(x, y)
*pixel\a = Alpha(p)
*pixel\r = Red(p)
*pixel\g = Green(p)
*pixel\b = Blue(p)
*pixel + 4
x + 1
If x >= w
x = 0
y - 1
EndIf
Wend
StopDrawing()
FreeArray(pix())
If (newW <> #PB_Ignore)Or(newH <> #PB_Ignore)
If newW = #PB_Ignore
newW = w
EndIf
If newH = #PB_Ignore
newH = h
EndIf
ResizeImage(hBmp, newW, newH, #PB_Image_Raw)
EndIf
ProcedureReturn hBmp
EndProcedure
; создание дочернего окна размером с картинку
Procedure wndCreateChild(hParentWnd, hImage)
ProcedureReturn OpenWindow(#PB_Any, 0, 0, ImageWidth(hImage), ImageHeight(hImage), "", #PB_Window_BorderLess|#WS_POPUP, WindowID(hParentWnd))
EndProcedure
; функция ошкуривания окна с учетом альфа канала
; hImage должна быть предварительно обработана фунцией png2bmp
Procedure wndSkin(hWnd, hImage)
; получаем хэндл битовой карты
Protected hDC = StartDrawing(ImageOutput(hImage))
DrawingMode(#PB_2DDrawing_AlphaChannel)
Protected pt2.TPoint; координаты нужного участка шкурки
pt2\x = 0
pt2\y = 0
Protected sz.TPoint; размер нужного участка шкурки
sz\x = ImageWidth(hImage)
sz\y = ImageHeight(hImage)
Protected bf.TBlendFunction; прозрачность
bf\BlendOp = 0;#AC_SRC_OVER
bf\BlendFlags = 0
bf\SourceConstantAlpha = 255 ; общая прозрачность окна
bf\AlphaFormat = 1;#AC_SRC_ALPHA; используем альфа-канал
; добавляем окну необходимые для ошкуривания свойства
SetWindowLong_(WindowID(hWnd), #GWL_EXSTYLE, GetWindowLong_(WindowID(hWnd), #GWL_EXSTYLE)|#WS_EX_LAYERED|#PB_Window_BorderLess|#WS_POPUP)
; ошкуриваем
UpdateLayeredWindow_(WindowID(hWnd), 0, 0, @sz, hDC, @pt2, 0, @bf, 2);#ULW_ALPHA)
StopDrawing()
Delay(1)
EndProcedure
; если перемещение инициировано, то перемещаем окно вслед за курсором
Procedure wndMoving(hWnd)
If Moving
GetCursorPos_(xy)
ResizeWindow(hWnd, xy\x + dX, xy\y + dY, #PB_Ignore, #PB_Ignore)
Moving = GetAsyncKeyState_(#VK_LBUTTON)
EndIf
EndProcedure
; инициируем перемещение окна
Procedure wndMoveOn(hWnd)
Moving = #True
GetCursorPos_(xy)
dx = WindowX(hWnd) - xy\x
dy = WindowY(hWnd) - xy\y
EndProcedure
; заносим в таблицу каналов результаты их смешивания с альфа-каналом
; просто небольшая оптимизация
Global iAlpha
Global iColor
For iAlpha = 0 To 255
For iColor = 0 To 255
acol(iAlpha, iColor) = (iAlpha * iColor) >> 8
Next
Nextа это пример использования модуля:
; ©barsunduk© 10/2011
EnableExplicit
UsePNGImageDecoder()
XIncludeFile("wndSkin.pb")
Global hWndParent, hWnd, hPopup
Global hPng, hBmp
Global defW, defH
Global Event, Menu, Quit
; невидимое родительское окно - для того чтобы программа не отображалась в панели задач
hWndParent = OpenWindow(#PB_Any, 0, 0, 1, 1, "AlphaSkin", #PB_Window_BorderLess|#PB_Window_Invisible)
; контекстное меню
hPopup = CreatePopupMenu(#PB_Any)
MenuItem(1, "Выход")
MenuBar()
MenuItem(2, "x 0.5")
MenuItem(3, "x 1.0")
; загрузка фона для шкурки
hPng = LoadImage(#PB_Any, GetPathPart(ProgramFilename()) + "Icons\back.png")
defW = ImageWidth(hPng)
defH = ImageHeight(hPng)
; создание битовой карты для шкурки
hBmp = png2bmp(hPng, #PB_Any, #PB_Ignore, #PB_Ignore)
; создание видимого (дочернего) окна размерами как у битовой карты
hWnd = wndCreateChild(hWndParent, hBmp)
; ошкуривание окна
wndSkin(hWnd, hBmp)
Quit = #False
Repeat
Event = WaitWindowEvent()
Select Event
Case #WM_LBUTTONDOWN
; передвигаем окно мышкой
; SendMessage_(WindowID(hWnd), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
; - этот способ вызывает утечку памяти
; заменим его на свой:
wndMoveOn(hWnd) ; инициализация перемещения
Case #WM_LBUTTONUP
; заканчиваем перетаскивание окна
Moving = #False
Case #WM_RBUTTONDOWN
; Контекстное меню правым кликом
DisplayPopupMenu(hPopup, WindowID(hWndParent))
Case #PB_Event_Menu
; обработка выбора пунктов контекстного меню
Menu = EventMenu()
If Menu = 1
; выход
Quit = #True
EndIf
If Menu = 2
; пересоздание битовой карты размером в половину оригинала
; старый битмап очищается во избежание закакивания памяти
hBmp = png2bmp(hPng, hBmp, defW / 2, defH / 2)
; переошкуривание окна
wndSkin(hWnd, hBmp)
EndIf
If Menu = 3
; пересоздание битовой карты нормального размера
hBmp = png2bmp(hPng, hBmp, defW, defH)
; переошкуривание окна
wndSkin(hWnd, hBmp)
EndIf
EndSelect
If Event = #PB_Event_CloseWindow
; выход по Alt+F4
Quit = #True
EndIf
; перемещение окна мышкой
wndMoving(hWnd)
Delay(20)
Until (Quit)
; ненужные пункты, но мне с ними как-то спокойнее
FreeImage(hPng)
FreeImage(hBmp)
EndОтредактировано barsunduk (04.04.2015 21:57:22)
