Fuente/ Codesnippets | | | | - Página 1 - |
| Jörg Sellmeyer | Yo ahora via Ole (Dank a Andreas Miethe - siempre otra vez) una funktionierendes Handle para Bitmaps (auch gif, ico y diverse otro Formate) ermitteln puede, el entonces bastante normal en una Bitmapstatic adecuado voluntad kann. Mit el Ermittlung el Größe kann Yo mich en el Fall todavía no bastante anfreunden. Wer como una Concepto ha - en el Code Es el Punto markiert.
Hier jedenfalls primero el Code, en una gültiges Handle auch para große Bilder a obtener. Wenn uno lo en el Programa häufiger verwendet, es sicher sinnvoller, el Init-Rutina sólo una vez al Anfang aufzurufen, aber así funktioniert lo ya veces klaglos. Bitte veces con Archivos größer como 5100 Pixeln testen. Aktuell Yo lo sólo jpg y gif probiert. Icos son tan größenmäßig no el problema.
$H windows.ph
'Konstanten
DEF &Picture_Release 8
DEF &Picture_GetHandle 12
DEF &Picture_GetType 20
DEF &Picture_Get_Width 24
DEF &Picture_Get_Height 28
DEF &Picture_Render 32
DEF &Picture_Select 44
'Globale Variables
DECLARE IID_IPicture#
DECLARE PData#
DECLARE HMEM&
Declarar OlePic#
Class OleImage = OleImage@,\
Ole_Init@,\
Ole_Free@,\
Ole_LoadImage@,\
Ole_GetType@,\
Ole_GetHandle@,\
Ole_FreeImage@,\
OLE32&,\
OLEPro32&,\
PictureObject&,\
hPic&,\
PicFormat&,\
Width&,\
Height&,\
GetSize@,\
Destroy@
Proc OleImage.OleImage
Parámetros File$
.Ole_Init()
.PictureObject& = .Ole_LoadImage(File$)
.PicFormat& = .Ole_GetType(.PictureObject&)
.hPic& = .Ole_GetHandle()
Imprimir .PictureObject&,.PicFormat&,.hpic&
ENDPROC
Proc OleImage.Ole_Init
.OLE32& = UseDll("OLE32")
.OLEPRO32& = UseDll("OLEPRO32")
Externo("OLE32","OleInitialize",0)
Dim IID_IPicture#,16
Largo IID_IPicture#,0 = $7BF80980
Word IID_IPicture#,4 = $BF32
Word IID_IPicture#,6 = $101A
Byte IID_IPicture#,8 = $8B
Byte IID_IPicture#,9 = $BB
Byte IID_IPicture#,10 = $00
Byte IID_IPicture#,11 = $AA
Byte IID_IPicture#,12 = $00
Byte IID_IPicture#,13 = $30
Byte IID_IPicture#,14 = $0C
Byte IID_IPicture#,15 = $AB
ENDPROC
Proc OleImage.Ole_Free
~GlobalFree(Hmem&)
Externo("OLE32","OleUninitialize")
FreeDll .OLE32&
FreeDll .OLEPRO32&
DISPOSE IID_IPicture#
ENDPROC
Proc OleImage.Ole_LoadImage
Declarar MemPointer&,PStream&,PictureObject&,PSize&
Parámetros Picture$
'------------------------
Conjunto("Filemode", 0)
PSIZE& = Filesize(Picture$)
Dim PData#,PSIZE&
BlockRead(Picture$,PData#,0,PSIZE&)'Daten en Bereichsvariable einlesen
'------------------------
~GlobalFree(Hmem&)
HMem& = ~GlobalAlloc($022,PSize&)'Speicher reservieren
Mempointer& = ~GlobalLock(Hmem&)'Pointer en Speicher
~RtlMoveMemory(MemPointer&,PData#,PSize&)'Bereichsvariable en Speicher schieben
DISPOSE PData#'Bereichsvariable liberación
~GlobalUnlock(HMem&)'Speicher para Gebrauch liberación
Externo("Ole32","CreateStreamOnHGlobal",Hmem&,1,addr(PStream&))'Stream-Pointer redactar
Externo("OlePro32","OleLoadPicture",PStream&,PSIZE&,0,IID_IPicture#,ADDR(PictureObject&))'Pointer fuer Pictureobject
'------------------------
Case PictureObject& > 0 : Volver PictureObject&
Case PictureObject& = 0 : Volver 0
ENDPROC
Proc OleImage.Ole_GetType
Declarar Command&,PicFormat&
Command& = Largo(.PictureObject&,0)
Call(@Largo(Command&,&Picture_GetType),.PictureObject&,addr(PicFormat&))
Volver PicFormat&
ENDPROC
Proc OleImage.GetSize
Parámetros DC&
Declarar Command&,w&,h&,xpixels&,ypixels&
Command& = Largo(.PictureObject&,0)
'hier se el Bildschirmauflösung pro Zoll abgefragt - en me 96x96.
'Aunque weiß Yo no, welche Función en welcher dll como angesprochen se.
Call(@Largo(Command&,&Picture_Get_Width),.PictureObject&,addr(w&))
Call(@Largo(Command&,&Picture_Get_Height),.PictureObject&,addr(h&))
'el Größe la ventana se ermittelt
xpixels& = ~GetDeviceCaps(DC&, 88)
ypixels& = ~GetDeviceCaps(DC&, 90)
'Umrechnung el Bildschirmauflösung en el Fenstergröße.
'Yo allerdings ni idea, como el Valor 2540 zustande kommt.
.Width& = Round((w&*xpixels&)/2540,0)
.Height& = Round((h&*ypixels&)/2540,0)
ENDPROC
Proc OleImage.Ole_GetHandle
Declarar Command&,PicHandle&
Command& = Largo(.PictureObject&,0)
Call(@Largo(Command&,&Picture_GetHandle),.PictureObject&,addr(PicHandle&))
Volver PicHandle&
ENDPROC
Proc OleImage.Ole_FreeImage
Parámetros PictureObject&
Declarar Command&
Command& = Largo(PictureObject&,0)
Call(@Largo(Command&,&Picture_Release),PictureObject&)
ENDPROC
Proc OleImage.Destroy
DeleteObject .hPic&,.PictureObject&
.Ole_Free()
ENDPROC
Declarar hbtn&,Bild$,hFont&,Anzeige&,OleAnzeige&,TestHandle&
Mensajes del usuario $10
~SetWindowLong(%hwnd,~GWL_STYLE,(~GetWindowLong(%hwnd,~GWL_STYLE) | $300000))
Ventana %maxx,%maxy
Título de la ventana "Handle por OLE"
hFont& = Crear("Font","Western ",14,0,0,0,0)
SetDialogFont hFont&
hbtn& = Crear("Button",%hwnd,"Bild laden",%maxx-80,40,60,24)
Sinestar encargado %key = 27'ESC final el Programa
If GetText $(%hwnd) <> "Handle por OLE"
WaitInput 4000
Título de la ventana "Handle por OLE"
ShowWindow(hbtn&,5)
EndIf
WaitInput
Case %uMessage = $10:Romper
If Clicked(hbtn&)
Bild$ = LoadFile$("ÖFFNE","alle unterstützten Formate|*.dib;*.bmp;*.rle;*.jpe;*.jpeg;*.jpg;*.gif;*.ico;*.cur;*.emf;*.wmf|\
Mapa de bits (bmp,rle,dib)|*.bmp;*.rle;*.dib|Jpeg (jpg,jpe,jpeg)|*.jpg;*.jpe;*.jpeg|Gif (gif)|*.gif|\
Enhanced Metafile (emf)|*.emf|Metafile (wmf)|*.wmf|Icons (Ico)|*.ico|Cursor (cur)|*.cur")
If Bild$ > ""
TestHandle& = Crear("HPIC",-1,Bild$)
'en großen Bildern es hier el Ergebnis 0
Título de la ventana Str$(TestHandle&) + " En muy großen Bildern es el Ergebnis hier 0"
DeleteObject TestHandle&
If SizeOf(OlePic#)
DestroyWindow(OleAnzeige&)
OlePic#.Destroy()
Disponer OlePic#
EndIf
OlePic# = New(OleImage,Bild$)
If Anzeige&
DestroyWindow(Anzeige&)
waitinput
Cls
EndIf
With OlePic#
'el Handleermittlung via Ole bringt una verwertbares Handle:
OlePic#.GetSize(%hdc2)
Imprimir .Width&,.Height&,"Typ:",.Ole_GetType()
If .PicFormat& = 1
OleAnzeige& = Crear("Mapa de bits",%hwnd,.hPic&,0,0)
.GetSize(%hdc2)
Imprimir .Width&,OlePic#.Height&
ElseIf .PicFormat& = 3
Imprimir "Icon es Typ:",.PicFormat&,"und kann más rápido con Profanmitteln adecuado voluntad."
EndIf
EndWith
EndIf
EndIf
Wend
If SizeOf(OlePic#)
OlePic#.Destroy()
Disponer OlePic#
EndIf
DeleteObject hFont&
End
Basierend en diesem Code [...] de Andreas Methe |
| | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ... | 03.06.2020 ▲ |
| |
| | | | - Página 2 - |
| | Jörg Sellmeyer | Leider lässt du uns en el Unklaren, con welchem Code Si es usted el Bild geladen hast. En me zumindest es con el Code de Matthias - also con rein profanen Mitteln - no ladbar. Das heißt, lo no es adecuado y lo se auch kein Handle producido, pero hPic& es 0.
Mit mi Code (con Ole) dagegen hay una gültiges Handle y el Bild se adecuado. Lo se natürlich sólo una kleiner Ausschnitt adecuado, porque el Code auch nichts más vorsieht.
Sollte lo al a geringen Speicher mentira, es sí trotzdem offensichtlich, dass el Ole-Método el bessere es, como el sí entonces en mi Sistema (con a wenig Speicher) funktioniert, während Crear("HPIC",...) como versagt. |
| | | | |
| | Matthias Arlt | 64k-Grenze wäre tal vez una Erklärungsversuch. Zu wenig Speicher más no, Yo aktuell 2.5GB RAM.
Jörg Sellmeyer (10.06.2020)
Sollte lo al a geringen Speicher mentira, es sí trotzdem offensichtlich, dass el Ole-Método el bessere es, como el sí entonces en mi Sistema (con a wenig Speicher) funktioniert, während Crear("HPIC",...) como versagt.
Das sehe Yo auch así. Trotzdem wäre interessant, si al Speicherausbau des Rechners hängt, Yo como dijo más no annehme, oder a el Speicherbitmap de Profano. Letzeres kann wohl sólo Roland sicher beantworten. Bisher ha sí dieses Problema no a Diskussion gestanden. Wohl porque lo keinem aufgefallen es...wann ha uno ya veces solch Riesenbild. |
| | | WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 10.06.2020 ▲ |
| |
| | Jörg Sellmeyer | In uno Auflösung de 300 dpi kneift Profano como ya viel früher. Wenn uno algo Grafikbearbeitung macht, es uno rápidamente en solchen Größen. Bisher Yo para el Anzeige solcher Bilder siempre una Crear("HTMLWin", H, S, N, X, Y, DX, DY). Como muss una continuación pero en el Ermittlung el Maße siempre otra vez en otro, nichtprofane Mittel zurückgreifen, qué Tiempo kostet y lästig es. Außerdem voluntad Yo eigentlich sólo ungern una Element vom Internetexplorer en mein Programa integrieren. Ein weiterer Vorteil de el HTMLWin es de paso todavía el problemlose Nutzung como scrollbares Element. Es en Profano bisher auch sólo suboptimal gelöst. |
| | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ... | 11.06.2020 ▲ |
| |
| | Matthias Arlt | Jörg Sellmeyer (11.06.2020)
Außerdem voluntad Yo eigentlich sólo ungern una Element vom Internetexplorer en mein Programa integrieren.
Kann Yo bien nachvollziehen...
Hier veces ni algo schlankere Variante...
declarar hBtn&,Pic$,GDIP_DLL&,GDPS#,GdipStatus&,PicObject&,hPic&,PicWidth&,PicHeight&,hdc&,bmp&,wChar$
GDIP_DLL& = UseDLL("GDIPLUS.DLL")
window 0,0-%maxx,%maxy
hBtn&=create("BUTTON",%hwnd,"Bild...",20,20,60,22)
proc LoadImageFile
parámetros Pic$
dim GDPS#,16
long GDPS#,0 = 1
long GDPS#,4 = 0
long GDPS#,8 = 0
long GDPS#,12 = 0
external("GDIPLUS.DLL","GdiplusStartup",addr(GdipStatus&),GDPS#,0)
disponer GDPS#
wChar$ = space$((len(Pic$)*2)+1)
external("KERNEL32","MultiByteToWideChar",0,0,addr(Pic$),-1,addr(wChar$),len(wChar$)+1)
external("GDIPLUS.DLL","GdipLoadImageFromFile",addr(wChar$),addr(PicObject&))
external("GDIPLUS.DLL","GdipCreateHBITMAPFromBitmap",PicObject&,addr(hPic&),0)
external("GDIPLUS.DLL","GdipGetImageWidth",PicObject&,addr(PicWidth&))
external("GDIPLUS.DLL","GdipGetImageHeight",PicObject&,addr(PicHeight&))
hdc& = external("GDI32","CreateCompatibleDC",0)
bmp& = external("GDI32","CreateCompatibleBitmap",%hdc,PicWidth&,PicHeight&)
external("GDI32","SelectObject",hdc&,hPic&)
external("GDI32","BitBlt",%hdc,0,0,width(%hwnd),height(%hwnd),hdc&,0,0,$CC0020)
external("GDI32","BitBlt",%hdc2,0,0,width(%hwnd),height(%hwnd),hdc&,0,0,$CC0020)
external("GDI32","DeleteObject",bmp&)
external("GDI32","DeleteDC",hdc&)
external("GDIPLUS.DLL","GdipDisposeImage",PicObject&)
external("GDIPLUS.DLL","GdiplusShutdown",GdipStatus&)
ENDPROC
mientras que 1
waitinput
if clicked(hBtn&)
Pic$=LoadFile$("Bild invitar...","*.*")
if FileExists(pic$)
UseCursor 2
LoadImageFile(Pic$)
UseCursor 0
endif
endif
wend
FreeDLL GDIP_DLL&
end
Lo scheint also definitiv a el Speicherbitmap de Profano a mentira, porque con Workarround por API funtioniert lo sí. |
| | | WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 11.06.2020 ▲ |
| |
| | RGH | Yo habe gerade veces nachgeschaut: El XProfan-Befehle y -Características, el Bilder de Archivos invitar (MLoadBmp, DrawPic, DrawSizedPic y Crear("HPIC",...)), nutzen una OLE-Rutina, el a Andreas' Code angelehnt es. Hier debería lo no Problemas con großen Bitmaps geben. Yo muss el veces näher überprüfen.
(Das gilt no para FreeProfan, como Yo FreePascal todavía no con OLE-Objekten verheiraten podría.)
Saludo Roland |
| | | XProfan X4Intel Duo E8400 3,0 GHz / 4 GB RAM / 1000 GB HDD - ATI Radeon HD 4770 512 MB - Windows 7 Home Premium 32Bit - XProfan X4 | 11.06.2020 ▲ |
| |
| | RGH | Ach sí: a negativen Handles: In Windows son el Handles unsigned Integer (sin Vorzeichen). Der Wertebereich va also de 0 a algo encima 4 Milliarden. El Handles y Integer en XProfan son signed Integer (con Vorzeichen) con un Wertebereich de - 2 Milliarden a + 2 Milliarden. Windows-Handles, el encima 2147483647 mentira, voluntad por lo tanto negativo dargestellt, qué aber nichts a ihrer Función ändert. Handles kleiner como 0 son also ebenso gültig.
Saludo Roland |
| | | XProfan X4Intel Duo E8400 3,0 GHz / 4 GB RAM / 1000 GB HDD - ATI Radeon HD 4770 512 MB - Windows 7 Home Premium 32Bit - XProfan X4 | 11.06.2020 ▲ |
| |
| | RGH | Gerade getestet: Mit Matthias' Code (reines XProfan) podría Yo mi größten Bilder (16 MPixel, Dateigröße encima 6 MB) problemlos invitar. Größere Bilder Yo no. Yo benutze mi aktuelle XProfan-Versión.
Apéndice: Und auch el oben verlinkte Afrika-Bild macht en más alto Auflösung (75 MPixel) no Problemas.
Saludo Roland |
| | | Intel Duo E8400 3,0 GHz / 4 GB RAM / 1000 GB HDD - ATI Radeon HD 4770 512 MB - Windows 7 Home Premium 32Bit - XProfan X4 | 11.06.2020 ▲ |
| |
| | Matthias Arlt | Tuve con 11.2 getestet y Jörg vmtl. con X4. Dann scheinen como wohl todavía otro Faktoren una Papel a spielen...sólo welche? Mir war el en efecto todavía nie aufgefallen, como Yo solch große Bilder eben auch no habe. Ach sí...si FreeProfan y OLE se no así bastante mögen...mi "schlankere" API-Variante kommt sí bastante sin OLE de. |
| | | WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 11.06.2020 ▲ |
| |
| | Jörg Sellmeyer | RGH (11.06.2020)
Yo habe gerade veces nachgeschaut: El XProfan-Befehle y -Características, el Bilder de Archivos invitar (MLoadBmp, DrawPic, DrawSizedPic y Crear("HPIC",...)), nutzen una OLE-Rutina, el a Andreas' Code angelehnt es. Hier debería lo no Problemas con großen Bitmaps geben. Yo muss el veces näher überprüfen.
(Das gilt no para FreeProfan, como Yo FreePascal todavía no con OLE-Objekten verheiraten podría.)
Saludo Roland
RGH
Apéndice: Und auch el oben verlinkte Afrika-Bild macht en más alto Auflösung (75 MPixel) no Problemas.
Como frage Yo mich aber, por qué en el No funktioniert. Yo zwar todavía XP con 2GB Ram aber con meiner Variante de Andreas' Code funktioniert lo sí, also kann no generell al Speicher oder el Windowsversion mentira. Tal vez kannst du otra vez schauen, qué como el Unterschiede en deiner Versión a meiner son. Der verschlankte Code de Matthias funktioniert en me de paso auch no.
Außerdem fällt me en, dass Matthias imprimir verwendet, en el Bild a verarbeiten. Das se en mi Code vermieden, pero sólo por Speicherschiebereien el Handle ermittelt. |
| | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ... | 11.06.2020 ▲ |
| |
| | Matthias Arlt | @Jörg Yo habe hier en diesem PC en efecto XP SP2 en él. Nachdem nun Roland no Problemas beim Laden des Bildes hatte, tener Yo el Ganze veces rápidamente en un virtuellen Win 7 probiert. Und siehe como...hay hay auch kein Problema!
Wenn se nun el profaninterne Code lt. Roland a el OLE-Prozedere de Andreas anlehnt, muß lo aber doch Unterschiede geben, porque extern funtioniert lo sí mittels OLE.
Das imprimir en mi Code es hay eigentlich sólo, porque Yo el Handle adecuado bekommen quería. ¿Por qué aber esta API-Variante, el eigentlich sólo GDI(+)-Características nutzt, No en va, me está nun otra vez una Rätsel.
Mysteriös...aber immerhin una Schritt más... |
| | | WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 11.06.2020 ▲ |
| |
| | Jörg Sellmeyer | Yo habs ahora en nem Laptop con Win7 y 4GB Ram getestet y lo funktioniert con deinem Code. Das erklärt aber siempre todavía no, por qué lo en me con mi Code auch en mkeinem minderbemittelten Rechner funktioniert pero no con deinem Code. |
| | | | |
| | Matthias Arlt | Es sí el Mysterium...
GDI+ debería en XP sí standardmäßig disponible ser. Es lo also vmtl. no. Usted könntest vlt. veces el Rückgabewerte schrittweise para cada Funktionsaufruf ansehen. Eventuell führt el algo más !?
Festhalten puede wir jedenfalls, daß se create("HPIC" bajo XP (y wohl sólo hay) en Bildern de annähernd 8000x8000 untypisch verhält. Kein Problema, si al weiß oder solche Bilder no ha.
Den folgenden Passus kannst Usted auch de el OLE-Variante entfernen:
TestHandle& = Crear("HPIC",-1,Bild$) Título de la ventana Str$(TestHandle&) + " En muy großen Bildern es el Ergebnis hier 0" DeleteObject TestHandle&
OLE kommt sin ihn de y benötigt ihn no (systemunabhängig). Deshalb es él hay m.E. auch no hilfreich (y stiftet vlt. Verwirrung). |
| | | WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 11.06.2020 ▲ |
| |
|
Zum QuelltextThemeninformationenDieses Thema ha 4 subscriber: |