Español
Foro

Vorschaubild de großen Bilddateien

 
- Página 1 -



GDL
Hallöle,

Yo muß ca. 50 Vorschaubilder de 100X100 Pixel de Bilddateien erzeugen.
Dabei haben cada Bilder siempre > 4 Mb.

Posesiones ahora rumgespielt. Dabei es Dieter ser GDI-Plus Ver código fuente al schnellsten. Nur desafortunadamente stimmt el Seitenverhältnis no.

Gibt lo una Möglichkeit Dieters Code así abzuändern dass el Seitenverhältnis stimmt? Yo bekomme no hin.
'Bilddateigröße war beim Test 4,19mb groß
declarar h&,b&,c&,d&,za&,ze&,pfad$
cls
b&=create("picbutton",%hwnd,0,10,10,105,105)
c&=create("picbutton",%hwnd,0,300,10,105,105)
d&=create("picbutton",%hwnd,0,10,230,105,105)

proc testen

    '==============================================
    'Como telefonisch besprochen (David)
    'XProfan1
    h&=create("hnewpic",100,100,0)
    za&=&GetTickCount
    startpaint h&
    drawsizedpic pfad$,0,0-100,100;0
    endpaint
    SendMessage(b&,$00F7,0,h&)
    ze&=&GetTickCount
    drawtext 10,120,str$(ze&-za&)+" Millisekunden XProfan Versión1"
    drawtext 10,150," Seitenverhältnis stimmt nicht"
    'Bild se verzerrt
    '================================================================
    'Nach XProfan2
    za&=&GetTickCount
    h&=Crear("hSizedPic",-1,pfad$,100,100,1)
    SendMessage(c&,$00F7,0,h&)
    ze&=&GetTickCount
    drawtext 300,120,str$(ze&-za&)+" Millisekunden XProfan Versión2"
    'Bild no es verzerrt
    '==================================================================

ENDPROC

'######################################
' de Dieter Zornow

Proc InitGDIPlus

    Declarar gdpsi#,gdiplusToken&
    STRUCT GdiplusStartupInput = GdiplusVersion&,DebugEventCallback&,SuppressBackgroundThread&,SuppressExternalCodecs&
    Dim gdpsi#,GdiplusStartupInput
    gdpsi#.GdiplusVersion& = 1
    gdpsi#.DebugEventCallback& = 0
    gdpsi#.SuppressBackgroundThread& = 0
    gdpsi#.SuppressExternalCodecs& = 0
    Externo("GDIPLUS.DLL","GdiplusStartup",ADDR(gdiplusToken&),gdpsi#,0)
    Disponer gdpsi#
    Volver gdiplusToken&

ENDPROC

Proc ExitGDIPlus

    Parámetros gdiplusToken&
    Externo("GDIPLUS.DLL","GdiplusShutdown",gdiplusToken&)

ENDPROC

Proc CatchImage

    Parámetros MemPointer& ,Size&
    Struct GdiplusStartupInput = GdiplusVersion&,DebugEventCallback&,SuppressBackgroundThread&,SuppressExternalCodecs&
    Var GDIP& = ImportDll("Gdiplus.dll","")
    Var OLE& = ImportDll("Ole32.dll","")
    Var Kernel& = ImportDll("Kernel32.dll","")
    Declarar 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)
    Disponer 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& = Largo(pStream&,0)
    call(Largo(Command&,8),pStream&)'IStream.Release
    GlobalFree(m_hBuffer&)
    GdipDisposeImage(ImageObject&)
    GdipDeleteGraphics(GraphicObject&)
    GdiplusShutdown(gdiplusToken&)
    FreeDll GDIP&
    FreeDll OLE&
    FreeDll Kernel&
    Volver RetVal&

ENDPROC

proc test1

    declarar mem#,size&,bild$
    bild$=pfad$
    size& = filesize(bild$)
    dim mem#,size&
    set("Filemode",0)
    Blockread(bild$,mem#,0,size&)
    set("filemode",2)
    var hBild& = CatchImage(mem#,sizeof(mem#))
    Disponer mem#
    declarar Image&,Thumb&,hBitmap&
    var hadl& = InitGDIPlus()
    Externo("GDIPLUS.DLL","GdipCreateBitmapFromHBITMAP",hbild&,0,addr(Image&))
    Externo("GDIPLUS.DLL","GdipGetImageThumbnail",Image&,100,100,addr(Thumb&),0,0)'picture size
    Externo("GDIPLUS.DLL","GdipCreateHBITMAPFromBitmap",Thumb&,addr(hBitmap&),0)
    SendMessage(d&,$00F7,0,hBitmap&)
    ExitGDIPlus(hadl&)
    'Bild se verzerrt, es pero no así verpixelt

ENDPROC

'#####################################################
chdir "C:\\bueroumgebung\\verzeichnis031\\weihnachten\\"'Pfad para Testen adaptar
pfad$=upper$(LoadFile$("Lade una Bild","*.jpg"))
caso right$(pfad$,4)=".JPG":testen
za&=&GetTickCount
caso right$(pfad$,4)=".JPG":test1
ze&=&GetTickCount
drawtext 10,350,str$(ze&-za&)+" Millisekunden XProfan GDI-Plus"
drawtext 10,380," Seitenverhältnis stimmt nicht"
waitinput
deleteobject h&



Grüßle
Georg

84 kB
Hochgeladen:03.09.2015
Ladeanzahl192
Descargar
 
Windows7 Xprofan 8,9,10 [...]  [...] 
03.09.2015  
 



« Dieser Contribución wurde como Solución gekennzeichnet. »


GDL
@Michael

Das "Testen" war en el letzten Posts no mehr en el Versuchsprog.
Sorry, war mein Fehler.

Ausschlaggebend war dies:


Außerdem voluntad el DLL's ständig otra vez de el Speicher geworfen. Lass ellos doch a para Ende drin. Como InitGDIPlus y ExitGDIPlus el DLL's todavía brauchen (y ellos así otra vez en el Speicher holen) Yo el veces en InitGDI y ExitGDI ausgelagert.


Der nun gehende Versuchsaufbau:
'Vorschaubild de großen Bilddateien
'Bilddateigröße war beim Test 4,19mb groß
 {$CLQ}
Declarar GDIP&,OLE&,Kernel&
DEF CreateStreamOnHGlobal(3)!"OLE32","CreateStreamOnHGlobal"

Proc InitGDI

    GDIP& = ImportDll("Gdiplus.dll","")
    OLE& = ImportDll("Ole32.dll","")
    Kernel& = ImportDll("Kernel32.dll","")

ENDPROC

Proc ExitGDI

    FreeDLL Kernel&
    FreeDLL OLE&
    FreeDLL GDIP&

ENDPROC

declarar b&,c&,d&,za&,ze&,pfad$,i%,RetVal&
cls
d&=create("picbutton",%hwnd,0,10,230,105,105)
'######################################
' de Dieter Zornow

Proc InitGDIPlus

    Declarar gdpsi#,gdiplusToken&
    STRUCT GdiplusStartupInput = GdiplusVersion&,DebugEventCallback&,SuppressBackgroundThread&,SuppressExternalCodecs&
    Dim gdpsi#,GdiplusStartupInput
    gdpsi#.GdiplusVersion& = 1
    gdpsi#.DebugEventCallback& = 0
    gdpsi#.SuppressBackgroundThread& = 0
    gdpsi#.SuppressExternalCodecs& = 0
    Externo("GDIPLUS.DLL","GdiplusStartup",ADDR(gdiplusToken&),gdpsi#,0)
    Disponer gdpsi#
    Volver gdiplusToken&

ENDPROC

Proc ExitGDIPlus

    Parámetros gdiplusToken&
    Externo("GDIPLUS.DLL","GdiplusShutdown",gdiplusToken&)

ENDPROC

Proc CatchImage

    Parámetros MemPointer& ,Size&
    Struct GdiplusStartupInput = GdiplusVersion&,DebugEventCallback&,SuppressBackgroundThread&,SuppressExternalCodecs&
    Declarar gdpsi#,gdiplusToken&,ImageObject&,GraphicObject&,pStream&
    Dim gdpsi#,GdiplusStartupInput
    gdpsi#.GdiplusVersion& = 1
    gdpsi#.DebugEventCallback& = 0
    gdpsi#.SuppressBackgroundThread& = 0
    gdpsi#.SuppressExternalCodecs& = 0
    GdiplusStartup(ADDR(gdiplusToken&),gdpsi#,0)
    Disponer 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& = Largo(pStream&,0)
    call(Largo(Command&,8),pStream&)'IStream.Release
    GlobalFree(m_hBuffer&)
    GdipDisposeImage(ImageObject&)
    GdipDeleteGraphics(GraphicObject&)
    GdiplusShutdown(gdiplusToken&)
    Volver RetVal&

ENDPROC

proc test1

    declarar mem#,size&,bild$,ImageWidth&,ImageHeight&,Dreisatz!,ThumbHeight%,ThumbWidth%
    bild$=pfad$
    size& = filesize(bild$)
    dim mem#,size&
    set("Filemode",0)
    Blockread(bild$,mem#,0,size&)
    set("filemode",2)
    var hBild& = CatchImage(mem#,sizeof(mem#))
    Disponer mem#
    declarar Image&,Thumb&,hBitmap&
    var hadl& = InitGDIPlus()
    Externo("GDIPLUS.DLL","GdipCreateBitmapFromHBITMAP",hbild&,0,addr(Image&))
    Externo("GDIPLUS.DLL","GdipGetImageWidth",Image&,ADDR(ImageWidth&))'Breite ermitteln
    Externo("GDIPLUS.DLL","GdipGetImageHeight",Image&,ADDR(ImageHeight&))'Hoehe ermitteln

    if ImageWidth& = ImageHeight&' Quadratisch

        ThumbWidth% = 100
        ThumbHeight% = 100

    elseif ImageWidth& > ImageHeight&' Querformat

        Dreisatz! = ImageWidth&/100
        ThumbHeight% = ImageHeight&/Dreisatz!
        ThumbWidth% = 100

    elseif ImageWidth& < ImageHeight&' Hochformat

        Dreisatz! = ImageHeight&/100
        ThumbWidth% = ImageWidth&/Dreisatz!
        ThumbHeight% = 100

    endif

    Externo("GDIPLUS.DLL","GdipGetImageThumbnail",Image&,ThumbWidth%,ThumbHeight%,addr(Thumb&),0,0)'Thumb size
    Externo("GDIPLUS.DLL","GdipCreateHBITMAPFromBitmap",Thumb&,addr(hBitmap&),0)
    SendMessage(d&,$00F7,0,hBitmap&)
    ExitGDIPlus(hadl&)
    'Bild se verzerrt, es pero no así verpixelt

ENDPROC

'#####################################################
chdir "C:\\bueroumgebung\\verzeichnis031\\weihnachten\\"'Pfad para Testen adaptar
pfad$=upper$(LoadFile$("Lade una Bild","*.jpg"))
InitGDI()
i%=1

whilenot i% > 1000

    za&=&GetTickCount
    caso right$(pfad$,4)=".JPG" : test1
    deleteobject RetVal&'wichtig
    ze&=&GetTickCount
    inc i%
    drawtext 10,350,str$(ze&-za&)+" Millisekunden XProfan GDI-Plus"
    drawtext 10,380," Seitenverhältnis stimmt nicht"

wend

ExitGDI()
waitinput
 
Windows7 Xprofan 8,9,10 [...]  [...] 
05.09.2015  
 




ByteAttack

KompilierenMarcaSeparación
External("GDIPLUS.DLL","GdipGetImageThumbnail",Image&,100,100,addr(Thumb&),0,0)'picture size
>

Ist no el Bildgröße, pero el Thumb-Größe.
Am besten el Bildgröße vorher ermitteln (con GdipGetImageHeight y Width) y luego el Verhältnis nehemen para el Thumb...

Ejemplo: En una Bild de 200x100 wäre el Thumb entonces natürlich:
KompilierenMarcaSeparación
External("GDIPLUS.DLL","GdipGetImageThumbnail",Image&,100,50,addr(Thumb&),0,0)'thumb size
>
 
XProfan X3
Website:  [...] 
Facebook:  [...] 
04.09.2015  
 




ByteAttack

KompilierenMarcaSeparación
proc test1

    declare mem#,size&,bild$,ImageWidth&,ImageHeight&,Dreisatz!,ThumbHeight%
    bild$=pfad$
    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","GdipGetImageWidth",Image&,ADDR(ImageWidth&))'Breite ermitteln
    External("GDIPLUS.DLL","GdipGetImageHeight",Image&,ADDR(ImageHeight&))'Hoehe ermitteln
    Dreisatz!=ImageWidth&/100
    ThumbHeight%=ImageHeight&/Dreisatz!
    External("GDIPLUS.DLL","GdipGetImageThumbnail",Image&,100,ThumbHeight%,addr(Thumb&),0,0)'Thumb size
    External("GDIPLUS.DLL","GdipCreateHBITMAPFromBitmap",Thumb&,addr(hBitmap&),0)
    Sendmessage(d&,$00F7,0,hBitmap&)
    ExitGDIPlus(hadl&)

ENDPROC


 
Website:  [...] 
Facebook:  [...] 
04.09.2015  
 




GDL
¡Hola ByteAttack

Gracias.

Muss aber todavía rausfinden wo lo weiterhin hakt.
Irgendeine Speicherfreigabe tippe Yo veces.

Nach 40veces Aufruf uno 4Mb Bildatei kommt Fehlermeldung
"Division por Null"

También se el Erstellzeit siempre länger.

=================
..
..
SendMessage(d&,$00F7,0,hBitmap&)
ExitGDIPlus(hadl&)

Hier una en el Anschluß
deleteobject hBitmap&

lässt el Programa abstürzen.
Also muss lo qué más ser.

Grüßle
Georg
 
XProfan X3
Windows7 Xprofan 8,9,10 [...]  [...] 
04.09.2015  
 




ByteAttack
En
Dreisatz!=ImageWidth&/100
ThumbHeight%=ImageHeight&/Dreisatz!

Vorher abfragen, si el Werte no 0 son...
Dann ha él tal vez no Expediente geladen???
Case ImageWidth&=0:Romper
Case ImageHeigt&=0:Romper
oder
Casenote ImageWidth&=0:Dreisatz!=ImageWidth&/100
Casenote ImageHeight&=0:ThumbHeight%=ImageHeight&/Dreisatz!
 
XProfan X3
Website:  [...] 
Facebook:  [...] 
04.09.2015  
 




ByteAttack
Apéndice... El Berechnung es sowieso falso....

En Gráficos el en el "Hochformat" son, funktioniert lo natürlich no! Das todo war sólo como beispiel pensamiento
 
XProfan X3
Website:  [...] 
Facebook:  [...] 
04.09.2015  
 




ByteAttack

Case ImageWidth&=0:Romper
Case ImageHeight&=0:Romper

if ImageWidth&=ImageHeight&' Quadratisch

    ThumbWidth%=100
    ThumbHeight%=100

elseif ImageWidth&>ImageHeight&' Querformat

    Dreisatz!=ImageWidth&/100
    ThumbHeight%=ImageHeight&/Dreisatz!
    ThumbWidth%=100

elseif ImageWidth&<ImageHeight&' Hochformat

    Dreisatz!=ImageHeight&/100
    ThumbWidth%=ImageWidth&/Dreisatz!
    ThumbHeight%=100

endif

Externo("GDIPLUS.DLL","GdipGetImageThumbnail",Image&,ThumbWidth%,ThumbHeight%,addr(Thumb&),0,0)'picture size
 
XProfan X3
Website:  [...] 
Facebook:  [...] 
04.09.2015  
 




GDL
Supi Ausrichtung funzt.
=========
Yo habe aber todavía kein Ergebnis wegen langsamer voluntad.

Wenn Yo Dieters Codeschnippsel solo nehme, Yo folgendes Problema como más oben Nuevo sólo sin Choque y sin Fehlermeldung.

En Bilder encima 4MB
Lo se de el 40 Bild entonces simplemente no Thumb mehr erstellt y el Erstellzeit se siempre länger.
Von 650ms a ca. 1800 ms.
En 100 Bilder es entonces el Erstellzeit en ca. 8sec. Aber sin Thumb.

En Bilder bajo 1MB kommt el Effekt entonces später.

para Bild:
Bis para Bild 39 passen ImageHeight& y Imagewidth& y en Bild 40 springen beide Werte en 0.
Wenn Yo esta 0 Abfange stürzt zwar el Prog. no mehr de, pero voluntad auch no Thumbs mehr erstellt.


43 kB
Hochgeladen:04.09.2015
Ladeanzahl181
Descargar
 
Windows7 Xprofan 8,9,10 [...]  [...] 
04.09.2015  
 




Jörg
Sellmeyer
Como es porque, si Si es usted el Bildobjekt löschst, bevor du una neues erstellst?
proc test1

    declarar mem#,size&,bild$
    bild$=pfad$
    size& = filesize(bild$)
    dim mem#,size&
    set("Filemode",0)
    Blockread(bild$,mem#,0,size&)
    set("filemode",2)
    'Hier altes Objeto löschen
    Case hBild& <> 0:DeleteObject hBild&
    var hBild& = CatchImage(mem#,sizeof(mem#))
    Disponer mem#
    declarar Image&,Thumb&,hBitmap&
    var hadl& = InitGDIPlus()
    Externo("GDIPLUS.DLL","GdipCreateBitmapFromHBITMAP",hbild&,0,addr(Image&))
    Externo("GDIPLUS.DLL","GdipGetImageThumbnail",Image&,100,100,addr(Thumb&),0,0)'picture size
    Externo("GDIPLUS.DLL","GdipCreateHBITMAPFromBitmap",Thumb&,addr(hBitmap&),0)
    SendMessage(d&,$00F7,0,hBitmap&)
    'auch hier el Objeto löschen. Wenn lo en el Static es, debería lo eigentlich überflüssig ser
    DeleteObject hBitmap&
    ExitGDIPlus(hadl&)
    'Bild se verzerrt, es pero no así verpixelt

ENDPROC

 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
05.09.2015  
 




Michael
W.
Müsste el Imagen no auch weg? Finde lo así en el Schnelle no en MS - el haben como sí mächtig umgeräumt (nichts mehr al alten Platz).
 
XProfan X3
System: Windows 8/10, XProfan X4
Programmieren, das spannendste Detektivspiel der Welt.
05.09.2015  
 




ByteAttack
Michael W. (05.09.15)
Müsste el Imagen no auch weg? Finde lo así en el Schnelle no en MS - el haben como sí mächtig umgeräumt (nichts mehr al alten Platz).


Finde Yo auch correcto sch....ade. Durch ihr neues Visual Studio haben ellos todos "wichtigen" Informationen el MSDN en el .net-Formato gebracht...
Alle Links el Yo hatte, son quasi wertlos...
 
XProfan X3
Website:  [...] 
Facebook:  [...] 
05.09.2015  
 




GDL
¡Hola Jörg,

como tener Yo auch ya rumprobiert.

Wenn Yo deleteobject hBitmap& hay einfüge stürzt XProfan de.



Nehme Yo XPSE her, muss esta Def. nachträglich al Programmanfang eingefügt voluntad.

DEF CreateStreamOnHGlobal(3)!"OLE32","CreateStreamOnHGlobal"

Sonst bricht XPSE de.

Nach Einfügen el Def va con XPSE entonces zwar Deleteobject hBitmap&

pero se trotzdem siempre langsamer y bricht después de el 40ten Thumb de.

Grüßle
Georg

21 kB
Hochgeladen:05.09.2015
Ladeanzahl204
Descargar
 
Windows7 Xprofan 8,9,10 [...]  [...] 
05.09.2015  
 




Respuesta


Título del Tema, max. 100 Signo.
 

Systemprofile:

Kein Systemprofil creado. [anlegen]

XProfan:

 Contribución  Font  Smilies  ▼ 

Bitte registro en una Contribución a verfassen.
 

Tema opciones

18.618 Views

Untitledvor 0 min.
Langer18.12.2021
Georg25.01.2021
H.Brill05.01.2019
AndreasS27.12.2018
Más...

Themeninformationen



Admins  |  AGB  |  Applications  |  Autores  |  Chat  |  Política de Privacidad  |  Descargar  |  Entrance  |  Ayuda  |  Merchantportal  |  Pie de imprenta  |  Mart  |  Interfaces  |  SDK  |  Services  |  Juegos  |  Búsqueda  |  Support

Ein Projekt aller XProfan, el lo son!


Mi XProfan
Privado Noticias
Eigenes Ablageforum
Temas-Merkliste
Eigene Beiträge
Eigene Temas
Zwischenablage
Cancelar
 Deutsch English Français Español Italia
Traducciones

Política de Privacidad


Wir uso Cookies sólo como Session-Cookies wegen el technischen Notwendigkeit y en uns hay no Cookies de Drittanbietern.

Wenn du hier en unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung de Informationen en unseren Cookies en XProfan.Net a.

Weitere Informationen a unseren Cookies y dazu, como du el Kontrolle darüber behältst, findest du en unserer nachfolgenden Datenschutzerklärung.


einverstandenDatenschutzerklärung
Yo möchte no Cookie