(931)  S'inscrire

Français
Source/ Codesnippets

Bitmaps Uebergosse Verarbeiten

 
Andreas Miethe:
KompilierenMarqueSéparation
'###############################################
'BITMAPS sur Speicherbereich mappen et Montrer
'###############################################
'cela Problem de très grossen Bitmaps, qui avec
'Profan pas geladen volonté, wird avec cela
'umgangen.
'Desweiteren ist es so moeglich un Bitmap
'dans un Memory-Bitmap trop zeichnen. on hat
'alors un Handle !
'###############################################
DEF OpenFile(3) ! "Kernel32","OpenFile"
DEF CreateFileMapping(6) ! "Kernel32","CreateFileMappingA"
DEF MapViewOfFile(5) ! "Kernel32","MapViewOfFile"
DEF UnmapViewOfFile(1) ! "Kernel32","UnmapViewOfFile"
DEF StretchDIBits(13) ! "GDI32","StretchDIBits"
DEF CloseHandle(1) ! "Kernel32","CloseHandle"
DEF GetWindowLong(2) !"User32", "GetWindowLongA"
DEF SetWindowLong(3) !"User32", "SetWindowLongA"
DEF ScrollWindow(5) "User32","ScrollWindow"
DEF ScrollWindowEx(8) "User32","ScrollWindowEx"
DEF SetScrollRange(5) ! "User32","SetScrollRange"
DEF UpdateWindow(1) ! "User32","UpdateWindow"
DEF GetDC(1) ! "User32","GetDC"
DEF ScrollDC(7) "User32","ScrollDC"
Déclarer OfStruct#
Déclarer DataPointer#
Déclarer PixelStartPointer#
Déclarer BMPHeader#
Déclarer FileHeaderLenght&
Déclarer OfBits&
Déclarer BmpWidth&
Déclarer BmpHeight&
Déclarer Identifyer&
Def &OF_SHARE_DENY_NONE $040
Def &PAGE_READONLY $02
Def &FILE_MAP_READ $04
Def &DIB_RGB_COLORS  0
Def &SRCCOPY $0CC0020
Def &GWL_STYLE  -16
Def &SBM_SETRANGE $0E2
Def &SB_BOTH $03
Déclarer FileName$,FileHandle&,MapHandle&,Data&
Déclarer OfBits&,BmpWidth&,BmpHeight&
Laisser FileName$ = "farbe.bmp" Pfad anpassen
Faible OfStruct#,136
Faible DataPointer#,4
Faible PixelStartPointer#,4
Faible BMPHeader#,54
Laisser FileHeaderLenght& = 14
FileMode 0
Assign #1,Filename$
OpenRW #1
Bitmap-En-tête einlesen
BlockRead(#1,BmpHeader#,0,54)
Fermer #1
Laisser Identifyer& = $4D42 Bitmap-Identität
SetTrueColor 1
window %maxx+1,0-640,480
SetWindowLong(%hwnd,&GWL_STYLE,or(GetWindowLong(%hwnd,&GWL_STYLE),$300000))
setwindowpos %hwnd = 0,0-641,480
'Ist qui File un gültiges Bitmap ???

Si Hex$(word(bmpheader#,0)) = identifyer&

    Laisser OfBits& = long(bmpheader#,10)ici commencer qui Bilddaten
    Laisser BmpWidth& = long(bmpheader#,18)Bildbreite
    Laisser BmpHeight& = long(bmpheader#,22)Bildhoehe
    avec OpenFile un File-Handle ermitteln
    Laisser Filehandle& = OpenFile(Addr(Filename$),OfStruct#,&OF_SHARE_DENY_NONE)
    avec CreateFileMapping un Map-Handle ermitteln
    Laisser MapHandle& = CreateFileMapping(FileHandle&,0,&PAGE_READONLY,0,0,0)
    avec MapViewOfFile un File-Mapping-Object anlegen
    Laisser Data& = MapViewOfFile(MapHandle&,&FILE_MAP_READ,0,0,0)
    Pointer pour Bitmapdaten
    Laisser DataPointer# = Int(Data& + FileHeaderLenght&)
    Pointer pour Pixel-données
    Laisser PixelStartPointer# = Int(Data& + OfBits&)
    'aus dem gemappten File sur den Bildschirm
    StretchDIBits(%hdc,0,0,BmpWidth&,BmpHeight&,0,0,BmpWidth&,BmpHeight&,PixelStartPointer#,DataPointer#,&DIB_RGB_COLORS,&SRCCOPY)
    StretchDIBits(%hdc,0,0,BmpWidth&,BmpHeight&,0,0,BmpWidth&,BmpHeight&,PixelStartPointer#,DataPointer#,&DIB_RGB_COLORS,&SRCCOPY)
    Déclarer ende%,y%,x%
    Laisser y%=%wintop
    Laisser x%=%winleft
    Usermessages $0115,$0114

    Whilenot ende%

        Waitinput

        Si %umessage = $0115

            StretchDIBits(%hdc,x%,y%,BmpWidth&,BmpHeight&,0,0,BmpWidth&,BmpHeight&,PixelStartPointer#,DataPointer#,&DIB_RGB_COLORS,&SRCCOPY)
            sub y%,10

        elseif %umessage = $0114

            StretchDIBits(%hdc,x%,y%,BmpWidth&,BmpHeight&,0,0,BmpWidth&,BmpHeight&,PixelStartPointer#,DataPointer#,&DIB_RGB_COLORS,&SRCCOPY)
            sub x%,10

        endif

    Wend

d'autre

    'Bereichsvariablen freigeben
    clear OfStruct#
    clear DataPointer#
    clear PixelStartPointer#
    clear BMPHeader#
    Dispose OfStruct#
    Dispose DataPointer#
    Dispose PixelStartPointer#
    Dispose BMPHeader#
    'Handles freigeben
    UnmapViewOfFile(Data&)
    CloseHandle(FileHandle&)
    CloseHandle(MapHandle&)
    Imprimer "kein Bitmap"

endif

Fin
 
14.05.2005  ▲
 




Jörg
Sellmeyer
Repariert...
 
XProfan X4
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
28.05.2020  ▲
 




Michael
W.
sûrement?
Einmal heraus kopiert - [F9] - faute

Den Kommentaren fehlt cela Apostroph
 
Alle Sprachen
System: Windows 8/10, XProfan X4
Programmieren, das spannendste Detektivspiel der Welt.
31.05.2020  ▲
 




Jörg
Sellmeyer
Hm - je dachte, je hätte. Entweder hat qui Forumsoftware cela encore zerschossen, ou bien je hab meinen Kommentar sous une falschen Fil gesetzt.

comment De toute façon - maintenant läufts...
KompilierenMarqueSéparation
'###############################################
'BITMAPS sur Speicherbereich mappen et Montrer
'###############################################
'cela Problem de très grossen Bitmaps, qui avec
'Profan pas geladen volonté, wird avec cela
'umgangen.
'Desweiteren ist es so moeglich un Bitmap
'dans un Memory-Bitmap trop zeichnen. on hat
'alors un Handle !
'###############################################
 $I profalt.inc
DEF OpenFile(3) ! "Kernel32","OpenFile"
DEF CreateFileMapping(6) ! "Kernel32","CreateFileMappingA"
DEF MapViewOfFile(5) ! "Kernel32","MapViewOfFile"
DEF UnmapViewOfFile(1) ! "Kernel32","UnmapViewOfFile"
DEF StretchDIBits(13) ! "GDI32","StretchDIBits"
DEF CloseHandle(1) ! "Kernel32","CloseHandle"
DEF GetWindowLong(2) !"User32", "GetWindowLongA"
DEF SetWindowLong(3) !"User32", "SetWindowLongA"
DEF ScrollWindow(5) "User32","ScrollWindow"
DEF ScrollWindowEx(8) "User32","ScrollWindowEx"
DEF SetScrollRange(5) ! "User32","SetScrollRange"
DEF UpdateWindow(1) ! "User32","UpdateWindow"
DEF GetDC(1) ! "User32","GetDC"
DEF ScrollDC(7) "User32","ScrollDC"
Déclarer OfStruct#
Déclarer DataPointer#
Déclarer PixelStartPointer#
Déclarer BMPHeader#
Déclarer FileHeaderLenght&
Déclarer OfBits&
Déclarer BmpWidth&
Déclarer BmpHeight&
Déclarer Identifyer&
Def &OF_SHARE_DENY_NONE $040
Def &PAGE_READONLY $02
Def &FILE_MAP_READ $04
Def &DIB_RGB_COLORS  0
Def &SRCCOPY $0CC0020
Def &GWL_STYLE  -16
Def &SBM_SETRANGE $0E2
Def &SB_BOTH $03
Déclarer FileName$,FileHandle&,MapHandle&,Data&
'Déclarer OfBits&,BmpWidth&,BmpHeight&
Laisser FileName$ = "farbe.bmp"'Pfad anpassen
'avec einem Bild, deutlich größer comme 8000 x 8000 (215mb), funktioniert es
Faible OfStruct#,136
Faible DataPointer#,4
Faible PixelStartPointer#,4
Faible BMPHeader#,54
Laisser FileHeaderLenght& = 14
FileMode 0
Assign #1,Filename$
OpenRW #1
'Bitmap-En-tête einlesen
BlockRead(#1,BmpHeader#,0,54)
Fermer #1
Laisser Identifyer& = $4D42'Bitmap-Identität
SetTrueColor 1
window %maxx+1,0-640,480
SetWindowLong(%hwnd,&GWL_STYLE,or(GetWindowLong(%hwnd,&GWL_STYLE),$300000))
setwindowpos %hwnd = 0,0-2041,1400
'Ist qui File un gültiges Bitmap ???

Si word(bmpheader#,0) = identifyer&'im Original était ici Hex$(word(bmpheader#,0)) avec identifiyer& verglichen worden, quoi naturellement pas allez

    Laisser OfBits& = long(bmpheader#,10)'ici commencer qui Bilddaten
    Laisser BmpWidth& = long(bmpheader#,18)'Bildbreite
    Laisser BmpHeight& = long(bmpheader#,22)'Bildhoehe
    'avec OpenFile un File-Handle ermitteln
    Laisser Filehandle& = OpenFile(Addr(Filename$),OfStruct#,&OF_SHARE_DENY_NONE)
    'avec CreateFileMapping un Map-Handle ermitteln
    Laisser MapHandle& = CreateFileMapping(FileHandle&,0,&PAGE_READONLY,0,0,0)
    'avec MapViewOfFile un File-Mapping-Object anlegen
    Laisser Data& = MapViewOfFile(MapHandle&,&FILE_MAP_READ,0,0,0)
    'Pointer pour Bitmapdaten
    Laisser DataPointer# = Int(Data& + FileHeaderLenght&)
    'Pointer pour Pixel-données
    Laisser PixelStartPointer# = Int(Data& + OfBits&)
    'aus dem gemappten File sur den Bildschirm
    StretchDIBits(%hdc,0,0,BmpWidth&,BmpHeight&,0,0,BmpWidth&,BmpHeight&,PixelStartPointer#,DataPointer#,&DIB_RGB_COLORS,&SRCCOPY)
    StretchDIBits(%hdc,0,0,BmpWidth&,BmpHeight&,0,0,BmpWidth&,BmpHeight&,PixelStartPointer#,DataPointer#,&DIB_RGB_COLORS,&SRCCOPY)
    Déclarer ende%,y%,x%
    Laisser y%=%wintop
    Laisser x%=%winleft
    Usermessages $0115,$0114

    Whilenot ende%

        Waitinput

        Si %umessage = $0115

            StretchDIBits(%hdc,x%,y%,BmpWidth&,BmpHeight&,0,0,BmpWidth&,BmpHeight&,PixelStartPointer#,DataPointer#,&DIB_RGB_COLORS,&SRCCOPY)
            sub y%,10

        elseif %umessage = $0114

            StretchDIBits(%hdc,x%,y%,BmpWidth&,BmpHeight&,0,0,BmpWidth&,BmpHeight&,PixelStartPointer#,DataPointer#,&DIB_RGB_COLORS,&SRCCOPY)
            sub x%,10

        endif

    Wend

d'autre

    'Bereichsvariablen freigeben
    clear OfStruct#
    clear DataPointer#
    clear PixelStartPointer#
    clear BMPHeader#
    Dispose OfStruct#
    Dispose DataPointer#
    Dispose PixelStartPointer#
    Dispose BMPHeader#
    'Handles freigeben
    UnmapViewOfFile(Data&)
    CloseHandle(FileHandle&)
    CloseHandle(MapHandle&)
    Imprimer "kein Bitmap"

endif

waitinput
Fin
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
31.05.2020  ▲
 



Zum Quelltext


Topictitle, max. 100 marque.
 

Systemprofile:

ne...aucune Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

s'il te plaît s'inscrire um une Beitrag trop verfassen.
 

Options du sujet

Unreaded
abonner
La liste de voeux
Notes
guests
Effacer
Permanent
Done

3.800 Views

Untitledvor 0 min.
N.Art18.11.2020
iF24.09.2020
Stephan Sonneborn22.09.2020
Ernst07.09.2020
plus...

Themeninformationen

cet Thema hat 3 participant:

Jörg Sellmeyer (2x)
Michael W. (1x)
unbekannt (1x)


Admins  |  AGB  |  Applications  |  Auteurs  |  Chat  |  protection des données  |  Télécharger  |  Entrance  |  Aider  |  Merchantportal  |  Empreinte  |  Mart  |  Interfaces  |  SDK  |  Services  |  Jeux  |  cherche  |  Support

un projet aller XProfaner, qui il y a!


Mon XProfan
Privé Nouvelles
Eigenes Ablageforum
Sujets-La liste de voeux
Eigene Posts
Eigene Sujets
Zwischenablage
Annuler
 Deutsch English Français Español Italia
Traductions

protection des données


Wir verwenden Cookies seulement comme Session-Cookies à cause de qui technischen Notwendigkeit et chez uns gibt es aucun Cookies de Drittanbietern.

si du ici sur unsere Webseite klickst ou bien navigierst, stimmst du unserer Erfassung de Informationen dans unseren Cookies sur XProfan.Net trop.

Weitere Informationen trop unseren Cookies et en supplément, comment du qui Kontrolle par-dessus behältst, findest du dans unserer nachfolgenden Datenschutzerklärung.

d'accordDatenschutzerklärung
je voudrais keinen Cookie