PureCapture, (ScreenCapturing Windows)

[dobro]

capture resized

after resizing the window-click on the button "Capture"

the prg request the desired format (png,bmp,jpg)

prg or save the application, and what name (the path is kept)

prg saw the animated displays a catch:)

press spacebar or rightmouseclick for quit

; By Dobro
; Capture avec fenetre transparente redimensionable qui sert de cadre;
; purecolor_lib

usepngimageencoder ()
usejpegimageencoder ()
usejpegimagedecoder ()
usepngimagedecoder ()

Declare CaptureScreen(left.l, top.l, Width.l, Height.l)
Declare ShowWin()
Declare OpenWindow_Window_sauve()
Declare save_image()
Declare reload(FileName.s)
Declare info_sous_souris()

Enumeration
         #WIN
         #bouton
         #bouton_All
         #Image
         #bmp
         #jpg
         #png
         #info
         #Sprite
         #coche
EndEnumeration
                     ;{- Enumerations / DataSections
                                     ;{ Windows
Enumeration
         #Window_sauve
         #window
EndEnumeration
                                     ;}
                                     ;{ Gadgets
Enumeration
         #Container_0
         #Option_Jpg
         #Option_BMP
         #Option_Png
EndEnumeration
                                     ;}
                                     ;}
                                
Global x_win,y_win,flag=0


Structure sprite
        x.l
        y.l
        pas_x.l
        pas_y.l
EndStructure
        
Global Dim sprite.sprite(1)
sprite(1)\pas_x=2
sprite(1)\pas_y=-2
examinedesktops ()
Global ecran_x= desktopwidth (0)
Global ecran_y= desktopheight (0)
        
If initsprite () = 0 Or initkeyboard () = 0 Or initmouse () = 0
         messagerequester ( "Erreur" , "Impossible d'initialiser DirectX" , 0)
EndIf


Global FileName.s

Repeat
         ShowCursor_ (1) ; montre le curseur
        ShowWin()
Until flag=1
End



Procedure ShowWin()
         ;-------------------
         If openwindow ( #WIN , 0, 0, 300, 300, "Pure_Capture By Dobro" , #PB_Window_BorderLess |#PB_Window_SizeGadget |#PB_Window_Tool|#PB_Window_SystemMenu )
                 stickywindow ( #WIN , 1) ; mise au premier plan
                 buttongadget ( #bouton ,10,10,40,30, "capture" )
                PureCOLOR_SetButtonColor( #bouton , rgb ($F3,$E3,$21), rgb ($88,$0,$6C), rgb ($FD,$21,$9) , rgb ($0,$0,$0))
                 buttongadget ( #bouton_All ,250,10,40,30, "ALL" )
                PureCOLOR_SetButtonColor( #bouton_All , rgb ($72,$10,$68 ), rgb ($FF,$FF,$80), rgb ($FD,$21,$9) , rgb ($0,$0,$0))
                 checkboxgadget ( #coche ,10,50,40,30, "Auto" ) : setgadgetstate ( #coche , #PB_CheckBox_Unchecked )
                
                
                
                
                 setwindowcolor ( #WIN , #Blue )
                 SetWindowLong_ ( windowid ( #WIN ), #GWL_EXSTYLE , #WS_EX_LAYERED | #WS_EX_TOPMOST )
                 SetLayeredWindowAttributes_ ( windowid ( #WIN ), #Blue ,0, #LWA_COLORKEY )
         EndIf
         Repeat
                Event= waitwindowevent (2)
                 Select Event
                                
                         Case #PB_Event_Gadget
                                
                                 Select eventgadget ()
                                         Case #bouton_All
                                                 Beep_ (440,100)
                                                CaptureScreen( 0, 0, ecran_x, ecran_y)
                                                save_image()
                                                 ProcedureReturn
                                         Case #bouton
                                                 Beep_ (440,100)
                                                CaptureScreen( windowx ( #WIN )+4, windowy ( #WIN )+24, windowwidth ( #WIN ), windowheight ( #WIN ))
                                                save_image()
                                                reload(FileName.s)
                                                 ProcedureReturn
                                                
                                 EndSelect
                 EndSelect
                 If getgadgetstate ( #coche )= #PB_CheckBox_Checked
                         hidegadget ( #bouton ,1)
                         hidegadget ( #bouton_All ,1)
                         hidegadget ( #coche ,1)
                         setwindowtitle ( #WIN , "Press Return" )
                        info_sous_souris()
                         If GetAsyncKeyState_ ( #VK_RETURN )
                                CaptureScreen( windowx ( #WIN )+4, windowy ( #WIN )+24, windowwidth ( #WIN ), windowheight ( #WIN ))
                                save_image()
                                reload(FileName.s)
                                 ProcedureReturn
                         EndIf
                        
                 EndIf
                
         Until Event = #PB_Event_CloseWindow
        flag=1
EndProcedure



;
Procedure CaptureScreen(left.l, top.l, Width.l, Height.l)
         #CAPTUREBLT = $40000000
        x_win= windowx ( #WIN )
        y_win= windowy ( #WIN )
         closewindow ( #WIN )
        dm.DEVMODE ;structure for CreateDC()
        srcDC.l
        trgDC.l
        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|#CAPTUREBLT )
         ; OpenClipboard_ ( #Null )
         ; ******** clipboard incompatible avec Jpg **********
         ;EmptyClipboard_ ()
         ;SetClipboardData_ (2, BMPHandle)
         ; CloseClipboard_ ()
         ; ************************************************²
         If createimage ( #Image ,Width,Height)
                 If startdrawing ( imageoutput ( #Image ))
                                 drawimage (BMPHandle,0,0)
                         EndIf
                 stopdrawing ()
         EndIf
        
         DeleteDC_ ( trgDC)
         ReleaseDC_ ( BMPHandle, srcDC)
         ProcedureReturn
EndProcedure

Procedure save_image()
         If openwindow ( #Window_sauve , x_win, y_win, 133, 108, "Save image" , #PB_Window_BorderLess )
                 stickywindow ( #Window_sauve , 1) ; mise au premier plan
                
                 containergadget ( #Container_0 , 5, 5, 125, 95, #PB_Container_Raised )
                         optiongadget ( #Option_Jpg , 5, 5, 85, 25, "Jpg" )
                         optiongadget ( #Option_BMP , 5, 25, 85, 25, "Bmp" )
                         optiongadget ( #Option_Png , 5, 45, 85, 25, "Png" )
                 closegadgetlist ()
                
                 ;{- Event loop
                 Repeat
                         Select waitwindowevent ()
                                         ; ///////////////////
                                 Case #PB_Event_Gadget
                                         Select eventgadget ()
                                                 Case #Container_0
                                                 Case #Option_Jpg
                                                        type = #jpg
                                                        iEvent = #PB_Event_CloseWindow
                                                 Case #Option_BMP
                                                        type= #bmp
                                                        iEvent = #PB_Event_CloseWindow
                                                 Case #Option_Png
                                                        type= #png
                                                        iEvent = #PB_Event_CloseWindow
                                         EndSelect
                         EndSelect
                 Until iEvent = #PB_Event_CloseWindow
                 closewindow ( #Window_sauve )
         EndIf
         ;}
         If openfile ( #info , "capture.inf" )
                path$= readstring ( #info )
                 closefile ( #info )
         EndIf
        
         If path$= ""
                path$= "c:\"
         EndIf
         If getextensionpart (FileName.s) <> ""
                FileName.s= mid (FileName.s,1, len (FileName.s)-4)
         EndIf
        
         Select type
                 Case #jpg
                        FileName.s= savefilerequester ( "sauve jpg" ,path$, "*.jpg" ,1)+ ".jpg"
                         If saveimage ( #Image , FileName.s, #PB_ImagePlugin_JPEG ,10,32 ) =0
                                 messagerequester ( "erreur" , "pas pu enregistrer l'image" )
                                 ProcedureReturn
                         EndIf
                        
                 Case #bmp
                        FileName.s= savefilerequester ( "sauve bmp" ,path$, "*.bmp" ,1)+ ".bmp" ; bug !!
                         If saveimage ( #Image , FileName.s, #PB_ImagePlugin_BMP ,10,32)=0 ; bug !!!
                                 messagerequester ( "erreur" , "pas pu enregistrer l'image" )
                                 ProcedureReturn
                         EndIf
                        
                 Case #png
                        FileName.s= savefilerequester ( "sauve png" ,path$, "*.png" ,1)+ ".png"
                         If saveimage ( #Image , FileName.s, #PB_ImagePlugin_PNG )=0
                                 messagerequester ( "erreur" , "pas pu enregistrer l'image" )
                                 ProcedureReturn
                         EndIf
         EndSelect
        
         If openfile ( #info , "capture.inf" )<>0
                 writestringn ( #info , getpathpart (FileName.s) )
                 closefile ( #info )
         EndIf
         delay (200)
EndProcedure ;

Procedure reload(FileName.s)
        
         ;- Ouverture de la fenêtre et de l'écran
        hwnd = openwindow ( #window , 0, 0, ecran_x, ecran_y, "View_Capture Press Space_bar" , #PB_Window_Tool| #PB_Window_BorderLess )
         stickywindow ( #window , 1) ; mise au premier plan
         openwindowedscreen ( windowid ( #window ), 0, 0, ecran_x, ecran_y, 0, 0, 0)
         loadsprite ( #Sprite ,FileName.s)
         ;- début de la boucle
         resizewindow ( #window , 10, 10, spritewidth ( #Sprite )+50, spriteheight ( #Sprite )+50)
         Repeat
                 examinemouse () ; on demande a purebasic de surveiller les event de souris !
                 examinekeyboard () ; on demande a purebasic de surveiller les event de clavier!
                evnt= windowevent ()
                 delay (2)
                 Select evnt
                         Case #PB_Event_CloseWindow
                                 End
                 EndSelect
                sprite(1)\x=sprite(1)\x+sprite(1)\pas_x
                sprite(1)\y=sprite(1)\y+sprite(1)\pas_y
                 If sprite(1)\x+ spritewidth ( #Sprite )>WindowWidth( #window )
                        sprite(1)\pas_x=-sprite(1)\pas_x
                 EndIf
                 If sprite(1)\y+ spriteheight ( #Sprite )>WindowHeight( #window )
                        sprite(1)\pas_y=-sprite(1)\pas_y
                 EndIf
                 If sprite(1)\x<0
                        sprite(1)\pas_x=-sprite(1)\pas_x
                 EndIf
                 If sprite(1)\y<0
                        sprite(1)\pas_y=-sprite(1)\pas_y
                 EndIf
                 displaysprite ( #Sprite ,sprite(1)\x,sprite(1)\y)
                 flipbuffers () : clearscreen ( rgb (0,0,0))
         Until keyboardpushed ( #PB_Key_Space ) Or mousebutton ( #PB_MouseButton_Right )
         closewindow ( #window )
        
EndProcedure


Procedure info_sous_souris()
        WinMouse = WindowFromPoint_ ( desktopmousex () | desktopmousey () << 32)
         GetClientRect_ (WinMouse, Fenetre.rect) :
         ClientToScreen_ (WinMouse, FenetreHG.POINT)
         resizewindow ( #WIN ,FenetreHG\x-4,FenetreHG\y-24,Fenetre\ right ,Fenetre\bottom )
EndProcedure

[dige]

Thats pretty cool! Using a window instead a rubberband is very handy.
Thanks for sharing!

[epidemicz]

Ha! Very intersting, thanks for sharing

[dobro]

Thanks

[skywalk]

Thanks dobro for the great post!

Questions?

1. Why does the compiler allow a Structure definition inside a Procedure?
The Structure is not restricted to the Procedure as "Protected Structure" produces a Syntax Error.

2. Does this also work in Windows7?
Good to add #CAPTUREBLT = $40000000 to PB constants list.
BitBlt_ ( trgDC, 0, 0, Width, Height, srcDC, left , top, #SRCCOPY|#SRCPAINT|#CAPTUREBLT )

[dobro]

Thanks dobro for the great post!

Questions?

1. Why does the compiler allow a Structure definition inside a Procedure?
The Structure is not restricted to the Procedure as "Protected Structure" produces a Syntax Error.

just an aesthetic presentation

the procedure is thus displaceable
with a structure that goes

[dobro]

Google Translate :

update code colored

I was passing by the capture clipboard
but it was a problem with the jpg format!

it seems that they lose pixels in the case
it does not get any image ....

so I deleted the passage by Clipboard, for a direct creation of the image
Result is clean with all the format:)




*************************************************************
in French :
mise a jour du code coloré

je faisais passer la capture par le clipboard
mais ça posait des problemes avec le format Jpg !

il semble que celui ci laisse des plumes dans l'affaire
on ne récupere pas toute l'image ....

alors j'ai supprimé le passage par Clipboard , pour une creation direct de l'image
Résultat , c'est clean avec tout les format

[IdeasVacuum]

.....That is a good change dobro, because the clipboard is primarily there for the User rather than for an app.

How did you do your post in colour? Looks fantastic.

[cas]

@IdeasVacuum:
Agree, modifying (overwriting) clipboard is just evil.
Code is inside Quote tags, not Code tags, so you can use colors. And looks to me like he applied all colors manually. Huge work just for posting.

@dobro:
You forgot to comment out line: OpenClipboard_ ( #Null )

[gnozal]

... Code is inside Quote tags, not Code tags, so you can use colors. And looks to me like he applied all colors manually. Huge work just for posting.

He's using his 'Colorer' tool that is available on the French PB board. Some people use it there in their posts.

[dobro]

@IdeasVacuum:
Agree, modifying (overwriting) clipboard is just evil.
Code is inside Quote tags, not Code tags, so you can use colors. And looks to me like he applied all colors manually. Huge work just for posting.

yes I use "The Colorer"
one of my tools production, which can color code
Purebasic in BBcode or HTML code

From the clipboard to html code or BBcode,

or from a file *. bp or more (batch conversion) to HTML code

This tool is no longer available in download
just for my personal use ...

it allows me to recognize my codes on the French forum

@dobro:
You forgot to comment out line: OpenClipboard_ ( #Null )

hooo! Thanks

last update

good this will be my last modification on this code
I changed the mode of operation
It now allows capturing several times
to exit the program, click the red cross of the capture window

I also spent the capture window in sticky:)

here I think I'll leave it:)


Thank you to you

[yrreti]

Dobro, The clarity on your capture window is amazing!
I really appreciate you sharing your code sample.
I had written a similar program program sometime back, but the transparency see through part was always
like looking through foggy glasses. I used and modified parts of my code to include that excellent part
of your code to also give it that clarity, but left the rest of my code intact. Unlike yours, I just copy the capture
to the clipboard, and paste it where ever I want too. But I use a Red Box outline to highlight the capture area,
and also use the minimize and maximize functions.
I put my code here for you or anyone else who would like to use it.
Again, thanks for sharing that code. I was never happy with the clarity of mine, and now it's fixed.

Code: Select all

;Notes:
;This code uses some of the code from dobro that gives it that excellent clarity.
;But I included many things from my code that I liked and needed. 
;This code can be maximized and minimized, besides size adjusted.
;It also has a Red Box that Highlights the capture area so you know exactly what is
;being captured and don't get confused with another windows side.
;Pressing F7 minimizes the window and copies the image to the Clipboard.
;Then you can paste that image where ever you need to.


Enumeration
  #CaptureBoxWin
EndEnumeration

UseJPEGImageDecoder()
UsePNGImageDecoder()
UseTIFFImageDecoder()
UseTGAImageDecoder()

ExamineDesktops()
Global dtw=DesktopWidth(0)  ;Using this method so it can easily set the window up for
Global dth=DesktopHeight(0) ;different display resolution settings.  Because I'm using
;these values to adjust the capture image box window start position.

Global wx2=500
Global wy2=400

Global wx1=(dtw/2)-(wx2/2)
Global wy1=(dth/2)-(wy2/2)

Procedure CaptureScreen(left.l, top.l, Width.l, Height.l)
  ;The following adjustment is added to compensate for border and title width
  ;and seems to be just right to capture only inside the Red Box.
  If top>0
    top=top+25
    Height=Height-6
  Else
    Height=Height+22
  EndIf
  Width=Width-4
  Left=Left+6
  #CAPTUREBLT = $40000000
  x_win= WindowX ( #CaptureBoxWin )
  y_win= WindowY ( #CaptureBoxWin )
  ;CloseWindow ( #CaptureBoxWin )
  dm.DEVMODE ;structure for CreateDC()
  srcDC.l
  trgDC.l
  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|#SRCPAINT|#CAPTUREBLT )
  OpenClipboard_ ( #Null )
  EmptyClipboard_ ()
  SetClipboardData_ (2, BMPHandle)
  CloseClipboard_ ()
  DeleteDC_ ( trgDC)
  ReleaseDC_ ( BMPHandle, srcDC)
  ProcedureReturn
EndProcedure

LoadFont(26, "Arial", 12)    
LoadFont(27, "Arial", 20)

;- CaptureWindow ---------------------
BoxMsg$="PureCapture: Move/Adj Box on Image  F7=Capture"
OpenWindow ( #CaptureBoxWin , wx1,wy1,wx2,wy2, BoxMsg$ , #PB_Window_BorderLess |#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_SizeGadget |#PB_Window_SystemMenu | #PB_Window_ScreenCentered )
SetWindowColor ( #CaptureBoxWin , #Blue )
hwnd = WindowID(#CaptureBoxWin)
SetWindowLong_(Hwnd,#GWL_EXSTYLE,GetWindowLong_(Hwnd,#GWL_EXSTYLE) | #WS_EX_LAYERED| #WS_EX_TOPMOST )
SetLayeredWindowAttributes_ ( WindowID ( #CaptureBoxWin ), #Blue ,0, #LWA_COLORKEY )
StickyWindow(#CaptureBoxWin, 1)

Repeat
  wx1 = WindowX(#CaptureBoxWin) ;Returns the left position on the screen, in pixels, of the given window.
  wy1 = WindowY(#CaptureBoxWin)  ;Returns the top position on the screen, in pixels, of the given window.
  wx2 = WindowWidth(#CaptureBoxWin) ;Return the width, in pixels, of the given window.
  wy2 = WindowHeight(#CaptureBoxWin) ;Returns the height, in pixels, of the given window.
  
  If wy1<0 And wy1>-3000  ;minimize = -32000 (because off screen)
    wy1=-4
    ResizeWindow(#CaptureBoxWin, wx1, wy1, wx2, wy2)
  EndIf
  
  ;Needed to put image back on screen when you click on maximize.
  If wy2>dth
    wy2=dth
    ResizeWindow(#CaptureBoxWin, wx1, wy1, wx2, wy2)
  EndIf
  
  Ev = WaitWindowEvent()
  If Ev = #WM_KEYDOWN
    If GetAsyncKeyState_(#VK_F7)
      
      wx1 = WindowX(#CaptureBoxWin) ;Returns the left position on the screen, in pixels, of the given window.
      wy1 = WindowY(#CaptureBoxWin)  ;Returns the top position on the screen, in pixels, of the given window.
      wx2 = WindowWidth(#CaptureBoxWin) ;Return the width, in pixels, of the given window.
      wy2 = WindowHeight(#CaptureBoxWin) ;Returns the height, in pixels, of the given window.
      SetWindowState(#CaptureBoxWin, #PB_Window_Minimize)
      Delay(1000)  ;delay needed or the C window will not be removed completely when
      ;using Vista or Windows 7 with AREO.  Without AREO - no problem, but the extra
      ;delay time doesn't really hurt in normal use, so just leave it in.
      
      ;To remove screen capture below screen bottom.(gives black screen)
      ba=0;ba = bottom adjust
      If wy2+wy1>dth-20
        ba=(wy2+wy1)-(dth-20)
      EndIf
      CaptureScreen(wx1, wy1, wx2, wy2-ba)
    EndIf
  EndIf
  
  Select Ev
    
  Case #PB_Event_Repaint
    wx1 = WindowX(#CaptureBoxWin) ;Returns the left position on the screen, in pixels, of the given window.
    wy1 = WindowY(#CaptureBoxWin)  ;Returns the top position on the screen, in pixels, of the given window.
    wx2 = WindowWidth(#CaptureBoxWin) ;Return the width, in pixels, of the given window.
    wy2 = WindowHeight(#CaptureBoxWin)
    If wy1<-5 And wy1>-3000
      wy1=-4
      ResizeWindow(#CaptureBoxWin, wx1, wy1, wx2, wy2)
    EndIf
    If wy2>dth
      wy2=dth
      ResizeWindow(#CaptureBoxWin, wx1, wy1, wx2, wy2)
    EndIf
    
    If wx1>-5 And wy1>-5 ; needed because minimize will give negative numbers
      ;and the program will fault out.
      px2=wx2
      py2=wy2
      hdc = StartDrawing(WindowOutput(#CaptureBoxWin))
      DrawingMode(#PB_2DDrawing_Outlined)
      ;Text "Press F7 to Capture" line length = @ 262
      If px2>262
        DrawingFont(FontID(26))
        DrawText(((px2-262)/2), (py2/2)-20, "Press " , RGB(255, 0, 0),RGB(255, 255, 255))
        
        DrawingFont(FontID(27))
        DrawText(((px2-262)/2)+54, (py2/2)-28, "F7" , RGB(255, 0, 0),RGB(255, 255, 255))
        
        DrawingFont(FontID(26))
        DrawText(((px2-262)/2)+94, (py2/2)-20, " to Capture Image" , RGB(255, 0, 0),RGB(255, 255, 255))
      Else
        DrawingFont(FontID(26))
        DrawText(((px2-262)/2)+90, (py2/2)-55, "Press " , RGB(255, 0, 0),RGB(255, 255, 255))
        
        DrawingFont(FontID(27))
        DrawText(((px2-262)/2)+144, (py2/2)-63, "F7" , RGB(255, 0, 0),RGB(255, 255, 255))
        
        DrawingFont(FontID(26))
        DrawText(((px2-262)/2)+74, (py2/2)-20, " to Capture Image" , RGB(255, 0, 0),RGB(255, 255, 255))
      EndIf
      
      Box(0,0,WindowWidth(#CaptureBoxWin),WindowHeight(#CaptureBoxWin), #Red)
      Box(1,1,WindowWidth(#CaptureBoxWin)-2,WindowHeight(#CaptureBoxWin)-2, #Red)
      Box(2,2,WindowWidth(#CaptureBoxWin)-4,WindowHeight(#CaptureBoxWin)-4, #Red)
      StopDrawing()
      hwnd = WindowID(#CaptureBoxWin)
      SetWindowLong_(Hwnd,#GWL_EXSTYLE,GetWindowLong_(Hwnd,#GWL_EXSTYLE) | #WS_EX_LAYERED)
    EndIf
    
  Default
  EndSelect
  
Until Ev = #PB_Event_CloseWindow
End

[dobro]

Thank !
the idea came to me mostly a result of this post of SkyManager

viewtopic.php?f=5&t=45362&p=346208&sid= ... 0a#p346208

[dobro]

Small update

Adding the button "All" to capture the entire screen

[dobro]

update of my code colored

Adding a CheckBoxGadget "Auto"

when this check is enabled, the window catch
will automatically take the size of the object underneath the mouse

it is useful to quickly capture a button for example

In this mode, a return key is pressed will launch Capture
(just read the title of the window)