PureBasic Forums - English

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

Code: Select all

Procedure CopyHdcToClip()
Protected BitMapHandle.i, MemNeeded.i, MemPtr.i, BitMapWidth.i, BitMapHeight.i
Protected ImageHdc.i, hBmp.i
Protected CanvasDc.i
#CanvasImage = 1

Structure myBITMAPINFO
  bmiHeader.BITMAPINFOHEADER
  bmiColors.RGBQUAD[1]
EndStructure

Protected BitMapInfo.myBITMAPINFO

CanvasDc = GetDC_(GadgetID(canvasnum))
BitMapHandle = GetCurrentObject_(CanvasDc, #OBJ_BITMAP)
BitMapInfo\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
GetDIBits_(CanvasDc, BitMapHandle, 0, 0 , 0, @BitMapInfo, #DIB_RGB_COLORS)
BitMapWidth = BitMapInfo\bmiHeader\biWidth 
BitMapHeight = Abs(BitMapInfo\bmiHeader\biHeight)
MemNeeded =  BitMapWidth * BitMapHeight * 4
MemPtr = AllocateMemory(MemNeeded)
BitMapInfo\bmiHeader\biHeight = BitMapHeight  ;minus bitmapheight would make it top down
BitMapInfo\bmiHeader\biCompression = #BI_RGB
GetDIBits_(CanvasDc, BitMapHandle, 0, BitMapHeight, MemPtr, @BitMapInfo, #DIB_RGB_COLORS)
If CreateImage(#CanvasImage, BitMapInfo\bmiHeader\biWidth, BitMapInfo\bmiHeader\biHeight) 
  ImageHdc = StartDrawing(ImageOutput(#CanvasImage))  
  hBmp = GetCurrentObject_(ImageHdc, #OBJ_BITMAP)
  SetDIBits_(ImageHdc, hBmp, 0, BitMapInfo\bmiHeader\biHeight, MemPtr, @BitMapInfo, #DIB_RGB_COLORS)
  StopDrawing()
  SetClipboardImage(#CanvasImage)
  FreeImage(#CanvasImage)
EndIf
FreeMemory(MemPtr)
ReleaseDC_(GadgetID(canvasnum), CanvasDc)
EndProcedure

Code: Select all

OpenWindow(0, 0, 0, 800, 500, "", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered|#PB_Window_Invisible)
CanvasGadget(0, 10, 10, 780, 480)
HideWindow(0, #False)

Repeat  
  event = WaitWindowEvent() 
  Select event
    Case #PB_Event_Gadget
      Select EventGadget()
          
        Case 0
          hdc = StartDrawing(CanvasOutput(0))
            SetDCPenColor_(hdc, RGB(Random(255), Random(255), Random(255)))
            SelectObject_(hdc, GetStockObject_(#DC_PEN))
            SetDCBrushColor_(hdc, RGB(Random(255), Random(255), Random(255)))
            SelectObject_(hdc, GetStockObject_(#DC_BRUSH))
            RoundRect_(hdc, Random(780), Random(480), Random(780), Random(480), 32, 32)
          StopDrawing()
          
      EndSelect
  EndSelect
Until event = #PB_Event_CloseWindow