Tweet
'#debug display
#compile exe
#dim all
#include "WIN32API.INC"
' steering
'
$picpath="c:\pics\busbust.jpg" '<========== change to your image
'
'==========================================================================
' GDIPLUS DECLARATIONS
' borrowed from the GDIPlus header file published in the PowerBASIC forums
' by Patrice Terrier
'==========================================================================
'GDIP CONSTANTS
%QualityModeHigh = 2 ' Best rendering quality
%UnitPixel = 2 ' Each unit is one device pixel.
'-----------------------------------------------------------------------------------------------------------------------
'
type GdiplusStartupInput
GdiplusVersion as dword '// Must be 1
DebugEventCallback as dword '// Ignored on free builds
SuppressBackgroundThread as long '// FALSE unless you're prepared to call
'// the hook/unhook functions properly
SuppressExternalCodecs as long '// FALSE unless you want GDI+ only to use
'// its internal image codecs.
end type
'
'-----------------------------------------------------------------------------------------------------------------------
'
type GdiplusStartupOutput
' // The following 2 fields are NULL if SuppressBackgroundThread is FALSE.
' // Otherwise, they are functions which must be called appropriately to
' // replace the background thread.
' //
' // These should be called on the application's main message loop - i.e.
' // a message loop which is active for the lifetime of GDI+.
' // "NotificationHook" should be called before starting the loop,
' // and "NotificationUnhook" should be called after the loop ends.
NotificationHook as dword
NotificationUnhook as dword
end type
'
'GDIP CONSTANTS
%QualityModeHigh = 2 ' Best rendering quality
%UnitPixel = 2 ' Each unit is one device pixel.
'--------------------------------------------------------------------------------
'
type GdiplusStartupInput
GdiplusVersion as dword '// Must be 1
DebugEventCallback as dword '// Ignored on free builds
SuppressBackgroundThread as long '// FALSE unless you're prepared to call
'// the hook/unhook functions properly
SuppressExternalCodecs as long '// FALSE unless you want GDI+ only to use
'// its internal image codecs.
end type
'
'-----------------------------------------------------------------------------------------------------------------------
'
type GdiplusStartupOutput
' // The following 2 fields are NULL if SuppressBackgroundThread is FALSE.
' // Otherwise, they are functions which must be called appropriately to
' // replace the background thread.
' //
' // These should be called on the application's main message loop - i.e.
' // a message loop which is active for the lifetime of GDI+.
' // "NotificationHook" should be called before starting the loop,
' // and "NotificationUnhook" should be called after the loop ends.
NotificationHook as dword
NotificationUnhook as dword
end type
'
'-----------------------------------------------------------------------------------------------------------------------
type ImageCodecInfo
ClassID as guid '// CLSID. Codec identifier
FormatID as guid '// GUID. File format identifier
CodecName as dword '// WCHAR*. Pointer to a null-terminated string
'// that contains the codec name
DllName as dword '// WCHAR*. Pointer to a null-terminated string
'// that contains the path name of the DLL in
'// which the codec resides. If the codec is not
'// a DLL, this pointer is NULL
FormatDescription as dword '// WCHAR*. Pointer to a null-terminated string
'// that contains the name of the format used by the codec
FilenameExtension as dword '// WCHAR*. Pointer to a null-terminated string
'// that contains all file-name extensions associated
'// with the codec. The extensions are separated with semicolons.
MimeType as dword '// WCHAR*. Pointer to a null-terminated string
'// that contains the mime type of the codec
Flags as dword '// Combination of flags from the ImageCodecFlags enumeration
Version as dword '// Integer that indicates the version of the codec
SigCount as dword '// Integer that indicates the number of signatures
'// used by the file format associated with the codec
SigSize as dword '// Integer that indicates the number of bytes of each signature
SigPattern as dword '// BYTE*. Pointer to an array of bytes that contains
'// the pattern for each signature
SigMask as dword '// BYTE*. Pointer to an array of bytes that contains
'// the mask for each signature
end type
'-----------------------------------------------------------------------------------------------------------------------
'
declare function GdipSetInterpolationMode lib "gdiplus.dll" alias "GdipSetInterpolationMode" (byval graphics as long, byval interpolation as long) as long
declare function GdipDrawImageRectI lib "gdiplus.dll" alias "GdipDrawImageRectI" (byval graphics as long, byval nImage as long, byval x as long, byval y as long, byval nWidth as long, byval Height as long) as long
declare function GdipGetImageWidth lib "gdiplus.dll" alias "GdipGetImageWidth" (byval nImage as long, nWidth as long) as long
declare function GdipGetImageHeight lib "gdiplus.dll" alias "GdipGetImageHeight" (byval nImage as long, Height as long) as long
declare function GdipDeleteGraphics lib "gdiplus.dll" alias "GdipDeleteGraphics" (byval graphics as long) as long
declare function GdipGraphicsClear lib "gdiplus.dll" alias "GdipGraphicsClear" (byval graphics as long, byval lColor as long) as long
declare function GdipCreateFromHDC lib "gdiplus.dll" alias "GdipCreateFromHDC" (byval hdc as long, graphics as long) as long
declare function GdipGetImagePixelFormat lib "gdiplus.dll" alias "GdipGetImagePixelFormat" _
(byval nImage as long, PixelFormat as long) as long
declare function GdipGetImageDimension lib "gdiplus.dll" alias "GdipGetImageDimension" _
(byval nImage as long, nWidth as single, Height as single) as long
declare function GdiplusStartup lib "GDIPLUS.DLL" alias "GdiplusStartup" _
(token as dword, inputbuf as GdiplusStartupInput, outputbuf as GdiplusStartupOutput) as long
declare sub GdiplusShutdown lib "GDIPLUS.DLL" alias "GdiplusShutdown" _
(byval token as dword)
declare function GdipLoadImageFromFile lib "GDIPLUS.DLL" alias "GdipLoadImageFromFile" _
(byval flname as string, lpImage as dword) as long
declare function GdipDisposeImage lib "GDIPLUS.DLL" alias "GdipDisposeImage" _
(byval lpImage as dword) as long
'==========================================================================
' GDIPLUS PROCS
'==========================================================================
'-----------------------------------------------------------------------------------------------------------------------
' load the image file, returning the image handle
function loadimagefile (picpath as string) as long
local limage as long
GDIPLoadImageFromFile ucode$(picPath), limage
'
if limage = 0 then
function = -1
exit function
end if
function = limage
end function
'
'-------------------------------------------------------------------------------------------------------
' Computes location and size to stretch a bitmap preserving its aspect.
'
sub skIconise (byval xPic as long, byval yPic as long, _ picture dimensions
byval xCell as long, byval yCell as long, _ FRAME dimensions
byref xOfs as long, byref yOfs as long, _ calc'd offset in frame
byref xSize as long, byref ySize as long) export ' thumbnail dimensions
local scale as single
if xPIC& then scale! = xCell& / xPic&
if scale! > 1 then scale! = 1
xSize& = xPic& * scale!: ySize& = yPic& * scale!
' In case Height > 150 compute new scale factor
if ySize& > yCell& then
if yPic& then scale! = yCell& / yPic&
xSize& = xPic& * scale!: ySize& = yPic& * scale!
end if
xOfs& = (xCell& - xSize&) \ 2
yOfs& = (yCell& - ySize&) \ 2
end sub
'-----------------------------------------------------------------------------
' 1st param is the window handle for the image window
' 2nd is DC is called for a WM_ERASEBKGND message, zero for a WM_PAINT message
' 3rd is image handle
sub PaintW(hW as long, hDC as long, limage as long, pfont as dword, pformat as dword, pbrush as dword)
local ps as PAINTSTRUCT
local r, rpic as RECT
'local rf as rectf
local hG as dword
local tx, ty, framex, framey, l, ofsx, ofsy as long
local W, H as single
local s as string
' hDC = hDCin
getclientrect(hW, r)
rpic = r
frameX = r.nRight - r.nLeft
frameY = r.nBottom - r.nTop
GdipGetImageDimension lImage, W, H
' calculate coordinates to centre image in frame, retaining the original proportion
skIconise ( W, H, frameX, frameY, ofsX, ofsY, tX, tY)
if GdipCreatefromHDC ( hDC, hG) = 0 then
if hG <> 0 then
GDIpGraphicsClear hG, &HFFFF' clear to white
if limage then
fillrect hDC, rpic, getstockobject(%gray_brush)
framerect hDC, rpic, getstockobject(%gray_brush)
end if
' can also set smoothing mode, etc here
GdipSetInterpolationMode(hG, %QualityModeHigh)
GdipDrawImageRectI(hG, limage, r.nleft + ofsX, r.ntop + ofsY, tX, tY)
if hG <> 0 then gdipdeletegraphics hG
end if
end if
end sub
'==========================================================================
' END OF GDIPLUS STUFF
'==========================================================================
'--------------------------------------------------------
function pbmain () as long
local GW, hDC, lresult as long
local nstatus as long
local token as dword
local StartupInput as GdiplusStartupInput
local pbrush, pfont, pfontfamily, pformat as dword
local WW, HH as single
local sfont as string
local skey as string
local limage as long
freeconsole
if isfile($picpath) = 0 then
' you have to supply an image path and it must be smaller than the desktop.
messagebox 0, "you have to supply an image path", "Fatal", %mb_taskmodal
exit function
end if
StartupInput.GdiplusVersion = 1
nStatus = GdiplusStartup(token, StartupInput, byval %NULL)
if nStatus then
messagebox 0, "Error initializing GDI+", "Warning", %mb_taskmodal
exit function
end if
'
limage = loadimagefile ($picpath)
GdipGetImageDimension lImage, WW, HH
graphic window "test: ESC to exit", 0, 0, WW, HH to GW
graphic attach GW, 0, redraw
graphic window stabilize
graphic get dc to hDC
call paintW(gW, hDC, limage, pfont, pformat, pbrush)
graphic redraw
do
graphic waitkey$ to skey
loop until skey = $esc
'
graphic window end
if limage <> 0 then
lresult = gdipdisposeimage(limage)
end if
'
GdiplusShutdown token
graphic window normalize
end function
'==================================================================================================
' GDI Plus includes for Loading images from file (eg .jpg) to/from PB Bitmaps SM 3 Feb 2010
'==================================================================================================
' Code below based on "" by Chris Holbrook PB Forums 3 Jan 2010, based on Jose Roca's work
'
' When dealing with API's such as GDI plus the proper course of action is to grab the type library
' from Jose Roca's site (or others...) as an include, and all the functions will be available.
' The downside is that your compile time may well go through the roof, and you have no chance of
' browsing or understanding just HOW MUCH of that library is being used. And because it basically
' supersedes the powerbasic libraries, things may get complicated when you upgrade. Following the
' approach used by Chris Holbrook (and others...) a second method is to include this file, with
' just the stripped down declarations necessary to get the job done - about 2% of the original.
'
' You need need to be able to find out about GDI plus, reference Jose Rocas site (link @ 2/2/2010)
' http://www.jose.it-berater.org/gdiplus/iframe/index.htm
' You also should have on hand a link to full type library from Jose Roca (link valid @ 2/2/2010)
' http://www.jose.it-berater.org/smfforum/index.php?board=344.0
'
'--------------------------------------------------------------------------------------------------
%UnitPixel = 2 ' Sets each unit to be one device pixel
'--------------------------------------------------------------------------------------------------
'
TYPE GdiplusStartupInput
GdiplusVersion AS DWORD ' Must be 1
DebugEventCallback AS DWORD ' Ignored on free builds
SuppressBackgroundThread AS LONG ' FALSE unless you're prepared to call
' the hook/unhook functions properly
SuppressExternalCodecs AS LONG ' FALSE unless you want GDI+ only to use
' its internal image codecs.
END TYPE
'--------------------------------------------------------------------------------------------------
'
TYPE GdiplusStartupOutput
NotificationHook AS DWORD
NotificationUnhook AS DWORD
END TYPE
'--------------------------------------------------------------------------------------------------
'
TYPE ImageCodecInfo
ClassID AS GUID ' CLSID. Codec identifier
FormatID AS GUID ' GUID. File format identifier
CodecName AS DWORD ' WCHAR*. Pointer to a null-terminated string
' that contains the codec name
DllName AS DWORD ' WCHAR*. Pointer to a null-terminated string
' that contains the path name of the DLL in
' which the codec resides. If the codec is not
' a DLL, this pointer is NULL
FormatDescription AS DWORD ' WCHAR*. Pointer to a null-terminated string
' that contains the name of the format used by the codec
FilenameExtension AS DWORD ' WCHAR*. Pointer to a null-terminated string
' that contains all file-name extensions associated
' with the codec. The extensions are separated with semicolons.
MimeType AS DWORD ' WCHAR*. Pointer to a null-terminated string
' that contains the mime type of the codec
Flags AS DWORD ' Combination of flags from the ImageCodecFlags enumeration
Version AS DWORD ' Integer that indicates the version of the codec
SigCount AS DWORD ' Integer that indicates the number of signatures
' used by the file format associated with the codec
SigSize AS DWORD ' Integer that indicates the number of bytes of each signature
SigPattern AS DWORD ' BYTE*. Pointer to an array of bytes that contains
' the pattern for each signature
SigMask AS DWORD ' BYTE*. Pointer to an array of bytes that contains
' the mask for each signature
END TYPE
'--------------------------------------------------------------------------------------------------
DECLARE FUNCTION GdiplusStartup LIB "GDIPLUS.DLL" ALIAS "GdiplusStartup" _
(token AS DWORD, inputbuf AS GdiplusStartupInput, outputbuf AS GdiplusStartupOutput) AS LONG
DECLARE SUB GdiplusShutdown LIB "GDIPLUS.DLL" ALIAS "GdiplusShutdown" _
(BYVAL token AS DWORD)
DECLARE FUNCTION GdipGetImageEncodersSize LIB "GDIPLUS.DLL" ALIAS "GdipGetImageEncodersSize" _
(numEncoders AS DWORD, nSize AS DWORD) AS LONG
DECLARE FUNCTION GdipGetImageEncoders LIB "GDIPLUS.DLL" ALIAS "GdipGetImageEncoders" _
(BYVAL numEncoders AS DWORD, BYVAL nSize AS DWORD, BYVAL lpEncoders AS DWORD) AS LONG
DECLARE FUNCTION GdipSaveImageToFile LIB "GDIPLUS.DLL" ALIAS "GdipSaveImageToFile" _
(BYVAL lpImage AS DWORD, BYVAL flname AS DWORD, BYREF clsidEncoder AS GUID, _
BYREF EncoderParams AS DWORD) AS LONG
DECLARE FUNCTION GdipLoadImageFromFile LIB "GDIPLUS.DLL" ALIAS "GdipLoadImageFromFile" _
(BYVAL flnameptr AS DWORD, lpImage AS DWORD) AS LONG
'1st parm of GdipLoadImageFromFile is byval string in Patrice's translation and byval dword in
' Jose Roca's translation "for consistency with 1000s of functions..." per PBforums 19/11/09
DECLARE FUNCTION GdipGetImageDimension LIB "GDIPLUS.DLL" ALIAS "GdipGetImageDimension" _
(BYVAL nImage AS LONG, nWidth AS SINGLE, Height AS SINGLE) AS LONG
DECLARE FUNCTION GdipCreateFromHDC LIB "GDIPLUS.DLL" ALIAS "GdipCreateFromHDC" _
(BYVAL hdc AS LONG, graphics AS LONG) AS LONG
DECLARE FUNCTION GdipDrawImageRectRect LIB "GDIPLUS.DLL" ALIAS "GdipDrawImageRectRect" _
(BYVAL graphics AS DWORD, BYVAL pImage AS DWORD, _
BYVAL dstx AS SINGLE, BYVAL dsty AS SINGLE, BYVAL dstwidth AS SINGLE, BYVAL dstheight AS SINGLE, _
BYVAL srcx AS SINGLE, BYVAL srcy AS SINGLE, BYVAL srcwidth AS SINGLE, BYVAL srcheight AS SINGLE, _
BYVAL srcUnit AS LONG, BYVAL imageAttributes AS DWORD, _
BYVAL pcallback AS DWORD, BYVAL callbackData AS DWORD) AS LONG
DECLARE FUNCTION GdipCreateBitmapFromGdiDib LIB "GDIPLUS.DLL" ALIAS "GdipCreateBitmapFromGdiDib" _
(BYREF BitMapInfo, BYVAL DWORD, BYREF DWORD) AS LONG
DECLARE FUNCTION GdipDisposeImage LIB "GDIPLUS.DLL" ALIAS "GdipDisposeImage" _
(BYVAL lpImage AS DWORD) AS LONG
DECLARE FUNCTION GdipDeleteGraphics LIB "GDIPLUS.DLL" ALIAS "GdipDeleteGraphics" _
(BYVAL Graphics AS LONG) AS LONG
' I need to leave 3 more (unused) definitions here for compatibility with another module I use:
'declare function GdipGetImagePixelFormat lib "GDIPLUS.DLL" alias "GdipGetImagePixelFormat" _
' (byval nImage as long, PixelFormat as long) as long
'declare function GdipCreateBitmapFromScan0 lib "GDIPLUS.DLL" alias "GdipCreateBitmapFromScan0" _
' (byval long, byval long, byval long, byval long, byref any, byref dword) as long
'declare function GdipGetImageGraphicsContext lib "GDIPLUS.DLL" alias "GdipGetImageGraphicsContext" _
' (byval nImage as long, graphics as long) as long
'--------------------------------------------------------------------------------------------------
' ==========================================================================
' GetEncoderClsid
' The function GetEncoderClsid in the following example receives the MIME
' type of an encoder and returns the class identifier (CLSID) of that encoder.
' The MIME types of the encoders built into GDI+ are as follows:
' image/bmp image/jpeg image/gif image/tiff image/png
' ==========================================================================
FUNCTION GdiPlusGetEncoderClsid (BYVAL strMimeType AS STRING) AS STRING
'Retrieve encoder's clsid, where strMimeType is ansi string e.g. "image/jpeg"
'Routine courtesy Jose Roca GdipUtils.inc, freeware, posted PB Forums 23/12/09
LOCAL hr AS LONG
LOCAL pImageCodecInfo AS ImageCodecInfo PTR
LOCAL numEncoders AS DWORD
LOCAL nSize AS DWORD
LOCAL i AS LONG
LOCAL wstrlen AS LONG
LOCAL sMimeType AS STRING
hr = GdipGetImageEncodersSize(numEncoders, nSize)
REDIM buffer(nSize - 1) AS BYTE
pImageCodecInfo = VARPTR(buffer(0))
hr = GdipGetImageEncoders(numEncoders, nSize, BYVAL pImageCodecInfo)
IF hr = 0 THEN
FOR i = 1 TO numEncoders
wstrlen = lstrlenW(BYVAL @pImageCodecInfo.MimeType)
IF wstrlen THEN sMimeType = ACODE$(PEEK$(@pImageCodecInfo.MimeType, wstrlen * 2))
IF INSTR(UCASE$(sMimeType), UCASE$(strMimeType) ) THEN
FUNCTION = GUIDTXT$(@pImageCodecInfo.ClassID)
EXIT FOR
END IF
INCR pImageCodecInfo '// Increments pointer
NEXT
END IF
END FUNCTION
'===============================================================================
' Loading images from file .png .jpg .gif .tif ( and .bmp) to/from PB Bitmaps
'===============================================================================
FUNCTION GraphicLoadImageFileToBitmap( _
BYREF sImageFileName AS STRING, _ 'Image to load, extension = type
OPTIONAL BYVAL MaxWidth AS DWORD, _ 'Constrain Width to value, 0 = None
OPTIONAL BYVAL MaxHeight AS DWORD, _ 'Constrain Height value, 0 = None
OPTIONAL BYVAL StretchImg AS DWORD _ '0 = normal, 1 = Stretch image to xy
) AS DWORD 'Returns PB bitmap handle of image
'-------------------------------------------------------------------------------
'Supply the function with an ImageFileName - for instance photo.jpg - and it
' will attempt to make a new PB Graphic memory bitmap containing the image.
'You can optionally specify a maximum width and/or height for the image, and
' have the routine scale it as it is read in. While rarely needed, you can
' also optionally stretch the image, in which case the image will be made to
' equal MaxWidth and MaxHeight even though that may stretch or squash it.
'sImageFileName can be name or path+name, extn determines file type, eg jpg, png
'The function needs GDIPlus - so your program needs XP or better, basically.
'You need to call GdiplusStartup and GdiplusShutdown in your apps init/close
' If you do not Gdiplus calls will access memory they are not allowed - a GPF
'When you are finished using the PB memory bitmap, you must delete it with
' GRAPHIC BITMAP END. (Steven Murray 3 February 2010 airborn.com.au)
'-------------------------------------------------------------------------------
LOCAL ucImageFileName AS WSTRING 'sImageFileName converted to unicode
LOCAL pImage AS DWORD 'GDI+ image pointer, after reading in
LOCAL ImgWidth AS SINGLE 'Image width, pixels
LOCAL ImgHeight AS SINGLE 'Image height, pixels
LOCAL hBmp AS DWORD 'PB Graphic bitmap handle for image
LOCAL hDC AS DWORD 'Device context for PB Graphic bitmap
LOCAL pGraphics AS DWORD 'GDI+ Graphics object used to draw image
LOCAL hStatus AS LONG 'Status return value
IF StretchImg<>0 AND (MaxWidth=0 OR MaxHeight=0) THEN EXIT FUNCTION 'If bogus xy
IF ISFALSE ISFILE(sImageFileName) THEN
MSGBOX "[GraphicLoadImageFileToBitmap] called on <" & sImageFileName & _
"> Missing file"
EXIT FUNCTION 'Exit if image not available
END IF
ucImageFileName = sImageFileName 'Gdip wants filename as unicode
'Next ask GDI+ to read in the picture (ucImageFileName) to GDI+ image (pImage)
hStatus = GdipLoadImagefromFile(STRPTR(ucImageFileName),pImage)
IF hStatus THEN
MSGBOX "[GraphicLoadImageFileToBitmap] [GdipLoadImagefromFile] read error on <" & _
sImageFileName & ">"
EXIT FUNCTION 'Exit if GDI plus error on read
END IF
GdipGetImageDimension(pImage, ImgWidth, ImgHeight) 'Quiz GDI to get image size
IF ImgWidth = 0 OR ImgHeight = 0 THEN EXIT FUNCTION 'Exit if bogus image size
IF MaxWidth = 0 THEN MaxWidth = ImgWidth 'If not specified, width = actual
IF MaxHeight = 0 THEN MaxHeight = ImgHeight 'If not specified, height = actual
IF StretchImg= 0 THEN 'Only find maximums if no stretch
IF (ImgWidth / MaxWidth) > (ImgHeight / MaxHeight) THEN 'If width constrained
IF ImgWidth > MaxWidth THEN 'If a shrink is needed
MaxHeight = ImgHeight / (ImgWidth / MaxWidth) 'MaxHeight is now new y
END IF
ELSE
IF ImgHeight > MaxHeight THEN 'If a shrink is needed
MaxWidth = ImgWidth / (ImgHeight / MaxHeight) 'MaxWidth is now new x
END IF
END IF
END IF
GRAPHIC BITMAP NEW MaxWidth, MaxHeight TO hBmp 'Make a correctly sized PB Bitmap
IF hBmp = 0 THEN 'Test if PB could make the Bitmap
IF pImage THEN GdipDisposeImage(pImage) 'Cleanup
EXIT FUNCTION 'Exit if PB could not make Bitmap
END IF
'Else, we have proper sized Bitmap
GRAPHIC ATTACH hBmp, 0 'Select Bitmap as graphic target
GRAPHIC GET DC TO hDC 'Get a device context for Bitmap
hStatus = GdipCreateFromHDC(hDC, pGraphics) 'Create Graphic object
hStatus = GdipDrawImageRectRect(pGraphics, pImage, 0, 0, MaxWidth, MaxHeight, _
0, 0, ImgWidth, ImgHeight, %UnitPixel, %NULL, %NULL, %NULL)
IF pImage THEN GdipDisposeImage(pImage) 'Cleanup
IF pGraphics THEN GdipDeleteGraphics(pGraphics) ' more Cleanup
IF hStatus = 0 THEN
FUNCTION = hBmp 'If draw worked, return Bitmap
ELSE
GRAPHIC BITMAP END 'If draw failed, release Bitmap
END IF
GRAPHIC DETACH 'Finished with Bitmap, detach
END FUNCTION
'===============================================================================
FUNCTION GraphicSaveBitmapToImageFile(BYVAL hBmp AS DWORD, _
sImageFileName AS STRING) AS LONG
'-------------------------------------------------------------------------------
'Supply the function with a PB Graphic memory bitmap containing an image,
' while specifying an ImageFileName - For instance photo.jpg - to write
'The extension of the filename selects image type: .png/.jpg/.gif/.bmp/.tif
'This function is intended as the complement of GraphicLoadImageFileToBitmap
'The function needs GDIPlus - so your program needs XP or better, basically.
'When you are finished using the PB memory bitmap, you must delete it with
' GRAPHIC BITMAP END. (Steven Murray 3 February 2010 airborn.com.au)
'-------------------------------------------------------------------------------
' hBmp PB bitmap handle of image to be saved
' sImageFileName Name image to be saved as, extn = type
LOCAL ucImageFileName AS STRING 'sImageFileName converted to unicode
LOCAL Exten AS STRING 'sImageFileName extension eg ".jpg"
LOCAL FType AS STRING 'sImageFileName mime-type eg "image-jpeg"
LOCAL EncoderClsid AS GUID '16 byte GUID string of image encoder
LOCAL bmpDat AS STRING 'PB graphic bitmap saved to this string
LOCAL ImgWidth AS LONG 'Width of the bitmap in pixels
LOCAL ImgHeight AS LONG 'Height of the bitmap in pixels
LOCAL PixelPtr AS DWORD 'Pointer the start of the pixel data
LOCAL sbmi AS Bitmapinfo 'Bitmapinfo Structure - dib header
LOCAL pImage AS DWORD 'GDI+ image pointer, after conversion
LOCAL hStatus AS LONG 'Status return value
FUNCTION = %TRUE '
GRAPHIC ATTACH hBmp, 0 'Select Bitmap as "graphic target" to read out of
GRAPHIC GET BITS TO bmpDat 'And get the image data into the string bmpDat
ImgWidth = CVL(bmpDat,1) : ImgHeight = CVL(bmpDat,5) 'Get PB bitmap dimensions
PixelPtr = STRPTR(bmpDat) + 8 'First 8 bytes are width/height, then pixels
sbmi.bmiHeader.biSize = SIZEOF(sbmi.bmiHeader) 'Length of the structure
sbmi.bmiHeader.biWidth = ImgWidth 'Width of the bitmap
sbmi.bmiHeader.biHeight = 0-ImgHeight 'Height + sign is drawing direction
sbmi.bmiHeader.biPlanes = 1
sbmi.bmiHeader.biBitCount = 32 'Each pixel in bitmap is 32 bits
sbmi.bmiHeader.biCompression = %BI_RGB 'Actually, PB says it is BGR, but this works
'Next create a GDI+ bitmap (called pImage) from the bmi header we just made
' and the Pixel data supplied by "Graphic Get Bits" from the original bitmap
hStatus = GdipCreateBitmapFromGdiDib(BYREF sbmi, BYVAL PixelPtr, pImage)
IF hStatus THEN FUNCTION = %FALSE : EXIT FUNCTION 'Indicate failure and exit
Exten = LCASE$(PATHNAME$(EXTN,sImageFileName)) : FType = "" 'Get extension
'Now translate the file extension (eg ".png") to mimetype (eg "image/png")
FType = SWITCH$(Exten=".png", "image/png", Exten=".jpg", "image/jpeg", _
Exten=".gif", "image/gif", Exten=".tif", "image/tiff", _
Exten=".bmp", "image/bmp") 'Default seems to be bmp
EncoderClsid = GUID$(GdiPlusGetEncoderClsid(FType)) 'Get the CLSID of selected encoder
ucImageFileName = UCODE$(sImageFileName & $NUL) 'Translate the filename to unicode
'Next save the GDI+ bitmap (pImage) as an image of type specified by EncoderClsid
'to the filename specified when this function was called with no Encoder parameters
hStatus = GdipSaveImageToFile(pImage, STRPTR(ucImageFileName), EncoderClsid, BYVAL %Null)
IF hStatus THEN FUNCTION = %FALSE
IF pImage THEN GdipDisposeImage(pImage) 'Cleanup
END FUNCTION
'-----------------------------------------------------------------------------
FUNCTION PBMAIN () AS LONG
LOCAL GdipToken AS DWORD
LOCAL StartupInput AS GdiplusStartupInput
'Initialise GDI+ - this is required ONCE in app if any GDI+ stuff is used
StartupInput.GdiplusVersion = 1
IF GdiplusStartup(GdipToken,StartupInput, BYVAL %NULL) THEN
MSGBOX "Error initialising GDI+" ,,$AppTitle
EXIT FUNCTION
END IF
...
GdiplusShutdown GdipToken 'Shutdown GDI plus
END FUNCTION
Comment