PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Screen Capture

https://www.purebasic.fr/english/viewtopic.php?t=17264

Page 1 of 1

Screen Capture

Posted: Tue Oct 18, 2005 9:05 pm
by Droopy
Code updated for 5.20+

Some Functions for Screen capture based on Kale Code

Code: Select all

;/ Author : Kale / Droopy

; Return pointer to BMP SnapShot

Global CaptureScreenWidth , CaptureScreenHeight , CaptureScreenBMPHandle

Procedure CaptureScreenPart(Left.l, Top.l, Width.l, Height.l) 
  dm.DEVMODE 
  BMPHandle.l 
  srcDC = CreateDC_("DISPLAY", "", "", dm) 
  trgDC = CreateCompatibleDC_(srcDC) 
  BMPHandle = CreateCompatibleBitmap_(srcDC, Width, Height) 
  SelectObject_( trgDC, BMPHandle) 
  BitBlt_( trgDC, 0, 0, Width, Height, srcDC, Left, Top, #SRCCOPY) 
  DeleteDC_( trgDC) 
  ReleaseDC_( BMPHandle, srcDC)
  
  CaptureScreenHeight=Height
  CaptureScreenWidth=Width
  CaptureScreenBMPHandle=BMPHandle
  ProcedureReturn BMPHandle 
EndProcedure 

Procedure CaptureFullScreen()
  ProcedureReturn CaptureScreenPart(0,0,GetSystemMetrics_(#SM_CXSCREEN),GetSystemMetrics_(#SM_CYSCREEN))
EndProcedure

Procedure CaptureWindow(Handle.l) ; ### The Window must be visible !

    If Handle 
      WindowSize.RECT 
      GetWindowRect_(Handle, @WindowSize) 
      ProcedureReturn CaptureScreenPart(WindowSize\Left, WindowSize\Top, WindowSize\Right - WindowSize\Left, WindowSize\Bottom - WindowSize\Top) 
    EndIf
    
EndProcedure 

; #PB_ImagePlugin_BMP / #PB_ImagePlugin_JPEG / #PB_ImagePlugin_PNG
; JpegCompression 0 (Bad) to 10 (Best) --> Only for Jpeg

Procedure SaveCapture(File.s, ImagePlugin , JpegCompression) 
  
  If CaptureScreenBMPHandle
    Id=CreateImage(#PB_Any, CaptureScreenWidth, CaptureScreenHeight) 
    StartDrawing(ImageOutput(Id)) 
    DrawImage(CaptureScreenBMPHandle,0,0) 
    StopDrawing()
    
    Select ImagePlugin
      
      Case #PB_ImagePlugin_JPEG 
        UseJPEGImageEncoder()
        Retour=SaveImage(Id, File,#PB_ImagePlugin_JPEG,JpegCompression)
        
      Case #PB_ImagePlugin_PNG
        UsePNGImageEncoder()
        Retour=SaveImage(Id, File,#PB_ImagePlugin_PNG)
        
      Default
        Retour=SaveImage(Id, File)
        
    EndSelect

    FreeImage(Id)
    
  EndIf
  
  ProcedureReturn Retour
EndProcedure

;/ Test
CaptureFullScreen()
SaveCapture("c:\CaptureFullScreen.png",#PB_ImagePlugin_PNG,0)
SaveCapture("c:\CaptureFullScreen.bmp",#PB_ImagePlugin_BMP,0)
SaveCapture("c:\CaptureFullScreen.Jpg",#PB_ImagePlugin_JPEG,10)

Re: Screen Capture

Posted: Tue Oct 18, 2005 11:21 pm
by Kale
Some Functions for Screen capture based on Kale Code
Not mine, i nicked it from somewhere too! :P

Posted: Wed Oct 19, 2005 12:19 am
by rsts
Nice piece of code.

Thanks to both of you for sharing it.

cheers

Posted: Wed Oct 19, 2005 6:17 am
by DarkDragon
My Version(Mixed with Danilos version):

Windows/Linux:

Code: Select all

;Screenshots unter Windows und Linux erstellen
;Gemischt mit Danilos variante hier: http://www.purearea.net/pb/CodeArchiv/Windows_System/Screenshots/MakeWindowScreenshot.pb
; Autor: DarkDragon/Danilo ;) .
;
#SCREENSHOT_MOUSE = 2

CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Procedure GetCurrentCursor(*pt.Point)
 hWindow.l
 dwThreadID.l
 dwCurrentThreadID.l
 Result = 0
 If GetCursorPos_(*pt)
   hWindow = WindowFromPoint_(*pt\x, *pt\y)
   If IsWindow_(hWindow)
     dwThreadID = GetWindowThreadProcessId_(hWindow, @nil)
     dwCurrentThreadID = GetCurrentThreadId_()
     
     If (dwCurrentThreadID <> dwThreadID)
       If AttachThreadInput_(dwCurrentThreadID, dwThreadID, 1)
         Result.l = GetCursor_()
         AttachThreadInput_(dwCurrentThreadID, dwThreadID, 0)
       EndIf
     Else
       Result.l = GetCursor_()
     EndIf
   EndIf
 EndIf
 ProcedureReturn Result
EndProcedure
CompilerEndIf

Procedure MakeDesktopScreenshot(ImageNr,x,y,Width,Height,Flags)
 CompilerIf #PB_Compiler_OS = #PB_OS_Linux
 RunProgram("import", "-window root -crop "+Str(Width)+"x"+Str(Height)+"+"+Str(x)+"+"+Str(y)+" /tmp/snapshot.bmp", "/", 1)
 hImage = LoadImage(ImageNr, "/tmp/snapshot.bmp")
 CompilerElse
 hImage = CreateImage(ImageNr,Width,Height)
 If hImage
   hDC = StartDrawing(ImageOutput())
   If hDC
     DeskDC = GetDC_(GetDesktopWindow_())
     If DeskDC
       BitBlt_(hDC,0,0,Width,Height,DeskDC,x,y,#SRCCOPY)
     EndIf
     ReleaseDC_(GetDesktopWindow_(),DeskDC)
   EndIf
   If (Flags & #SCREENSHOT_MOUSE)
     hCursor = GetCurrentCursor(@pt.Point)
     DrawImage(hCursor, pt\x-capX, pt\y-capY)
   EndIf
   StopDrawing()
 EndIf
 CompilerEndIf
 ProcedureReturn hImage
EndProcedure

Procedure ViewImage()
  If OpenWindow(1000, 0, 0, ImageWidth(), ImageHeight(), #PB_Window_SystemMenu, "Image")
    CreateGadgetList(WindowID())
    ImageGadget(1000, 0, 0, ImageWidth(), ImageHeight(), ImageID())
   
    Repeat
      Event = WaitWindowEvent()
      Delay(10)
    Until Event = #PB_Event_CloseWindow
    CloseWindow(1000)
  EndIf
EndProcedure

Delay(1000)
hImg = MakeDesktopScreenshot(0,100,300,512,256,#SCREENSHOT_MOUSE)
If hImg
ViewImage()
FreeImage(0)
EndIf
With Mouse-Area-Control:

Code: Select all

#SCREENSHOT_MOUSE = 2

ExamineDesktops()

CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Procedure GetCurrentCursor(*pt.Point)
 hWindow.l
 dwThreadID.l
 dwCurrentThreadID.l
 Result = 0
 If GetCursorPos_(*pt)
   hWindow = WindowFromPoint_(*pt\x, *pt\y)
   If IsWindow_(hWindow)
     dwThreadID = GetWindowThreadProcessId_(hWindow, @nil)
     dwCurrentThreadID = GetCurrentThreadId_()
     
     If (dwCurrentThreadID <> dwThreadID)
       If AttachThreadInput_(dwCurrentThreadID, dwThreadID, 1)
         Result.l = GetCursor_()
         AttachThreadInput_(dwCurrentThreadID, dwThreadID, 0)
       EndIf
     Else
       Result.l = GetCursor_()
     EndIf
   EndIf
 EndIf
 ProcedureReturn Result
EndProcedure
CompilerEndIf

Procedure MakeDesktopScreenshot(ImageNr,x,y,Width,Height,Flags)
 CompilerIf #PB_Compiler_OS = #PB_OS_Linux
 RunProgram("import", "-window root -crop "+Str(Width)+"x"+Str(Height)+"+"+Str(x)+"+"+Str(y)+" /tmp/snapshot.bmp", "/", 1)
 hImage = LoadImage(ImageNr, "/tmp/snapshot.bmp")
 CompilerElse
 hImage = CreateImage(ImageNr,Width,Height)
 If hImage
   hDC = StartDrawing(ImageOutput())
   If hDC
     DeskDC = GetDC_(GetDesktopWindow_())
     If DeskDC
       BitBlt_(hDC,0,0,Width,Height,DeskDC,x,y,#SRCCOPY)
     EndIf
     ReleaseDC_(GetDesktopWindow_(),DeskDC)
   EndIf
   If (Flags & #SCREENSHOT_MOUSE)
     hCursor = GetCurrentCursor(@pt.Point)
     DrawImage(hCursor, pt\x-capX, pt\y-capY)
   EndIf
   StopDrawing()
 EndIf
 CompilerEndIf
 ProcedureReturn hImage
EndProcedure

Procedure ViewImage()
  If OpenWindow(1000, 0, 0, ImageWidth(), ImageHeight(), #PB_Window_SystemMenu, "Image")
    CreateGadgetList(WindowID())
    ImageGadget(1000, 0, 0, ImageWidth(), ImageHeight(), ImageID())
   
    Repeat
      Event = WaitWindowEvent()
      Delay(10)
    Until Event = #PB_Event_CloseWindow
    CloseWindow(1000)
  EndIf
EndProcedure

InitSprite()
InitMouse()

Structure Area
  X.l
  Y.l
  Width.l
  Height.l
EndStructure

Procedure MouseControlScreenshot(Img, Flags)
  Area.Area
  MakeDesktopScreenshot(Img,0,0,DesktopWidth(0),DesktopHeight(0), Flags)
  OpenScreen(DesktopWidth(0), DesktopHeight(0), 32, "Capture")
 
  Repeat
    If IsScreenActive()
    ExamineMouse()
   
    MouseX = MouseX()
    MouseY = MouseY()
    If MouseButton(1)
      If capMouse = 0
        oMouseX = MouseX
        oMouseY = MouseY
        capMouse = 1
      EndIf
    Else
      If capMouse = 1
        If MouseX < oMouseX : v = oMouseX : oMouseX = MouseX : MouseX = v : EndIf
        If MouseY < oMouseY : v = oMouseY : oMouseY = MouseY : MouseY = v : EndIf
        Area\X = oMouseX
        Area\Y = oMouseY
        Area\Width = MouseX-oMouseX
        Area\Height = MouseY-oMouseY
        Q = 1
      EndIf
    EndIf
   
    ClearScreen(0, 0, 0)
    StartDrawing(ScreenOutput())
    DrawImage(ImageID(), 0, 0)
    DrawingMode(4|2)
    If capMouse <> 0
    Box(oMouseX, oMouseY, MouseX-oMouseX, MouseY-oMouseY)
    EndIf
    DrawingMode(2)
    Box(MouseX-1 , MouseY-10, 2 , 20)
    Box(MouseX-10, MouseY-1 , 20, 2 )
    StopDrawing()
    FlipBuffers()
    EndIf
   
    Delay(10)
  Until Q = 1
  CloseScreen()
  ImgNew = GrabImage(Img, #PB_Any, Area\X, Area\Y, Area\Width, Area\Height)
  FreeImage(Img)
  CopyImage(ImgNew, Img)
  FreeImage(ImgNew)
  ProcedureReturn ImageID()
EndProcedure

Delay(1000)
;hImg = MakeDesktopScreenshot(0,100,300,512,256,#SCREENSHOT_MOUSE)
hImg = MouseControlScreenshot(0,#SCREENSHOT_MOUSE)
If hImg
ViewImage()
FreeImage(0)
EndIf



And on windows it can also show the mousecursor. You need ImageMagick on Linux.

Posted: Wed Oct 19, 2005 7:54 am
by Droopy
Very good, but i don't understand anything @Linux

Posted: Tue Oct 25, 2005 10:55 pm
by GeoTrail
Might be a silly question but how do I get the handle of the active window for use with CaptureWindow(Handle.l) ?

Posted: Tue Oct 25, 2005 11:29 pm
by Droopy

Code: Select all

Handle =FindWindow_(0, WindowsName) ; Ex "Calculator"
Handle = GetForegroundWindow_() ; Windows that have the focus

Posted: Wed Oct 26, 2005 10:26 am
by GeoTrail
Aaa that simple?
Hehe thanks Droopy :)

Posted: Thu Feb 09, 2006 10:55 pm
by Straker
I am using Droopy's code (which is very nice - thanks), but to capture a window, that window must be on top. So I have been using code to bring it forward and take the snap then put back the top window. However, this is quite ugly, since it makes various application windows flash and come forward, you know what I mean.

So.... does anyone know how to capture the client area of a window that isn't on top?

In other words, same as Droopy's window capture code above, except for two things:

- client area only: no borders
- window does not have to be topmost.

I can probably get around the topmost issue, by causing the entire screen not to repaint while the capture is taking place - if anyone knows how to do this too.

Thanks.

Posted: Fri Feb 10, 2006 5:25 am
by Sparkie
Straker wrote:So.... does anyone know how to capture the client area of a window that isn't on top?
Take a look here and see if it helps. There is also the API PrintWindow() for XP only if that is an option for you. Also, if these are web pages you are trying to capture, there may be another option available to you.

Posted: Fri Feb 10, 2006 6:01 am
by PB
> to capture a window, that window must be on top

Yep, even the good ol' PrintScreen can't do it. (Try it: Open Notepad and Calc,
and then make Notepad always on top, then cover Calc with a bit of it. Then
give Calc the focus, and do Alt+PrintScreen -- you'll see that the capture has
part of Calc's image covered by part of Notepad). :(

Posted: Fri Feb 10, 2006 2:43 pm
by Straker
Thanks Sparkie - I think thats what I am looking for.

Basically, I want to perform a similar function to this FireFox extension but with different application windows at a desktop level.

Posted: Sat Apr 22, 2006 3:04 pm
by netmaestro
I fooled around with this a bit. The PrintWindow function, while not available directly from PureBasic, works well. To test this, start the calculator and click the PureBasic IDE so that the calculator disappears behind it. Then run the program. It should print the calculator window on your test window:

Code: Select all

OpenWindow(0,0,0,640,480,"",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
OpenLibrary(0,"user32.DLL") 
win=FindWindow_(#Null,"Calculator")
hdc=StartDrawing(WindowOutput(0))
  CallFunction(0,"PrintWindow",win,hdc,0)
StopDrawing()
Repeat:Until WaitWindowEvent()=#PB_Event_CloseWindow
To print only the client area, pass a 1 as last parameter instead of 0.

@Sparkie: Thanks for the tip!
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited