Foro | | | | - Página 1 - |
| GDL | Hallöle,
Yo muß ca. 50 Vorschaubilder de 100X100 Pixel de Bilddateien erzeugen. Dabei haben cada Bilder siempre > 4 Mb.
Posesiones ahora rumgespielt. Dabei es Dieter ser GDI-Plus Ver código fuente al schnellsten. Nur desafortunadamente stimmt el Seitenverhältnis no.
Gibt lo una Möglichkeit Dieters Code así abzuändern dass el Seitenverhältnis stimmt? Yo bekomme no hin.
'Bilddateigröße war beim Test 4,19mb groß
declarar 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
'==============================================
'Como 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 Versión1"
drawtext 10,150," Seitenverhältnis stimmt nicht"
'Bild se verzerrt
'================================================================
'Nach XProfan2
za&=&GetTickCount
h&=Crear("hSizedPic",-1,pfad$,100,100,1)
SendMessage(c&,$00F7,0,h&)
ze&=&GetTickCount
drawtext 300,120,str$(ze&-za&)+" Millisekunden XProfan Versión2"
'Bild no es verzerrt
'==================================================================
ENDPROC
'######################################
' de Dieter Zornow
Proc InitGDIPlus
Declarar gdpsi#,gdiplusToken&
STRUCT GdiplusStartupInput = GdiplusVersion&,DebugEventCallback&,SuppressBackgroundThread&,SuppressExternalCodecs&
Dim gdpsi#,GdiplusStartupInput
gdpsi#.GdiplusVersion& = 1
gdpsi#.DebugEventCallback& = 0
gdpsi#.SuppressBackgroundThread& = 0
gdpsi#.SuppressExternalCodecs& = 0
Externo("GDIPLUS.DLL","GdiplusStartup",ADDR(gdiplusToken&),gdpsi#,0)
Disponer gdpsi#
Volver gdiplusToken&
ENDPROC
Proc ExitGDIPlus
Parámetros gdiplusToken&
Externo("GDIPLUS.DLL","GdiplusShutdown",gdiplusToken&)
ENDPROC
Proc CatchImage
Parámetros MemPointer& ,Size&
Struct GdiplusStartupInput = GdiplusVersion&,DebugEventCallback&,SuppressBackgroundThread&,SuppressExternalCodecs&
Var GDIP& = ImportDll("Gdiplus.dll","")
Var OLE& = ImportDll("Ole32.dll","")
Var Kernel& = ImportDll("Kernel32.dll","")
Declarar 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)
Disponer 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& = Largo(pStream&,0)
call(Largo(Command&,8),pStream&)'IStream.Release
GlobalFree(m_hBuffer&)
GdipDisposeImage(ImageObject&)
GdipDeleteGraphics(GraphicObject&)
GdiplusShutdown(gdiplusToken&)
FreeDll GDIP&
FreeDll OLE&
FreeDll Kernel&
Volver RetVal&
ENDPROC
proc test1
declarar 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#))
Disponer mem#
declarar Image&,Thumb&,hBitmap&
var hadl& = InitGDIPlus()
Externo("GDIPLUS.DLL","GdipCreateBitmapFromHBITMAP",hbild&,0,addr(Image&))
Externo("GDIPLUS.DLL","GdipGetImageThumbnail",Image&,100,100,addr(Thumb&),0,0)'picture size
Externo("GDIPLUS.DLL","GdipCreateHBITMAPFromBitmap",Thumb&,addr(hBitmap&),0)
SendMessage(d&,$00F7,0,hBitmap&)
ExitGDIPlus(hadl&)
'Bild se verzerrt, es pero no así verpixelt
ENDPROC
'#####################################################
chdir "C:\\bueroumgebung\\verzeichnis031\\weihnachten\\"'Pfad para Testen adaptar
pfad$=upper$(LoadFile$("Lade una Bild","*.jpg"))
caso right$(pfad$,4)=".JPG":testen
za&=&GetTickCount
caso 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 |
| | | | |
| | « Dieser Contribución wurde como Solución gekennzeichnet. » | | GDL | @Michael
Das "Testen" war en el letzten Posts no mehr en el Versuchsprog. Sorry, war mein Fehler.
Ausschlaggebend war dies:
Außerdem voluntad el DLL's ständig otra vez de el Speicher geworfen. Lass ellos doch a para Ende drin. Como InitGDIPlus y ExitGDIPlus el DLL's todavía brauchen (y ellos así otra vez en el Speicher holen) Yo el veces en InitGDI y ExitGDI ausgelagert.
Der nun gehende Versuchsaufbau:
'Vorschaubild de großen Bilddateien
'Bilddateigröße war beim Test 4,19mb groß
{$CLQ}
Declarar 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
declarar b&,c&,d&,za&,ze&,pfad$,i%,RetVal&
cls
d&=create("picbutton",%hwnd,0,10,230,105,105)
'######################################
' de Dieter Zornow
Proc InitGDIPlus
Declarar gdpsi#,gdiplusToken&
STRUCT GdiplusStartupInput = GdiplusVersion&,DebugEventCallback&,SuppressBackgroundThread&,SuppressExternalCodecs&
Dim gdpsi#,GdiplusStartupInput
gdpsi#.GdiplusVersion& = 1
gdpsi#.DebugEventCallback& = 0
gdpsi#.SuppressBackgroundThread& = 0
gdpsi#.SuppressExternalCodecs& = 0
Externo("GDIPLUS.DLL","GdiplusStartup",ADDR(gdiplusToken&),gdpsi#,0)
Disponer gdpsi#
Volver gdiplusToken&
ENDPROC
Proc ExitGDIPlus
Parámetros gdiplusToken&
Externo("GDIPLUS.DLL","GdiplusShutdown",gdiplusToken&)
ENDPROC
Proc CatchImage
Parámetros MemPointer& ,Size&
Struct GdiplusStartupInput = GdiplusVersion&,DebugEventCallback&,SuppressBackgroundThread&,SuppressExternalCodecs&
Declarar 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)
Disponer 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& = Largo(pStream&,0)
call(Largo(Command&,8),pStream&)'IStream.Release
GlobalFree(m_hBuffer&)
GdipDisposeImage(ImageObject&)
GdipDeleteGraphics(GraphicObject&)
GdiplusShutdown(gdiplusToken&)
Volver RetVal&
ENDPROC
proc test1
declarar 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#))
Disponer mem#
declarar Image&,Thumb&,hBitmap&
var hadl& = InitGDIPlus()
Externo("GDIPLUS.DLL","GdipCreateBitmapFromHBITMAP",hbild&,0,addr(Image&))
Externo("GDIPLUS.DLL","GdipGetImageWidth",Image&,ADDR(ImageWidth&))'Breite ermitteln
Externo("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
Externo("GDIPLUS.DLL","GdipGetImageThumbnail",Image&,ThumbWidth%,ThumbHeight%,addr(Thumb&),0,0)'Thumb size
Externo("GDIPLUS.DLL","GdipCreateHBITMAPFromBitmap",Thumb&,addr(hBitmap&),0)
SendMessage(d&,$00F7,0,hBitmap&)
ExitGDIPlus(hadl&)
'Bild se verzerrt, es pero no así verpixelt
ENDPROC
'#####################################################
chdir "C:\\bueroumgebung\\verzeichnis031\\weihnachten\\"'Pfad para Testen adaptar
pfad$=upper$(LoadFile$("Lade una Bild","*.jpg"))
InitGDI()
i%=1
whilenot i% > 1000
za&=&GetTickCount
caso 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
|
| | | | | |
| | ByteAttack | KompilierenMarcaSeparaciónExternal("GDIPLUS.DLL","GdipGetImageThumbnail",Image&,100,100,addr(Thumb&),0,0)'picture size > Ist no el Bildgröße, pero el Thumb-Größe. Am besten el Bildgröße vorher ermitteln (con GdipGetImageHeight y Width) y luego el Verhältnis nehemen para el Thumb...
Ejemplo: En una Bild de 200x100 wäre el Thumb entonces natürlich: KompilierenMarcaSeparaciónExternal("GDIPLUS.DLL","GdipGetImageThumbnail",Image&,100,50,addr(Thumb&),0,0)'thumb size > |
| | | | |
| | ByteAttack | KompilierenMarcaSeparación
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
|
| | | | |
| | GDL | ¡Hola ByteAttack
Gracias.
Muss aber todavía rausfinden wo lo weiterhin hakt. Irgendeine Speicherfreigabe tippe Yo veces.
Nach 40veces Aufruf uno 4Mb Bildatei kommt Fehlermeldung "Division por Null"
También se el Erstellzeit siempre länger.
================= .. .. SendMessage(d&,$00F7,0,hBitmap&) ExitGDIPlus(hadl&)
Hier una en el Anschluß deleteobject hBitmap&
lässt el Programa abstürzen. Also muss lo qué más ser.
Grüßle Georg |
| | | | |
| | ByteAttack | En
Dreisatz!=ImageWidth&/100
ThumbHeight%=ImageHeight&/Dreisatz!
Vorher abfragen, si el Werte no 0 son... Dann ha él tal vez no Expediente geladen???
|
| | | | |
| | ByteAttack | Apéndice... El Berechnung es sowieso falso....
En Gráficos el en el "Hochformat" son, funktioniert lo natürlich no! Das todo war sólo como beispiel pensamiento |
| | | | |
| | ByteAttack |
Case ImageWidth&=0:Romper
Case ImageHeight&=0:Romper
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
Externo("GDIPLUS.DLL","GdipGetImageThumbnail",Image&,ThumbWidth%,ThumbHeight%,addr(Thumb&),0,0)'picture size
|
| | | | |
| | GDL | Supi Ausrichtung funzt. ========= Yo habe aber todavía kein Ergebnis wegen langsamer voluntad.
Wenn Yo Dieters Codeschnippsel solo nehme, Yo folgendes Problema como más oben Nuevo sólo sin Choque y sin Fehlermeldung.
En Bilder encima 4MB Lo se de el 40 Bild entonces simplemente no Thumb mehr erstellt y el Erstellzeit se siempre länger. Von 650ms a ca. 1800 ms. En 100 Bilder es entonces el Erstellzeit en ca. 8sec. Aber sin Thumb.
En Bilder bajo 1MB kommt el Effekt entonces später.
para Bild: Bis para Bild 39 passen ImageHeight& y Imagewidth& y en Bild 40 springen beide Werte en 0. Wenn Yo esta 0 Abfange stürzt zwar el Prog. no mehr de, pero voluntad auch no Thumbs mehr erstellt.
|
| | | | |
| | Jörg Sellmeyer | Como es porque, si Si es usted el Bildobjekt löschst, bevor du una neues erstellst?
proc test1
declarar mem#,size&,bild$
bild$=pfad$
size& = filesize(bild$)
dim mem#,size&
set("Filemode",0)
Blockread(bild$,mem#,0,size&)
set("filemode",2)
'Hier altes Objeto löschen
Case hBild& <> 0:DeleteObject hBild&
var hBild& = CatchImage(mem#,sizeof(mem#))
Disponer mem#
declarar Image&,Thumb&,hBitmap&
var hadl& = InitGDIPlus()
Externo("GDIPLUS.DLL","GdipCreateBitmapFromHBITMAP",hbild&,0,addr(Image&))
Externo("GDIPLUS.DLL","GdipGetImageThumbnail",Image&,100,100,addr(Thumb&),0,0)'picture size
Externo("GDIPLUS.DLL","GdipCreateHBITMAPFromBitmap",Thumb&,addr(hBitmap&),0)
SendMessage(d&,$00F7,0,hBitmap&)
'auch hier el Objeto löschen. Wenn lo en el Static es, debería lo eigentlich überflüssig ser
DeleteObject hBitmap&
ExitGDIPlus(hadl&)
'Bild se verzerrt, es pero no así verpixelt
ENDPROC
|
| | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ... | 05.09.2015 ▲ |
| |
| | Michael W. | Müsste el Imagen no auch weg? Finde lo así en el Schnelle no en MS - el haben como sí mächtig umgeräumt (nichts mehr al alten Platz). |
| | | XProfan X3System: Windows 8/10, XProfan X4 Programmieren, das spannendste Detektivspiel der Welt. | 05.09.2015 ▲ |
| |
| | ByteAttack | Michael W. (05.09.15)
Müsste el Imagen no auch weg? Finde lo así en el Schnelle no en MS - el haben como sí mächtig umgeräumt (nichts mehr al alten Platz).
Finde Yo auch correcto sch....ade. Durch ihr neues Visual Studio haben ellos todos "wichtigen" Informationen el MSDN en el .net-Formato gebracht... Alle Links el Yo hatte, son quasi wertlos... |
| | | | |
| | GDL | ¡Hola Jörg,
como tener Yo auch ya rumprobiert.
Wenn Yo deleteobject hBitmap& hay einfüge stürzt XProfan de.
Nehme Yo XPSE her, muss esta Def. nachträglich al Programmanfang eingefügt voluntad.
DEF CreateStreamOnHGlobal(3)!"OLE32","CreateStreamOnHGlobal"
Sonst bricht XPSE de.
Nach Einfügen el Def va con XPSE entonces zwar Deleteobject hBitmap&
pero se trotzdem siempre langsamer y bricht después de el 40ten Thumb de.
Grüßle Georg |
| | | | |
|
RespuestaTema opciones | 18.611 Views |
ThemeninformationenDieses Thema ha 4 subscriber: |