Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Bitmaps auf Speicherbereich mappen und anzeigen
###############################################
BITMAPS auf Speicherbereich mappen und anzeigen
###############################################
Das Problem von sehr grossen Bitmaps, die mit
Profan nicht geladen werden, wird damit
umgangen.
Desweiteren ist es so moeglich ein Bitmap
in ein Memory-Bitmap zu zeichnen. Man hat
also ein 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
Declare OfStruct#
Declare DataPointer#
Declare PixelStartPointer#
Declare BMPHeader#
Declare FileHeaderLenght&
Declare OfBits&
Declare BmpWidth&
Declare BmpHeight&
Declare 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
Declare FileName$,FileHandle&,MapHandle&,Data&
Declare OfBits&,BmpWidth&,BmpHeight&
Let FileName$ = BIG.BMP Pfad anpassen
Dim OfStruct#,136
Dim DataPointer#,4
Dim PixelStartPointer#,4
Dim BMPHeader#,54
Let FileHeaderLenght& = 14
FileMode 0
Assign #1,Filename$
OpenRW #1
Bitmap-Header einlesen
BlockRead(#1,BmpHeader#,0,54)
Close #1
Let 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 der File ein gültiges Bitmap ???
If Hex$(word(bmpheader#,0)) = identifyer&
Let OfBits& = long(bmpheader#,10)Hier beginnen die Bilddaten
Let BmpWidth& = long(bmpheader#,18)Bildbreite
Let BmpHeight& = long(bmpheader#,22)Bildhoehe
Mit OpenFile ein File-Handle ermitteln
Let Filehandle& = OpenFile(Addr(Filename$),OfStruct#,&OF_SHARE_DENY_NONE)
Mit CreateFileMapping ein Map-Handle ermitteln
Let MapHandle& = CreateFileMapping(FileHandle&,0,&PAGE_READONLY,0,0,0)
Mit MapViewOfFile ein File-Mapping-Object anlegen
Let Data& = MapViewOfFile(MapHandle&,&FILE_MAP_READ,0,0,0)
Pointer fuer Bitmapdaten
Let DataPointer# = Int(Data& + FileHeaderLenght&)
Pointer fuer Pixel-Daten
Let PixelStartPointer# = Int(Data& + OfBits&)
aus dem gemappten File auf 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)
Declare ende%,y%,x%
Let y%=%wintop
Let x%=%winleft
Usermessages $0115,$0114
Whilenot ende%
Waitinput
If %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
else
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&)
Print kein Bitmap
/../function-references/XProfan/endif/'>endif
Fin