[MODULE] Desktop/Window Capture

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
Mijikai
Beiträge: 754
Registriert: 25.09.2016 01:42

[MODULE] Desktop/Window Capture

Beitrag von Mijikai »

Viel Spaß :D

Code:

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
Beispiel:

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