Capture screen , windows or zones by APIS or gdiplusX
* below 7 codes relative to the subject
*1)* This captures the entier screen or any active visible window by the API keybd_event.
* can simulate the keys Printscreen or alt+Printscreen with the API Keybd_event.
* can also , in a form put a timer , and capture any screen activity into images( transformed to video for ex.)
Can put the code in systray (using systray.vcx class) and use it if necessary.
*Begin code
Declare Integer Sleep In kernel32 Integer
Local m.y
m.y=Inputbox("capture screen (1)-capture active window (2)","","1")
m.y=Val(m.y)
If !Inlist (m.y,1,2)
m.y=1 &&capture entier screen
Endi
Do Case
Case m.y=1
_Screen.WindowState=1
Sleep(200)
=captureScreen()
Case m.y=2
_Screen.WindowState=1
Sleep(200)
Messagebox("click on the window to getfocus -activate the window-....waiting 2 seconds..",0+32+4096,2000)
Sleep(2000)
=captureWin()
Endcase
Sleep(200)
Messagebox("your capture is in clipboard-this runs Mspaint and paste it...",0+32+4096,"",1000)
sleep(200)
=ypaste()
Return
Function captureScreen()
&&capture entier screen
Declare Integer keybd_event In Win32API ;
INTEGER, Integer, Integer, Integer
#Define KEYEVENTF_KEYUP 2
#Define KEYEVENTF_EXTENDEDKEY 1
#Define VK_SNAPSHOT 44 && from the winuser.h
*The following commands copy the entier screen to the clipboard (the equivalent of PrintScrn):
DoEvents
keybd_event( VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0 )
keybd_event( VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0 )
DoEvents
Endfunc
Function captureWin()
&&capture active window
Declare Integer keybd_event In Win32API ;
INTEGER, Integer, Integer, Integer
#Define VK_SNAPSHOT 44 && from the winuser.h
#Define VK_LMENU 164
#Define KEYEVENTF_KEYUP 2
#Define KEYEVENTF_EXTENDEDKEY1
*The following commands copy the active application window to the
*clipboard (the equivalent of ALT+PrintScrn):click on the window to getfocus otherwise entier screen is captured.
DoEvents
keybd_event( VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0 )
keybd_event( VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0 )
keybd_event( VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0 )
keybd_event( VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0 )
DoEvents
Endfunc
Function ypaste()
Run/N mspaint
Sleep(2000)
Local oshell
oshell=Newobject("wscript.shell")
oshell.sendkeys("^{v}") &&standard wundows hotkey CTRL+V
Endfunc
*endcode
*2)*Must point to system.app and then you can make captures
*capture entier screen.
*
*begin Code
Local m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Do Locfile("System.App")
Set Defa To (yrep)
Local m.ext
m.ext=Inputbox("Save as: PNG,JPG,BMP,GIF","","PNG")
If ! Inlist(Upper(m.ext),"PNG","JPG","BMP","GIF")
m.ext="PNG" &&default
Endi
Declare Integer Sleep In kernel32 Integer
_Screen.WindowState=1
Sleep(300)
Local loCaptureBmp As xfcBitmap
With _Screen.System.Drawing
loCapture = .Bitmap.FromScreen()
Local m.lcdest
m.lcdest=m.yrep+"myCapture."+m.ext
m.ext=Upper(m.ext)
Local m.oo
Do Case
Case m.ext="PNG"
loCapture.Save(m.lcdest,.imaging.imageformat.PNG)
Case m.ext="JPG"
loCapture.Save(m.lcdest,.imaging.imageformat.JPEG)
Case m.ext="BMP"
loCapture.Save(m.lcdest,.imaging.imageformat.BMP)
Case m.ext="GIF"
loCapture.Save(m.lcdest,.imaging.imageformat.GIF)
Endcase
Endwith
If File(m.lcdest)
Run/N explorer &lcdest
Else
Messagebox("An error was occured!",16+4096,"Error",1000)
Endi
*Endcode
*formats to save can be :
*image PNG.........use syntax: .imaging.Imageformat.PNG
*image GIF...................: .imagingImageFormat.GIF
*image BMP...................: .imaging.ImageFormat.BMP
*image tif...................: .imaging.ImageFormat.TIF
*etc.. (open and see system.Drawing.prg)
*3)*Must point to system.app and then you can make captures
*capture entier screen.
*Fromscreen() of system.drawing.prg ....LPARAMETERS tHWnd, tiX, tiY, tiWidth, tiHeight,tlEnsureVisible
*can crop the window with the function fromScreen()-can also use th crop gdiplusX function
*Begin code
Local m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Do Locfile("System.App")
Set Defa To (yrep)
Local m.xcas
m.xcas=Inputbox("Capture desktop zone(1),vfp screen zone(2)","","1")
If ! Inlist(Upper(m.xcas),"1","2")
m.xcas="1" &&default
Endi
m.xcas=Val(m.xcas)
Local m.ext
m.ext=Inputbox("Save as: PNG,JPG,BMP,GIF","","PNG")
If ! Inlist(Upper(m.ext),"PNG","JPG","BMP","GIF")
m.ext="PNG" &&default
Endi
Declare Integer Sleep In kernel32 Integer
Sleep(300)
Local loCaptureBmp As xfcBitmap
With _Screen.System.Drawing
Do Case
Case m.xcas=1
_Screen.WindowState=1
Sleep(300)
loCapture = .Bitmap.Fromscreen(0,100,100,500,500) &&capture zone desktop
Case m.xcas=2
_Screen.WindowState=2
Activate Window calculator
Sleep(1000)
loCapture = .Bitmap.Fromscreen(_Screen.HWnd,0,0,500,500) &&capture zone desktop
Release Window calculator
Endcase
Local m.lcdest
m.lcdest=m.yrep+"myCapture."+m.ext
m.ext=Upper(m.ext)
Local m.oo
Do Case
Case m.ext="PNG"
loCapture.Save(m.lcdest,.imaging.imageformat.PNG)
Case m.ext="JPG"
loCapture.Save(m.lcdest,.imaging.imageformat.JPEG)
Case m.ext="BMP"
loCapture.Save(m.lcdest,.imaging.imageformat.BMP)
Case m.ext="GIF"
loCapture.Save(m.lcdest,.imaging.imageformat.GIF)
&&tif... .imaging.ImageFormat.TIF
Endcase
Endwith
If File(m.lcdest)
Run/N explorer &lcdest
Else
Messagebox("An error was occured!",16+4096,"Error",1000)
Endi
_Screen.WindowState=2
*Endcode
*4)*this Captures the full form and all visible controls in a vfp form as png images with fomscreen() gdiplusX function
*Begin code
Do Locfile("system.app")
Declare Integer Sleep In kernel32 Integer
Do Form Home(1)+"samples\solution\europa\polygons.scx" Name yb
Sleep(4000) &&wait to ply the form
Local m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
If !Directory(m.yrep+"images")
Md (m.yrep+"images")
Endi
Local locapturebmp As xfcbitmap
With yb
locapturebmp = _Screen.System.drawing.Bitmap.fromscreen(yb.HWnd) &&capture full form
locapturebmp.Save(m.yrep+ "images\ycap_full_form" + ".png",_Screen.System.drawing.imaging.imageformat.png)
Messagebox(Trans(.ControlCount)+" controls.",0+32+4096,'',1000)
For i=1 To .ControlCount &&capture form controls
With .Controls(i)
Try
locapturebmp = _Screen.System.drawing.Bitmap.fromscreen(yb.HWnd,.Left,.Top,.Width,.Height)
locapturebmp.Save(m.yrep+ "images\ycap"+Trans(i) + ".png",_Screen.System.drawing.imaging.imageformat.png)
Catch
Endtry
Endwith
Endfor
Endwith
*release polygons.scx
yb.Release
*show captured png
Local m.oo
m.oo=m.yrep+"images"
Run/N explorer &oo
*end code
*5)*this code captures all visible windows child of desktop as png images
*only the visible windows are selected from the hierarchy.
*a part of these are really capturable, others appears as black images,must make another condition on coord...
*This code use APIs to scan the desktop windows hierarchy and fromscreen() to capture them(if ensureVisible=.t.)
*Begin code
Do Locfile("system.app")
Local m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
If !Directory(m.yrep+"images")
Md (m.yrep+"images")
Else
Dele File ( m.yrep+"images\*.*")
Endi
Do yDeclare
Local hParent, hWindow
hParent = GetDesktopWindow()
hWindow = 0
Create Cursor ycurs (winhandle I)
Do While .T. &&iterate on all windows to capture handles
Store Replicate(Chr(0),255) To cClass
hWindow = FindWindowEx(hParent, hWindow,;
Null, Null)
If !hWindow = 0
Insert Into ycurs Values (hWindow)
Else
Exit
Endif
Enddo
Select ycurs
Local j
j=0
Local locapturebmp As xfcbitmap
Scan
If IsWindowVisible(winhandle)=1 &&ensure window is visible to apply fromScreen() gdiplusX function
locapturebmp = _Screen.System.drawing.Bitmap.fromscreen(winhandle) &&capture full window
locapturebmp.Save(m.yrep+ "images\ycap"+Trans(Recno()) + ".png",_Screen.System.drawing.imaging.imageformat.png)
j=j+1
Endi
Endscan
Messagebox( Trans(j)+" visible windows identified+captured!",0+32+4096,"",1000)
*show captured png
Local m.oo
m.oo=m.yrep+"images"
Run/N explorer &oo
Return
Procedure yDeclare
Declare Integer IsWindowVisible In user32 Integer HWnd
Declare Integer GetLastError In kernel32
Declare Integer GetDesktopWindow In user32
Declare Integer FindWindowEx In user32;
INTEGER hwndParent, Integer hwndChildAfter,;
STRING @lpszClass, String @lpszWindow
*End code
*6)* this can capture the screen activity with an interval of 1 second with a timeout of 20 seconds
*the captured images are gathered in images folder.
*all the screen activity is captured as images.
*can capture also with this idea a specific window activity (as a video for ex).....
*with gdiplusX function fomscreen() can install capture zone (set hwnd,x,y,width,height of the window to capture) as the parameters below and add a timer to capture):
*
*Begin code
clea all
Do Locfile("System.App")
Publi m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
If !Directory(m.yrep+"images")
Md (m.yrep+"images")
Else
Dele File (m.yrep+"imges\*.*")
Endi
Set Defa To (yrep)
Publi m.ext
m.ext=Inputbox("Save as: PNG,JPG,BMP,GIF","","JPG")
If ! Inlist(Upper(m.ext),"PNG","JPG","BMP","GIF")
m.ext="JPG" &&default
Endi
Local oShell
oShell=Newobject("shell.application") &&reduce all windows
oShell.toggleDesktop()
oShell=Null
Release oShell
*can activate the window to capture or desktop
With _Screen
.AddProperty("timeout",20) &&20 sec
.AddProperty("t0",Seconds())
.AddObject("timer1","ytimer")
With .timer1
Messagebox("Capture starting...",0+32+4096,'',2000)
.Enabled=.T.
Endwith
.Visible=.F.
Endwith
Define Class ytimer As Timer
Enabled=.F.
Interval=1000
Procedure Timer
Local loCaptureBmp As xfcBitmap
With _Screen.System.Drawing
loCapture = .Bitmap.FromScreen()
Local m.lcdest
m.lcdest=m.yrep+"images\"+Sys(2015)+"."+m.ext
m.ext=Upper(m.ext)
Local m.oo
Do Case
Case m.ext="PNG"
loCapture.Save(m.lcdest,.imaging.imageformat.PNG)
Case m.ext="JPG"
loCapture.Save(m.lcdest,.imaging.imageformat.JPEG)
Case m.ext="BMP"
loCapture.Save(m.lcdest,.imaging.imageformat.BMP)
Case m.ext="GIF"
loCapture.Save(m.lcdest,.imaging.imageformat.GIF)
Endcase
If Seconds()-_Screen.t0>_Screen.Timeout
This.Enabled=.F.
_Screen.Visible=.T.
Messagebox("Captures finished...",0+32+4096,"",1000)
Local m.oo
m.oo=m.yrep+"images"
Run/N explorer &oo &&see the captured images (can order by date..)
Endi
Endwith
Endproc
*End code
*7)*This is a basic code on systray to capture the desktop or any visible window.
*the capture is sent to mspaint to paste an can modify image and save it manually.
*see on traybar the icon ,click and fire a contextuel menu.
*this uses the systray vfp class.
*can make a proj produce an exe and make this app under hands in systray to capture.Link to the exe in windows menu start to make it permanently in systray for use.
*for more can download this: http://www.foxite.com/downloads/default.aspx?id=222
*Updated on samedi 28 février 2015; 10:20:59
*Begin code
Declare Integer Sleep In kernel32 Integer
set path to home(1)+"samples\solution\toledo\"
Publi m.osystray
m.osystray = Createobject("ycapture")
Read Events
Define Class ycapture As Systray Of "Systray.VCX"
IconFile = Home(1) + "Graphics\Icons\Misc\misc15.ico"
TipText = "ycapture"
MenuText = "1;Capture desktop ;2; Capture focused window;3;Exit"
Procedure ProcessMenuEvent
Lparameters nMenuItemID
Do Case
Case nMenuItemID = 0
* User cleared the menu. Do nothing.
Case nMenuItemID = 1
=ycaptureScreen()
Sleep(1000)
ypaste()
Case nMenuItemID = 2
Messagebox("Click on window to capture !",0+32+4096,"",800)
Sleep(2000)
=yCaptureWin()
Sleep(1000)
ypaste()
Case nMenuItemID = 3
* Exit Application
This.RemoveIconFromSystray()
Clear Events
Endcase
Endproc
Enddefine
Function ycaptureScreen()
&&capture entier screen
Declare Integer keybd_event In Win32API ;
INTEGER, Integer, Integer, Integer
#Define KEYEVENTF_KEYUP 2
#Define KEYEVENTF_EXTENDEDKEY 1
#Define VK_SNAPSHOT 44 && from the winuser.h
*The following commands copy the entier screen to the clipboard (the equivalent of PrintScrn):
DoEvents
keybd_event( VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0 )
keybd_event( VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0 )
DoEvents
Endfunc
Function yCaptureWin()
&&capture active window
Declare Integer keybd_event In Win32API ;
INTEGER, Integer, Integer, Integer
#Define VK_SNAPSHOT 44 && from the winuser.h
#Define VK_LMENU 164
#Define KEYEVENTF_KEYUP 2
#Define KEYEVENTF_EXTENDEDKEY 1
*The following commands copy the active application window to the
*clipboard (the equivalent of ALT+PrintScrn):click on the window to getfocus otherwise entier screen is captured.
DoEvents
keybd_event( VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0 )
keybd_event( VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0 )
keybd_event( VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0 )
keybd_event( VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0 )
DoEvents
Endproc
Function ypaste()
Run/N mspaint
Sleep(2000)
Local oshell
oshell=Newobject("wscript.shell")
oshell.sendkeys("^{v}") &&standard wundows hotkey CTRL+V
Endfunc
*End code
