XProfan

English

GDL

Hallöle,

I must ca. 50 Vorschaubilder of 100X100 Pixel from Bilddateien produce.
thereby having each Images always > 4 Mb.

have now rumgespielt. thereby is Dieter his GDI-plus View source on the fastest. only unfortunately is correct the Seitenverhältnis not.

gives it a Possibility Dieters code so abzuändern that the Seitenverhältnis is correct? I get not there.

Compile Mark Separation

'Bilddateigröße was at Test 4,19mb big
declare h&,b&,c&,d&,za&,ze&,way$
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 testing

    '==============================================
    'How phone discussed (David)
    'XProfan1
    h&=create("hnewpic",100,100,0)
    za&=&GetTickCount
    startpaint h&
    drawsizedpic way$,0,0-100,100;0
    endpaint
    Sendmessage(b&,$00F7,0,h&)
    ze&=&GetTickCount
    drawtext 10,120,st$(ze&-za&)+" Millisekunden XProfan Version1"
    drawtext 10,150," Seitenverhältnis is correct nicht"
    'Image verzerrt
    '================================================================
    'After XProfan2
    za&=&GetTickCount
    h&=Create("hSizedPic",-1,way$,100,100,1)
    Sendmessage(c&,$00F7,0,h&)
    ze&=&GetTickCount
    drawtext 300,120,st$(ze&-za&)+" Millisekunden XProfan Version2"
    'Image not verzerrt
    '==================================================================

endproc

'######################################
' 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&
    Var GDIP& = ImportDll("Gdiplus.dll","")
    Var OLE& = ImportDll(Ole32.dll,"")
    Var Kernel& = ImportDll("Kernel32.dll","")
    Declare gdpsi#,gdiplusToken&,ImageObject&,GraphicObject&,pStream&,RetVal&
    'GDIPlus started
    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&)
    FreeDll GDIP&
    FreeDll OLE&
    FreeDll Kernel&
    Return RetVal&

ENDPROC

proc Test1

    declare mem#,size&,presentment$
    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","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&)
    'Image verzerrt, is not so verpixelt

endproc

'#####################################################
chdir "C:\\bueroumgebung\\directory031\\christmas\\"'way to that testing adjust
pfad$=upper$(LoadFile $("Lade one Bild","*.jpg"))
case right$(way$,4)=".JPG":testing
za&=&GetTickCount
case right$(way$,4)=".JPG":Test1
ze&=&GetTickCount
drawtext 10,350,st$(ze&-za&)+" Millisekunden XProfan GDI-Plus"
drawtext 10,380," Seitenverhältnis is correct nicht"
waitinput
deleteobject h&

Grüßle
Georg

vorschaubild.png	84 kB

Hochgeladen:	09/03/15

Downloadcounter:
		Download

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

[...]

09/03/15 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

« this Posting watts as Solution marked. »

- Page 2 -

GDL

@Michael

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

determining was this:

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%,RetVal&
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&
    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
    deleteobject RetVal&'important
    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

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

[...]

09/05/15 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

- Page 1 -

ByteAttack

with

Compile Mark Separation

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

before inquire, whether The values not 0 are...
then has it Perhaps no File loaded???

Compile Mark Separation

Case ImageWidth&=0:Break
Case ImageHeigt&=0:Break
or
Casenote ImageWidth&=0:Dreisatz!=ImageWidth&/100
Casenote ImageHeight&=0:ThumbHeight%=ImageHeight&/Dreisatz!

XProfan X3
Website: [...]

Facebook: [...]

09/04/15 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

ByteAttack

Nachtrag... The Berechnung is anyhow wrong....

with Graphics The in the "Hochformat" are, functions it naturally not! the whole was only as example virtual

XProfan X3
Website: [...]

Facebook: [...]

09/04/15 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

ByteAttack

Compile Mark Separation

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

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)'picture size

XProfan X3
Website: [...]

Facebook: [...]

09/04/15 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

GDL

Supi Align working.
=========
I have but yet no Result because of slow down.

If I Dieters Codeschnippsel solo take, have I the following trouble How moreover supra posted only without crash and without Error Message.

with Images over 4MB
it'll ex whom 40 Image then simply no Thumb More prepares and the Erstellzeit becomes always longer.
From 650ms To ca. 1800 ms.
with 100 Images is then The Erstellzeit with ca. 8sec. but without Thumb.

with Images under 1MB comes the effect then later.

to that Image:
To to that Image 39 fit ImageHeight& and Imagewidth& and with Image 40 jumping both values on 0.
If I these 0 Abfange crashes of course the Prog. not any more ex, but it go too no Thumbs More prepares.

fehler.png	43 kB

Hochgeladen:	09/04/15

Downloadcounter:
		Download

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

[...]

09/04/15 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Jörg
Sellmeyer

How is it because, if You the Bildobjekt löschst, before You one new erstellst?

Compile Mark Separation

proc Test1

    declare mem#,size&,presentment$
    presentment$=way$
    size& = filesize(presentment$)
    dim mem#,size&
    set("Filemode",0)
    BlockRead(presentment$,mem#,0,size&)
    set("filemode",2)
    'here altes Objekt delete
    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&)
    'here the Objekt delete. If it on the Static is, should it really superfluously his
    DeleteObject hBitmap&
    ExitGDIPlus(hadl&)
    'Image verzerrt, is not so verpixelt

endproc

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

09/05/15 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Michael
W.

Should the Image not too lane? find it so on The speedy not MS - The having there Yes powerful umgeräumt (nothing more on the middle-aged Space).

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

09/05/15 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

ByteAttack

Michael W. (05.09.15)

Should the Image not too lane? find it so on The speedy not MS - The having there Yes powerful umgeräumt (nothing more on the middle-aged Space).

find so did i really beautiful....farewell. through your new Visual studio having tappt im dunkeln any "wichtigen" Information the MSDN into .net-stature brought...
any left The I had, are quasi trashy...

XProfan X3
Website: [...]

Facebook: [...]

09/05/15 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

- Page 2 -

GDL

Hello Jörg,

there Have so did i already rumprobiert.

If I deleteobject hBitmap& there einfüge crashes XProfan ex.

take I XPSE since, must these Def. as an afterthought on the Programmanfang eingefügt go.

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

otherwise fractures XPSE ex.

After Insert the Def goes with XPSE then of course Deleteobject hBitmap&

but it'll nevertheless always slower and fractures to the 40ten Thumb ex.

Grüßle
Georg

fehler.png	21 kB

Hochgeladen:	09/05/15

Downloadcounter:
		Download

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

[...]

09/05/15 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Michael
W.

the eigentliche memory-trouble lying in "Testen".
there becomes h& for 2 Images used.
I have it time on h1& and h2& changed.

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.

Compile Mark Separation

'Vorschaubild from large Bilddateien
'Bilddateigröße was at Test 4,19mb big
Declare 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&,way$
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 testing

    '==============================================
    'How phone discussed (David)
    'XProfan1
    h1&=create("hnewpic",100,100,0)
    za&=&GetTickCount
    startpaint h1&
    drawsizedpic way$,0,0-100,100;0
    endpaint
    Sendmessage(b&,$00F7,0,h1&)
    ze&=&GetTickCount
    drawtext 10,120,st$(ze&-za&)+" Millisekunden XProfan Version1"
    drawtext 10,150," Seitenverhältnis is correct nicht"
    'Image verzerrt
    '================================================================
    'After XProfan2
    za&=&GetTickCount
    h2&=Create("hSizedPic",-1,way$,100,100,1)
    Sendmessage(c&,$00F7,0,h2&)
    ze&=&GetTickCount
    drawtext 300,120,st$(ze&-za&)+" Millisekunden XProfan Version2"
    'Image not verzerrt
    '==================================================================

endproc

'######################################
' 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()

    While 1

        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
        Case ImageWidth& = 0 : Break
        Case ImageHeight& = 0 : Break

        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&)
        BREAK

    EndWhile

    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"))
case right$(way$,4)=".JPG" : testing
InitGDI()
za&=&GetTickCount
case right$(way$,4)=".JPG" : Test1
ze&=&GetTickCount
ExitGDI()
drawtext 10,350,st$(ze&-za&)+" Millisekunden XProfan GDI-Plus"
drawtext 10,380," Seitenverhältnis is correct nicht"
waitinput
deleteobject h1&,h2&

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

09/05/15 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

GDL

@Michael

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

determining was this:

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%,RetVal&
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&
    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
    deleteobject RetVal&'important
    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