| |
| |
|
| - Page 1 - |
|
Jörg
Sellmeyer | I Have now via Ole (Thanks on Andreas Miethe - over ands over again) one funktionierendes lever for Bitmaps (too gif, ico and diverse others Formate) detect can, the then integrally normal on one Bitmapstatic showing can. with the investigation the Size can I me in the drop not yet integrally make friends. who there a idea has - in the code is the place markiert.
here anyway first the code, for a gültiges lever too for large Images to obtain.
If one it in the program more frequently uses, is it sure sinnvoller, The Init-routine only once at the beginning aufzurufen, but so functions it already time klaglos.
Please time with Files larger as 5100 Pixeln testing. currently have I it only with jpg and gif probiert. Icos are so größenmäßig not the trouble.
$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&
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&)'data in Memory-Variable reading
'------------------------
~GlobalFree(Hmem&)
HMem& = ~GlobalAlloc($022,PSize&)'memory reservieren
Mempointer& = ~GlobalLock(Hmem&)'Pointer on memory
~RtlMoveMemory(MemPointer&,PData#,PSize&)'Memory-Variable in memory schieben
DISPOSE PData#'Memory-Variable enable
~GlobalUnlock(HMem&)'memory to that use enable
External("Ole32","CreateStreamOnHGlobal",Hmem&,1,addr(PStream&))'Stream-Pointer create
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)
'here becomes The Bildschirmauflösung per inch quizzed - by me 96x96.
'though white I do not, which function in which dll there addressed becomes.
Call(@Long(Command&,&Picture_Get_Width),.PictureObject&,addr(w&))
Call(@Long(Command&,&Picture_Get_Height),.PictureObject&,addr(h&))
'The Size the Fensters becomes determined
xpixels& = ~GetDeviceCaps(DC&, 88)
ypixels& = ~GetDeviceCaps(DC&, 90)
'Umrechnung the Bildschirmauflösung on The Fenstergröße.
'I Have though no idea, How the worth 2540 zustande comes.
.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&,Image$,hFont&,Anzeige&,OleAnzeige&,TestHandle&
User Messages $10
~SetWindowLong(%hwnd,~GWL_STYLE,(~GetWindowLong(%hwnd,~GWL_STYLE) | $300000))
Window %maxx,%maxy
Window Title "Handle by 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 exits the program
If GetText$(%hwnd) <> "Handle by OLE"
WaitInput 4000
Window Title "Handle by OLE"
ShowWindow(hbtn&,5)
EndIf
WaitInput
Case %uMessage = $10:Break
If Clicked(hbtn&)
Image$ = LoadFile $("ÖFFNE","alle supported 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 Image$ > ""
TestHandle& = Create("HPIC",-1,Image$)
'with large Images is here the Result 0
Window Title Str $(TestHandle&) + " with very large Images is the Result here 0"
DeleteObject TestHandle&
If SizeOf(OlePic#)
DestroyWindow(OleAnzeige&)
OlePic#.Destroy()
Dispose OlePic#
EndIf
OlePic# = New(OleImage,Image$)
If Anzeige&
DestroyWindow(Anzeige&)
waitinput
Cls
EndIf
With OlePic#
'The Handleermittlung via Ole yielding verwertbares lever:
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 is type:",.PicFormat&,"und can faster with Profanmitteln showing."
EndIf
EndWith
EndIf
EndIf
Wend
If SizeOf(OlePic#)
OlePic#.Destroy()
Dispose OlePic#
EndIf
DeleteObject hFont&
End
based on this code [...]  of Andreas Methe |
|
| |
| Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ...  | 06/03/20 ▲ |
|
| |
|
|
| |
| |
| - Page 2 - |
|
RGH | straight tested: with Matthias' code (reines XProfan) could I mean biggest Images (16 MPixel, Filesize over 6 MB) free from problems loading. larger Images have I do not. I use my actually XProfan-Version.
Nachtrag: and too the supra verlinkte africa-Image power in highest dissolution (75 MPixel) no Problems.
Greeting
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 | 06/11/20 ▲ |
|
| |
|
|
Matthias
Arlt | I had with 11.2 tested and Jörg vmtl. with X4. then shine there well yet others factors a strain To play...only which? me was indeed yet never noticed, I such large Images even neither have.
alas Yes...if FreeProfan and OLE not so right like...my "schlankere" API-Variante comes Yes integrally without OLE from. |
|
| |
| WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 06/11/20 ▲ |
|
| |
|
|
Jörg
Sellmeyer | RGH (11.06.2020)
I have straight time nachgeschaut: The XProfan-command and -functions, The Images from Files loading (MLoadBmp, DrawPic, DrawSizedPic and Create("HPIC",...)), benefit a OLE-routine, The on Andreas' code angelehnt is. here ought to it no Problems with large Bitmaps give. I must the time hither to check on.
(This is not for FreeProfan, I FreePascal not yet with OLE-Objects verheiraten could.)
Greeting
Roland
RGH
Nachtrag: and too the supra verlinkte africa-Image power in highest dissolution (75 MPixel) no Problems.
there question I but, Why the not at me functions. I Have of course yet XP with 2GB Ram but with my Variante of Andreas' code functions it Yes, means can not generally on the memory or the Windowsversion lying.
Perhaps can you again look, what since the Differences in your Version To of my are.
The verschlankte Code Matthias functions by me incidentally neither. 
Also falls me on, that Matthias print uses, around the Image To process. This will in my code vermieden, separate only through Speicherschiebereien the lever determined. |
|
| |
| Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ... | 06/11/20 ▲ |
|
| |
|
|
Matthias
Arlt | @Jörg
I have here on this PC indeed XP SP2 on it. after now Roland no Problems at loading the Bildes having, Have I the whole time quick in a virtual Win 7 probiert. and see there...there there too no trouble!
If itself now the profaninterne code lt. Roland on the OLE-Prozedere of Andreas anlehnt, must But still differences give, because extern funtioniert it Yes through OLE.
the print in my code standing there really only, because I the lever displayed get wished. Why but these API-Variante, The really only GDI(+)-functions uses, with you not goes, is me now again puzzel.
Mysteriös...but at least a step moreover... |
|
| |
| WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 06/11/20 ▲ |
|
| |
|
|
Jörg
Sellmeyer | | I habs now on nem Laptop with Win7 and 4GB Ram tested and it functions with your code. the declared but still not, Why it by me with my code on mkeinem minderbemittelten computer functions but not your code. |
|
| |
| |
| |
|
|
Matthias
Arlt | this is Yes the Mysterium...
GDI+ ought to with XP Yes standardmäßig present his. this is it means vmtl. not.
You could vlt. times the Rückgabewerte schrittweise for each Funktionsaufruf standing. possible lead the something moreover !?
capture can we anyway, that itself create("HPIC" XP (and well only there) with Images of roughly 8000x8000 untypisch behave. no trouble, if to the white or such Images not has.
whom subesquent Passus can You too from the OLE-Variante Remove:
TestHandle& = Create("HPIC",-1,Image$)
Window Title Str$(TestHandle&) + " with very large Images is the Result here 0"
DeleteObject TestHandle&
OLE comes without it from and needed it not (systemunabhängig). therefore is it there m.E. neither helpful (and stiftet vlt. Verwirrung). |
|
| |
| WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 06/11/20 ▲ |
|
| |
|
| |
| |
| - Page 3 - |
|
|
Jörg
Sellmeyer | The code is far of it removes, as lauffähiger/nutzbarer Code serve.
yet serves it go ahead Test- and Anschauungszwecken. |
|
| |
| |
| |
|
|
Matthias
Arlt | alone so How he's vlt. less but as ausbaufähige Base already.
the what it do should "Laden and Anzeigen" works still free from problems. |
|
| |
| WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 06/11/20 ▲ |
|
| |
|
|
RGH | i don't know, whether one energy for Problems use ought to, The only at really antiquated Windows XP appear ... especially since I no Possibility More have, XP To testing.
Greeting
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 | 06/11/20 ▲ |
|
| |
|
|
Matthias
Arlt | @Roland
No, I see there too none Handlungsbedarf, after the trouble recognized and eingegrenzt is and it working Workarrounds gives.
with the antiquated with XP is the once in a while not so simply. for defined technical Applications is XP sometimes already something like How the smallest joint denominator, circa unverhältnismäßigen hoisted To avoid. |
|
| |
| WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 06/11/20 ▲ |
|
| |
|
|
Jörg
Sellmeyer | @Roland; naturally can I whom viewpoint understand - correctly. to accept can I The attitude not.
It's all right not (only) circa a antiquated Windowsversion, separate for a Program. what at a place unnecessary Resources verbrät. there can itself slight on the viewpoint retire, to the customer itself still what New/News buy, then runs it again. But this is a attitude, The in the meantime moreover led has, that PC, The former High-End-machines were, nowadys, hardly yet as Bürocomputer taugen, because self The Schreibprogramm so lavish with Plattenplatz and Ram bypass, that any two years one new PC hermuss, if one with this software Uptodate his wants.
Profan is To Happiness distant of such absurd Auswüchsen, but it bid itself on, the way faithfully To stay, if it still evident a alternative gives, The Yes apparently none so far removes from the ohnehin installed Codeteilen To his shining.
basis of my code, is exactly the code [...] of Andreas. I Have the only in a class gepackt, because me the stature gefällt.
The only Difference is, I the image not whom Olemitteln on the screen bring, separate the lever use, circa it moreover with Profanmitteln To process.
Perhaps is the already the point, where in your code a small Änderung wonder effect could. |
|
| |
| |
| |
|
|
Matthias
Arlt | | I Have whom "schlanken" code again revised. there were in the Eifer the Probierens 2 Profan-command drin stayed, The into API-routine not hineingehören. |
|
| |
| WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 06/12/20 ▲ |
|
| |
|
(273)
Deutsch
English
Français
Español
Italia