GDI and DIBS

BlitzMax Forums/BlitzMax Programming/GDI and DIBS

The Forum Archive is locked. These are the original blitzbasic.com forums, kept so their posts can still be read and searched. No new topics, replies or edits can be made here. To join the conversation, head over to the Blitz3D+ forums.

TomToad
 #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
 #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
 #3
Do a search on the forums, I think theres already a fairly developed GDI module.