XProfan

Français

@Michael

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

Ausschlaggebend était ca:

GDL (05.09.15)

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%
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&,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()
    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
    ze&=&GetTickCount
    inc i%
    drawtext 10,350,str$(ze&-za&)+" Millisekunden XProfan GDI-Plus"
    drawtext 10,380," Seitenverhältnis stimmt nicht"

Wend

ExitGDI()
waitinput