ShapedDemo1.bas

This code accompanies the article Creating a Nonrectangular Window

 'ShapedDemo1.bas - Janet Terra 
 'Demo to accompany 
 'Demo - Creating a Nonrectangular Window 
 'LBPE July, 2011 
 'Originally appeared in 
 'LB Newsletter #132, May, 2005 
 
 Nomainwin 
 
 'Define the Window 
 WindowWidth = 500 
 WindowHeight = 500 
 UpperLeftX = int((DisplayWidth-WindowWidth)/2) 
 UpperLeftY = int((DisplayHeight-WindowHeight)/2) 
 
 graphicbox #ShapeWindow.gb, 0, 0, 500, 500 
 stylebits #ShapeWindow.gb, 0, _WS_BORDER, 0, 0 
 'Keep the Shaped Window in the Forefront 
 stylebits #ShapeWindow, 0, 0, _WS_EX_TOPMOST, 0 
 
 open "Shape Window" for window_popup as #ShapeWindow 
 #ShapeWindow "trapclose [closeShapeWindow]" 
 
 'Obtain the Handles and Device Controls 
 hBw = hWnd(#ShapeWindow) 
 hBgb = hWnd(#ShapeWindow.gb) 
 hDCw = GetDC(hBw) 
 hDCgb = GetDC(hBgb) 
 
 'Draw the Shape 
 #ShapeWindow.gb "Down" 
 Gosub gosub [drawShape] 
 
 'Set background to Transparent 
 Call call SetBkMode hDCgb, 1 
 'Release memory 
 Call call ReleaseDC hBgb, hDCbg 
 
 'Format Text 
 #ShapeWindow.gb "font Courier_New 14 Bold" 
 #ShapeWindow.gb "color Black; place 120 150" 
 #ShapeWindow.gb "\Alt-F4 to Close" 
 #ShapeWindow.gb "flush" 
 Wait wait 
 
 [closeShapeWindow] 
 'Delete API created objects before closing program 
 Call call DelObject hBw 
 Close close #ShapeWindow 
 End end 
 
 [drawShape] 
 'Original values for hRgn is meaningless 
 hRgn = RectRegion(0, 0, 0, 0) 
 
 'hRgn1 = Elliptical Source Region 
 hRgn1 = EllipticRegion(100, 50, 200, 250) 
 'Paint the Ellipse Red 
 brushColor1 = 255 'Red Brush 
 hBrush1 = createBrush(brushColor1) 
 Call call SelObject hDCw, hBrush1 
 Call call PaintRegion hDCw, hRgn1 
 Call call DelObject hBrush1 
 
 'Set hRgn to the Combination of itself and hRgn1 
 newRgn = CombineRgn(hRgn, hRgn, hRgn1, _RGN_OR) 
 
 'Delete hRgn1 
 Call call DelObject hRgn1 
 
 'hRgn2 = Rectangular Source Region 
 hRgn2 = RectRegion(150, 75, 300, 200) 
 'Paint the rectangle blue 
 brushColor2 = 255 * 256^2 'Blue Brush 
 hBrush2 = createBrush(brushColor2) 
 Call call SelObject hDCw, hBrush2 
 Call call PaintRegion hDCw, hRgn2 
 Call call DelObject hBrush2 
 
 'Set hRgn to the Combination of itself and hRgn2 
 newRgn = CombineRgn(hRgn, hRgn, hRgn2, _RGN_OR) 
 
 'Delete hRgn2 
 Call call DelObject hRgn2 
 
 'Set hRgn as the Window 
 Call call SetWindowRgn hBw, hRgn, 1 
 Return Function return 
 
 function GetDC(hW) 
 Calldll calldll #user32, "GetDC", _ 
 hW as ulong, _ 
 GetDC as ulong 
 End Function Function end function 
 
 function RectRegion(ulx, uly, width, height) 
 CallDLL calldll #gdi32, "CreateRectRgn", _ 
 ulx as long, _ 
 uly as long, _ 
 width as long, _ 
 height as long, _ 
 RectRegion as ulong 
 End Function Function end function 
 
 function EllipticRegion(ulx, uly, width, height) 
 CallDLL calldll #gdi32, "CreateEllipticRgn", _ 
 ulx as long, _ 
 uly as long, _ 
 width as long, _ 
 height as long, _ 
 EllipticRegion as ulong 
 End Function Function end function 
 
 function CombineRgn(hDest, hSource1, hSource2, combineMode) 
 CallDLL calldll #gdi32, "CombineRgn", _ 
 hDest as ulong, _ 
 hSource1 as ulong, _ 
 hSource2 as ulong, _ 
 combineMode as long, _ 
 CombineRgn as ulong 
 End Function Function end function 
 
 function createBrush(brushColor) 
 Calldll calldll #gdi32, "CreateSolidBrush", _ 
 brushColor as long, _ 
 createBrush as ulong 
 End Function Sub end function 
 
 sub PaintRegion hDC, hRgn 
 Calldll calldll #gdi32, "PaintRgn", _ 
 hDC as ulong, _ 
 hRgn as ulong, _ 
 null as long 
 End Sub Sub end sub 
 
 sub DelObject hObject 
 Calldll calldll #gdi32, "DeleteObject",_ 
 hObject as ulong,_ 
 null as long 
 End Sub Sub end sub 
 
 sub SelObject hDC, hBrush 
 Calldll calldll #gdi32, "SelectObject", _ 
 hDC as ulong, _ 
 hBrush as ulong, _ 
 null as long 
 End Sub Sub end sub 
 
 sub ReleaseDC hWnd, hDC 
 Calldll calldll #user32,"ReleaseDC", _ 
 hWnd as ulong,_ 
 hDC as ulong, _ 
 null as long 
 End Sub Sub end sub 
 
 sub SetWindowRgn hWnd, hRgn, redrawMode 
 Calldll calldll #user32, "SetWindowRgn",_ 
 hWnd as ulong,_ 
 hRgn as ulong,_ 
 redrawMode as boolean,_ 
 SetWindowRgn as long 
 End Sub Sub end sub 
 
 sub SetBkMode hDC, flag 
 Calldll calldll #gdi32, "SetBkMode", _ 
 hDC as ulong,_ 
 flag as long, _ 
 null as long 
 End Sub end sub