Source/ Codesnippets | | | | - page 1 - |
| Jörg Sellmeyer | je hab maintenant via Ole (Dank à Andreas Miethe - toujours wieder) un funktionierendes Handle pour Bitmaps (aussi gif, ico et diverse autre Formate) ermitteln peut, cela ensuite entier normal sur einem Bitmapstatic angezeigt volonté peux. avec qui Ermittlung qui Taille peux je mich dans dem le cas encore pas entier anfreunden. qui là une concept hat - im Code ist qui Stelle markiert.
ici jedenfalls erstmal qui Code, um un gültiges Handle aussi pour grand Bilder trop conservé. si on es im Programme häufiger verwendet, ist es sûrement sinnvoller, qui Init-Routine seulement einmal am Anfang aufzurufen, mais so funktioniert es déjà la fois klaglos. s'il te plaît la fois avec Fichiers größer comme 5100 Pixeln testen. Aktuell habe je es seulement avec jpg et gif probiert. Icos sommes oui größenmäßig pas cela 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&
Déclarer 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
Paramètres File$
.Ole_Init()
.PictureObject& = .Ole_LoadImage(File$)
.PicFormat& = .Ole_GetType(.PictureObject&)
.hPic& = .Ole_GetHandle()
Imprimer .PictureObject&,.PicFormat&,.hpic&
ENDPROC
Proc OleImage.Ole_Init
.OLE32& = UseDll("OLE32")
.OLEPRO32& = UseDll("OLEPRO32")
Externe("OLE32","OleInitialize",0)
Faible 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&)
Externe("OLE32","OleUninitialize")
FreeDll .OLE32&
FreeDll .OLEPRO32&
DISPOSE IID_IPicture#
ENDPROC
Proc OleImage.Ole_LoadImage
Déclarer MemPointer&,PStream&,PictureObject&,PSize&
Paramètres Picture$
'------------------------
Set("Filemode", 0)
PSIZE& = Filesize(Picture$)
Faible PData#,PSIZE&
BlockRead(Picture$,PData#,0,PSIZE&)'données dans Bereichsvariable einlesen
'------------------------
~GlobalFree(Hmem&)
HMem& = ~GlobalAlloc($022,PSize&)'grenier reservieren
Mempointer& = ~GlobalLock(Hmem&)'Pointer sur grenier
~RtlMoveMemory(MemPointer&,PData#,PSize&)'Bereichsvariable dans grenier schieben
DISPOSE PData#'Bereichsvariable freigeben
~GlobalUnlock(HMem&)'grenier zum Gebrauch freigeben
Externe("Ole32","CreateStreamOnHGlobal",Hmem&,1,addr(PStream&))'Stream-Pointer erstellen
Externe("OlePro32","OleLoadPicture",PStream&,PSIZE&,0,IID_IPicture#,ADDR(PictureObject&))'Pointer pour Pictureobject
'------------------------
Cas PictureObject& > 0 : Retour PictureObject&
Cas PictureObject& = 0 : Retour 0
ENDPROC
Proc OleImage.Ole_GetType
Déclarer Command&,PicFormat&
Command& = Long(.PictureObject&,0)
Call(@Long(Command&,&Picture_GetType),.PictureObject&,addr(PicFormat&))
Retour PicFormat&
ENDPROC
Proc OleImage.GetSize
Paramètres DC&
Déclarer Command&,w&,h&,xpixels&,ypixels&
Command& = Long(.PictureObject&,0)
'ici wird qui Bildschirmauflösung pro douane abgefragt - chez mir 96x96.
'Allerdings sais je pas, quelle Funktion dans quel dll là angesprochen wird.
Call(@Long(Command&,&Picture_Get_Width),.PictureObject&,addr(w&))
Call(@Long(Command&,&Picture_Get_Height),.PictureObject&,addr(h&))
'qui Taille des Fensters wird ermittelt
xpixels& = ~GetDeviceCaps(DC&, 88)
ypixels& = ~GetDeviceCaps(DC&, 90)
'change qui Bildschirmauflösung sur qui Fenstergröße.
'je hab allerdings je n'en sais rien, comment qui Wert 2540 zustande venez.
.Width& = Round((w&*xpixels&)/2540,0)
.Height& = Round((h&*ypixels&)/2540,0)
ENDPROC
Proc OleImage.Ole_GetHandle
Déclarer Command&,PicHandle&
Command& = Long(.PictureObject&,0)
Call(@Long(Command&,&Picture_GetHandle),.PictureObject&,addr(PicHandle&))
Retour PicHandle&
ENDPROC
Proc OleImage.Ole_FreeImage
Paramètres PictureObject&
Déclarer Command&
Command& = Long(PictureObject&,0)
Call(@Long(Command&,&Picture_Release),PictureObject&)
ENDPROC
Proc OleImage.Destroy
DeleteObject .hPic&,.PictureObject&
.Ole_Free()
ENDPROC
Déclarer hbtn&,Bild$,hFont&,Anzeige&,OleAnzeige&,TestHandle&
Utilisateur Messages $10
~SetWindowLong(%hwnd,~GWL_STYLE,(~GetWindowLong(%hwnd,~GWL_STYLE) | $300000))
Fenêtre %maxx,%maxy
Titre de la fenêtre "Handle per OLE"
hFont& = Créer("Font","Western ",14,0,0,0,0)
SetDialogFont hFont&
hbtn& = Créer("Button",%hwnd,"Bild laden",%maxx-80,40,60,24)
WhileNot %clé = 27'ESC finissez cela Programme
Si GetText $(%hwnd) <> "Handle per OLE"
WaitInput 4000
Titre de la fenêtre "Handle per OLE"
ShowWindow(hbtn&,5)
EndIf
WaitInput
Cas %uMessage = $10:Pause
Si 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|Icônes (Ico)|*.ico|Cursor (cur)|*.cur")
Si Bild$ > »
TestHandle& = Créer(«PCSI»,-1,Bild$)
'chez grand Bildern ist ici cela Ergebnis 0
Titre de la fenêtre Str$(TestHandle&) + " chez très grand Bildern ist cela Ergebnis ici 0"
DeleteObject TestHandle&
Si SizeOf(OlePic#)
DestroyWindow(OleAnzeige&)
OlePic#.Destroy()
Dispose OlePic#
EndIf
OlePic# = New(OleImage,Bild$)
Si Anzeige&
DestroyWindow(Anzeige&)
waitinput
Cls
EndIf
With OlePic#
'qui Handleermittlung via Ole bringt un verwertbares Handle:
OlePic#.GetSize(%hdc2)
Imprimer .Width&,.Height&,"Typ:",.Ole_GetType()
Si .PicFormat& = 1
OleAnzeige& = Créer("Bitmap",%hwnd,.hPic&,0,0)
.GetSize(%hdc2)
Imprimer .Width&,OlePic#.Height&
ElseIf .PicFormat& = 3
Imprimer "Icon ist Typ:",.PicFormat&,"und peux plus rapide avec Profanmitteln angezeigt volonté."
EndIf
EndWith
EndIf
EndIf
Wend
Si SizeOf(OlePic#)
OlePic#.Destroy()
Dispose OlePic#
EndIf
DeleteObject hFont&
Fin
Basierend sur diesem Code [...] de Andreas Methe |
| | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ... | 03.06.2020 ▲ |
| |
| | | | - page 2 - |
| | Jörg Sellmeyer | malheureusement peut du uns im Unklaren, avec welchem Code du cela Bild geladen la hâte. chez mir zumindest ist es avec dem Code de Matthias - alors avec rein profanen Mitteln - pas ladbar. cela est, es wird pas angezeigt et es wird aussi ne...aucune Handle erzeugt, mais hPic& ist 0.
avec meinem Code (avec Ole) dagegen gibt es un gültiges Handle et cela Bild wird angezeigt. Es wird naturellement seulement un kleiner Ausschnitt angezeigt, weil qui Code aussi rien plus vorsieht.
Sollte es am trop geringen grenier liegen, ist es oui quand même offensichtlich, dass qui Ole-Methode qui bessere ist, là qui oui ensuite sur meinem System (avec trop wenig grenier) funktioniert, au cours de Créer(«PCSI»,...) là versagt. |
| | | | |
| | Matthias Arlt | 64k-frontière wäre peut-être un Erklärungsversuch. trop wenig grenier plutôt pas, j'ai aktuell 2.5GB RAM.
Jörg Sellmeyer (10.06.2020)
Sollte es am trop geringen grenier liegen, ist es oui quand même offensichtlich, dass qui Ole-Methode qui bessere ist, là qui oui ensuite sur meinem System (avec trop wenig grenier) funktioniert, au cours de Créer(«PCSI»,...) là versagt.
cela vois je aussi so. quand même wäre intéressant, si es am Speicherausbau des Rechners hängt, quoi je comment dit plutôt pas annehme, ou bien à qui Speicherbitmap de Profan. Letzeres peux wohl seulement Roland sûrement répondre. Bisher hat oui cet Problem pas zur Diskussion gestanden. Wohl weil es aucun aufgefallen ist...quand hat on déjà la fois solch Riesenbild. |
| | | WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 10.06.2020 ▲ |
| |
| | Jörg Sellmeyer | dans einer Auflösung de 300 dpi kneift Profan là déjà viel früher. si on quelque chose Grafikbearbeitung pouvoir, ist on vite chez solchen Größen. Bisher habe je pour qui Anzeige solcher Bilder toujours un Créer("HTMLWin", H, S, N, X, Y, DX, DY). là muss on ensuite mais chez qui Ermittlung qui Maße toujours wieder sur autre, nichtprofane Mittel zurückgreifen, quoi Zeit kostet et embêtant ist. Aussi veux je eigentlich seulement ungern un Element vom Internetexplorer dans mon Programme intégrer. un weiterer Vorteil de dem HTMLWin ist incidemment encore qui problemlose Nutzung comme scrollbares Element. c'est dans Profan bisher aussi seulement 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)
Aussi veux je eigentlich seulement ungern un Element vom Internetexplorer dans mon Programme intégrer.
peux je bien nachvollziehen...
ici la fois encore une quelque chose schlankere 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
tandis que 1
waitinput
si clicked(hBtn&)
Pic$=LoadFile$("Bild magasin...","*.*")
si FileExists(pic$)
UseCursor 2
LoadImageFile(Pic$)
UseCursor 0
endif
endif
Wend
FreeDLL GDIP_DLL&
end
Es scheint alors définitif à qui Speicherbitmap de Profan trop liegen, car avec Workarround per API funtioniert es oui. |
| | | WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 11.06.2020 ▲ |
| |
| | RGH | j'ai justement la fois nachgeschaut: qui XProfan-Befehle et -Funktionen, qui Bilder aus Fichiers magasin (MLoadBmp, DrawPic, DrawSizedPic et Créer(«PCSI»,...)), nutzen une OLE-Routine, qui à Andreas' Code angelehnt ist. ici sollte es aucun Probleme avec grand Bitmaps donner. je muss cela la fois näher überprüfen.
(cela gilt pas pour FreeProfan, là je Free Pascal encore pas avec OLE-Objekten verheiraten konnte.)
Salut 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 | ah oui: trop negativen Handles: dans Windows sommes qui Handles unsigned Integer (sans Vorzeichen). qui Wertebereich allez alors de 0 jusqu'à quelque chose sur 4 Milliarden. qui Handles et Integer dans XProfan sommes signed Integer (avec Vorzeichen) avec einem Wertebereich de - 2 Milliarden jusqu'à + 2 Milliarden. Windows-Handles, qui sur 2147483647 liegen, volonté daher négative dargestellt, quoi mais rien à ihrer Funktion ändert. Handles kleiner comme 0 sommes alors ebenso gültig.
Salut 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 | justement getestet: avec Matthias' Code (reines XProfan) konnte je mon größten Bilder (16 MPixel, Dateigröße sur 6 MB) problemlos magasin. Größere Bilder habe je pas. je benutze mon aktuelle XProfan-Version.
Nachtrag: et aussi cela dessus verlinkte afrique-Bild pouvoir dans höchster Auflösung (75 MPixel) aucun Probleme.
Salut 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 | je hatte avec 11.2 getestet et Jörg vmtl. avec X4. ensuite sembler là wohl encore autre Faktoren une rôle trop spielen...seulement quelle? Mir était cela oui aussi encore nie aufgefallen, là je solch grand Bilder plan aussi pas habe. ah oui...si FreeProfan et OLE sich pas so droite lieben...mon "schlankere" API-variante venez oui entier sans OLE aus. |
| | | WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 11.06.2020 ▲ |
| |
| | Jörg Sellmeyer | RGH (11.06.2020)
j'ai justement la fois nachgeschaut: qui XProfan-Befehle et -Funktionen, qui Bilder aus Fichiers magasin (MLoadBmp, DrawPic, DrawSizedPic et Créer(«PCSI»,...)), nutzen une OLE-Routine, qui à Andreas' Code angelehnt ist. ici sollte es aucun Probleme avec grand Bitmaps donner. je muss cela la fois näher überprüfen.
(cela gilt pas pour FreeProfan, là je Free Pascal encore pas avec OLE-Objekten verheiraten konnte.)
Salut Roland
RGH
Nachtrag: et aussi cela dessus verlinkte afrique-Bild pouvoir dans höchster Auflösung (75 MPixel) aucun Probleme.
là frage je mich mais, pourquoi cela chez Je ne funktioniert. je hab zwar encore XP avec 2GB Ram mais avec meiner variante de Andreas' Code funktioniert es oui, alors peux es pas generell am grenier ou bien qui Version Windows liegen. peut-être peux du nochmal regarder, quoi là qui Unterschiede dans deiner Version trop meiner sommes. qui verschlankte Code de Matthias funktioniert chez mir incidemment aussi pas.
Aussi fällt mir sur, dass Matthias imprimer verwendet, um cela Bild trop verarbeiten. cela wird dans mon Code vermieden, mais seulement par Speicherschiebereien cela Handle ermittelt. |
| | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ... | 11.06.2020 ▲ |
| |
| | Matthias Arlt | @Jörg j'ai ici sur diesem PC oui aussi XP SP2 sur elle. après que eh bien Roland aucun Probleme beim magasin des Bildes hatte, hab je cela Ganze la fois vite dans einem virtuellen Win 7 probiert. et siehe là...là gibt es aussi ne...aucune Problem!
si sich eh bien qui profaninterne Code lt. Roland à cela OLE-Prozedere de Andreas anlehnt, doit es mais doch Unterschiede donner, car extern funtioniert es oui mittels OLE.
cela imprimer dans mon Code steht là eigentlich seulement, weil je cela Handle angezeigt bekommen voulais. pourquoi mais cet API-variante, qui eigentlich seulement GDI(+)-Funktionen utilise, chez Dir pas allez, c'est moi eh bien wieder un Rätsel.
Mysteriös...mais immerhin une Schritt plus... |
| | | WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 11.06.2020 ▲ |
| |
| | Jörg Sellmeyer | je habs maintenant aussi sur nem Laptop avec Win7 et 4GB Ram getestet et es funktioniert avec deinem Code. cela erklärt mais toujours pas, pourquoi es chez mir avec meinem Code aussi sur mkeinem minderbemittelten calculateur funktioniert mais pas avec deinem Code. |
| | | | |
| | Matthias Arlt | c'est oui cela Mysterium...
GDI+ sollte chez XP oui standardmäßig vorhanden son. c'est es alors vmtl. pas. Du könntest vlt. fois le Rückgabewerte schrittweise pour jeden Funktionsaufruf regarder. Eventuell führt cela quelque chose plus !?
Festhalten peut wir jedenfalls, qui sich create(«PCSI» sous XP (et wohl seulement là) chez Bildern de annähernd 8000x8000 untypisch verhält. ne...aucune Problem, si on cela sais ou bien solche Bilder pas hat.
Den folgenden Passus peux Du aussi aus qui OLE-variante entfernen:
TestHandle& = Créer(«PCSI»,-1,Bild$) Titre de la fenêtre Str$(TestHandle&) + " chez très grand Bildern ist cela Ergebnis ici 0" DeleteObject TestHandle&
OLE venez sans ihn aus et nécessaire ihn pas (systemunabhängig). c'est pourquoi ist il là m.E. aussi pas hilfreich (et stiftet vlt. Verwirrung). |
| | | WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 11.06.2020 ▲ |
| |
|
Zum QuelltextOptions du sujet | 9.344 Views |
Themeninformationencet Thema hat 4 participant: |