'****************** Demo: DIB zur Laufzeit erzeugen
'****************** Profan² 7.0
'****************** © by TCS (Uwe "Pascal" Niemeier) 02'2002

window 30,30-200,200
settruecolor 1'---Farbwerte als 32-Bit interpretieren
declare bmp#,Pic#,Static&,Pic&

def CreateDIBitmap(6) !"GDI32","CreateDIBitmap"
def FillMemory(3) !"KERNEL32","RtlFillMemory"

'---BITMAPINFOHEADER-Struktur, erweitert um 256*4 Bytes für ColorTable
struct bmpHEADER = Size&,Width&,Height&,Planes%,BitCount%,nc&,SizeImage&,nc&,nc&,nc&,nc&,RGB#(256)
dim bmp#,bmpHEADER
clear bmp#
bmp#.Size&=40'---------Größe von BITMAPINFOHEADER (ohne ColorTable)
bmp#.Width&=32
bmp#.Height&=32
bmp#.Planes%=1
bmp#.BitCount%=8'------8-Bit-Farben (=256)
bmp#.SizeImage&=1024'--Breite*Höhe

'--Reihenfolge von RGBQUAD-Member: Blau,Grün,Rot,Reserved (siehe winhlp32)
long bmp#,40=rgb(255,000,000)'---Blau
long bmp#,44=rgb(000,255,000)'---Grün
long bmp#,48=rgb(000,000,255)'---Rot
long bmp#,52=rgb(128,128,128)'---Grau

dim Pic#,1024'--------------Bereich für Bildinformationen (Pixel) bereitstellen
clear Pic#

FillMemory(Pic#+768,256,0)'--Steifen mit den ersten 4 Einträgen des ColorTables
FillMemory(Pic#+512,256,1)
FillMemory(Pic#+256,256,2)
FillMemory(Pic#+000,256,3)

Pic&=CreateDIBitmap(%hdc,bmp#,4,Pic#,bmp#,0)'------Neue DIB erzeugen

Static&=control("static","",$5000000e,50,50,0,0,%hwnd,1,%hinstance)
sendmessage(Static&,370,0,Pic&)

dispose bmp#
dispose Pic#
waitkey