XProfan

Français

GDL

Hallöle,

je dois ca. 50 Vorschaubilder de 100X100 Pixel aus Bilddateien erzeugen.
Dabei avons chaque Bilder toujours > 4 Mb.

Habe maintenant rumgespielt. Dabei ist Dieter son GDI-Plus Voir le texte source am schnellsten. seulement malheureusement stimmt cela Seitenverhältnis pas.

Gibt es une Possibilité Dieters Code so abzuändern dass cela Seitenverhältnis stimmt? je bekomme es pas hin.

Kompilieren Marque Séparation

'Bilddateigröße était beim Test 4,19mb grand
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

    '==============================================
    'comment 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
    '================================================================
    'Pour XProfan2
    za&=&GetTickCount
    h&=Créer("hSizedPic",-1,pfad$,100,100,1)
    SendMessage(c&,$00F7,0,h&)
    ze&=&GetTickCount
    drawtext 300,120,str$(ze&-za&)+" Millisekunden XProfan Version2"
    'Bild wird pas verzerrt
    '==================================================================

endproc

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

Proc InitGDIPlus

    Déclarer gdpsi#,gdiplusToken&
    STRUCT GdiplusStartupInput = GdiplusVersion&,DebugEventCallback&,SuppressBackgroundThread&,SuppressExternalCodecs&
    Faible gdpsi#,GdiplusStartupInput
    gdpsi#.GdiplusVersion& = 1
    gdpsi#.DebugEventCallback& = 0
    gdpsi#.SuppressBackgroundThread& = 0
    gdpsi#.SuppressExternalCodecs& = 0
    Externe("GDIPLUS.DLL","GdiplusStartup",ADDR(gdiplusToken&),gdpsi#,0)
    Dispose gdpsi#
    Retour gdiplusToken&

ENDPROC

Proc ExitGDIPlus

    Paramètres gdiplusToken&
    Externe("GDIPLUS.DLL","GdiplusShutdown",gdiplusToken&)

ENDPROC

Proc CatchImage

    Paramètres MemPointer& ,Size&
    Struct GdiplusStartupInput = GdiplusVersion&,DebugEventCallback&,SuppressBackgroundThread&,SuppressExternalCodecs&
    Var GDIP& = ImportDll("Gdiplus.dll",»)
    Var OLE& = ImportDll("Ole32.dll",»)
    Var Kernel& = ImportDll("Kernel32.dll",»)
    Déclarer gdpsi#,gdiplusToken&,ImageObject&,GraphicObject&,pStream&,RetVal&
    'GDIPlus starten
    Faible gdpsi#,GdiplusStartupInput
    gdpsi#.GdiplusVersion& = 1
    gdpsi#.DebugEventCallback& = 0
    gdpsi#.SuppressBackgroundThread& = 0
    gdpsi#.SuppressExternalCodecs& = 0
    GdiplusStartup(ADDR(gdiplusToken&),gdpsi#,0)
    Dispose gdpsi#
    'grenier 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&
    Retour 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()
    Externe("GDIPLUS.DLL","GdipCreateBitmapFromHBITMAP",hbild&,0,addr(Image&))
    Externe("GDIPLUS.DLL","GdipGetImageThumbnail",Image&,100,100,addr(Thumb&),0,0)'picture size
    Externe("GDIPLUS.DLL","GdipCreateHBITMAPFromBitmap",Thumb&,addr(hBitmap&),0)
    SendMessage(d&,$00F7,0,hBitmap&)
    ExitGDIPlus(hadl&)
    'Bild wird verzerrt, ist mais pas so verpixelt

endproc

'#####################################################
chdir "C:\\bueroumgebung\\verzeichnis031\\weihnachten\\"'Pfad zum Testen anpassen
pfad$=upper$(LoadFile$("Lade un Bild","*.jpg"))
cas right$(pfad$,4)=".JPG":testen
za&=&GetTickCount
cas 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

vorschaubild.png	84 kB

Hochgeladen:	03.09.2015

Downloadcounter:
		Download

Windows7 Xprofan 8,9,10 [...]

[...]

03.09.2015 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

« cette Beitrag wurde comme Solution gekennzeichnet. »

- page 2 -

GDL

@Michael

cela "Testen" était chez den letzten Posts pas plus im Versuchsprog.
Sorry, était mon faute.

Ausschlaggebend était ca:

Aussi volonté qui DLL's ständig wieder aus dem grenier geworfen. Lass vous doch jusqu'à zum Ende drin. là InitGDIPlus et ExitGDIPlus qui DLL's encore brauchen (et vous avec cela wieder dans den grenier holen) habe je cela la fois dans InitGDI et ExitGDI ausgelagert.

qui eh bien gehende Versuchsaufbau:

Kompilieren Marque Séparation

'Vorschaubild aus grand Bilddateien
'Bilddateigröße était beim Test 4,19mb grand
 {$CLQ}
Déclarer 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)
'######################################
' de Dieter Zornow

Proc InitGDIPlus

    Déclarer gdpsi#,gdiplusToken&
    STRUCT GdiplusStartupInput = GdiplusVersion&,DebugEventCallback&,SuppressBackgroundThread&,SuppressExternalCodecs&
    Faible gdpsi#,GdiplusStartupInput
    gdpsi#.GdiplusVersion& = 1
    gdpsi#.DebugEventCallback& = 0
    gdpsi#.SuppressBackgroundThread& = 0
    gdpsi#.SuppressExternalCodecs& = 0
    Externe("GDIPLUS.DLL","GdiplusStartup",ADDR(gdiplusToken&),gdpsi#,0)
    Dispose gdpsi#
    Retour gdiplusToken&

ENDPROC

Proc ExitGDIPlus

    Paramètres gdiplusToken&
    Externe("GDIPLUS.DLL","GdiplusShutdown",gdiplusToken&)

ENDPROC

Proc CatchImage

    Paramètres MemPointer& ,Size&
    Struct GdiplusStartupInput = GdiplusVersion&,DebugEventCallback&,SuppressBackgroundThread&,SuppressExternalCodecs&
    Déclarer gdpsi#,gdiplusToken&,ImageObject&,GraphicObject&,pStream&
    Faible gdpsi#,GdiplusStartupInput
    gdpsi#.GdiplusVersion& = 1
    gdpsi#.DebugEventCallback& = 0
    gdpsi#.SuppressBackgroundThread& = 0
    gdpsi#.SuppressExternalCodecs& = 0
    GdiplusStartup(ADDR(gdiplusToken&),gdpsi#,0)
    Dispose gdpsi#
    'grenier 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&)
    Retour 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()
    Externe("GDIPLUS.DLL","GdipCreateBitmapFromHBITMAP",hbild&,0,addr(Image&))
    Externe("GDIPLUS.DLL","GdipGetImageWidth",Image&,ADDR(ImageWidth&))'Breite ermitteln
    Externe("GDIPLUS.DLL","GdipGetImageHeight",Image&,ADDR(ImageHeight&))'Hoehe ermitteln

    si ImageWidth& = ImageHeight&' carrée

        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

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

endproc

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

whilenot i% > 1000

    za&=&GetTickCount
    cas right$(pfad$,4)=".JPG" : test1
    deleteobject RetVal&'important
    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 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

- page 1 -

ByteAttack

chez

Kompilieren Marque Séparation

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

auparavant abfragen, si qui Werte pas 0 sommes...
ensuite hat il peut-être aucun Dossier geladen???

Kompilieren Marque Séparation

Cas ImageWidth&=0:Pause
Cas ImageHeigt&=0:Pause
ou bien
Casenote ImageWidth&=0:Dreisatz!=ImageWidth&/100
Casenote ImageHeight&=0:ThumbHeight%=ImageHeight&/Dreisatz!

XProfan X3
Website: [...]

Facebook: [...]

04.09.2015 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

ByteAttack

Nachtrag... qui Berechnung ist sowieso faux....

chez Grafiken qui im "Hochformat" sommes, funktioniert es naturellement pas! cela ganze était seulement comme beispiel gedacht

XProfan X3
Website: [...]

Facebook: [...]

04.09.2015 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

ByteAttack

Kompilieren Marque Séparation

Cas ImageWidth&=0:Pause
Cas ImageHeight&=0:Pause

si ImageWidth&=ImageHeight&' carrée

    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

Externe("GDIPLUS.DLL","GdipGetImageThumbnail",Image&,ThumbWidth%,ThumbHeight%,addr(Thumb&),0,0)'picture size

XProfan X3
Website: [...]

Facebook: [...]

04.09.2015 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

GDL

Supi Ausrichtung funzt.
=========
j'ai mais encore ne...aucune Ergebnis à cause de langsamer volonté.

si je Dieters Codeschnippsel solo nehme, habe je folgendes Problem comment plus dessus posté seulement sans Absturz et sans Fehlermeldung.

chez Bilder sur 4MB
Es wird ab den 40 Bild ensuite simple aucun Thumb plus erstellt et qui Erstellzeit wird toujours länger.
de 650ms jusqu'à ca. 1800 ms.
chez 100 Bilder ist ensuite qui Erstellzeit chez ca. 8sec. mais sans Thumb.

chez Bilder sous 1MB venez qui effet ensuite später.

zum Bild:
jusqu'à zum Bild 39 passen ImageHeight& et Imagewidth& et chez Bild 40 springen beide Werte sur 0.
si je cet 0 Abfange stürzt zwar cela Prog. pas plus ab, mais es volonté aussi aucun Thumbs plus erstellt.

fehler.png	43 kB

Hochgeladen:	04.09.2015

Downloadcounter:
		Download

Windows7 Xprofan 8,9,10 [...]

[...]

04.09.2015 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Jörg
Sellmeyer

comment ist es car, si du cela Bildobjekt löschst, bevor du un nouveau erstellst?

Kompilieren Marque Séparation

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)
    'ici altes objet effacer
    Cas hBild& <> 0:DeleteObject hBild&
    var hBild& = CatchImage(mem#,sizeof(mem#))
    Dispose mem#
    declare Image&,Thumb&,hBitmap&
    var hadl& = InitGDIPlus()
    Externe("GDIPLUS.DLL","GdipCreateBitmapFromHBITMAP",hbild&,0,addr(Image&))
    Externe("GDIPLUS.DLL","GdipGetImageThumbnail",Image&,100,100,addr(Thumb&),0,0)'picture size
    Externe("GDIPLUS.DLL","GdipCreateHBITMAPFromBitmap",Thumb&,addr(hBitmap&),0)
    SendMessage(d&,$00F7,0,hBitmap&)
    'aussi ici cela objet effacer. si es sur dem Static ist, devrait es eigentlich überflüssig son
    DeleteObject hBitmap&
    ExitGDIPlus(hadl&)
    'Bild wird verzerrt, ist mais pas so verpixelt

endproc

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

05.09.2015 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Michael
W.

Müsste cela Image pas aussi weg? Finde es so sur qui Schnelle pas chez MS - qui avons là oui mächtig umgeräumt (rien plus am alten place).

XProfan X3
System: Windows 8/10, XProfan X4
Programmieren, das spannendste Detektivspiel der Welt.

05.09.2015 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

ByteAttack

Michael W. (05.09.15)

Müsste cela Image pas aussi weg? Finde es so sur qui Schnelle pas chez MS - qui avons là oui mächtig umgeräumt (rien plus am alten place).

Finde je aussi richtig sch....ade. par son nouveau Visual Studio est-ce que vous avez alle "wichtigen" Informationen qui MSDN dans cela .net-Format gebracht...
Alle à gauche qui je hatte, sommes quasi wertlos...

XProfan X3
Website: [...]

Facebook: [...]

05.09.2015 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

- page 2 -

GDL

allô Jörg,

là hab je aussi déjà rumprobiert.

si je deleteobject hBitmap& là einfüge stürzt XProfan ab.

Nehme je XPSE her, muss cet Def. nachträglich am Programmanfang eingefügt volonté.

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

Sonst bricht XPSE ab.

Pour insérer qui Def allez avec XPSE ensuite zwar Deleteobject hBitmap&

mais es wird quand même toujours langsamer et bricht pour dem 40ten Thumb ab.

Grüßle
Georg

fehler.png	21 kB

Hochgeladen:	05.09.2015

Downloadcounter:
		Download

Windows7 Xprofan 8,9,10 [...]

[...]

05.09.2015 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Michael
W.

cela eigentliche grenier-Problem liegt dans "Testen".
là wird h& pour 2 Bilder genutzt.
j'ai es la fois sur h1& et h2& geändert.

Aussi volonté qui DLL's ständig wieder aus dem grenier geworfen. Lass vous doch jusqu'à zum Ende drin. là InitGDIPlus et ExitGDIPlus qui DLL's encore brauchen (et vous avec cela wieder dans den grenier holen) habe je cela la fois dans InitGDI et ExitGDI ausgelagert.

Kompilieren Marque Séparation

'Vorschaubild aus grand Bilddateien
'Bilddateigröße était beim Test 4,19mb grand
Déclarer GDIP&,OLE&,Kernel&

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 h1&,h2&,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

    '==============================================
    'comment telefonisch besprochen (David)
    'XProfan1
    h1&=create("hnewpic",100,100,0)
    za&=&GetTickCount
    startpaint h1&
    drawsizedpic pfad$,0,0-100,100;0
    endpaint
    SendMessage(b&,$00F7,0,h1&)
    ze&=&GetTickCount
    drawtext 10,120,str$(ze&-za&)+" Millisekunden XProfan Version1"
    drawtext 10,150," Seitenverhältnis stimmt nicht"
    'Bild wird verzerrt
    '================================================================
    'Pour XProfan2
    za&=&GetTickCount
    h2&=Créer("hSizedPic",-1,pfad$,100,100,1)
    SendMessage(c&,$00F7,0,h2&)
    ze&=&GetTickCount
    drawtext 300,120,str$(ze&-za&)+" Millisekunden XProfan Version2"
    'Bild wird pas verzerrt
    '==================================================================

endproc

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

Proc InitGDIPlus

    Déclarer gdpsi#,gdiplusToken&
    STRUCT GdiplusStartupInput = GdiplusVersion&,DebugEventCallback&,SuppressBackgroundThread&,SuppressExternalCodecs&
    Faible gdpsi#,GdiplusStartupInput
    gdpsi#.GdiplusVersion& = 1
    gdpsi#.DebugEventCallback& = 0
    gdpsi#.SuppressBackgroundThread& = 0
    gdpsi#.SuppressExternalCodecs& = 0
    Externe("GDIPLUS.DLL","GdiplusStartup",ADDR(gdiplusToken&),gdpsi#,0)
    Dispose gdpsi#
    Retour gdiplusToken&

ENDPROC

Proc ExitGDIPlus

    Paramètres gdiplusToken&
    Externe("GDIPLUS.DLL","GdiplusShutdown",gdiplusToken&)

ENDPROC

Proc CatchImage

    Paramètres MemPointer& ,Size&
    Struct GdiplusStartupInput = GdiplusVersion&,DebugEventCallback&,SuppressBackgroundThread&,SuppressExternalCodecs&
    Déclarer gdpsi#,gdiplusToken&,ImageObject&,GraphicObject&,pStream&,RetVal&
    Faible gdpsi#,GdiplusStartupInput
    gdpsi#.GdiplusVersion& = 1
    gdpsi#.DebugEventCallback& = 0
    gdpsi#.SuppressBackgroundThread& = 0
    gdpsi#.SuppressExternalCodecs& = 0
    GdiplusStartup(ADDR(gdiplusToken&),gdpsi#,0)
    Dispose gdpsi#
    'grenier 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&)
    Retour 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()

    Tandis que 1

        Externe("GDIPLUS.DLL","GdipCreateBitmapFromHBITMAP",hbild&,0,addr(Image&))
        Externe("GDIPLUS.DLL","GdipGetImageWidth",Image&,ADDR(ImageWidth&))'Breite ermitteln
        Externe("GDIPLUS.DLL","GdipGetImageHeight",Image&,ADDR(ImageHeight&))'Hoehe ermitteln
        Cas ImageWidth& = 0 : Pause
        Cas ImageHeight& = 0 : Pause

        si ImageWidth& = ImageHeight&' carrée

            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

        Externe("GDIPLUS.DLL","GdipGetImageThumbnail",Image&,ThumbWidth%,ThumbHeight%,addr(Thumb&),0,0)'Thumb size
        Externe("GDIPLUS.DLL","GdipCreateHBITMAPFromBitmap",Thumb&,addr(hBitmap&),0)
        SendMessage(d&,$00F7,0,hBitmap&)
        BREAK

    Endwhile

    ExitGDIPlus(hadl&)
    'Bild wird verzerrt, ist mais pas so verpixelt

endproc

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

XProfan X3
System: Windows 8/10, XProfan X4
Programmieren, das spannendste Detektivspiel der Welt.

05.09.2015 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

GDL

@Michael

cela "Testen" était chez den letzten Posts pas plus im Versuchsprog.
Sorry, était mon faute.

Ausschlaggebend était ca:

qui eh bien gehende Versuchsaufbau:

Kompilieren Marque Séparation

'Vorschaubild aus grand Bilddateien
'Bilddateigröße était beim Test 4,19mb grand
 {$CLQ}
Déclarer 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)
'######################################
' de Dieter Zornow

Proc InitGDIPlus

    Déclarer gdpsi#,gdiplusToken&
    STRUCT GdiplusStartupInput = GdiplusVersion&,DebugEventCallback&,SuppressBackgroundThread&,SuppressExternalCodecs&
    Faible gdpsi#,GdiplusStartupInput
    gdpsi#.GdiplusVersion& = 1
    gdpsi#.DebugEventCallback& = 0
    gdpsi#.SuppressBackgroundThread& = 0
    gdpsi#.SuppressExternalCodecs& = 0
    Externe("GDIPLUS.DLL","GdiplusStartup",ADDR(gdiplusToken&),gdpsi#,0)
    Dispose gdpsi#
    Retour gdiplusToken&

ENDPROC

Proc ExitGDIPlus

    Paramètres gdiplusToken&
    Externe("GDIPLUS.DLL","GdiplusShutdown",gdiplusToken&)

ENDPROC

Proc CatchImage

    Paramètres MemPointer& ,Size&
    Struct GdiplusStartupInput = GdiplusVersion&,DebugEventCallback&,SuppressBackgroundThread&,SuppressExternalCodecs&
    Déclarer gdpsi#,gdiplusToken&,ImageObject&,GraphicObject&,pStream&
    Faible gdpsi#,GdiplusStartupInput
    gdpsi#.GdiplusVersion& = 1
    gdpsi#.DebugEventCallback& = 0
    gdpsi#.SuppressBackgroundThread& = 0
    gdpsi#.SuppressExternalCodecs& = 0
    GdiplusStartup(ADDR(gdiplusToken&),gdpsi#,0)
    Dispose gdpsi#
    'grenier 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&)
    Retour 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()
    Externe("GDIPLUS.DLL","GdipCreateBitmapFromHBITMAP",hbild&,0,addr(Image&))
    Externe("GDIPLUS.DLL","GdipGetImageWidth",Image&,ADDR(ImageWidth&))'Breite ermitteln
    Externe("GDIPLUS.DLL","GdipGetImageHeight",Image&,ADDR(ImageHeight&))'Hoehe ermitteln

    si ImageWidth& = ImageHeight&' carrée

        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

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

endproc

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

whilenot i% > 1000

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

Wend

ExitGDI()
waitinput