XProfan

English

@Michael

the "Testen" was with whom last Posts not any more in the Versuchsprog.
Sorry, was my Error.

determining was this:

GDL (05.09.15)

Also go The DLL's constantly again from memory thrown. Lass tappt im dunkeln still until end drin. there InitGDIPlus and ExitGDIPlus The DLL's yet need (and so again into memory fetch) have I the time in InitGDI and ExitGDI ausgelagert.

The now gehende Versuchsaufbau:

Compile Mark Separation

'Vorschaubild from large Bilddateien
'Bilddateigröße was at Test 4,19mb big
 {$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&,way$,i%
cls
d&=create("picbutton",%hwnd,0,10,230,105,105)
'######################################
' of 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&,RetVal&
    Dim gdpsi#,GdiplusStartupInput
    gdpsi#.GdiplusVersion& = 1
    gdpsi#.DebugEventCallback& = 0
    gdpsi#.SuppressBackgroundThread& = 0
    gdpsi#.SuppressExternalCodecs& = 0
    GdiplusStartup(ADDR(gdiplusToken&),gdpsi#,0)
    Dispose gdpsi#
    'memory provide
    Var m_hBuffer& = GlobalAlloc(2,Size&)
    Var pBuffer& = GlobalLock(m_hBuffer&)
    RtlMoveMemory(pBuffer&,MemPointer&,Size&)
    GlobalUnlock(m_hBuffer&)
    'Stream produce
    CreateStreamOnHGlobal(m_hBuffer&,1,Addr(pStream&))
    GdipCreateBitmapFromStream(pStream&,Addr(ImageObject&))
    'hBitmap produce
    GdipCreateHBITMAPFromBitmap(ImageObject&,Addr(RetVal&),0)
    'straighten up
    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&,presentment$,ImageWidth&,ImageHeight&,Dreisatz!,ThumbHeight%,ThumbWidth%
    presentment$=way$
    size& = filesize(presentment$)
    dim mem#,size&
    set("Filemode",0)
    BlockRead(presentment$,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&))'wide detect
    External("GDIPLUS.DLL","GdipGetImageHeight",Image&,ADDR(ImageHeight&))'Hoehe detect

    if ImageWidth& = ImageHeight&' quadratic

        ThumbWidth% = 100
        ThumbHeight% = 100

    elseif ImageWidth& > ImageHeight&' Landscape

        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&)
    'Image verzerrt, is not so verpixelt

endproc

'#####################################################
chdir "C:\\bueroumgebung\\directory031\\christmas\\"'way to that testing adjust
pfad$=upper$(LoadFile $("Lade one Bild","*.jpg"))
InitGDI()
i%=1

whilenot i% > 1000

    za&=&GetTickCount
    case right$(way$,4)=".JPG" : Test1
    ze&=&GetTickCount
    inc i%
    drawtext 10,350,st$(ze&-za&)+" Millisekunden XProfan GDI-Plus"
    drawtext 10,380," Seitenverhältnis is correct nicht"

wend

ExitGDI()
waitinput