[реклама вместо картинки]
недавно понадобилось мне создать шкурку из 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)