ShapedWindowDemo3.bas

This code accompanies the article Creating a Nonrectangular Window

 'ShapedDemo3.bas - Janet Terra 
 'Demo to accompany 
 'Demo - Creating a Nonrectangular Window 
 'LBPE July, 2011 
 'Originally appeared in 
 'LB Newsletter #132, May, 2005 
 
 
 ' Use Flood Fill for changing background color to Buttonface 
 'Load a bitmap 
 loadbmp "pic", "boy.bmp" 
 
 'Open a small window for coloring 
 nomainwin 
 WindowWidth = 100 
 WindowHeight = 150 
 UpperLeftX = int((DisplayWidth-WindowWidth)/2) 
 UpperLeftY = int((DisplayHeight-WindowHeight)/2) 
 
 open "Untitled" for graphics as #g 
 
 'Get the DC of the window 
 hg = GetDC(hWnd(#g)) 
 'Fill with buttonface and change color to buttonface 
 #g "down; fill buttonface; drawbmp pic; flush" 
 #g "color buttonface; backcolor buttonface" 
 'Find the background color of the pic 
 origColor = pixelColor(hg, 1, 1) 
 'Change the background color to buttonface 
 call FloodFill hg, origColor, 1, 1 
 'Unload the old pic from memory 
 unloadbmp "pic" 
 'Place the new pic in memory 
 #g "getbmp pic 0 0 54 100" 
 'Get the handle of this pic 
 hPic = hBmp("pic") 
 'Close this window 
 close #g 
 '========================================= 
 
 'Define the Window 
 WindowWidth = 400 
 WindowHeight = 400 
 UpperLeftX = int((DisplayWidth-WindowWidth)/2) 
 UpperLeftY = int((DisplayHeight-WindowHeight)/2) 
 
 statictext #RoundWindow.st1, "", 90, 106, 200, 120 
 stylebits #RoundWindow.st1, _SS_BITMAP or _SS_CENTERIMAGE, 0, 0, 0 
 title2$ = "Alt - F4 to Close" 
 statictext #RoundWindow.st2, title2$, 90, 250, 200, 20 
 stylebits #RoundWindow.st2, _ES_CENTER, 0, 0, 0 
 
 open "No Title" for window as #RoundWindow 
 #RoundWindow "trapclose [closeRoundWindow]" 
 #RoundWindow.st2, "!font New_Courier 12 Bold" 
 
 'Obtain the Handles and Device Controls 
 hRw = hWnd(#RoundWindow) 
 hSt = hWnd(#RoundWindow.st1) 
 
 'Define the circle 
 hRgn = EllipticRegion(40, 80, 350, 380) 
 call SetWindowRgn hRw, hRgn 
 
 'Set the image 
 call setImage hSt, hPic 
 wait 
 
 [closeRoundWindow] 
 unloadbmp "pic" 
 call DelObject hBw 
 close #RoundWindow 
 end 
 
 sub DelObject hObject 
 calldll #gdi32, "DeleteObject",_ 
 hObject as ulong,_ 
 null as long 
 end sub 
 
 function GetDC(hW) 
 calldll #user32, "GetDC", _ 
 hW as ulong, _ 
 GetDC as ulong 
 end function 
 
 function RectRegion(ulx, uly, width, height) 
 calldll #gdi32, "CreateRectRgn", _ 
 ulx as long, _ 
 uly as long, _ 
 width as long, _ 
 height as long, _ 
 RectRegion as ulong 
 end function 
 
 sub SelObject hDC, hBrush 
 calldll #gdi32, "SelectObject", _ 
 hDC as ulong, _ 
 hBrush as ulong, _ 
 null as long 
 end sub 
 
 function EllipticRegion(ulx, uly, width, height) 
 calldll #gdi32, "CreateEllipticRgn", _ 
 ulx as long, _ 
 uly as long, _ 
 width as long, _ 
 height as long, _ 
 EllipticRegion as ulong 
 end function 
 
 sub SetWindowRgn hWnd, hRgn 
 calldll #user32, "SetWindowRgn",_ 
 hWnd as ulong,_ 
 hRgn as ulong,_ 
 1 as boolean,_ 
 returnSWR as long 
 end sub 
 
 function pixelColor(hDC, x, y) 
 calldll #gdi32, "GetPixel", _ 
 hDC as ulong, _ 
 x as long, _ 
 y as long, _ 
 pixelColor as long 
 end function 
 
 function hue$(hueColor) 
 hueBlue = Int(hueColor/256^2) 
 hueColor = hueColor - hueBlue*256^2 
 hueGreen = Int(hueColor/256) 
 hueRed = hueColor - hueGreen*256 
 hue$ = hueRed;" ";hueGreen;" ";hueBlue 
 end function 
 
 sub FloodFill hDC, origColor, x, y 
 calldll #gdi32, "ExtFloodFill", _ 
 hDC as uLong, _ 
 x as Long, _ 
 y as Long, _ 
 origColor as Long, _ 
 1 as Long, _ 
 result As Long 
 end sub 
 
 sub setImage hStatic, hImage 
 calldll #user32, "SendMessageA",_ 
 hStatic as ulong, _ 
 _STM_SETIMAGE as long, _ 
 _IMAGE_BITMAP as long, _ 
 hImage as ulong, _ 
 result as long 
 end sub 

Second Part Title Text here. 'code here