ShapedWindowDemo1

=ShapedDemo1.bas=
This code accompanies the article [[ShapedWindow|Creating a Nonrectangular Window]]

[[code format="lb"]]
'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"
    Gosubgosub [drawShape]

'Set background to Transparent
    Callcall SetBkMode hDCgb, 1
'Release memory
    Callcall 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"
    Waitwait

 [closeShapeWindow]
'Delete API created objects before closing program
    Callcall 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)
    Callcall 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
    Callcall 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)
    Callcall 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
    Callcall DelObject hRgn2

'Set hRgn as the Window
    Callcall SetWindowRgn hBw, hRgn, 1
    Return
    return

    Functionfunction GetDC(hW)
        Calldll
        calldll #user32, "GetDC", _
            hW as ulong, _
            GetDC as ulong
    End Functionend function

    Functionfunction 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 Functionend function

    Functionfunction 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 Functionend function

    Functionfunction 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 Functionend function

    Functionfunction createBrush(brushColor)
        Calldll
        calldll #gdi32, "CreateSolidBrush", _
            brushColor as long, _
            createBrush as ulong
    End Functionend function

    Subsub PaintRegion hDC, hRgn
        Calldll
        calldll #gdi32, "PaintRgn", _
            hDC as ulong, _
            hRgn as ulong, _
            null as long
    End Subend sub

    Subsub DelObject hObject
        Calldll
        calldll #gdi32, "DeleteObject",_
            hObject as ulong,_
            null as long
    End Subend sub

    Subsub SelObject hDC, hBrush
        Calldll
        calldll #gdi32, "SelectObject", _
            hDC as ulong, _
            hBrush as ulong, _
            null as long
    End Subend sub

    Subsub ReleaseDC hWnd, hDC
        Calldll
        calldll #user32,"ReleaseDC", _
            hWnd as ulong,_
            hDC as ulong, _
            null as long
     End Subend sub

    Subsub SetWindowRgn hWnd, hRgn, redrawMode
        Calldll
        calldll #user32, "SetWindowRgn",_
            hWnd as ulong,_
            hRgn as ulong,_
            redrawMode as boolean,_
            SetWindowRgn as long
    End Subend sub

    Subsub SetBkMode hDC, flag
        Calldll
        calldll #gdi32, "SetBkMode", _
            hDC as ulong,_
            flag as long, _
            null as long
     End Subend sub
[[code]]