GDI and DIBS

BlitzMax Forums/BlitzMax Programming/GDI and DIBS

TomToad

(Posted 2008) [#1]

I'm trying to program some GDI functions. Been doing just fine so far until I got to the point of trying to render DIBs (Device Independent Bitmaps).
Here is the code so far. (sorry, very little is commented)

SuperStrict

Const OBJ_PEN:Int = 1
Const OBJ_BRUSH:Int = 2
Const OBJ_PAL:Int = 5
Const OBJ_FONT:Int = 6
Const OBJ_BITMAP:Int = 7
Const OBJ_EXTPEN:Int = 11
Const OBJ_REGION:Int = 8
Const OBJ_DC:Int = 3
Const OBJ_MEMDC:Int = 10
Const OBJ_METAFILE:Int = 9
Const OBJ_METADC:Int = 4
Const OBJ_ENHMETAFILE:Int = 13
Const OBJ_ENHMETADC:Int = 12

Const PS_GEOMETRIC:Int = 	65536
Const PS_COSMETIC:Int =	0
Const PS_ALTERNATE:Int = 	8
Const PS_SOLID:Int = 	0
Const PS_DASH:Int =	1
Const PS_DOT:Int =	2
Const PS_DASHDOT:Int =	3
Const PS_DASHDOTDOT:Int =	4
Const PS_NULL:Int =	5
Const PS_USERSTYLE:Int =	7
Const PS_INSIDEFRAME:Int =	6
Const PS_ENDCAP_ROUND:Int =	0
Const PS_ENDCAP_SQUARE:Int =	256
Const PS_ENDCAP_FLAT:Int =	512
Const PS_JOIN_BEVEL:Int =	4096
Const PS_JOIN_MITER:Int =	8192
Const PS_JOIN_ROUND:Int =	0
Const PS_STYLE_MASK:Int =	15
Const PS_ENDCAP_MASK:Int =	3840
Const PS_TYPE_MASK:Int =	983040


Extern "win32"
	Function ExtCreatePen:Int(style:Int, width:Int, logbrush:Byte Ptr, stylecount:Int, stylePtr:Byte Ptr)="ExtCreatePen@20"
	Function ReleaseDC( hwnd:Int, hdc:Int )
	Function GetCurrentObject( hdc:Int, objectType:Int )
	Function MoveToEx( hdc:Int, x:Int, y:Int, point:Int )
	Function LineTo( hdc:Int, x:Int, y:Int )
	Function Rectangle( hdc:Int, x1:Int, y1:Int, x2:Int, y2:Int)
	Function SetPixel( hdc:Int, x:Int, y:Int, Color:Int)
	Function GetCursorPos( pPoint:Byte Ptr )
	Function SetROP2( hdc:Int, mode:Int )
	Function SetDCBrushColor(hdc:Int, Color:Int)
	Function SetDCPenColor(hdc:Int, Color:Int)
	Function DeleteObject(Obj:Int)
	Function CreatePen(Style:Int, Width:Int, Color:Int)
	Function CreateBitmap(Width:Int,Height:Int,Planes:Int,bpp:Int,pixels:Byte Ptr)
EndExtern

Type TBitMap
	Field BitMap:Int
	Field Pixmap:TPixmap
	
	Function Create:TBitMap(hdc:Int, Pixmap:TPixmap)
		Local BitMap:TBitMap = New TBitMap
		Local bpp:Int = GetDeviceCaps(hdc, BITSPIXEL)
		DebugLog bpp
		Select bpp
			Case 24
				BitMap.Pixmap = ConvertPixmap(Pixmap,PF_RGB888)
			Case 32
				BitMap.Pixmap = ConvertPixmap(Pixmap,PF_RGBA8888)
			Default
				RuntimeError("Pixmap format not implemented")
		End Select
		BitMap.BitMap = CreateBitMap(bitmap.Pixmap.Width,Bitmap.Pixmap.Height,bpp/8,bpp,Bitmap.Pixmap.Pixels)
		If Bitmap.Bitmap = Null Then RuntimeError("Couldn't create the bitmap")
		Return BitMap
	End Function
	
	Method Delete()
		DeleteObject(BitMap)
	End Method
End Type

Global Window:TGadget = CreateWindow("Test GDI",100,100,640,480,Null,WINDOW_TITLEBAR|WINDOW_CLIENTCOORDS)
Global Panel:TGadget = CreatePanel(0,0,640,480,Window,PANEL_ACTIVE)
SetGadgetColor Panel,128,128,128
Global Gdi:TGdi = TGdi.Create(Panel)
Gdi.SetPenAttributes(255,0,0)
Local filename:String = RequestFile("Bitmap")
Global Pixmap:TPixmap = LoadPixmap(Filename)
Global Bitmap:TBitmap = gdi.BitmapFromPixmap(Pixmap)

Repeat
	WaitEvent()
	Select EventID()
		Case EVENT_WINDOWCLOSE
			End
		Case EVENT_MOUSEMOVE
			DrawCursor(EventX(),EventY())
	End Select
Forever

Function DrawCursor(x:Int,y:Int)
	Gdi.Clear()
	Gdi.Blit(BitMap,x,y)
End Function

Type TGdi
	Field hWnd:Int 'handle of the panel gadget
	Field GdiPanel:TGadget
	Field ClearBrush:Int = CreateSolidBrush($FFFFFF)	
	Field Pen:Int = CreatePen(PS_SOLID,1,0)
	
	Method Delete()
		DeleteObject(Pen)
		DeleteObject(ClearBrush)
	End Method
		
	Function Create:TGdi(Panel:TGadget)
		If Panel
			Local Gdi:TGdi = New TGdi
			Gdi.GdiPanel = Panel
			Gdi.hwnd = QueryGadget(Panel,QUERY_HWND)
			Return Gdi
		Else
			RuntimeError("NULL Gadget pointer")
		End If
	End Function
	
	Method BitmapFromPixmap:TBitmap(Pixmap:TPixmap)
		Local hdc:Int = GetDC(hwnd)
		Local Bitmap:TBitmap = TBitMap.Create(hdc,Pixmap)
		releasedc(hwnd,hdc)
		Return BitMap
	End Method
	
	Method Line(x1:Int, y1:Int, x2:Int, y2:Int)
		Local hdc:Int = GetDC(hwnd)
		selectObject(hdc,Pen)
		MoveToEx(hdc,x1,y1,0)
		LineTo(hdc,x2,y2)
		ReleaseDC(hwnd,hdc)
	End Method
	
	Method Clear(r:Int=-1,g:Int=-1,b:Int=-1)
		
		Local RectArray:Int[4]
		RectArray[0] = 0
		RectArray[1] = 0
		RectArray[2] = GadgetWidth(GdiPanel)
		RectArray[3] = GadgetHeight(GdiPanel)
		Local hdc:Int = GetDC(hwnd)
		FillRect(hdc,RectArray,ClearBrush)
		ReleaseDC(hwnd,hdc)
	End Method
		
	Method SetPenAttributes(Red:Int,Green:Int,Blue:Int,Width:Int = 1, Style:Int = PS_SOLID)	
		DeleteObject(Pen)	
		Pen = CreatePen(Style,Width,Blue Shl 16 + green Shl 8 + red)	
	End Method
	
	Method Blit(BitMap:TBitMap,dx:Int,dy:Int,dw:Int=-1,dh:Int=-1,sx:Int=0,sy:Int=0)
		Local hdc:Int = GetDC(hwnd)
		If dw < 0
			dw = BitMap.PixMap.Width
			dh = BitMap.PixMap.Height
		End If
		Local shdc:Int = CreateCompatibleDC(hdc)
		Selectobject(shdc,Bitmap.Bitmap)
		
		BitBlt(hdc,dx,dy,dw,dh,shdc,sx,sy,ROP_SRCCOPY)
		releaseDC(hwnd,hdc)
	End Method	
End Type

The problem is in the TBitmap.Create() function. I send it a pixmap and try to create a bitmap from it. But the CreateBitmap() function always returns a NULL.

Here is the MSDN entry for CreateBitmap()
http://msdn2.microsoft.com/en-us/library/ms532305(VS.85).aspx

Edit: fixed a bug in my code, but itwasn't related to the problem at hand.

TomToad

(Posted 2008) [#2]

Well, I've managed to solve the problem by creating a new DIB and copying the pixel data one pixel at a time. However, i would like to find a way to create a DIB using the Pixmap directly so that I can alter a pixmap with GDI commands.

SuperStrict

Const OBJ_PEN:Int = 1
Const OBJ_BRUSH:Int = 2
Const OBJ_PAL:Int = 5
Const OBJ_FONT:Int = 6
Const OBJ_BITMAP:Int = 7
Const OBJ_EXTPEN:Int = 11
Const OBJ_REGION:Int = 8
Const OBJ_DC:Int = 3
Const OBJ_MEMDC:Int = 10
Const OBJ_METAFILE:Int = 9
Const OBJ_METADC:Int = 4
Const OBJ_ENHMETAFILE:Int = 13
Const OBJ_ENHMETADC:Int = 12

Const PS_GEOMETRIC:Int = 	65536
Const PS_COSMETIC:Int =	0
Const PS_ALTERNATE:Int = 	8
Const PS_SOLID:Int = 	0
Const PS_DASH:Int =	1
Const PS_DOT:Int =	2
Const PS_DASHDOT:Int =	3
Const PS_DASHDOTDOT:Int =	4
Const PS_NULL:Int =	5
Const PS_USERSTYLE:Int =	7
Const PS_INSIDEFRAME:Int =	6
Const PS_ENDCAP_ROUND:Int =	0
Const PS_ENDCAP_SQUARE:Int =	256
Const PS_ENDCAP_FLAT:Int =	512
Const PS_JOIN_BEVEL:Int =	4096
Const PS_JOIN_MITER:Int =	8192
Const PS_JOIN_ROUND:Int =	0
Const PS_STYLE_MASK:Int =	15
Const PS_ENDCAP_MASK:Int =	3840
Const PS_TYPE_MASK:Int =	983040


Extern "win32"
	Function ExtCreatePen:Int(style:Int, width:Int, logbrush:Byte Ptr, stylecount:Int, stylePtr:Byte Ptr)="ExtCreatePen@20"
	Function ReleaseDC( hwnd:Int, hdc:Int )
	Function GetCurrentObject( hdc:Int, objectType:Int )
	Function MoveToEx( hdc:Int, x:Int, y:Int, point:Int )
	Function LineTo( hdc:Int, x:Int, y:Int )
	Function Rectangle( hdc:Int, x1:Int, y1:Int, x2:Int, y2:Int)
	Function SetPixel( hdc:Int, x:Int, y:Int, Color:Int)
	Function GetCursorPos( pPoint:Byte Ptr )
	Function SetROP2( hdc:Int, mode:Int )
	Function SetDCBrushColor(hdc:Int, Color:Int)
	Function SetDCPenColor(hdc:Int, Color:Int)
	Function DeleteObject(Obj:Int)
	Function CreatePen(Style:Int, Width:Int, Color:Int)
	Function CreateBitmap(Width:Int,Height:Int,Planes:Int,bpp:Int,pixels:Byte Ptr)
EndExtern

Type TBitMap
	Field BitMap:Int
	Field Width:Int
	Field Height:Int
		
	Function Create:TBitMap(hdc:Int, Pixmap:TPixmap)
		Local BitMap:TBitMap = New TBitMap
		Bitmap.Width = Pixmap.Width
		Bitmap.Height = Pixmap.Height
		Local bpp:Int = GetDeviceCaps(hdc, BITSPIXEL)
		BitMap.BitMap = CreateCompatibleBitmap(hdc,Bitmap.Width,Bitmap.Height)
		If Bitmap.Bitmap = Null Then RuntimeError("Couldn't create the bitmap")
		Local CDC:Int = CreateCompatibleDC(hdc)
		Local OldBitmap:Int = SelectObject(CDC,Bitmap.Bitmap)
		For Local x:Int = 0 To Bitmap.Width - 1
			For Local y:Int = 0 To Bitmap.Height - 1
				Local Pixel:Int = ReadPixel(Pixmap,x,y)
				SetPixel(CDC,x,y,(Pixel & $FF) Shl 16 + (Pixel & $FF00) + (Pixel & $FF0000) Shr 16)
			Next
		Next
		SelectObject(CDC,OldBitmap)
		deleteDC(CDC)
		
		Return BitMap
	End Function
	
	Method Delete()
		DeleteObject(BitMap)
	End Method
End Type

Global Window:TGadget = CreateWindow("Test GDI",100,100,640,480,Null,WINDOW_TITLEBAR|WINDOW_CLIENTCOORDS)
Global Panel:TGadget = CreatePanel(0,0,640,480,Window,PANEL_ACTIVE)
SetGadgetColor Panel,128,128,128
Global Gdi:TGdi = TGdi.Create(Panel)
Gdi.SetPenAttributes(255,0,0)
Local filename:String = RequestFile("Bitmap")
Global Pixmap:TPixmap = LoadPixmap(Filename)
Global Bitmap:TBitmap = gdi.BitmapFromPixmap(Pixmap)

Repeat
	WaitEvent()
	Select EventID()
		Case EVENT_WINDOWCLOSE
			End
		Case EVENT_MOUSEMOVE
			DrawCursor(EventX(),EventY())
	End Select
Forever

Function DrawCursor(x:Int,y:Int)
	Gdi.Clear()
	Gdi.Blit(BitMap,x,y)
End Function

Type TGdi
	Field hWnd:Int 'handle of the panel gadget
	Field GdiPanel:TGadget
	Field ClearBrush:Int = CreateSolidBrush($FFFFFF)	
	Field Pen:Int = CreatePen(PS_SOLID,1,0)
	
	Method Delete()
		DeleteObject(Pen)
		DeleteObject(ClearBrush)
	End Method
		
	Function Create:TGdi(Panel:TGadget)
		If Panel
			Local Gdi:TGdi = New TGdi
			Gdi.GdiPanel = Panel
			Gdi.hwnd = QueryGadget(Panel,QUERY_HWND)
			Return Gdi
		Else
			RuntimeError("NULL Gadget pointer")
		End If
	End Function
	
	Method BitmapFromPixmap:TBitmap(Pixmap:TPixmap)
		Local hdc:Int = GetDC(hwnd)
		Local Bitmap:TBitmap = TBitMap.Create(hdc,Pixmap)
		releasedc(hwnd,hdc)
		Return BitMap
	End Method
	
	Method Line(x1:Int, y1:Int, x2:Int, y2:Int)
		Local hdc:Int = GetDC(hwnd)
		Local OldPen:Int = selectObject(hdc,Pen)
		MoveToEx(hdc,x1,y1,0)
		LineTo(hdc,x2,y2)
		SelectObject(hdc,OldPen)
		ReleaseDC(hwnd,hdc)
	End Method
	
	Method Clear(r:Int=-1,g:Int=-1,b:Int=-1)
		
		Local RectArray:Int[4]
		RectArray[0] = 0
		RectArray[1] = 0
		RectArray[2] = GadgetWidth(GdiPanel)
		RectArray[3] = GadgetHeight(GdiPanel)
		Local hdc:Int = GetDC(hwnd)
		FillRect(hdc,RectArray,ClearBrush)
		ReleaseDC(hwnd,hdc)
	End Method
		
	Method SetPenAttributes(Red:Int,Green:Int,Blue:Int,Width:Int = 1, Style:Int = PS_SOLID)	
		DeleteObject(Pen)	
		Pen = CreatePen(Style,Width,Blue Shl 16 + green Shl 8 + red)	
	End Method
	
	Method Blit(BitMap:TBitMap,dx:Int,dy:Int,dw:Int=-1,dh:Int=-1,sx:Int=0,sy:Int=0)
		Local hdc:Int = GetDC(hwnd)
		If dw < 0
			dw = BitMap.Width
			dh = BitMap.Height
		End If
		Local shdc:Int = CreateCompatibleDC(hdc)
		Local OldBitMap:Int = Selectobject(shdc,Bitmap.Bitmap)
		
		BitBlt(hdc,dx,dy,dw,dh,shdc,sx,sy,ROP_SRCCOPY)
		SelectObject(shdc,OldBitMap)
		DeleteDC(shdc)
		releaseDC(hwnd,hdc)
	End Method	
End Type

plash

(Posted 2008) [#3]

Do a search on the forums, I think theres already a fairly developed GDI module.