how can i copy to or get a bitmap from/to the canvas? i try that for a long time now and can not get it to work.
i do not want to use image.
Code: Select all
EnableExplicit
#NrVideoPages = 2
#FullScr = 0
#CustScr = 1
Global.i Dim grBitmap(2) ; HBITMAP
Global.i maxX, maxY, bitPixel, WinMaxY, WinMaxX, windowWidth, windowHeight, screenWidth, screenHeight
Global.i windowsize, customWidth, customHeight, grEnabled = #False, maxColors, dx, dy
Global.i grHandle, grWindow, grMemory, hdcScreen, hdcScreenCompat, grTemp ; HDC
Global.i old_Palette, old_Pen, old_Brush, old_Bitmap, old_Font ; HGDIOBJ
Global.i winNum, Event, canvasnum, visualPage=1, activePage=1, canvasimage, old_hbmp
Global.RECT grRect
Procedure Startup_SetBitmaps()
Protected *pbmi.BITMAPINFO
Protected *pbits
Protected i.i, dx_bor, dy_bor, dx, dy
*pbmi = AllocateMemory(SizeOf(BITMAPINFOHEADER) * SizeOf(RGBQUAD))
With *pbmi\bmiHeader
\biSize = SizeOf(BITMAPINFOHEADER)
\biWidth = maxX+1
\biHeight= maxY+1
\biPlanes= 1
\biBitCount = bitPixel
\biClrUsed = 0
\biCompression = #BI_RGB
\biSizeImage = 0
\biClrImportant = 0
EndWith
For i = 0 To #NrVideoPages-1
grBitmap(i) = CreateDIBSection_(grWindow, *pbmi, #DIB_RGB_COLORS, *pbits, #Null, 0)
Next
FreeMemory(*pbmi)
EndProcedure
Procedure.i Startup(custWidth.i=400, custHeight.i=400, bitWidth.i=400, bitHeight.i=400, winsize.i = #CustScr)
Protected.RECT grRect
bitPixel = (GetDeviceCaps_(GetDC_(GetDesktopWindow_()), #BITSPIXEL))
maxColors = 1 << bitPixel
screenWidth = GetSystemMetrics_(#SM_CXSCREEN)
screenHeight = GetSystemMetrics_(#SM_CYSCREEN)
If winsize = #FullScr
dx = screenWidth
dy = screenHeight
windowWidth = dx
windowHeight= dy
Else
; dx_bor = 2 * GetSystemMetrics_(#SM_CXFIXEDFRAME)
; dy_bor = 2 * GetSystemMetrics_(#SM_CYFIXEDFRAME) + GetSystemMetrics_(#SM_CYCAPTION)
; dx=custWidth
; dy=custHeight
; windowWidth = dx + dx_bor
; windowHeight= dy + dy_bor
windowWidth = custWidth
windowHeight= custHeight
EndIf
maxX = bitWidth
maxY = bitHeight
winNum = OpenWindow(#PB_Any, 0, 0, windowWidth, windowHeight, "PureBasic Window", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_TitleBar | #PB_Window_SizeGadget)
If winNum = 0: ProcedureReturn -1 : EndIf
canvasnum = CanvasGadget(#PB_Any, 0, 0, bitWidth, bitHeight, #PB_Canvas_Border | #PB_Canvas_Keyboard)
;SetWindowCallback(@WinCallback())
grHandle = WindowID(winNum)
hdcScreen = CreateDC_("DISPLAY", "", "", #Null)
hdcScreenCompat = CreateCompatibleDC_(hdcScreen)
GetClientRect_(grHandle,grRect)
WinMaxY = grRect\right
WinMaxX = grRect\bottom
grWindow = GetDC_(grHandle)
grMemory = CreateCompatibleDC_(#Null)
grTemp = CreateCompatibleDC_(#Null)
old_Palette= GetCurrentObject_(grWindow, #OBJ_PAL)
old_Pen = GetCurrentObject_(grWindow, #OBJ_PEN)
old_Brush = GetCurrentObject_(grWindow, #OBJ_BRUSH)
old_Font = GetCurrentObject_(grWindow, #OBJ_FONT)
old_Bitmap = GetCurrentObject_(grMemory, #OBJ_BITMAP)
Startup_SetBitmaps()
SetTextColor_(grMemory, $FFFF)
RoundRect_(grMemory,100,100,200,200,30,30)
TextOut_(grMemory,200,200,"Hello World",11)
EndProcedure
Startup(400,400, 1200, 800)
Repeat
Event = WaitWindowEvent()
If Event = #PB_Event_Gadget
Select EventGadget()
Case canvasnum
If StartDrawing(CanvasOutput(canvasnum))
old_hbmp = SelectObject_(grMemory, grBitmap(visualPage-1))
;SetGadgetAttribute(canvasnum, #PB_Canvas_Image, grMemory)
canvasimage = GetGadgetAttribute(canvasnum, #PB_Canvas_Image)
SelectObject_(canvasimage, grMemory)
SelectObject_(grMemory,old_hbmp)
StopDrawing()
EndIf
EndSelect
EndIf
Until Event = #PB_Event_CloseWindow