ShapedWindowDemo1

Edit 4 …
Older Version Newer Version

JanetTerra JanetTerra Jul 4, 2011 

[[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"
    Gosub [drawShape]

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

 [closeShapeWindow]
'Delete API created objects before closing program
    Call DelObject hBw
    Close #ShapeWindow
    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 SelObject hDCw, hBrush1
    Call PaintRegion hDCw, hRgn1
    Call DelObject hBrush1

'Set hRgn to the Combination of itself and hRgn1
    newRgn = CombineRgn(hRgn, hRgn, hRgn1, _RGN_OR)

'Delete hRgn1
    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 SelObject hDCw, hBrush2
    Call PaintRegion hDCw, hRgn2
    Call DelObject hBrush2

'Set hRgn to the Combination of itself and hRgn2
    newRgn = CombineRgn(hRgn, hRgn, hRgn2, _RGN_OR)

'Delete hRgn2
    Call DelObject hRgn2

'Set hRgn as the Window
    Call SetWindowRgn hBw, hRgn, 1
    Return

    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

    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

    Function CombineRgn(hDest, hSource1, hSource2, combineMode)
        CallDLL #gdi32, "CombineRgn", _
            hDest as ulong, _
            hSource1 as ulong, _
            hSource2 as ulong, _
            combineMode as long, _
            CombineRgn as ulong
    End Function

    Function createBrush(brushColor)
        Calldll #gdi32, "CreateSolidBrush", _
            brushColor as long, _
            createBrush as ulong
    End Function

    Sub PaintRegion hDC, hRgn
        Calldll #gdi32, "PaintRgn", _
            hDC as ulong, _
            hRgn as ulong, _
            null as long
    End Sub

    Sub DelObject hObject
        Calldll #gdi32, "DeleteObject",_
            hObject as ulong,_
            null as long
    End Sub

    Sub SelObject hDC, hBrush
        Calldll #gdi32, "SelectObject", _
            hDC as ulong, _
            hBrush as ulong, _
            null as long
    End Sub

    Sub ReleaseDC hWnd, hDC
        Calldll #user32,"ReleaseDC", _
            hWnd as ulong,_
            hDC as ulong, _
            null as long
     End Sub

    Sub SetWindowRgn hWnd, hRgn, redrawMode
        Calldll #user32, "SetWindowRgn",_
            hWnd as ulong,_
            hRgn as ulong,_
            redrawMode as boolean,_
            SetWindowRgn as long
    End Sub

    Sub SetBkMode hDC, flag
        Calldll #gdi32, "SetBkMode", _
            hDC as ulong,_
            flag as long, _
            null as long
     End Sub
[[code]]