That's the solution I need, resizing the dialog to fit the picture is not on!
Any ideas?
Here's a little compileable (PBWin 8.04) program to illustrate the problem.
Code:
'
' GDIP image display problem by Chris Holbrook
'
#COMPILE EXE
#DIM ALL
'------------------------------------------------------------------------------
' ** Includes **
'------------------------------------------------------------------------------
#IF NOT %DEF(%WINAPI)
#INCLUDE "WIN32API.INC"
#ENDIF
#INCLUDE "COMMCTRL.INC"
#INCLUDE "comdlg32.inc"
#INCLUDE "minigdip.inc"
'------------------------------------------------------------------------------
' ** Constants **
'------------------------------------------------------------------------------
%IDD_DIALOG1 = 101
%IDC_getpic_bn = 7
%IDC_pic_lab = 106
'------------------------------------------------------------------------------
' ** Declarations **
'------------------------------------------------------------------------------
DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
'------------------------------------------------------------------------------
GLOBAL gOldSubClassProc AS DWORD
GLOBAL g_image AS LONG
'--------------------------------------------------
FUNCTION getpic (hD AS LONG) AS STRING
LOCAL buf, spath, sfile AS STRING
LOCAL dwstyle AS DWORD
LOCAL hFile AS LONG
'------------------------ get database file
dwStyle = %OFN_EXPLORER OR %OFN_FILEMUSTEXIST OR %OFN_HIDEREADONLY
Buf = "Picture files (*.JPG)|*.JPG|"
'IF gddlpath <> "" THEN spath = gddlpath
IF OpenFileDialog (hD, "Locate JPG file ", sfile, spath, buf, "JPG", dwstyle) = 0 THEN
EXIT FUNCTION
END IF
FUNCTION = sfile
END FUNCTION
'-----------------------------------------------------------------------------
' 1st param is the window handle for the control
' 2nd is DC is called for a WM_ERASEBKGND message, zero for a WM_PAINT message
'
SUB PaintW(hW AS LONG, hDCin AS LONG, himage AS LONG)
LOCAL ps AS PAINTSTRUCT
LOCAL r AS RECT
LOCAL hdc, hG AS DWORD
LOCAL tx, ty, framex, framey, ofsx, ofsy AS LONG
LOCAL wide, high AS SINGLE
IF hDCin = 0 THEN
hDC = BeginPaint(hW, ps)
ELSE
hDC = hDCin
END IF
getClientrect(hW, r)
frameX = r.nRight - r.nLeft
frameY = r.nBottom - r.nTop
GdipGetImageDimension hImage, wide, high
' calc coordinates to centre image in frame, retaining original proportion
skIconise ( wide, high, frameX, frameY, ofsX, ofsY, tX, tY)
IF GdipCreatefromHDC ( hDC, hG) = 0 THEN
IF hG <> 0 THEN
GDIpGraphicsClear hG, &HC0C0C0C0 ' background colour seen in exposed part of dialog
' can also set smoothing mode, etc here
GdipSetInterpolationMode(hG, %QualityModeHigh)
GdipDrawImageRectI(hG, himage, ofsX, ofsY, tX, tY)
IF hG <> 0 THEN gdipdeletegraphics hG
END IF
END IF
'
IF hDCin = 0 THEN EndPaint(hW, ps)
IF hDC <> 0 THEN deleteobject(hDC)
END SUB
'------------------------------------------------------------------------------
' ** Main Application Entry Point **
'------------------------------------------------------------------------------
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
ShowDIALOG1 %HWND_DESKTOP
' GdipDisposeImage(g_Image)
' deleteobject(g_Bitmap)
GdiplusShutdown token
END FUNCTION
'------------------------------------------------------------------------------
' ** CallBacks **
'------------------------------------------------------------------------------
CALLBACK FUNCTION ShowDIALOG1Proc()
STATIC picpath AS STRING
LOCAL s AS STRING
LOCAL i, maxx, maxy, nstatus AS LONG
STATIC hW, hG, X, Y AS LONG
LOCAL wide, high AS SINGLE
LOCAL frameX, frameY, ofsX, ofsY, tX, tY AS LONG
STATIC r AS rect
DIM arr(1000) AS STATIC STRING
STATIC hdc, l AS LONG
SELECT CASE AS LONG CBMSG
CASE %WM_INITDIALOG
CASE %WM_NCACTIVATE
STATIC hWndSaveFocus AS DWORD
IF ISFALSE CBWPARAM THEN
' Save control focus
hWndSaveFocus = GetFocus()
ELSEIF hWndSaveFocus THEN
' Restore control focus
SetFocus(hWndSaveFocus)
hWndSaveFocus = 0
END IF
CASE %WM_DESTROY
' Important! Remove the subclassing
SetWindowLong hW, %GWL_WNDPROC, gOldSubClassProc
CASE %WM_COMMAND
' Process control notifications
SELECT CASE AS LONG CBCTL
CASE %IDC_getpic_bn
IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
s = getpic(CBHNDL)
IF s <> "" THEN
picpath = s
getClientrect(hW, r)
' create global image & bitmap without saving image file
g_image = resizeimage ( picpath, "", hW, r.nright - r.nleft, r.nbottom - r.ntop)
END IF
invalidaterect hW, r, %TRUE
END IF
END SELECT
CASE %WM_PAINT
CALL PaintW(CBHNDL, 0, g_image)
CASE %WM_ERASEBKGND
CALL paintW(CBHNDL, hDC, g_image)
FUNCTION = 1
EXIT FUNCTION
END SELECT
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Dialogs **
'------------------------------------------------------------------------------
FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
LOCAL lRslt AS LONG
LOCAL hDlg AS DWORD
DIALOG NEW hParent, "Load, Resize and display image from file (DDT + " + _
"GDIPlus)", 12, 56, 454, 223, %WS_POPUP OR %WS_BORDER OR %WS_CAPTION _
OR %WS_SYSMENU OR %WS_CLIPSIBLINGS OR %WS_CLIPCHILDREN OR _
%WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR _
%DS_SETFONT, %WS_EX_CLIENTEDGE OR %WS_EX_CONTROLPARENT OR _
%WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
CONTROL ADD BUTTON, hDlg, %IDC_getpic_bn, "Get Image File", 15, 195, 40, _
20, %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_TEXT OR _
%BS_MULTILINE OR %BS_PUSHBUTTON OR %BS_CENTER OR %BS_VCENTER, _
%WS_EX_LEFT OR %WS_EX_LTRREADING
DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
FUNCTION = lrslt
END FUNCTION
'==============================================================================
Code:
'--------------------------------------------------------------------------------
' MiniGDIP.inc placed in public domain by Chris Holbrook June 2006
'
' based on code by Messrs Terrier, Schullian, Walker & others, thanks to Simon Morgan for debugging.
' modified Jan 2008: globals no longer used
'--------------------------------------------------------------------------------
'GDIP CONSTANTS
%QualityModeHigh = 2 ' Best rendering quality
%UnitPixel = 2 ' Each unit is one device pixel.
'--------------------------------------------------------------------------------
' Mini-GDIP.inc
'
' based on code by Messrs Patrice Terrier, Don Schullian, David Walker & others, thanks to Simon Morgan for debugging.
'-----------------------------------------------------------------------------------------------------------------------
'
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 GdipCreateBitmapFromHBITMAP LIB "gdiplus.dll" ALIAS "GdipCreateBitmapFromHBITMAP" (BYVAL hbm AS LONG, BYVAL hpal AS LONG, nBitmap 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 GdipCreateFromHWND LIB "gdiplus.dll" ALIAS "GdipCreateFromHWND" (BYVAL hwnd AS LONG, 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 GdipGetImageGraphicsContext LIB "gdiplus.dll" ALIAS "GdipGetImageGraphicsContext" _
(BYVAL nImage AS LONG, graphics AS LONG) 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 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 STRING, clsidEncoder AS GUID, _
OPTIONAL BYVAL EncoderParams AS DWORD) AS LONG
DECLARE FUNCTION GdipCreateBitmapFromScan0 LIB "gdiplus.dll" ALIAS "GdipCreateBitmapFromScan0" _
(BYVAL nWidth AS LONG, BYVAL Height AS LONG, BYVAL stride AS LONG, BYVAL PixelFormat AS LONG, _
scan0 AS ANY, nBitmap AS LONG) AS LONG
DECLARE FUNCTION GdipGetInterpolationMode LIB "gdiplus.dll" ALIAS "GdipGetInterpolationMode" _
(BYVAL graphics AS LONG, interpolation AS LONG) AS LONG
DECLARE FUNCTION GdipDrawImageRectRectI LIB "gdiplus.dll" ALIAS "GdipDrawImageRectRectI" _
(BYVAL graphics AS LONG, BYVAL nImage AS LONG, BYVAL dstx AS LONG, BYVAL dsty AS LONG, _
BYVAL dstwidth AS LONG, BYVAL dstheight AS LONG, BYVAL srcx AS LONG, BYVAL srcy AS LONG, _
BYVAL srcwidth AS LONG, BYVAL srcheight AS LONG, BYVAL srcUnit AS LONG, _
OPTIONAL BYVAL imageAttributes AS LONG, OPTIONAL BYVAL pCALLBACK AS LONG, _
OPTIONAL BYVAL callbackData AS LONG) AS LONG
DECLARE FUNCTION GdipGetSmoothingMode LIB "gdiplus.dll" ALIAS "GdipGetSmoothingMode" _
(BYVAL graphics AS LONG, SmoothingMd AS LONG) 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
'
'-----------------------------------------------------------------------------------------------------------------------
'
FUNCTION ReadUnicodeString (BYVAL lp AS DWORD) AS STRING
LOCAL p AS BYTE PTR, s AS STRING
p = lp '// Pointer to the string
IF p = %Null THEN EXIT FUNCTION '// Null pointer
WHILE CHR$(@p) <> $NUL
s = s + CHR$(@p)
p = p + 2 '// Unicode strings require two bytes per character
WEND
FUNCTION = s
END FUNCTION
'
'-----------------------------------------------------------------------------------------------------------------------
'
' ==========================================================================
' 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 GetEncoderClsid (BYVAL sMimeType AS STRING) AS STRING
DIM pImageCodecInfo AS ImageCodecInfo PTR
LOCAL numEncoders AS DWORD, nSize AS DWORD
LOCAL lRslt AS LONG, i AS LONG, x AS LONG
LOCAL p AS BYTE PTR, s AS STRING
LOCAL nSigCount AS LONG, nSigSize AS LONG
sMimeType = UCASE$(sMimeType)
lRslt = GdipGetImageEncodersSize(numEncoders, nSize)
REDIM buffer(nSize - 1) AS BYTE
pImageCodecInfo = VARPTR(buffer(0))
lRslt = GdipGetImageEncoders(numEncoders, nSize, pImageCodecInfo)
IF lRslt = 0 THEN
FOR i = 1 TO numEncoders
IF INSTR(UCASE$(ReadUnicodeString(@pImageCodecInfo.MimeType)), sMimeType) THEN
FUNCTION = GUIDTXT$(@pImageCodecInfo.ClassID)
EXIT FOR
END IF
INCR pImageCodecInfo '// Increments pointer
NEXT
END IF
END FUNCTION
'
'-----------------------------------------------------------------------------------------------------------------------
' write resized image to file and/or window. If filename is blank, file will not be created.
' If window handle is null, window will not be painted.
FUNCTION ResizeImage (picpath AS STRING, destpath AS STRING, hW AS DWORD, maxwidth AS DWORD, maxheight AS DWORD) AS LONG
LOCAL origwidth AS SINGLE
LOCAL origheight AS SINGLE
LOCAL lPixelFormat AS LONG
LOCAL s AS STRING
LOCAL EncoderClSID AS GUID
LOCAL extn AS STRING
LOCAL imagestyle AS STRING
LOCAL OfsX, OfsY, Tx, Ty AS LONG
LOCAL hbitmap, himage, graphics AS DWORD
'
IF destpath <> "" THEN ' if destpath is not specified we still load the global image
extn = UCASE$(PARSE$(destpath,".",-1))
SELECT CASE CONST$ extn
CASE "BMP" : imagestyle = "image/bmp"
CASE "EMF" : imagestyle = "image/x-emf"
CASE "GIF" : imagestyle = "image/gif"
CASE "ICO" : imagestyle = "image/x-icon"
CASE "JPG", "JPEG" : imagestyle = "image/jpeg"
CASE "PNG" : imagestyle = "image/png"
CASE "TIF", "TIFF" : imagestyle = "image/tiff"
CASE "WMF" : imagestyle = "image/x-wmf"
CASE ELSE
' return image handle value of zero to indicate failure
EXIT FUNCTION
END SELECT
END IF
'
GDIPLoadImageFromFile UCODE$(picPath), hImage
'
IF hImage = 0 THEN
' return image handle value of zero to indicate failure
EXIT FUNCTION
END IF
'
GdipGetImageDimension hImage, origwidth, origheight
'
skIconise ( origwidth, origheight, maxwidth, maxheight, ofsX, ofsY, tX, tY)
'
GdipGetImagePixelFormat hImage, lPixelFormat
' create right-size bitmap
GdipCreateBitmapFromScan0 tX, tY, 0, lPixelFormat, BYVAL 0&, hBitmap
' get graphics handle to bitmap
GdipGetImageGraphicsContext hBitmap, graphics
GdipSetInterpolationMode graphics, %QualityModeHigh
' drop image into graphics object
GdipDrawImageRectRectI graphics, hImage, 0, 0, tX, tY, 0, 0, origwidth, origheight, %UnitPixel
' save resized image to file if output filename is not null
IF destpath <> "" THEN
s = GetEncoderClsid(imagestyle)
EncoderCLSID = GUID$(s)
GdipSaveImageToFile hbitmap, UCODE$(DestPath), EncoderCLSID, %NULL
END IF
' get rid of unwanted GDI objects
CALL GdipDeleteGraphics(graphics)
deleteobject hbitmap
FUNCTION = himage
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