autodefine "off"

$include "windowssdk.inc"

TYPE BITMAP
	INT bmType
	INT bmWidth
	INT bmHeight
	INT bmWidthCHARs
	WORD bmPlanes
	WORD bmBitsPixel
	INT bmBits
ENDTYPE
	BITMAP bmp

TYPE BITMAPINFOHEADER
	INT biSize
	INT biWidth
	INT biHeight
	WORD biPlanes
	WORD biBitCount
	INT biCompression
	INT biSizeImage
	INT biXPelsPerMeter
	INT biYPelsPerMeter
	INT biClrUsed
	INT biClrImportant
ENDTYPE
	BITMAPINFOHEADER info

TYPE BITMAPFILEHEADER,1
	WORD bfType
	INT bfSize
	WORD bfReserved1
	WORD bfReserved2
	INT bfOffBits
ENDTYPE
	BITMAPFILEHEADER fileheader

DECLARE SaveBitmap(fileName:STRING,win:WINDOW,l:INT,t:INT,w:INT,h:INT)
DECLARE CreateInfoStructure(win:WINDOW,hBitmap:INT,info:BITMAPINFOHEADER),INT

WINDOW w
INT bml,bmt,bmw,bmh
ISTRING fileName[260]

OPENWINDOW w,0,0,360,180,@NOCAPTION|@BORDER,0,"Union Jack",&flag

'Draw blue background
	SETWINDOWCOLOR w,RGB(0,33,115)
'Draw white diagonals
	SETLINESTYLE w,@LSSOLID,36
	LINE w,0,0,360,180,RGB(255,255,255) 'top left to bottom right
	LINE w,360,0,0,180,RGB(255,255,255) 'top right to bottom left
'Draw four red diagonals
	SETLINESTYLE w,@LSSOLID,12
'Top left
MOVE w,0,6
	LINETO w,186,100,RGB(198,16,24)
'Bottom right
MOVE w,210,100
	LINETO w,360,174,RGB(198,16,24)
'Top right
MOVE w,188,80
	LINETO w,348,0,RGB(198,16,24)
'Bottom left
MOVE w,0,186
	LINETO w,192,90,RGB(198,16,24)
'Draw white cross
SETLINESTYLE w,@LSSOLID,1
	RECT w,150,0,60,180,RGB(255,255,255),RGB(255,255,255) 'white down
	RECT w,0,60,360,60,RGB(255,255,255),RGB(255,255,255) 'white across
'Draw red cross
SETLINESTYLE w,@LSSOLID,1
	RECT w,162,0,36,180,RGB(198,16,24),RGB(198,16,24) 'red down
	RECT w,0,72,360,36,RGB(198,16,24),RGB(198,16,24) 'red across

WAITUNTIL IsWindowClosed(w)
	END

SUB flag(),INT
	SELECT @MESSAGE
CASE @IDCREATE
	CENTERWINDOW w
CASE @IDKEYDOWN
	CLOSEWINDOW w
CASE @IDLBUTTONDN
	CLOSEWINDOW w
CASE @IDRBUTTONUP
	fileName=FILEREQUEST("Save Bitmap",w,0,"Bitmap Files (*.bmp)|*.bmp||","bmp")
IF LEN(fileName)
	GETCLIENTSIZE w,bml,bmt,bmw,bmh
	SaveBitmap(fileName,w,bml,bmt,bmw,bmh)
ENDIF
CASE @IDCLOSEWINDOW
	CLOSEWINDOW w
ENDSELECT
RETURN 0
ENDSUB

SUB SaveBitmap(fileName:STRING,win:WINDOW,l:INT,t:INT,w:INT,h:INT)
	INT hdcWin,hdcComp,hBitmap,hBitmapold,quadsize
	MEMORY lpbits,lpbminfo
	BFILE fileb=0
	ZeroMemory(info,LEN(info))
	ZeroMemory(fileheader,LEN(fileheader))
	hdcWin=GETHDC(win)
	hdcComp=CreateCompatibleDC(hdcWin)
IF hdcComp = 0
	MESSAGEBOX win,"Couldn't create DC","Error"
	RELEASEHDC win,hdcWin
	RETURN
ENDIF
	hBitmap=CreateCompatibleBitmap(hdcWin,w,h)
IF hBitmap=0
	MESSAGEBOX win,"Couldn't create Bitmap","Error"
	RELEASEHDC win,hdcWin
ENDIF
	hBitmapold=SelectObject(hdcComp,hBitmap)
	BitBlt(hdcComp,0,0,w,h,hdcWin,l,t,0x00CC0020)
	SelectObject(hdcComp,hBitmapold)
	DeleteDC(hdcComp)
'At this point hBitmap contains a valid bitmap handle. Fill in the BITMAPINFOHEADER and compute the color data
	quadsize=CreateInfoStructure(win,hBitmap,info)
'Allocate memory and get the 'bits' of the bitmap
	ALLOCMEM lpbits,1,info.biSizeImage
	ALLOCMEM lpbminfo,1,LEN(info)+quadsize
	WRITEMEM lpbminfo,1,info
	GetDIBits(hdcWin,hBitmap,0,info.biHeight,lpbits,lpbminfo,0)
'Open a binary file and write the header, color data and bitmap bits
IF(OPENFILE(fileb,fileName,"W")=0)
	fileheader.bfType=0x4D42
	fileheader.bfSize=LEN(fileheader)+info.biSize+quadsize+info.biSizeImage
	fileheader.bfOffBits=LEN(fileheader)+info.biSize+quadsize
	WRITE fileb,fileheader
	WRITE fileb,lpbminfo
	WRITE fileb,lpbits
	CLOSEFILE fileb
ENDIF
	FREEMEM lpbminfo
	FREEMEM lpbits
	RELEASEHDC win,hdcWin
	DeleteObject(hBitmap)
ENDSUB

SUB CreateInfoStructure(win:WINDOW,hBitmap:INT,info:BITMAPINFOHEADER)
	MEMORY mem
	WORD cClrBits
	INT quadsize
	quadsize=0
	ALLOCMEM mem,1,LEN(bmp)
	GetObjectA(hBitmap,LEN(bmp),mem)
	READMEM mem,1,bmp
	FREEMEM mem
	cClrBits=bmp.bmPlanes*bmp.bmBitsPixel
IF (cClrBits=1)
	cClrBits=1
ELSE
IF (cClrBits<=4)
	cClrBits=4
ELSE
IF (cClrBits<=8)
	cClrBits=8
ELSE
IF (cClrBits<=16)
	cClrBits=16
ELSE
IF (cClrBits<=24)
	cClrBits=24
ELSE
	cClrBits=32
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
    info.biSize=LEN(info)
    info.biWidth=bmp.bmWidth
    info.biHeight=bmp.bmHeight
    info.biPlanes=bmp.bmPlanes
    info.biBitCount=bmp.bmBitsPixel
IF (cClrBits<24)
	info.biClrUsed=2^cClrBits
ENDIF
	info.biCompression=0
	info.biSizeImage=(info.biWidth+7.0)/8.0*info.biHeight*cClrBits
IF (cClrBits<24)
	quadsize=4*(2^cClrBits)
ENDIF
RETURN quadsize
ENDSUB