Tweet
The best GDI reference on the www is Jose Roca's http://com.it-berater.org/gdiplus/GdiPlus.htm
This code contains a minimal set of declarations and also the GDIplus status codes, which may save someone a bit of typing.
The application itself just allows the user to choose a picture file of most formats supported by GDIP and displays the picture.
This code contains a minimal set of declarations and also the GDIplus status codes, which may save someone a bit of typing.
The application itself just allows the user to choose a picture file of most formats supported by GDIP and displays the picture.
Code:
' A very simple application which displays a picture file chosen by the user.
' Uses GDIPLUS and includes error reporting using GDIplus status codes
' PB Win 8.04, no dependencies except standard INCLUDES.
'
' Chris Holbrook 1 August 2008
'
#COMPILE EXE
#DIM ALL
#INCLUDE "WIN32API.INC"
#INCLUDE "comdlg32.inc"
%IDD_DIALOG1 = 101
%IDC_getpic_bn = 1004
'------------------------------------------------------------------------------
' GDI+ status (error) codes
%StatusOk = 0
%StatusGenericError = 1
%StatusInvalidParameter = 2
%StatusOutOfMemory = 3
%StatusObjectBusy = 4
%StatusInsufficientBuffer = 5
%StatusNotImplemented = 6
%StatusWin32Error = 7
%StatusWrongState = 8
%StatusAborted = 9
%StatusFileNotFound = 10
%StatusValueOverflow = 11
%StatusAccessDenied = 12
%StatusUnknownImageFormat = 13
%StatusFontFamilyNotFound = 14
%StatusFontStyleNotFound = 15
%StatusNotTrueTypeFont = 16
%StatusUnsupportedGdiplusVersion = 17
%StatusGdiplusNotInitialized = 18
%StatusPropertyNotFound = 19
%StatusPropertyNotSupported = 20
'---------------------------------------------------------------------
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
'
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 GdipDeleteGraphics LIB "gdiplus.dll" ALIAS "GdipDeleteGraphics" (BYVAL graphics 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
DECLARE 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) ' thumbnail dimensions
'-------------------------------------------------------------------------------------------------------
' 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
'---------------------------------------------------------------------
' get image filename
FUNCTION getpic (hD AS LONG) AS STRING
LOCAL buf, spath, sfile AS STRING
LOCAL dwstyle AS DWORD
LOCAL hFile AS LONG
dwStyle = %OFN_EXPLORER OR %OFN_FILEMUSTEXIST OR %OFN_HIDEREADONLY
Buf = "Picture files (*.JPG,*.PNG,*.TIF,*.ICO,*.GIF,*.BMP)|*.JPG|*.PNG|*.TIF|*.ICO|*.PNG|*.BMP|"
sfile = "*.JPG;*.PNG;*.TIF;*.ICO;*.GIF;*.BMP"
IF OpenFileDialog (hD, "Locate image file ", sfile, spath, buf, "JPG", dwstyle) = 0 THEN
EXIT FUNCTION
END IF
FUNCTION = sfile
END FUNCTION
'------------------------------------------------------------------------
' callback function for dialog on which the image is displayed
'
CALLBACK FUNCTION PicDlgCB()
STATIC sPicPath AS STRING
STATIC himage AS DWORD
LOCAL pGraphics AS DWORD
LOCAL hdc AS DWORD
LOCAL r AS rect
LOCAL lPixelFormat AS LONG
LOCAL l, framex, framey AS LONG
STATIC ofsx, ofsy, tX, tY AS LONG
LOCAL maxwidth, maxheight AS LONG
LOCAL origwidth, origheight AS SINGLE
STATIC sGDIPStatusCodes() AS STRING ' table of error codes referenced by GDIP status codes
LOCAL sGDIPfn AS STRING ' GDIP function name for error reporting
SELECT CASE AS LONG CBMSG
CASE %WM_INITDIALOG
' initialise static variables
himage = 0: ofsx = 0: ofsy = 0: tX = 0: tY = 0
' load GDIPlus error messages
GOSUB LoadGDIPERMS
'
CASE %WM_ERASEBKGND
IF himage = 0 THEN FUNCTION = 0 : EXIT SELECT
hdc = getdc(CBHNDL)
IF GdipCreatefromHDC ( hDC, pGraphics) = 0 THEN
l = GdipDrawImageRectI(pGraphics, himage, ofsX, ofsY, tX, tY)
IF l THEN sGDIPfn = "GdipDrawImageRectI": GOSUB gdiperror
END IF
FUNCTION = 1
'
CASE %WM_USER + 401
spicpath = UCODE$(GetPic(CBHNDL))
getClientrect(CBHNDL, r)
' pgraphics receives ptr to DC's graphics object
hdc = getdc(CBHNDL)
IF himage THEN gdipdisposeimage (himage)
l = GDIPLoadImageFromFile (BYVAL spicPath , BYREF hImage)
IF l THEN sGDIPfn = "GDIPLoadImageFromFile": GOSUB gdiperror
IF hImage = 0 THEN EXIT SELECT
' get image height, width & pixel format
l = GdipGetImageDimension (BYVAL hImage, BYREF origwidth, BYREF origheight)
IF l THEN sGDIPfn = "GdipGetImageDimension": GOSUB gdiperror
maxwidth = r.nright - r.nleft : maxheight = r.nbottom - r.ntop
l = GdipGetImagePixelFormat (BYVAL hImage, BYREF lPixelFormat)
IF l THEN sGDIPfn = "GdipGetImagePixelFormat": GOSUB gdiperror
' derive new image size for display on the dailog, preserving aspect ratio
' the results are declared STATIC so that the %WM_ERASEBKGND handler can use them
skIconise ( BYVAL origwidth, BYVAL origheight, BYVAL maxwidth, BYVAL maxheight, _
BYREF ofsX, BYREF ofsY, BYREF tX, BYREF tY)
' tidy up
gdipdeletegraphics pGraphics
IF l THEN sGDIPfn = "GdipDeleteGraphics": GOSUB gdiperror
releaseDC( CBHNDL, hdc )
' force redraw via WM_ERASEBKGND
invalidaterect CBHNDL, r, %TRUE
'
CASE %WM_DESTROY
IF himage THEN
l = gdipdisposeimage(himage)
IF l THEN sGDIPfn = "GdipDisposeImage": GOSUB gdiperror
END IF
releaseDC( CBHNDL, hdc )
END SELECT
EXIT FUNCTION
''''''''''''''''''''''
gdiperror:
? sGDIPfn + ":" + sGDIPStatusCodes(l)
EXIT FUNCTION
RETURN
''''''''''''''''''''''
LoadGDIPERMS:
DIM sGDIPStatusCodes(0 TO 20) AS STATIC STRING
sGDIPStatusCodes(%StatusOk ) = "Ok
sGDIPStatusCodes(%StatusGenericError ) = "Generic Error
sGDIPStatusCodes(%StatusInvalidParameter ) = "Invalid Parameter
sGDIPStatusCodes(%StatusOutOfMemory ) = "Out Of Memory
sGDIPStatusCodes(%StatusObjectBusy ) = "Object Busy
sGDIPStatusCodes(%StatusInsufficientBuffer ) = "Insufficient Buffer
sGDIPStatusCodes(%StatusNotImplemented ) = "Not Implemented
sGDIPStatusCodes(%StatusWin32Error ) = "Win32 Error
sGDIPStatusCodes(%StatusWrongState ) = "Wrong State
sGDIPStatusCodes(%StatusAborted ) = "Aborted
sGDIPStatusCodes(%StatusFileNotFound ) = "File Not Found
sGDIPStatusCodes(%StatusValueOverflow ) = "Value Overflow
sGDIPStatusCodes(%StatusAccessDenied ) = "Access Denied
sGDIPStatusCodes(%StatusUnknownImageFormat ) = "Unknown Image Format
sGDIPStatusCodes(%StatusFontFamilyNotFound ) = "Font Family Not Found
sGDIPStatusCodes(%StatusFontStyleNotFound ) = "Font Style Not Found
sGDIPStatusCodes(%StatusNotTrueTypeFont ) = "Not TrueType Font
sGDIPStatusCodes(%StatusUnsupportedGdiplusVersion ) = "Unsupported Gdiplus Version
sGDIPStatusCodes(%StatusGdiplusNotInitialized ) = "Gdiplus Not Initialized
sGDIPStatusCodes(%StatusPropertyNotFound ) = "Property Not Found
sGDIPStatusCodes(%StatusPropertyNotSupported ) = "Property Not Supported
RETURN
END FUNCTION
'------------------------------------------------------------------------
' main dialog callback function
'
CALLBACK FUNCTION MainDlgCB()
LOCAL s AS STRING
STATIC hPicWnd AS DWORD
SELECT CASE AS LONG CBMSG
CASE %WM_INITDIALOG
' create another dialog on which the image will be displayed.
' It didn't have to be a dialog, but if a control in the main dialog
' was used then it would have to be sub- or super-classed to receive its
' own WM_ERASEBKGND messages. This is just the easiest (DDT) way to do it.
DIALOG NEW CBHNDL, "", 85, 5, 190, 125, %WS_POPUP OR %WS_BORDER OR _
%WS_POPUP OR %WS_CHILD OR _
%WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_3DLOOK OR %DS_NOFAILCREATE OR _
%DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_TOOLWINDOW OR _
%WS_EX_TOPMOST OR %WS_EX_LEFT OR %WS_EX_LTRREADING TO hPicWnd
DIALOG SHOW MODELESS hPicWnd, CALL PicDlgCB 'TO lRslt
CASE %WM_COMMAND
SELECT CASE AS LONG CBCTL
CASE %IDC_getpic_bn
IF HI(WORD,CBWPARAM) = %BN_CLICKED THEN
sendmessage hPicWnd, %WM_USER + 401, 0, 0
END IF
END SELECT
END SELECT
END FUNCTION
'------------------------------------------------------------------
FUNCTION MainDlg(BYVAL hParent AS DWORD) AS LONG
LOCAL lRslt AS LONG
LOCAL hDlg AS DWORD
DIALOG NEW hParent, "using GDI+ example 1", 139, 129, 279, 135, _
%WS_POPUP OR %WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR _
%WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR _
%DS_NOFAILCREATE OR %DS_SETFONT, _
%WS_EX_CONTROLPARENT, TO hDlg
CONTROL ADD BUTTON, hDlg, %IDC_getpic_bn, "find a picture", 5, 5, 75, 15
DIALOG SHOW MODAL hDlg, CALL MainDlgCB TO lRslt
FUNCTION = lRslt
END FUNCTION
'=======================================================================
FUNCTION PBMAIN()
STATIC nstatus AS LONG
STATIC token AS DWORD
STATIC StartupInput AS GdiplusStartupInput
StartupInput.GdiplusVersion = 1
nStatus = GdiplusStartup(token, StartupInput, BYVAL %NULL)
IF nStatus THEN
MSGBOX "Error initializing GDI+", %mb_applmodal, "Warning"
EXIT FUNCTION
END IF
MainDlg %HWND_DESKTOP
GdiplusShutdown token
END FUNCTION
Comment