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)
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.
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.