Tweet
I'm having a heck of a time creating picture resizing in a picture viewer. (I used some old code by Patrice Terrier in creating this). Anyone have any ideas?
Here is some resizing code I found in a search of the PB forums and I can't get it to work with my program:
Here's the program:
This is the GDIPlus interface I'm using:
(Credit: Patrice Terrier)
Here is some resizing code I found in a search of the PB forums and I can't get it to work with my program:
Code:
function resizeimage(picpath$,destpath$,hw???,maxwidth???,maxheight???,mult!) as long
dim encoderclsid as guid
if destpath$<>"" then
extn$=ucase$(parse$(destpath$,".",-1))
select case 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
function=(-1)
exit function
end select
end if
if lpimage???<>0 then
gdipdisposeimage(lpimage???)
lpimage??? = 0
end if
gdiploadimagefromfile picpath$,lpimage???
if lpimage???=0 then
function=(-1)
exit function
end if
gdipgetimagedimension lpimage???,origwidth!,origheight!
xsize&=origwidth!*mult!
ysize&=origheight!*mult!
xofs&=(xcell&-xsize&)\2
yofs&=(ycell&-ysize&)\2
gdipgetimagepixelformat lpimage???,lpixelformat&
gdipcreatebitmapfromscan0 xsize&,ysize&,0,lpixelformat&,byval 0&,hbitmap&
gdipgetimagegraphicscontext hbitmap&,hwnd???
gdipsetinterpolationmode hwnd???,%qualitymodehigh
gdipdrawimagerectrecti hwnd???,lpimage???,0,0,xsize&,ysize&,0,0,origwidth!,origheight!,%unitpixel
if destpath$<>"" then
b$=getencoderclsid(imagestyle$)
encoderclsid=guid$(b$)
gdipsaveimagetofile g_bitmap,ucode$(destpath$),encoderclsid,%null
end if
end function
Code:
#compile exe
#register none
#include "\pbwin80\winapi\Win32Api.Inc"
#include "\pbwin80\winapi\ComDlg32.Inc"
#resource "WPICON.PBR"
#include "gdiplus.inc"
global hinstance&
declare function oleinitialize lib "ole32.dll" alias "OleInitialize" _
(dword) as long
declare sub oleuninitialize lib "ole32.dll" alias "OleUninitialize"
declare function createstreamonhglobal lib "ole32.dll" _
alias "CreateStreamOnHGlobal" _
(byval dword,byval dword,dword) as long
declare function oleloadpicture lib "oleaut32.dll" _
alias "OleLoadPicture" _
(byval dword,byval dword,byval dword, _
string*16,dword) as long
declare function commethod0(byval p0 as any) as dword
declare function commethod1(byval p0 as any,p1 as any) as dword
declare function commethod10(byval p0 as any,byval p1 as any, _
byval p2 as any,byval p3 as any, _
byval p4 as any,byval p5 as any, _
byval p6 as any,byval p7 as any, _
byval p8 as any,byval p9 as any, _
byval p10 as any) as dword
declare function wndproc(byval long,byval long,byval long, _
byval long) as long
declare function getfilename(long) as string
declare function loadpicturefile(asciiz) as dword
declare function createcontrol(byval string,byval string,byval long, _
byval long,byval long,byval long, _
byval long,byval long,byval long, _
byval long,byval long) as long
function winmain(byval hinst&,byval hprev&, _
byval cmdline as asciiz ptr,byval cmdshow&) as long
oleinitialize byval 0
dim wmsg as tagmsg
hinstance&=hinst&
''create class and register it with windows
dim wclass as wndclass
dim wclassname as asciiz*80
dim wcaption as asciiz*80
wclassname="TestPicViewer"
wclass.style=%cs_hredraw or %cs_vredraw
wclass.lpfnwndproc=codeptr(wndproc)
wclass.cbclsextra=0
wclass.cbwndextra=0
wclass.hinstance=hinstance&
wclass.hicon=%null
wclass.hcursor=loadcursor(%null,byval %idc_arrow)
wclass.hbrbackground=getstockobject(%gray_brush)
wclass.lpszmenuname=%null
wclass.lpszclassname=varptr(wclassname)
registerclass wclass
''figure size of window
xsize&=getsystemmetrics(%sm_cxscreen)
ysize&=getsystemmetrics(%sm_cyscreen)
x1&=0
y1&=0
x2&=xsize&
y2&=ysize&*(.95)
wcaption="Test PicViewer"
style&=%ws_vscroll or %ws_hscroll or %ws_overlappedwindow
hwnd&=createwindow(wclassname, _ ''window class name
wcaption, _ ''window caption
style&, _ ''window style
x1&, _ ''initial x position
y1&, _ ''initial y position
x2&, _ ''initial x size
y2&, _ ''initial y size
%null, _ ''parent window handle
%null, _ ''window menu handle
hinst&, _ ''program instance handle
%null) ''creation parameters
showwindow hwnd&,cmdshow&
updatewindow hwnd&
while istrue(getmessage(wmsg,byval %null,0,0))
translatemessage wmsg
dispatchmessage wmsg
wend
oleuninitialize
function=wmsg.wparam
end function
function wndproc(byval hwnd&,byval msg&,byval wparam&,byval lparam&) as long
static ppicture???,nwidth???,nheight???
static six as scrollinfo
static siy as scrollinfo
static namefile$,bmpfile$
static mult!
dim hproc as dword ptr
dim rc as rect
dim zfilename as asciiz*%max_path
dim zfileout as asciiz*%max_path
select case msg&
case %wm_create
hmainmenu&=createmenu
hmenu&=createpopupmenu
appendmenu hmenu&,%mf_string,201,"Open Picture File"
appendmenu hmenu&,%mf_string,210,"Exit"
appendmenu hmainmenu&,%mf_popup,hmenu&,"File"
hmenu&=createpopupmenu
hsubmenu&=createpopupmenu
appendmenu hsubmenu&,%mf_string,301,"x .25"
appendmenu hsubmenu&,%mf_string,302,"x .5"
appendmenu hsubmenu&,%mf_string,303,"x .75"
appendmenu hsubmenu&,%mf_string,304,"x 1 (Original)"
appendmenu hsubmenu&,%mf_string,305,"x 1.25"
appendmenu hsubmenu&,%mf_string,306,"x 1.5"
appendmenu hsubmenu&,%mf_string,307,"x 1.75"
appendmenu hsubmenu&,%mf_string,308,"x 2"
appendmenu hsubmenu&,%mf_string,309,"x 2.25"
appendmenu hsubmenu&,%mf_string,310,"x 2.5"
appendmenu hsubmenu&,%mf_string,311,"x 2.75"
appendmenu hsubmenu&,%mf_string,312,"x 3"
appendmenu hmenu&,%mf_popup,hsubmenu&,"Resize"
appendmenu hmainmenu&,%mf_popup,hmenu&,"View"
setmenu hwnd&,hmainmenu&
drawmenubar hwnd&
six.cbsize=sizeof(six)
six.fmask=%sif_all
six.nmin=1
six.nmax=1
six.npage=1
six.npos=1
setscrollinfo hwnd&,%sb_horz,six,%true
siy.cbsize=sizeof(siy)
siy.fmask=%sif_all
siy.nmin=1
siy.nmax=1
siy.npage=1
siy.npos=1
setscrollinfo hwnd&,%sb_vert,siy,%true
invalidaterect hwnd&,byval %null,%false
showwindow hwnd&,%sw_show
case %wm_paint
dim ps as paintstruct
hdc???=beginpaint(hwnd&,ps)
if ppicture???=0 then
endpaint hwnd&,ps
exit function
end if
getclientrect hwnd&,rc
fillrect hdc???,rc,getstockobject(%gray_brush)
hproc=ppicture???
[email protected]+24
call dword @hproc using commethod1(ppicture???,hmwidth???)
hproc=ppicture???
[email protected]+28
call dword @hproc using commethod1(ppicture???,hmheight???)
nwidth???=muldiv(hmwidth???, _
getdevicecaps(hdc???,%logpixelsx),2540)
nheight???=muldiv(hmheight???, _
getdevicecaps(hdc???,%logpixelsy),2540)
nhpos???=six.npos
nvpos???=siy.npos
hproc=ppicture???
[email protected]+32
call dword @hproc using commethod10(ppicture???,hdc???, _
-nhpos???,-nvpos???, _
nwidth???,nheight???,0,hmheight???,hmwidth???, _
-hmheight???,varptr(rc))
function=getstockobject(%null_brush)
endpaint hwnd&,ps
case %wm_vscroll
getscrollinfo hwnd&,%sb_vert,siy
select case lowrd(wparam&)
case %sb_top
siy.npos=siy.nmin
case %sb_bottom
siy.npos=siy.nmax
case %sb_linedown
siy.npos=siy.npos+1
if siy.npos>siy.nmax then siy.npos=siy.nmax
case %sb_lineup
siy.npos=siy.npos-1
if siy.npos<siy.nmin then siy.npos=siy.nmin
case %sb_thumbtrack
siy.npos=siy.ntrackpos
case %sb_thumbposition
siy.npos=siy.ntrackpos
case %sb_endscroll
siy.npos=siy.ntrackpos
case else
exit function
end select
setscrollinfo hwnd&,%sb_vert,siy,%true
invalidaterect hwnd&,byval %null,%false
showwindow hwnd&,%sw_show
exit function
case %wm_hscroll
getscrollinfo hwnd&,%sb_horz,six
select case lowrd(wparam&)
case %sb_left,%sb_lineleft
six.npos=six.npos-1
if six.npos<six.nmin then six.npos=six.nmin
case %sb_right,%sb_lineright
six.npos=six.npos+1
if six.npos>six.nmax then six.npos=six.nmax
case %sb_thumbposition
six.npos=six.ntrackpos
case %sb_endscroll
six.npos=six.ntrackpos
case %sb_thumbtrack
six.npos=six.ntrackpos
case else
exit function
end select
setscrollinfo hwnd&,%sb_horz,six,%true
invalidaterect hwnd&,byval %null,%false
showwindow hwnd&,%sw_show
exit function
case %wm_syscommand
if lowrd(wparam&)<>%sc_close then exit select
destroywindow hwnd&
function=1
exit function
case %wm_command
select case lowrd(wparam&)
case 201 ''open picture file
if hiwrd(wparam&)<>%bn_clicked then exit select
zfilename=getfilename(hwnd&)
if zfilename="" then exit function
namefile$=zfilename
mult!=1
lnf&=len(namefile$)
i&=instr(-1,namefile$,".")
xt$=ucase$(right$(namefile$,(lnf&-i&)))
if xt$<>"BMP" then
lnxt&=len(xt$)
zfileout=left$(namefile$,(lnf&-lnxt&))+"bmp"
convertimage zfilename,zfileout,"image/bmp"
bmpfile$=zfileout
else
bmpfile$=namefile$
end if
zfilename=bmpfile$
ppicture???=loadpicturefile(zfilename)
if ppicture???=0 then
''no file selected
else
setwindowtext hwnd&,zfilename
getclientrect hwnd&,rc
hdc???=getdc(hwnd&)
hproc=ppicture???
[email protected]+24
call dword @hproc using commethod1(ppicture???, _
hmwidth???)
hproc=ppicture???
[email protected]+28
call dword @hproc using commethod1(ppicture???, _
hmheight???)
nwidth???=muldiv(hmwidth???, _
getdevicecaps(hdc???,%logpixelsx),2540)
nheight???=muldiv(hmheight???, _
getdevicecaps(hdc???,%logpixelsy), _
2540)
xsize???=(rc.nright-rc.nleft)+1
ysize???=(rc.nbottom-rc.ntop)+1
if nwidth???>xsize??? then ''need horz scroll
six.nmax=(nwidth???-xsize???)
six.npage=1 ''10
else
six.nmax=1
six.npage=1
end if
six.cbsize=sizeof(six)
six.fmask=%sif_all
six.nmin=1
six.npos=1
setscrollinfo hwnd&,%sb_horz,six,%true
if nheight???>ysize??? then ''need vert scroll
siy.nmax=(nheight???-ysize???)
siy.npage=1 ''10
else
siy.nmax=1
siy.npage=1
end if
siy.cbsize=sizeof(siy)
siy.fmask=%sif_all
siy.nmin=1
siy.npos=1
setscrollinfo hwnd&,%sb_vert,siy,%true
end if
invalidaterect hwnd&,byval 0,1
updatewindow hwnd&
case 210 ''exit
postmessage hwnd&,%wm_syscommand,%sc_close,0
case 301 to 312 ''resize
lwa&=lowrd(wparam&)-300
mult!=lwa&*(.25)
picpath$=bmpfile$
destpath$=""
maxwidth???=2000
maxheight???=2000
resizeimage picpath$,hwnd&,maxwidth???,maxheight???,mult!
end select
case %wm_destroy
ppicture???=loadpicturefile("")
postquitmessage 0
function=0
exit function
end select
function=defwindowproc(hwnd&,msg&,wparam&,lparam&)
end function
function getfilename(hwnd&) as string
dim szcurdir1 as asciiz*%max_path
dim szcurdir2 as asciiz*%max_path
dim sztitlename as asciiz*%max_path
dim sztitle as asciiz*%max_path
dim szfile as asciiz*%max_path
dim ofn as openfilename
ofn.lstructsize=sizeof(ofn)
ofn.hwndowner=hwnd&
filter$="Graphic files (*.bmp,*.jpg,*.gif,*.tif,*.tiff)" _
+chr$(0)+"*.bmp;*.jpg;*.gif;*.tif;*.tiff"+chr$(0)
sztitle="Open A File"
ofn.lpstrfilter=strptr(filter$)
ofn.lpstrfiletitle=varptr(sztitlename)
ofn.nmaxfiletitle=sizeof(sztitlename)
ofn.lpstrtitle=varptr(sztitle)
ofn.flags=%ofn_hidereadonly or %ofn_createprompt _
or %ofn_explorer or %ofn_enablehook
getcurrentdirectory sizeof(szcurdir1),szcurdir1
getopenfilename ofn
getcurrentdirectory sizeof(szcurdir2),szcurdir2
if right$(szcurdir2,1)<>"\" then szcurdir2=szcurdir2+"\"
if sztitlename="" then
function=""
else
function=szcurdir2+sztitlename
end if
setcurrentdirectory szcurdir1
end function
function loadpicturefile(zpicturefilename as asciiz) as dword
dim idpic as string*16
idpic=mkl$(&h7bf80980)+mki$(&hbf32)+mki$(&h101a) _
+chr$(&h8b,&hbb,&h00,&haa,&h00,&h30,&h0c,&hab)
local pstream as dword ptr
local hproc as dword ptr
if ppicture??? then
hproc=ppicture???
[email protected]+8
call dword @hproc using commethod0(ppicture???)
ppicture???=0
end if
if zpicturefilename="" then exit function
hfile???=createfile(zpicturefilename,%generic_read, _
%file_share_read,byval 0,%open_existing,0, _
byval 0)
if hfile???<>%invalid_handle_value then
dwfilesize???=getfilesize(hfile???,byval 0)
if dwfilesize???<>&hffffffff& then
hglobal???=globalalloc(%gmem_moveable,dwfilesize???)
if hglobal??? then
pvdata???=globallock(hglobal???)
if pvdata??? then
if readfile(hfile???,byval pvdata???,dwfilesize???, _
dwbytesread???,byval 0)=0 then
dwbytesread???=0
end if
end if
globalunlock hglobal???
end if
end if
closehandle hfile???
end if
if (dwbytesread???=0) or (dwbytesread???<>dwfilesize???) then
exit function
end if
if createstreamonhglobal(hglobal???,1,pstream)<>%s_ok then
exit function
end if
retval???=oleloadpicture(pstream,dwfilesize???,%false,idpic,hproc)
select case retval???
case %s_ok
ppicture???=hproc
txt$=""
case %e_outofmemory
txt$="Out Of Memory!"
case %e_unexpected
txt$="Unexpected Format!"
case %e_pointer ''address in pStream or ppvObj is not valid
txt$="Invalid Format!"
case %e_nointerface ''object doesn't support specified interface
txt$="Format Not Supported!"
end select
if txt$<>"" then
msgbox txt$,%mb_ok,"Onscreen Takeoff"
end if
[email protected]+8
call dword @hproc using commethod0(pstream)
function=ppicture???
end function
function createcontrol(byval cclass$,byval ctxt$,byval style&, _
byval x1&,byval y1&,byval x2&,byval y2&, _
byval hparent&,byval ctid&,byval hinst&, _
byval extflg&) as long
dim szclass as asciiz*255
dim ztext as asciiz*255
ysize&=getsystemmetrics(%sm_cyscreen)
xsize&=ysize&+(ysize&/3)
szclass=cclass$
ztext=ctxt$
function=createwindow(szclass,ztext,style&,((x1&*xsize&)/640), _
((y1&*ysize&)/480),((x2&*xsize&)/640), _
((y2&*ysize&)/480),hparent&,ctid&,hinst&, _
extflg&)
end function
Code:
''gdiplus.dll declares and functions:
%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 hook/unhook functions
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 ''pointer to asciiz string with codec name
dllname as dword ''pointer to asciiz string with pathname of the dll where codec resides, or %null
formatdescription as dword ''pointer to asciiz string with name of the format used by codec
filenameextension as dword ''pointer to asciiz string with all filename extensions associated with the codec, separated with semicolons
mimetype as dword ''pointer to asciiz string with mime type of codec
flags as dword ''combination of flags from imagecodecflags
version as dword ''integer with version of the codec
sigcount as dword ''integer with no. of signatures used by file format associated with the codec
sigsize as dword ''integer with no. of bytes of each signature
sigpattern as dword ''pointer to array of bytes with the pattern for each signature
sigmask as dword ''pointer to array of bytes with the mask for each signature
end type
declare function gdiplusstartup lib "gdiplus.dll" _
alias "GdiplusStartup" _
(dword,gdiplusstartupinput,gdiplusstartupoutput) _
as long
declare sub gdiplusshutdown lib "gdiplus.dll" _
alias "GdiplusShutdown" (byval dword)
declare function gdiploadimagefromfile lib "gdiplus.dll" _
alias "GdipLoadImageFromFile" _
(byval string,dword) as long
declare function gdipdisposeimage lib "gdiplus.dll" _
alias "GdipDisposeImage" (byval dword) as long
declare function gdipgetimageencoderssize lib "gdiplus.dll" _
alias "GdipGetImageEncodersSize" _
(dword,dword) as long
declare function gdipgetimageencoders lib "gdiplus.dll" _
alias "GdipGetImageEncoders" _
(byval dword,byval dword,byval dword) as long
declare function gdipsaveimagetofile lib "gdiplus.dll" _
alias "GdipSaveImageToFile" _
(byval dword,byval string,guid, _
optional byval dword) as long
declare function gdipsetinterpolationmode lib "gdiplus.dll" _
alias "GdipSetInterpolationMode" _
(byval long,byval long) as long
declare function gdipcreatebitmapfromhbitmap lib "gdiplus.dll" _
alias "GdipCreateBitmapFromHBITMAP" _
(byval long,byval long,long) as long
declare function gdipdrawimagerecti lib "gdiplus.dll" _
alias "GdipDrawImageRectI" _
(byval long,byval long,byval long,byval long, _
byval long,byval long) as long
declare function gdipgetimagewidth lib "gdiplus.dll" _
alias "GdipGetImageWidth" _
(byval long,long) as long
declare function gdipgetimageheight lib "gdiplus.dll" _
alias "GdipGetImageHeight" _
(byval long,long) as long
declare function gdipdeletegraphics lib "gdiplus.dll" _
alias "GdipDeleteGraphics" _
(byval long) as long
declare function gdipgraphicsclear lib "gdiplus.dll" _
alias "GdipGraphicsClear" _
(byval long,byval long) as long
declare function gdipcreatefromhwnd lib "gdiplus.dll" _
alias "GdipCreateFromHWND" _
(byval long,long) as long
declare function gdipcreatefromhdc lib "gdiplus.dll" _
alias "GdipCreateFromHDC" _
(byval long,long) as long
declare function gdipgetimagepixelformat lib "gdiplus.dll" _
alias "GdipGetImagePixelFormat" _
(byval long,long) as long
declare function gdipgetimagedimension lib "gdiplus.dll" _
alias "GdipGetImageDimension" _
(byval long,single,single) as long
declare function gdipgetimagegraphicscontext lib "gdiplus.dll" _
alias "GdipGetImageGraphicsContext" _
(byval long,long) as long
declare function gdipcreatebitmapfromscan0 lib "gdiplus.dll" _
alias "GdipCreateBitmapFromScan0" _
(byval long,byval long,byval long,byval long, _
any,long) as long
declare function gdipgetinterpolationmode lib "gdiplus.dll" _
alias "GdipGetInterpolationMode" _
(byval long,long) as long
declare function gdipdrawimagerectrecti lib "gdiplus.dll" _
alias "GdipDrawImageRectRectI" _
(byval long,byval long,byval long,byval long, _
byval long,byval long,byval long,byval long, _
byval long,byval long,byval long, _
optional byval long,optional byval long, _
optional byval long) as long
declare function gdipgetsmoothingmode lib "gdiplus.dll" _
alias "GdipGetSmoothingMode" _
(byval long,long) as long
declare function readunicodestring(byval dword) as string
declare function getencoderclsid(byval string) as string
declare function convertimage(byval string,byval string, _
byval string) as long
declare function resizeimage(string,string,dword,dword,dword,single) as long
function readunicodestring(byval ucs???) as string
local p as byte ptr
p=ucs???
if p=%null then exit function
b$=""
do until chr$(@p)=$nul
b$=b$+chr$(@p)
p=p+2 ''unicode strings have 2 bytes per char
loop
function=b$
end function
function getencoderclsid(byval smimetype$) as string
dim pimagecodecinfo as imagecodecinfo ptr
dim p as byte ptr
smimetype$=ucase$(smimetype$)
gdipgetimageencoderssize(numencoders???,nsize???)
redim buffer?(nsize???-1)
pimagecodecinfo=varptr(buffer?(0))
y&=gdipgetimageencoders(numencoders???,nsize???,pimagecodecinfo)
if y&<>0 then exit function
for x???=1 to numencoders???
if instr(ucase$(readunicodestring(@pimagecodecinfo.mimetype)),smimetype$) then
function=guidtxt$(@pimagecodecinfo.classid)
exit for
end if
incr pimagecodecinfo
next x???
end function
function convertimage(byval loadflname$,byval saveflname$, _
byval smimetype$) as long
dim startupinput as gdiplusstartupinput
dim startupoutput as gdiplusstartupoutput
dim sencoderclsid as guid
if trim$(loadflname$)="" or trim$(saveflname$) = "" then
exit function
end if
startupinput.gdiplusversion=1
if gdiplusstartup(token???,startupinput,byval %null) then
msgbox "Error initializing GDI+",%mb_ok,"GDI+ Error"
exit function
end if
b$=getencoderclsid(smimetype$)
if b$="" then
msgbox "Encoder not installed",%mb_ok,"GDI+ Error"
exit function
end if
sencoderclsid=guid$(b$)
ucflname$=ucode$(loadflname$)
y&=gdiploadimagefromfile(ucflname$,lpimage???)
if y& then
function=y&
exit function
end if
if lpimage??? then
ucflname$=ucode$(saveflname$)
if gdipsaveimagetofile(lpimage???,ucflname$, _
sencoderclsid,encoderparams???) then
function=gdipdisposeimage(lpimage???)
exit function
end if
end if
gdipdisposeimage lpimage???
gdiplusshutdown token???
end function
function resizeimage(picpath$,destpath$,hw???,maxwidth???,maxheight???,mult!) as long
dim encoderclsid as guid
if destpath$<>"" then
extn$=ucase$(parse$(destpath$,".",-1))
select case 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
function=(-1)
exit function
end select
end if
if lpimage???<>0 then
gdipdisposeimage(lpimage???)
lpimage??? = 0
end if
gdiploadimagefromfile picpath$,lpimage???
if lpimage???=0 then
function=(-1)
exit function
end if
gdipgetimagedimension lpimage???,origwidth!,origheight!
xsize&=origwidth!*mult!
ysize&=origheight!*mult!
xofs&=(xcell&-xsize&)\2
yofs&=(ycell&-ysize&)\2
gdipgetimagepixelformat lpimage???,lpixelformat&
gdipcreatebitmapfromscan0 xsize&,ysize&,0,lpixelformat&,byval 0&,hbitmap&
gdipgetimagegraphicscontext hbitmap&,hwnd???
gdipsetinterpolationmode hwnd???,%qualitymodehigh
gdipdrawimagerectrecti hwnd???,lpimage???,0,0,xsize&,ysize&,0,0,origwidth!,origheight!,%unitpixel
if destpath$<>"" then
b$=getencoderclsid(imagestyle$)
encoderclsid=guid$(b$)
gdipsaveimagetofile g_bitmap,ucode$(destpath$),encoderclsid,%null
end if
end function
Comment