Quelltexte/ Codesnippets | | | | Jörg Sellmeyer | Ich hab jetzt via Ole (Dank an Andreas Miethe - immer wieder) ein funktionierendes Handle für Bitmaps (auch gif, ico und diverse andere Formate) ermitteln können, das dann ganz normal auf einem Bitmapstatic angezeigt werden kann. Mit der Ermittlung der Größe kann ich mich in dem Fall noch nicht ganz anfreunden. Wer da eine Idee hat - im Code ist die Stelle markiert.
Hier jedenfalls erstmal der Code, um ein gültiges Handle auch für große Bilder zu erhalten. Wenn man es im Programm häufiger verwendet, ist es sicher sinnvoller, die Init-Routine nur einmal am Anfang aufzurufen, aber so funktioniert es schon mal klaglos. Bitte mal mit Dateien größer als 5100 Pixeln testen. Aktuell habe ich es nur mit jpg und gif probiert. Icos sind ja größenmäßig nicht das Problem.
$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 Variablen
DECLARE IID_IPicture#
DECLARE PData#
DECLARE HMEM&
Declare 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
Parameters File$
.Ole_Init()
.PictureObject& = .Ole_LoadImage(File$)
.PicFormat& = .Ole_GetType(.PictureObject&)
.hPic& = .Ole_GetHandle()
Print .PictureObject&,.PicFormat&,.hpic&
EndProc
Proc OleImage.Ole_Init
.OLE32& = UseDll("OLE32")
.OLEPRO32& = UseDll("OLEPRO32")
External("OLE32","OleInitialize",0)
Dim IID_IPicture#,16
Long 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&)
External("OLE32","OleUninitialize")
FreeDll .OLE32&
FreeDll .OLEPRO32&
DISPOSE IID_IPicture#
EndProc
Proc OleImage.Ole_LoadImage
Declare MemPointer&,PStream&,PictureObject&,PSize&
Parameters Picture$
'------------------------
Set("Filemode", 0)
PSIZE& = Filesize(Picture$)
Dim PData#,PSIZE&
BlockRead(Picture$,PData#,0,PSIZE&)'Daten in Bereichsvariable einlesen
'------------------------
~GlobalFree(Hmem&)
HMem& = ~GlobalAlloc($022,PSize&)'Speicher reservieren
Mempointer& = ~GlobalLock(Hmem&)'Pointer auf Speicher
~RtlMoveMemory(MemPointer&,PData#,PSize&)'Bereichsvariable in Speicher schieben
DISPOSE PData#'Bereichsvariable freigeben
~GlobalUnlock(HMem&)'Speicher zum Gebrauch freigeben
External("Ole32","CreateStreamOnHGlobal",Hmem&,1,addr(PStream&))'Stream-Pointer erstellen
External("OlePro32","OleLoadPicture",PStream&,PSIZE&,0,IID_IPicture#,ADDR(PictureObject&))'Pointer fuer Pictureobject
'------------------------
Case PictureObject& > 0 : Return PictureObject&
Case PictureObject& = 0 : Return 0
EndProc
Proc OleImage.Ole_GetType
Declare Command&,PicFormat&
Command& = Long(.PictureObject&,0)
Call(@Long(Command&,&Picture_GetType),.PictureObject&,addr(PicFormat&))
Return PicFormat&
EndProc
Proc OleImage.GetSize
Parameters DC&
Declare Command&,w&,h&,xpixels&,ypixels&
Command& = Long(.PictureObject&,0)
'hier wird die Bildschirmauflösung pro Zoll abgefragt - bei mir 96x96.
'Allerdings weiß ich nicht, welche Funktion in welcher dll da angesprochen wird.
Call(@Long(Command&,&Picture_Get_Width),.PictureObject&,addr(w&))
Call(@Long(Command&,&Picture_Get_Height),.PictureObject&,addr(h&))
'die Größe des Fensters wird ermittelt
xpixels& = ~GetDeviceCaps(DC&, 88)
ypixels& = ~GetDeviceCaps(DC&, 90)
'Umrechnung der Bildschirmauflösung auf die Fenstergröße.
'Ich hab allerdings keine Ahnung, wie der Wert 2540 zustande kommt.
.Width& = Round((w&*xpixels&)/2540,0)
.Height& = Round((h&*ypixels&)/2540,0)
EndProc
Proc OleImage.Ole_GetHandle
Declare Command&,PicHandle&
Command& = Long(.PictureObject&,0)
Call(@Long(Command&,&Picture_GetHandle),.PictureObject&,addr(PicHandle&))
Return PicHandle&
EndProc
Proc OleImage.Ole_FreeImage
Parameters PictureObject&
Declare Command&
Command& = Long(PictureObject&,0)
Call(@Long(Command&,&Picture_Release),PictureObject&)
EndProc
Proc OleImage.Destroy
DeleteObject .hPic&,.PictureObject&
.Ole_Free()
EndProc
Declare hbtn&,Bild$,hFont&,Anzeige&,OleAnzeige&,TestHandle&
UserMessages $10
~SetWindowLong(%hwnd,~GWL_STYLE,(~GetWindowLong(%hwnd,~GWL_STYLE) | $300000))
Window %maxx,%maxy
WindowTitle "Handle per OLE"
hFont& = Create("Font","Western ",14,0,0,0,0)
SetDialogFont hFont&
hbtn& = Create("Button",%hwnd,"Bild laden",%maxx-80,40,60,24)
WhileNot %key = 27'ESC beendet das Programm
If GetText$(%hwnd) <> "Handle per OLE"
WaitInput 4000
WindowTitle "Handle per OLE"
ShowWindow(hbtn&,5)
EndIf
WaitInput
Case %uMessage = $10:Break
If Clicked(hbtn&)
Bild$ = LoadFile$("ÖFFNE","alle unterstützten Formate|*.dib;*.bmp;*.rle;*.jpe;*.jpeg;*.jpg;*.gif;*.ico;*.cur;*.emf;*.wmf|\
Bitmap (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& = Create("hPic",-1,Bild$)
'bei großen Bildern ist hier das Ergebnis 0
WindowTitle Str$(TestHandle&) + " Bei sehr großen Bildern ist das Ergebnis hier 0"
DeleteObject TestHandle&
If SizeOf(OlePic#)
DestroyWindow(OleAnzeige&)
OlePic#.Destroy()
Dispose OlePic#
EndIf
OlePic# = New(OleImage,Bild$)
If Anzeige&
DestroyWindow(Anzeige&)
waitinput
Cls
EndIf
With OlePic#
'die Handleermittlung via Ole bringt ein verwertbares Handle:
OlePic#.GetSize(%hdc2)
Print .Width&,.Height&,"Typ:",.Ole_GetType()
If .PicFormat& = 1
OleAnzeige& = Create("Bitmap",%hwnd,.hPic&,0,0)
.GetSize(%hdc2)
Print .Width&,OlePic#.Height&
ElseIf .PicFormat& = 3
Print "Icon ist Typ:",.PicFormat&,"und kann schneller mit Profanmitteln angezeigt werden."
EndIf
EndWith
EndIf
EndIf
Wend
If SizeOf(OlePic#)
OlePic#.Destroy()
Dispose OlePic#
EndIf
DeleteObject hFont&
End
Basierend auf diesem Code [...] von Andreas Methe |
| | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ... | 03.06.2020 ▲ |
| |
| | Matthias Arlt | Bei mir genügt ein ' sleep 100 ' vor dem ' with OlePic# '. Offenbar braucht die vorhergehende Aktion ein paar ms Zeit. Bei den ms ist noch Luft nach unten. Möglicherweise ist das systemabhängig. Die Bildgröße spielt da wohl keine Rolle. |
| | | WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 03.06.2020 ▲ |
| |
| | Jörg Sellmeyer | Eigentlich erstaunlich, dass es dann funktioniert, da ich da schlicht einen Fehler gemacht habe. Es muss heißen: Case Anzeige&: DestroyWindow(Anzeige&) Danke fürs Testen. Ist jetzt korrigiert. |
| | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ... | 04.06.2020 ▲ |
| |
| | Michael W. | 2,54 ist der Umrechnungswert inch nach cm
PictureObject ist ein StreamObjekt das da erzeugt wird. Und ganz offensichtlich erbt dieses StreamObjekt ein Objekt, dessen Methoden dann zum Abfragen der Größe und weiterer Dinge verwendet werden können.
Da wir bei unseren Objekten keine Zeiger und auch kein THIS haben, können wir diese Objekte leider in XProfan nicht wie einfache Objekte handhaben.
Create("hPic": Hast Du mal geschaut, welche Dateitypen da die Null erzeugen? Offensichtlich ist die Funktion nicht so vielseitig wie OLE.
Die Funktion Create("Bitmap",... wird 2x hintereinander aufgerufen.
--- Nachtrag: Ich hatte gehofft, das .Ole_GetType etwas sinnvolles liefert. Aber ich erhielt mit allem eine 1 geliefert. .ico/.cur führt zum Absturz, obwohl es bei den ladbaren Typen aufgeführt ist.
Hier der Test-Source:
$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 Variablen 'DECLARE OLE32&,OLEPRO32& DECLARE IID_IPicture# DECLARE PData# DECLARE HMEM& Declare 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 Parameters File$ .Ole_Init() .PictureObject& = .Ole_LoadImage(File$) .PicFormat& = .Ole_GetType(.PictureObject&) .hPic& = .Ole_GetHandle() EndProc
Proc OleImage.Ole_Init .OLE32& = UseDll("OLE32") .OLEPRO32& = UseDll("OLEPRO32") External("OLE32","OleInitialize",0) Dim IID_IPicture#,16 Long 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&) External("OLE32","OleUninitialize") FreeDll .OLE32& FreeDll .OLEPRO32& DISPOSE IID_IPicture# EndProc
Proc OleImage.Ole_LoadImage Declare MemPointer&,PStream&,PictureObject&,PSize& Parameters Picture$ '------------------------ Set("Filemode", 0) PSIZE& = Filesize(Picture$) Dim PData#,PSIZE& BlockRead(Picture$,PData#,0,PSIZE&)'Daten in Bereichsvariable einlesen '------------------------ ~GlobalFree(Hmem&) HMem& = ~GlobalAlloc($022,PSize&)'Speicher reservieren Mempointer& = ~GlobalLock(Hmem&)'Pointer auf Speicher ~RtlMoveMemory(MemPointer&,PData#,PSize&)'Bereichsvariable in Speicher schieben DISPOSE PData#'Bereichsvariable freigeben ~GlobalUnlock(HMem&)'Speicher zum Gebrauch freigeben External("Ole32","CreateStreamOnHGlobal",Hmem&,1,addr(PStream&))'Stream-Pointer erstellen External("OlePro32","OleLoadPicture",PStream&,PSIZE&,0,IID_IPicture#,ADDR(PictureObject&))'Pointer fuer Pictureobject '------------------------ Case PictureObject& > 0 : Return PictureObject& Case PictureObject& = 0 : Return 0 EndProc
Proc OleImage.Ole_GetType Declare Command&,PicFormat& Command& = Long(.PictureObject&,0) Call(@Long(Command&,&Picture_GetType),.PictureObject&,addr(PicFormat&)) Return PicFormat& EndProc
Proc OleImage.GetSize 'hier tauchen für mich ein paar ungelöste Fragen auf. Parameters DC& Declare Command&,w&,h&,xpixels&,ypixels& Command& = Long(.PictureObject&,0) 'hier wird die Bildschirmauflösung pro Zoll abgefragt - bei mir 96x96. 'Allerdings weiß ich nicht, welche Funktion in welcher dll da angesprochen wird. Call(@Long(Command&,&Picture_Get_Width),.PictureObject&,addr(w&)) Call(@Long(Command&,&Picture_Get_Height),.PictureObject&,addr(h&)) 'die Größe des Fensters wird ermittelt xpixels& = ~GetDeviceCaps(DC&, 88) ypixels& = ~GetDeviceCaps(DC&, 90) 'Umrechnung der Bildschirmauflösung auf die Fenstergröße. 'Ich hab allerdings keine Ahnung, wie der Wert 2540 zustande kommt. .Width& = Round((w&*xpixels&)/2540,0) .Height& = Round((h&*ypixels&)/2540,0) EndProc
Proc OleImage.Ole_GetHandle Declare Command&,PicHandle& Command& = Long(.PictureObject&,0) Call(@Long(Command&,&Picture_GetHandle),.PictureObject&,addr(PicHandle&)) Return PicHandle& EndProc
Proc OleImage.Ole_FreeImage Parameters PictureObject& Declare Command& Command& = Long(PictureObject&,0) Call(@Long(Command&,&Picture_Release),PictureObject&) EndProc
Proc OleImage.Destroy DeleteObject .hPic&,.PictureObject& .Ole_Free() EndProc
Declare hbtn&,Bild$,hFont&,Anzeige&,TestHandle& UserMessages $10 Cls ShowMax hFont& = Create("Font","Western ",14,0,0,0,0) SetDialogFont hFont& hbtn& = Create("Button",%hwnd,"Bild laden",%maxx-70,40,60,24)
'### zugefuegt ### Declare szTXT&, typ1TXT&, typ2TXT&, typ2$ szTXT& = Create("Text",%hwnd,"1000x1000",%maxx-70,40+30,60,24) typ1TXT& = Create("Text",%hwnd,"&bildtyp",%maxx-70,40+30+30,60,24) typ2TXT& = Create("Text",%hwnd,"$bildtyp",%maxx-70,40+30+30+30,60,24) '###
WhileNot %key = 27 'ESC beendet das Programm WaitInput Case %uMessage = $10 : Break
If Clicked(hbtn&) Bild$ = LoadFile$("ÖFFNE","alle unterstützten Formate|*.dib;*.bmp;*.rle;*.jpe;*.jpeg;*.jpg;*.gif;*.ico;*.cur;*.emf;*.wmf|\ Bitmap (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$ > "" '### zugefuegt ### typ2$ = Right$(Bild$,6) '6 wegen .tiff, .jpeg typ2$ = SubStr$(typ2$, 2, ".") '### TestHandle& = Create("hPic",-1,Bild$) 'bei sehr großen Bildern ist hier das Ergebnis 0 WindowTitle Str$(TestHandle&) + " Handle. Bei sehr großen Bildern ist das Ergebnis hier 0" DeleteObject TestHandle&
If SizeOf(OlePic#) OlePic#.Destroy() Dispose OlePic# EndIf
OlePic# = New(OleImage,Bild$) Case Anzeige&: DestroyWindow(Anzeige&) With OlePic# '### hier war 2. Create("Bitmap" 'die Handleermittlung via Ole bringt ein verwertbares Handle: Anzeige& = Create("Bitmap",%hwnd,.hPic&,0,0) OlePic#.GetSize(%hdc2) '### zugefuegt ### 'Print .Width&,.Height& SetText szTXT&, Trim$(Str$(.Width&) + "x" + Str$(.Height&)) SetText typ1TXT&, Trim$(Str$(.PicFormat&)) SetText typ2TXT&, Trim$(typ2$) '### EndWith EndIf EndIf Wend
If SizeOf(OlePic#) OlePic#.Destroy() Dispose OlePic# EndIf DeleteObject hFont&
End
|
| | | System: Windows 8/10, XProfan X4 Programmieren, das spannendste Detektivspiel der Welt. | 05.06.2020 ▲ |
| |
| | Jörg Sellmeyer | Um Ico und andere Formate geht es mir hier gar nicht. Ich versuche, einen Ansatz zu liefern, wie man große Bilder (die heutzutage mit jedem Handy im Megapixelbereich gemacht werden) mit Profan anzeigen kann. Die kleinen Formate funktionieren ja gut mit (Create(...)). Das eine zuviel ist mir beim letzten Kontrollgang durchgerutscht. - ist aber auch unerheblich.
Entscheidend ist ein Test mit Bildern (jpg) mit mindestens 3000 x 2000 Pixeln oder so. In dem Bereich bekommt man mit Create(...) eben kein gültiges Handle mehr, sondern nur noch Null und kann dementsprechend auch weder anzeigen, noch irgendwelche Werte auslesen. Wobei Profan schon bei viel kleineren Bildern kneift. Die Grenze liegt bei etwa 1 Mio Pixeln gesamt. Was eben heutzutage ein Witz ist.
Mit Ole geht das aber. Das korrekte Handle lässt sich auf einem profaneigenen Create("Bitmap",...) anzeigen und die Maße lassen sich dann eben auch (wenn auch umständlich) ermitteln. Ich hab oben mal einen korrigierten Code reingesetzt. Auf die Inch-Umrechnung hätte ich auch kommen können, als ehemaliger Tischler - Danke für den Hinweis. |
| | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ... | 05.06.2020 ▲ |
| |
| | Michael W. | 2592x1944 2448x3264 (von der weiß ich noch, die hat 9 MB) wird bei mir alles mit negativem handle angezeigt.
Das Scrollen kann man mit einem scrollbaren Hintergrund erreichen. Da gibts irgendwie "scrollable Gadget" oder so.
Der Testteil kann raus, weil Ole das ja im Griff hat. |
| | | System: Windows 8/10, XProfan X4 Programmieren, das spannendste Detektivspiel der Welt. | 05.06.2020 ▲ |
| |
| | Matthias Arlt | Kann ich nur bestätigen... Mehrfachtest mit Bildern größer als ca. 4000x3000 problemlos und auch durchgängig mit negativem Hdl. |
| | | WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 05.06.2020 ▲ |
| |
| | Jörg Sellmeyer | Das negative hdl ist nicht ungewöhnlich. Gibt es auch bei kleineren Bildern mit profaneigenen Mitteln immer mal wieder. Aber schön, dass es anscheinend problemlos klappt.
Ich werde das noch als Objekt fertig machen. Lieber wäre mir aber, wenn Roland die nächste Profanversion so aufbohrt, dass dann auch große Bilder damit ladbar sind.
Eine solche Funktion als externe Möglichkeit führt nur zu doppelten Aktionen, wenn man feststellt, dass Profan kein Handel erzeugen kann oder macht im Prinzip die Create("hPic",...) Funktion überflüssig, was ja auch nicht Sinn der Sache ist. |
| | | | |
| | Matthias Arlt | Hm...bei mir geht das mit eben diesen großen Bildern auch in reinem Profan. Grad mal schnell unter 11.2 getestet (wieder mit größer 4000x3000)
declare btn&,pic$,hPic&,hBmp&
window 0,0-%maxx,(%maxy-30)
btn&=create("BUTTON",%hwnd,"Bild...",20,20,60,22)
while 1
waitinput
if clicked(btn&)
pic$=LoadFile$("Bild laden...","*.*")
if FileExists(pic$)
case hPic& : deleteobject hPic&
case hBmp& : destroywindow(hBmp&)
hPic&=Create("hPic",-1,pic$)
hBmp&=Create("Bitmap",%hwnd,hPic&,0,0)
endif
endif
wend
case hPic& : deleteobject hPic&
Oder ich hab evtl. das Problem mißverstanden !? |
| | | WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 05.06.2020 ▲ |
| |
| | Jörg Sellmeyer | Probier mal das hier: [...] |
| | | | |
| | Matthias Arlt | Hab ich jetzt probiert. Interessant ist hier ja nur die größte Auflösung. Tatsächlich steigt Profan dabei aus. Verkleinere ich nun dieses Bild mit IrfanView auf ca. 90 Prozent seiner Größe, dann klappt das auch wieder mit Profan. Demnach ist die verarbeitbare Grenze für Profan bei rund 8000x8000.
Nachtrag: Ich bin noch mal den ungekehrten Weg gegangen und hab eines meiner eigenen Bilder auf über 8000 vergrößert. Auch da steigt Profan dann aus. Also liegt dort wohl das maximal Machbare.
Nachtrag 2: Und weil ich das nun genau wissen wollte, hab ich mich mal per MCLS ans Limit der Speicherbitmap herangetastet. Maximum war dann bei 7905x7905. |
| | | WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 06.06.2020 ▲ |
| |
| | Michael W. | also eine 64k-Grenze?
Ich habe das Bild mal geladen und getestet. Man sieht die Kapverdischen Inseln und Gibraltar. Der Rest vom gigantischen Bild ist nicht zu sehen. Aber abstürzen will das Programm nicht. Kann es sein, das ihr einfach nur zu wenig Speicher im Rechner habt?
8460x8900 Ich kann mir eigentlich nicht vorstellen das hier die Bildschirmgröße eine Rolle spielt. Mein Samsung Bildschirm schafft 1920x1080 in der jetzigen Einstellung. |
| | | System: Windows 8/10, XProfan X4 Programmieren, das spannendste Detektivspiel der Welt. | 10.06.2020 ▲ |
| |
|
Zum QuelltextThemenoptionen | 9.595 Betrachtungen |
ThemeninformationenDieses Thema hat 4 Teilnehmer: |