| |
|
|
- 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 - |
|
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 ▲ |
|
|
|
| |
|
- Página 3 - |
|
|
Jörg Sellmeyer | Der Code es weit su lejos, como lauffähiger/nutzbarer Code a dienen. Bisher dient él sólo a Test- y Anschauungszwecken. |
|
|
| |
|
|
|
Matthias Arlt | Allein como es vlt. weniger aber como ausbaufähige Base ya. Das qué él tun se "Laden y Anzeigen" klappt doch problemlos. |
|
|
| WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 11.06.2020 ▲ |
|
|
|
|
RGH | Yo weiß no, si uno Energie para Problemas uso debería, el sólo beim wirklich veralteten Windows XP auftreten ... especialmente Yo no Möglichkeit mehr habe, bajo XP a testen.
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 ▲ |
|
|
|
|
Matthias Arlt | @Roland Nein, Yo sehe como auch no Handlungsbedarf, después de el problema erkannt y eingegrenzt es y lo funktionierende Workarrounds son.
Mit el veraltet en XP es el hin y otra vez no así simplemente. Für cierto technische Anwendungen es XP manchmal ya algo como como el kleinste gemeinsame Nenner, en unverhältnismäßigen Aufwand a vermeiden. |
|
|
| WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 11.06.2020 ▲ |
|
|
|
|
Jörg Sellmeyer | @Roland; Natürlich kann Yo, el Standpunkt verstehen - correcto akzeptieren kann Yo el Einstellung no.
Lo va hier no (sólo) una veraltete Windowsversion, pero en una Programa. qué a uno Punto unnötig Resourcen verbrät. Como puede ser se ligeramente en el Standpunkt zurückziehen, se el Kunde se doch qué Neues/Noticias kaufen, entonces se ejecuta lo auch otra vez. Pero esto es una Einstellung, el mittlerweile dazu geführt ha, dass PC, el früher High-End-Maschinen waren, heutzutage, kaum todavía como Bürocomputer taugen, porque incluso el Schreibprogramm así verschwenderisch con Plattenplatz y Ram umgehen, dass todos zwei Jahre una neuer PC hermuss, si uno en dieser Software Uptodate ser voluntad. Profano es a Glück weit lejos de solch absurden Auswüchsen, pero bietet se a, el Pfad treu a bleiben, si doch offensichtlich una Alternative son, el sí anscheinend nada soweit lejos de los ohnehin eingebauten Codeteilen a ser scheint.
Grundlage de mi Code, es genau el Code [...] de Andreas. Yo el sólo en un Klasse gepackt, porque me Formato gefällt. Der einzige Diferencia es, dass Yo el Bild no con el Olemitteln en el Bildschirm bringe, pero el Handle nutze, en lo más con Profanmitteln a verarbeiten. Tal vez el sí ya el Punkt, wo en deinem Code una kleine Änderung Wunder bewirken podría. |
|
|
| |
|
|
|
Matthias Arlt | Yo el "schlanken" Code otra vez überarbeitet. Como waren en el Eifer des Probierens 2 Profano-Befehle drin geblieben, el en el API-Rutina no hineingehören. |
|
|
| WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 12.06.2020 ▲ |
|
|
|