Source / code snippets | | | | - 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 - |
| | Jörg Sellmeyer | unfortunately can You us in the Unklaren, with welchem code You the image loaded have. by me at least is it with the Code Matthias - means with mere profanen Mitteln - not ladbar. that is, it'll not displayed and it'll too no lever created, separate hPic& is 0.
with my code (with Ole) against it there one gültiges lever and the image becomes displayed. it'll naturally only one small neckline displayed, because the code too nothing moreover vorsieht.
ought to it on the To geringen memory lying, is it Yes nevertheless evident, that The Ole-method The better is, since the Yes then on my system (with To little memory) functions, during Create("HPIC",...) there fail. |
| | | | |
| | Matthias Arlt | 64k-boundary would Perhaps one Erklärungsversuch. To little memory sooner not, I have currently 2.5GB RAM.
Jörg Sellmeyer (10.06.2020)
ought to it on the To geringen memory lying, is it Yes nevertheless evident, that The Ole-method The better is, since the Yes then on my system (with To little memory) functions, during Create("HPIC",...) there fail.
the see so did i so. nevertheless would interestingly, whether it on the Speicherausbau the Rechners depends, I How said sooner not annehme, or on the Memory bitmap of Profan. Letzeres can well only Roland sure answer. yet has Yes this trouble not to Discussion stood. well because it keinem noticed is...when has one already time such Riesenbild. |
| | | WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 06/10/20 ▲ |
| |
| | Jörg Sellmeyer | In of/ one dissolution of 300 dpi pinch Profan there already plenty former. If something Grafikbearbeitung power, is one quick with such sizes. yet have I for display such Images always one Create("HTMLWin", H, s, n, X, Y, DX, DY). there must one then but with the investigation the Maße over ands over again on others, nichtprofane middle zurückgreifen, what Time cost and onerous is. Also I will really only ungern one element of Internet Explorer in my Program to assimilate. One Another benefit from the HTMLWin is incidentally yet The problemlose Use as scrollbares element. this is in Profan yet too only suboptimal resolved. |
| | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ... | 06/11/20 ▲ |
| |
| | Matthias Arlt | Jörg Sellmeyer (11.06.2020)
Also I will really only ungern one element of Internet Explorer in my Program to assimilate.
can I well understand...
here time another something slimmer Variante...
declare 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
parameters 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)
dispose 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
while 1
waitinput
if clicked(hBtn&)
Pic$=LoadFile $("Bild loading...","*.*")
if FileExists(pic$)
UseCursor 2
LoadImageFile(Pic$)
UseCursor 0
endif
endif
wend
FreeDLL GDIP_DLL&
end
it shining means definitiv on the Memory bitmap of Profan To lying, because with Workarround by API funtioniert it Yes. |
| | | WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 06/11/20 ▲ |
| |
| | RGH | 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 |
| | | 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 ▲ |
| |
| | RGH | alas Yes: To negativen Handles: In windows are The Handles unsigned Integer (without omen). The Wertebereich goes means of 0 To something over 4 Billion. The Handles and à ¼ just how? XProfan are signed Integer (with omen) with a Wertebereich of - 2 Billion To + 2 Billion. windows-Handles, The over 2147483647 lying, go therefore negative displayed, what but nothing on yours function changes. Handles small as 0 are means likewise validly.
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 ▲ |
| |
| | 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 ▲ |
| |
|
Zum QuelltextThemeninformationenthis Topic has 4 subscriber: |