Das OFFIZIELLE PROFAN SUPPORT FORUM
Einsteigerfragen
PROFAN-Programmierung
Helfer & Tools
Anregungen & Vorschläge
PROFAN-NEWS
Die Regeln!
2 - PROFAN-Programmierung

 Neues Thema  |  Zur Übersicht  |  Suchen  |  Einloggen   Vorherige Nachricht  |  Nächste Nachricht 
 Re: Thumbnails erstellen
Autor: Dieter Zornow (---.asianet.co.th)
Datum:   21.05.10 19:13

Versuch mal das, ist bei mir ziemlich schnell auch bei sehr großen Bildern.

 Proc InitGDIPlus
 Declare gdpsi#,gdiplusToken&
 STRUCT GdiplusStartupInput = GdiplusVersion&,DebugEventCallback&,SuppressBackgroundThread&,SuppressExternalCodecs&
 Dim gdpsi#,GdiplusStartupInput
 gdpsi#.GdiplusVersion& = 1
 gdpsi#.DebugEventCallback& = 0
 gdpsi#.SuppressBackgroundThread& = 0
 gdpsi#.SuppressExternalCodecs& = 0
 External("GDIPLUS.DLL","GdiplusStartup",ADDR(gdiplusToken&),gdpsi#,0)
 Dispose gdpsi#
 Return gdiplusToken&
 EndProc
 
 Proc ExitGDIPlus
 Parameters gdiplusToken&
 External("GDIPLUS.DLL","GdiplusShutdown",gdiplusToken&)
 Endproc
 
 Proc CatchImage
 Parameters MemPointer& ,Size&
     Struct GdiplusStartupInput = GdiplusVersion&,DebugEventCallback&,SuppressBackgroundThread&,SuppressExternalCodecs&
     Var GDIP& = ImportDll("Gdiplus.dll","")
     Var OLE& = ImportDll("Ole32.dll","")
     Var Kernel& = ImportDll("Kernel32.dll","")
     Declare gdpsi#,gdiplusToken&,ImageObject&,GraphicObject&,pStream&,RetVal&
     'GDIPlus starten
     Dim gdpsi#,GdiplusStartupInput
     gdpsi#.GdiplusVersion& = 1
     gdpsi#.DebugEventCallback& = 0
     gdpsi#.SuppressBackgroundThread& = 0
     gdpsi#.SuppressExternalCodecs& = 0
     GdiplusStartup(ADDR(gdiplusToken&),gdpsi#,0)
     Dispose gdpsi#
     'Speicher bereitstellen
     Var m_hBuffer& = GlobalAlloc(2,Size&)
     Var pBuffer& = GlobalLock(m_hBuffer&)
     RtlMoveMemory(pBuffer&,MemPointer&,Size&)
     GlobalUnlock(m_hBuffer&)
     'Stream erzeugen
     CreateStreamOnHGlobal(m_hBuffer&,1,Addr(pStream&))
     GdipCreateBitmapFromStream(pStream&,Addr(ImageObject&))
     'hBitmap erzeugen
     GdipCreateHBITMAPFromBitmap(ImageObject&,Addr(RetVal&),0)
     'aufräumen
     Var Command& = Long(pStream&,0)
     call(Long(Command&,8),pStream&)'IStream.Release
     GlobalFree(m_hBuffer&)
     GdipDisposeImage(ImageObject&)
     GdipDeleteGraphics(GraphicObject&)
     GdiplusShutdown(gdiplusToken&)
     FreeDll GDIP&
     FreeDll OLE&
     FreeDll Kernel&
     Return RetVal&
 EndProc
 
 
 cls
 declare mem#,size&
 var bild$ = Loadfile$("Bild laden","*.*")
 case bild$ = "":end
 size& = filesize(bild$)
 dim mem#,size&
 set("Filemode",0)
 Blockread(bild$,mem#,0,size&)
 set("filemode",2)
 var hBild& = CatchImage(mem#,sizeof(mem#))
 Dispose mem#
 declare Image&,Thumb&,hBitmap& 
 var hadl& = InitGDIPlus()
 External("GDIPLUS.DLL","GdipCreateBitmapFromHBITMAP",hbild&,0,addr(Image&))
 External("GDIPLUS.DLL","GdipGetImageThumbnail",Image&,200,200,addr(Thumb&),0,0) 'picture size
 External("GDIPLUS.DLL","GdipCreateHBITMAPFromBitmap",Thumb&,addr(hBitmap&),0)
 DrawPic hBitmap&,10,10;0
 ExitGDIPlus(hadl&)
 waitinput
 




 Beitrag beantworten  |  Foren-Liste  |  Alle Antworten   Neuerer Beitrag  |  Älteres Thema 

 Beiträge Autor  Datum
 Thumbnails erstellen  Neu
Marco Lenz 21.05.10 18:36 
 Re: Thumbnails erstellen  Neu
Dieter Zornow 21.05.10 19:13 
 Re: Thumbnails erstellen  Neu
Marco Lenz 21.05.10 20:34 
 Re: Thumbnails erstellen  Neu
Dieter Zornow 21.05.10 21:50 
 Re: Thumbnails erstellen  Neu
Marco Lenz 22.05.10 08:57 


 Foren-Liste  |  Zur Registrierung 
 Benutzerlogin
 Benutzername:
 Passwort:
 Login-Daten speichern:
   
 Passwort vergessen?
E-Mail-Adresse oder Username unten eingeben. Dann wird Dir per e-Mail ein neues Passwort zugeschickt.

phorum.org