PureBoard

Code: Alles auswählen

;CAPTURE MODULE
;------------------
;by Mijikai
;Windows only!
;------------------

DeclareModule CAPTURE
  Declare.i Target(Handle.i,*Area.RECT)
  Declare.i Frame(*Capture)
  Declare.l Pixel(*Capture,X.i,Y.i)
  Declare.i Height(*Capture)
  Declare.i Width(*Capture)
  Declare.i Free(*Capture)
EndDeclareModule

Module CAPTURE
  
  Structure CAPTURE_STRUCT
    Handle.i
    SDC.i
    TDC.i
    DIB.i
    Bits.i
    BMI.BITMAPINFO
    Area.RECT
  EndStructure
  
  #CAPTUREBLT = $40000000
  
  Procedure.i Target(Handle.i,*Area.RECT)
    Protected *Capture.CAPTURE_STRUCT
    If *Area 
      *Capture = AllocateMemory(SizeOf(CAPTURE_STRUCT))
      If *Capture
        With *Capture
          \Handle = Handle
          \SDC = GetDC_(\Handle)
          If \SDC
            \TDC = CreateCompatibleDC_(\SDC)
            If \TDC
              CopyMemory(*Area,@\Area,SizeOf(RECT))
              \BMI\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
              \BMI\bmiHeader\biWidth = \Area\right
              \BMI\bmiHeader\biHeight = - \Area\bottom
              \BMI\bmiHeader\biPlanes = 1
              \BMI\bmiHeader\biBitCount = 32
              \BMI\bmiHeader\biCompression  = #BI_RGB
              \DIB = CreateDIBSection_(\TDC,@\BMI,#DIB_RGB_COLORS,@\Bits,#Null,#Null)
              If \DIB
                If SelectObject_(\TDC,\DIB)
                  ProcedureReturn *Capture
                EndIf
                DeleteObject_(\DIB)
              EndIf
              DeleteDC_(\TDC)
            EndIf
            ReleaseDC_(\Handle,\SDC)
          EndIf
        EndWith
        FreeMemory(*Capture)
      EndIf
    EndIf
  EndProcedure
  
  Procedure.i Frame(*Capture.CAPTURE_STRUCT)
    With *Capture
      ProcedureReturn BitBlt_(\TDC,#Null,#Null,\Area\right,\Area\bottom,\SDC,\Area\left,\Area\top,#SRCCOPY|#CAPTUREBLT)  
    EndWith    
  EndProcedure
  
  Procedure.i Width(*Capture.CAPTURE_STRUCT)
    ProcedureReturn *Capture\Area\right - 1
  EndProcedure
  
  Procedure.i Height(*Capture.CAPTURE_STRUCT)
    ProcedureReturn *Capture\Area\bottom - 1
  EndProcedure
  
  Procedure.l Pixel(*Capture.CAPTURE_STRUCT,X.i,Y.i)
    Protected *Pixel.Long
    *Pixel = *Capture\Bits + ((Y * *Capture\Area\right + X) << 2)
    ProcedureReturn *Pixel\l
  EndProcedure
  
  Procedure.i Free(*Capture.CAPTURE_STRUCT)
    DeleteObject_(*Capture\DIB)
    DeleteDC_(*Capture\TDC)
    ReleaseDC_(*Capture\Handle,*Capture\SDC)
    FreeMemory(*Capture)
  EndProcedure
  
EndModule

Code: Alles auswählen

TestRect.RECT

TestRect\left = 400
TestRect\right = 400
TestRect\top = 400
TestRect\bottom = 400

Task = CAPTURE::Target(#Null,@TestRect)
If Task
  If CAPTURE::Frame(Task)
    If CreateImage(0,CAPTURE::Width(Task)+1,CAPTURE::Height(Task)+1)
      If StartDrawing(ImageOutput(0))
        For x = 0 To CAPTURE::Width(Task)
          For y = 0 To CAPTURE::Height(Task)
            Plot(x,y,CAPTURE::Pixel(Task,x,y));Swap Red & Blue for RGB if needed!
          Next
        Next 
        StopDrawing()
        Debug SaveImage(0,"testimg.bmp")
      EndIf
    EndIf
  EndIf 
  CAPTURE::Free(Task)
EndIf