Announcement

Collapse

New Sub-Forum

In an effort to help make sure there are appropriate categories for topics of discussion that are happening, there is now a sub-forum for databases and database programming under Special Interest groups. Please direct questions, etc., about this topic to that sub-forum moving forward. Thank you.
See more
See less

Resizing Image in OLE interface

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Resizing Image in OLE interface

    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:

    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
    Here's the program:

    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
    This is the GDIPlus interface I'm using:

    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
    (Credit: Patrice Terrier)
    Jim Seekamp

  • #2
    You can't resize an OLE picture using GdiPlus. You have to use the Render method of the IPicture interface.

    I have a custom control based in the IPicture interface: http://www.jose.it-berater.org/smffo...php?topic=86.0
    Forum: http://www.jose.it-berater.org/smfforum/index.php

    Comment


    • #3
      Thanks Jose, that helps a ton!
      Jim Seekamp

      Comment

      Working...
      X