Resizing Drawn Graphics

'scale drawn graphics to fill box
'Alyce Watson, August 2003
'API functions from LB Workshop
'http://alycesrestaurant.com/workshop.htm

nomainwin
swide=500   'desired image width
shigh=350   'desired image height
bwide=100   'current image width
bhigh=100   'current image height

WindowWidth=504:WindowHeight=396
graphicbox #1.g, 0,0,502,352
menu #1, "&File","&Stretch",[stretch],"E&xit",[quit]
Open "Graphics Scaler" for window_nf as #1
#1 "trapclose [quit]"
#1.g "down; fill blue; color red;size 2"
#1.g "backcolor cyan; place 50 50"
#1.g "circlefilled 50;flush"

'get DC of graphicbox
gDC=GetDC(hwnd(#1.g))


wait

[stretch]
if stretchedFlag=1 then
    notice "Image has already been stretched."
    wait
end if

'display in graphicbox, scaled
call StretchBlt gDC,0,0,swide,shigh,gDC,0,0,bwide,bhigh
'use getbmp to get and flush the stretched graphics
#1.g "segment segID"
#1.g "getbmp pix 0 0 ";swide;" ";shigh
#1.g "drawbmp pix 0 0; flush"
#1.g "delsegment ";segID
#1.g "discard"
stretchedFlag=1
wait

[quit]
call ReleaseDC hwnd(#1.g), gDC
close #1:end

Function GetDC(hWnd)
    CallDLL #user32, "GetDC",_
        hWnd As Long,_  'window or control handle
        GetDC As Long   'returns device context
    End Function

Sub ReleaseDC hWnd, hDC
    CallDLL#user32,"ReleaseDC",_
        hWnd As Long,_  'window or control handle
        hDC As Long,_   'handle of DC to delete
        result As Long
    End Sub

Sub StretchBlt hDCdest,x,y,w,h,hDCsrc,x2,y2,w2,h2
    CallDLL #gdi32, "SetStretchBltMode",_
        hDCdest As Long,_       'device context
        _COLORONCOLOR As Long,_ 'color reduction mode
        RESULT As Long
    CallDLL #gdi32, "StretchBlt",_
        hDCdest As Long,_   'destination
        x As Long,_         'destination x pos
        y As Long,_         'destination y pos 
        w As Long,_         'destination width desired
        h As Long,_         'destination height desired
        hDCsrc As Long,_    'source
        x2 As Long,_        'x location to start from source
        y2 As Long,_        'y location to start from source
        w2 As Long,_        'width desired from source
        h2 As Long,_        'height desired from source
        _SRCCOPY As Ulong,_ 'dwRasterOperation
        RESULT As Boolean
    End Sub

Displaying a Bitmap Resized

'scale bitmap to fill box
'Alyce Watson, August 2003
'API functions from LB Workshop
'http://alycesrestaurant.com/workshop.htm

nomainwin
swide=500   'desired image width
shigh=350   'desired image height

WindowWidth=504:WindowHeight=396
graphicbox #1.g, 0,0,502,352
menu #1, "&File","&Open",[open],"E&xit",[quit]
Open "Graphics Scaler" for window_nf as #1
#1 "trapclose [quit]"

'get DC of graphicbox
gDC=GetDC(hwnd(#1.g))

'create memory DC
mDC=CreateCompatibleDC(gDC)
wait

[open]
filedialog "Open","*.bmp",bmp$
if bmp$="" then wait

'unload previous image, if there is one
if hBitmap<>0 then unloadbmp "bitmap"

'load bitmap
loadbmp "bitmap",bmp$

'get handle of bitmap
hBitmap=hbmp("bitmap")

'get dimensions of image
bwide=BitmapWidth(hBitmap)
bhigh=BitmapHeight(hBitmap)

'select bmp into memory DC
oldBmp=SelectObject(mDC,hBitmap)

'display in graphicbox, scaled
call StretchBlt gDC,0,0,swide,shigh,mDC,0,0,bwide,bhigh
wait

[quit]
if hBitmap<>0 then unloadbmp "bitmap"
call ReleaseDC hwnd(#1.g), gDC
call DeleteDC mDC
close #1:end

Function GetDC(hWnd)
    CallDLL #user32, "GetDC",_
        hWnd As Long,_  'window or control handle
        GetDC As Long   'returns device context
    End Function

Sub ReleaseDC hWnd, hDC
    CallDLL#user32,"ReleaseDC",_
        hWnd As Long,_  'window or control handle
        hDC As Long,_   'handle of DC to delete
        result As Long
    End Sub

Function CreateCompatibleDC(hDC)
    CallDLL #gdi32,"CreateCompatibleDC",_
        hDC As Long,_               'window DC
        CreateCompatibleDC As Long  'memory DC
    End Function

Sub DeleteDC hDC
    CallDLL #gdi32, "DeleteDC",_
    hDC As Long,_   'memory DC to delete
    r As Boolean
    End Sub

Sub StretchBlt hDCdest,x,y,w,h,hDCsrc,x2,y2,w2,h2
    CallDLL #gdi32, "SetStretchBltMode",_
        hDCdest As Long,_       'device context
        _COLORONCOLOR As Long,_ 'color reduction mode
        RESULT As Long
    CallDLL #gdi32, "StretchBlt",_
        hDCdest As Long,_   'destination
        x As Long,_         'destination x pos
        y As Long,_         'destination y pos 
        w As Long,_         'destination width desired
        h As Long,_         'destination height desired
        hDCsrc As Long,_    'source
        x2 As Long,_        'x location to start from source
        y2 As Long,_        'y location to start from source
        w2 As Long,_        'width desired from source
        h2 As Long,_        'height desired from source
        _SRCCOPY As Ulong,_ 'dwRasterOperation
        RESULT As Boolean
    End Sub

Function BitmapWidth(Hbmp)
    struct BITMAP,_ 
    bmType As Long,_
    bmWidth As Long,_
    bmHeight As Long,_
    bmWidthBytes As Long,_
    bmPlanes As Word,_
    bmBitsPixel As Word,_
    bmBits As Long

    nSize=Len(BITMAP.struct)
    CallDLL #gdi32, "GetObjectA", Hbmp As Long,_
       nSize As Long,BITMAP As struct,_
       results As Long

    BitmapWidth=BITMAP.bmWidth.struct
End Function

Function BitmapHeight(Hbmp)
    struct BITMAP,_ 
    bmType As Long,_
    bmWidth As Long,_
    bmHeight As Long,_
    bmWidthBytes As Long,_
    bmPlanes As Word,_
    bmBitsPixel As Word,_
    bmBits As Long

    nSize=Len(BITMAP.struct)
    CallDLL #gdi32, "GetObjectA", Hbmp As Long,_
       nSize As Long,BITMAP As struct,_
       results As Long

    BitmapHeight=BITMAP.bmHeight.struct
End Function

Function SelectObject(hDC,hObject)
    CallDLL #gdi32,"SelectObject",_
        hDC As Long,_        'memory device context
        hObject As Long,_    'handle of object
        SelectObject As Long 'returns previously selected object
    End Function