(848)  Anmelden

Deutsch
Forum

Vorschaubild aus großen Bilddateien

 
- Seite 1 -



GDL
Hallöle,

ich muß ca. 50 Vorschaubilder von 100X100 Pixel aus Bilddateien erzeugen.
Dabei haben die einzelnen Bilder immer > 4 Mb.

Habe jetzt rumgespielt. Dabei ist Dieter sein GDI-Plus Quelltext am schnellsten. Nur leider stimmt das Seitenverhältnis nicht.

Gibt es eine Möglichkeit Dieters Code so abzuändern dass das Seitenverhältnis stimmt? Ich bekomme es nicht hin.
KompilierenMarkierenSeparieren
'Bilddateigröße war beim Test 4,19mb groß
declare 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

    '==============================================
    'Wie 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 Version1"
    drawtext 10,150," Seitenverhältnis stimmt nicht"
    'Bild wird verzerrt
    '================================================================
    'Nach XProfan2
    za&=&GetTickCount
    h&=Create("hSizedPic",-1,pfad$,100,100,1)
    Sendmessage(c&,$00F7,0,h&)
    ze&=&GetTickCount
    drawtext 300,120,str$(ze&-za&)+" Millisekunden XProfan Version2"
    'Bild wird nicht verzerrt
    '==================================================================

endproc

'######################################
' von Dieter Zornow

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

proc test1

    declare 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#))
    Dispose mem#
    declare Image&,Thumb&,hBitmap&
    var hadl& = InitGDIPlus()
    External("GDIPLUS.DLL","GdipCreateBitmapFromHBITMAP",hbild&,0,addr(Image&))
    External("GDIPLUS.DLL","GdipGetImageThumbnail",Image&,100,100,addr(Thumb&),0,0)'picture size
    External("GDIPLUS.DLL","GdipCreateHBITMAPFromBitmap",Thumb&,addr(hBitmap&),0)
    Sendmessage(d&,$00F7,0,hBitmap&)
    ExitGDIPlus(hadl&)
    'Bild wird verzerrt, ist aber nicht so verpixelt

endproc

'#####################################################
chdir "C:\\bueroumgebung\\verzeichnis031\\weihnachten\\"'Pfad zum Testen anpassen
pfad$=upper$(LoadFile$("Lade ein Bild","*.jpg"))
case right$(pfad$,4)=".JPG":testen
za&=&GetTickCount
case 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
Ladeanzahl: 180
Herunterladen
 
Windows7 Xprofan 8,9,10 [...]  [...] 
03.09.2015  ▲
Vollständiges Zitat
Absatzweise zitierenZeilenweise zitieren
 



« Dieser Beitrag wurde als Lösung gekennzeichnet. »


GDL
@Michael

Das "Testen" war bei den letzten Posts nicht mehr im Versuchsprog.
Sorry, war mein Fehler.

Ausschlaggebend war dies:


Außerdem werden die DLL's ständig wieder aus dem Speicher geworfen. Lass sie doch bis zum Ende drin. Da InitGDIPlus und ExitGDIPlus die DLL's noch brauchen (und sie damit wieder in den Speicher holen) habe ich das mal in InitGDI und ExitGDI ausgelagert.


Der nun gehende Versuchsaufbau:
KompilierenMarkierenSeparieren
'Vorschaubild aus großen Bilddateien
'Bilddateigröße war beim Test 4,19mb groß
 {$CLQ}
Declare 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

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

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&
    Declare 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)
    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&)
    Return RetVal&

EndProc

proc test1

    declare 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#))
    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

    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

    External("GDIPLUS.DLL","GdipGetImageThumbnail",Image&,ThumbWidth%,ThumbHeight%,addr(Thumb&),0,0)'Thumb size
    External("GDIPLUS.DLL","GdipCreateHBITMAPFromBitmap",Thumb&,addr(hBitmap&),0)
    Sendmessage(d&,$00F7,0,hBitmap&)
    ExitGDIPlus(hadl&)
    'Bild wird verzerrt, ist aber nicht so verpixelt

endproc

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

whilenot i% > 1000

    za&=&GetTickCount
    case 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

KompilierenMarkierenSeparieren
External("GDIPLUS.DLL","GdipGetImageThumbnail",Image&,100,100,addr(Thumb&),0,0)'picture size

Ist nicht die Bildgröße, sondern die Thumb-Größe.
Am besten die Bildgröße vorher ermitteln (mit GdipGetImageHeight und Width) und dann das Verhältnis nehemen für das Thumb...

Beispiel: Bei einem Bild von 200x100 wäre der Thumb dann natürlich:
KompilierenMarkierenSeparieren
External("GDIPLUS.DLL","GdipGetImageThumbnail",Image&,100,50,addr(Thumb&),0,0)'thumb size
 
XProfan X3
Website:  [...] 
Facebook:  [...] 
04.09.2015  ▲
 




ByteAttack

KompilierenMarkierenSeparieren
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
Hallo ByteAttack

Danke.

Muss aber noch rausfinden wo es weiterhin hakt.
Irgendeine Speicherfreigabe tippe ich mal.

Nach 40mal Aufruf einer 4Mb Bildatei kommt Fehlermeldung
"Division durch Null"

Ebenso wird die Erstellzeit immer länger.

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

Hier ein im Anschluß
deleteobject hBitmap&

lässt das Programm abstürzen.
Also muss es was anderes sein.

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




ByteAttack
Bei
KompilierenMarkierenSeparieren
Dreisatz!=ImageWidth&/100
ThumbHeight%=ImageHeight&/Dreisatz!

Vorher abfragen, ob die Werte nicht 0 sind...
Dann hat er vielleicht keine Datei geladen???
KompilierenMarkierenSeparieren
Case ImageWidth&=0:Break
Case ImageHeigt&=0:Break
oder
CaseNot ImageWidth&=0:Dreisatz!=ImageWidth&/100
CaseNot ImageHeight&=0:ThumbHeight%=ImageHeight&/Dreisatz!
 
XProfan X3
Website:  [...] 
Facebook:  [...] 
04.09.2015  ▲
 




ByteAttack
Nachtrag... Die Berechnung ist sowieso falsch....

Bei Grafiken die im "Hochformat" sind, funktioniert es natürlich nicht! Das ganze war nur als beispiel gedacht
 
XProfan X3
Website:  [...] 
Facebook:  [...] 
04.09.2015  ▲
 




ByteAttack

KompilierenMarkierenSeparieren
Case ImageWidth&=0:Break
Case ImageHeight&=0:Break

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

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




GDL
Supi Ausrichtung funzt.
=========
Ich habe aber noch kein Ergebnis wegen langsamer werden.

Wenn ich Dieters Codeschnippsel solo nehme, habe ich folgendes Problem wie weiter oben gepostet nur ohne Absturz und ohne Fehlermeldung.

Bei Bilder über 4MB
Es wird ab den 40 Bild dann einfach keine Thumb mehr erstellt und die Erstellzeit wird immer länger.
Von 650ms bis ca. 1800 ms.
Bei 100 Bilder ist dann die Erstellzeit bei ca. 8sec. Aber ohne Thumb.

Bei Bilder unter 1MB kommt der Effekt dann später.

zum Bild:
Bis zum Bild 39 passen ImageHeight& und Imagewidth& und bei Bild 40 springen beide Werte auf 0.
Wenn ich diese 0 Abfange stürzt zwar das Prog. nicht mehr ab, aber es werden auch keine Thumbs mehr erstellt.


43 kB
Hochgeladen:04.09.2015
Ladeanzahl: 170
Herunterladen
 
Windows7 Xprofan 8,9,10 [...]  [...] 
04.09.2015  ▲
 




Jörg
Sellmeyer
Wie ist es denn, wenn du das Bildobjekt löschst, bevor du ein neues erstellst?
KompilierenMarkierenSeparieren
proc test1

    declare mem#,size&,bild$
    bild$=pfad$
    size& = filesize(bild$)
    dim mem#,size&
    set("Filemode",0)
    Blockread(bild$,mem#,0,size&)
    set("filemode",2)
    'Hier altes Objekt löschen
    Case hBild& <> 0:DeleteObject hBild&
    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&,100,100,addr(Thumb&),0,0)'picture size
    External("GDIPLUS.DLL","GdipCreateHBITMAPFromBitmap",Thumb&,addr(hBitmap&),0)
    Sendmessage(d&,$00F7,0,hBitmap&)
    'auch hier das Objekt löschen. Wenn es auf dem Static ist, müsste es eigentlich überflüssig sein
    DeleteObject hBitmap&
    ExitGDIPlus(hadl&)
    'Bild wird verzerrt, ist aber nicht so verpixelt

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




Michael
W.
Müsste das Image nicht auch weg? Finde es so auf die Schnelle nicht bei MS - die haben da ja mächtig umgeräumt (nichts mehr am 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 das Image nicht auch weg? Finde es so auf die Schnelle nicht bei MS - die haben da ja mächtig umgeräumt (nichts mehr am alten Platz).


Finde ich auch richtig sch....ade. Durch ihr neues Visual Studio haben sie alle "wichtigen" Informationen der MSDN in das .net-Format gebracht...
Alle Links die ich hatte, sind quasi wertlos...
 
XProfan X3
Website:  [...] 
Facebook:  [...] 
05.09.2015  ▲
 




GDL
Hallo Jörg,

da hab ich auch schon rumprobiert.

Wenn ich deleteobject hBitmap& dort einfüge stürzt XProfan ab.



Nehme ich XPSE her, muss diese Def. nachträglich am Programmanfang eingefügt werden.

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

Sonst bricht XPSE ab.

Nach Einfügen der Def geht mit XPSE dann zwar Deleteobject hBitmap&

aber es wird trotzdem immer langsamer und bricht nach dem 40ten Thumb ab.

Grüßle
Georg

21 kB
Hochgeladen:05.09.2015
Ladeanzahl: 193
Herunterladen
 
Windows7 Xprofan 8,9,10 [...]  [...] 
05.09.2015  ▲
 



12
►

Antworten


Thementitel, max. 100 Zeichen.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Beitrag  Schrift  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Themenoptionen

Ungelesen
Abonnieren
Merkliste
Hinweise
Gäste
Löschen
Ständig
Erledigt

18.461 Betrachtungen

Unbenanntvor 0 min.
Langer18.12.2021
Georg25.01.2021
H.Brill05.01.2019
AndreasS27.12.2018
Mehr...

Themeninformationen

Dieses Thema hat 4 Teilnehmer:

GDL (6x)
ByteAttack (6x)
Michael W. (3x)
Jörg Sellmeyer (1x)


Admins  |  AGB  |  Anwendungen  |  Autoren  |  Chat  |  Datenschutz  |  Download  |  Eingangshalle  |  Hilfe  |  Händlerportal  |  Impressum  |  Mart  |  Schnittstellen  |  SDK  |  Services  |  Spiele  |  Suche  |  Support

Ein Projekt aller XProfaner, die es gibt!


Mein XProfan
Private Nachrichten
Eigenes Ablageforum
Themen-Merkliste
Eigene Beiträge
Eigene Themen
Zwischenablage
Abmelden
 Deutsch English Français Español Italia
Übersetzungen

Datenschutz


Wir verwenden Cookies nur als Session-Cookies wegen der technischen Notwendigkeit und bei uns gibt es keine Cookies von Drittanbietern.

Wenn du hier auf unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung von Informationen in unseren Cookies auf XProfan.Net zu.

Weitere Informationen zu unseren Cookies und dazu, wie du die Kontrolle darüber behältst, findest du in unserer nachfolgenden Datenschutzerklärung.

einverstandenDatenschutzerklärung
Ich möchte keinen Cookie