Aktuelle Zeit: 22.07.2018 18:42

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 1 Beitrag ] 
Autor Nachricht
 Betreff des Beitrags: [MODULE] Desktop/Window Capture
BeitragVerfasst: 26.09.2017 20:27 
Offline
Benutzeravatar

Registriert: 25.09.2016 01:42
Viel Spaß :D

Code:
Code:
;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:
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


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 1 Beitrag ] 

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 2 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye