PureBasic Forums - English

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

Capture Part or Full of Screen using mouse [Windows]

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

Page 1 of 1

Capture Part or Full of Screen using mouse [Windows]

Posted: Sun Sep 30, 2012 6:13 pm
by RASHAD
Tested with PB 4.61 x86 - Win 7 x64
Included a few of small tips

Code: Select all

#CAPTUREBLT  = $40000000
#VK_STARTKEY = $5B

UseJPEGImageEncoder()
UsePNGImageEncoder()

FWidth = GetSystemMetrics_(#SM_CXSCREEN)
FHeight = GetSystemMetrics_(#SM_CYSCREEN)

Procedure MinimizeAll()

keybd_event_(#VK_STARTKEY, 0, 0, 0)
keybd_event_(#VK_M, 0, 0, 0)
keybd_event_(#VK_M, 0, #KEYEVENTF_KEYUP, 0)
keybd_event_(#VK_STARTKEY, 0, #KEYEVENTF_KEYUP, 0)

EndProcedure

Procedure RestoreAll()

keybd_event_(#VK_STARTKEY, 0, 0, 0)
keybd_event_(#VK_SHIFT,0,0,0)
keybd_event_(#VK_M,0, 0, 0)
keybd_event_(#VK_M,0, #KEYEVENTF_KEYUP, 0)
keybd_event_(#VK_SHIFT,0,#KEYEVENTF_KEYUP,0)
keybd_event_(#VK_STARTKEY, 0, #KEYEVENTF_KEYUP, 0)

EndProcedure

Procedure HideFromTaskBar(hWnd, Flag)
  Protected TBL.ITaskbarList

  CoInitialize_(0)
  If CoCreateInstance_(?CLSID_TaskBarList, 0, 1, ?IID_ITaskBarList, @TBL) = #S_OK
    TBL\HrInit()
    If Flag
      TBL\DeleteTab(hWnd)
    Else
      TBL\AddTab(hWnd)
    EndIf
    TBL\Release()
  EndIf
  CoUninitialize_()

  DataSection
    CLSID_TaskBarList:
    Data.l $56FDF344
    Data.w $FD6D, $11D0
    Data.b $95, $8A, $00, $60, $97, $C9, $A0, $90
    IID_ITaskBarList:
    Data.l $56FDF342
    Data.w $FD6D, $11D0
    Data.b $95, $8A, $00, $60, $97, $C9, $A0, $90
  EndDataSection
EndProcedure

hWnd = OpenWindow(0,-300,-300,0,0,"",#PB_Window_BorderLess)
SetWindowColor(0,#Red)
SetWindowLong_(WindowID(0),#GWL_EXSTYLE,#WS_EX_LAYERED)
SetLayeredWindowAttributes_(WindowID(0),#Red,0,#LWA_COLORKEY)

OpenWindow(1,0,0,300,52,"Test",#WS_POPUP|#PB_Window_SystemMenu| #PB_Window_ScreenCentered|#PB_Window_Tool,WindowID(0))
ButtonGadget(1,5,5,90,40,"Capture"+Chr(10)+"Part of Screen",#BS_MULTILINE|#BS_CENTER|#BS_VCENTER|#WS_DLGFRAME)
ButtonGadget(2,105,5,90,40,"Capture"+Chr(10)+"Full Screen",#BS_MULTILINE|#BS_CENTER|#BS_VCENTER|#WS_DLGFRAME)
ButtonGadget(3,205,5,90,40,"Save As...",#BS_MULTILINE|#BS_CENTER|#BS_VCENTER|#WS_DLGFRAME)
HideFromTaskBar(WindowID(0), 1)

r.RECT
pen = CreatePen_(#PS_SOLID, 1, #Red)
brush = GetStockObject_(#NULL_BRUSH)
Repeat
  Select WaitWindowEvent()
      
      Case #PB_Event_CloseWindow
            Quit = 1
      
      Case #PB_Event_Gadget
          Select EventGadget()
           Case 1
                 Run ! 1
                 If Run = 1
                    ResizeWindow(0,0,0,FWidth,FHeight)
                 EndIf
                 
           Case 2
                If IsImage(0)
                   FreeImage(0)
                EndIf
                  MinimizeAll()
                  HideWindow(1,1)
                  Delay(300)
                  hBitmap = CreateImage(0,FWidth,FHeight)
                  hdc = StartDrawing(ImageOutput(0))
                  SelectObject_(hdc, hBitmap)
                  BitBlt_(hdc, 0, 0, FWidth,FHeight, GetDC_(GetDesktopWindow_()), 0, 0, #SRCCOPY | #CAPTUREBLT)
                  StopDrawing()
                  HideWindow(1,0)
                  RestoreAll()
                ;DeleteDC_(hdc)              
                  ReleaseDC_(hWnd, hdc)
                  
                 
           Case 3
                 SFile$ = SaveFileRequester("Save image as", "Image.bmp", "bmp|*.bmp|jpg|*.jpg;*.jpeg|png|*.png", 0)
                 Ext$ = GetExtensionPart(SFile$)
                 If Ext$ = "bmp"
                    SaveImage(0,SFile$,#PB_ImagePlugin_BMP)
                 ElseIf Ext$ = "jpg"
                    SaveImage(0,SFile$,#PB_ImagePlugin_JPEG)
                 ElseIf Ext$ = "png"
                    SaveImage(0,SFile$,#PB_ImagePlugin_PNG)
                 EndIf
                 
          EndSelect
          
      Case #WM_MOUSEMOVE
            If Flag = 1
                GetCursorPos_(p.POINT)
                Rectangle_(hdc, r\left,r\top,r\right,r\bottom)
                r\right = p\x
                r\bottom = p\y
                Rectangle_(hdc, r\left,r\top,r\right,r\bottom)
            EndIf 
        
  
      Case #WM_LBUTTONDOWN
            If GetActiveGadget() <> 1
                InvalidateRect_(hWnd, 0,1)
                GetCursorPos_(p.POINT)
                SetRect_(r,p\x,p\y,p\x-1,p\y-1)
                hdc = GetDC_(hWnd)
                SelectObject_(hdc, pen)
                SelectObject_(hdc, brush)
                SetROP2_(hdc, #R2_NOT)
                Rectangle_(hdc, r\left,r\top,r\right,r\bottom)
                Flag = 1
            EndIf
        
      Case #WM_LBUTTONUP
            If Flag = 1
              If IsImage(0)
                 FreeImage(0)
              EndIf
              width = r\right-r\left-2
              height = r\bottom-r\top-2
              If width > 0 And height > 0
                hBitmap = CreateImage(0,width,height)
                hdc = StartDrawing(ImageOutput(0))
                SelectObject_(hdc, hBitmap)
                BitBlt_(hdc, 0, 0, width, height, GetDC_(GetDesktopWindow_()), r\left+1, r\top+1,#SRCCOPY | #CAPTUREBLT)
                StopDrawing()
              EndIf
              ;DeleteDC_(hdc)              
              ReleaseDC_(hWnd, hdc)
              If Run = 0
                 ResizeWindow(0,-300,-300,0,0)
              EndIf              
              Flag = 0
            EndIf          

             
  EndSelect 

Until Quit = 1 Or GetAsyncKeyState_(#VK_ESCAPE)
End

Re: Capture Part or Full of Screen using mouse [Windows]

Posted: Sun Sep 30, 2012 7:57 pm
by falsam
Good trick Rashad. thank you for sharing. :)

Re: Capture Part or Full of Screen using mouse [Windows]

Posted: Mon Oct 01, 2012 9:03 am
by Bisonte
Nice... Like the Window Snipping Tool that shipped with Win7 Image

To be "perfect", how about capture the fullscreen first, then open your window... so your window is not on the capture image...

Re: Capture Part or Full of Screen using mouse [Windows]

Posted: Mon Oct 01, 2012 7:57 pm
by Kwai chang caine
Apparently the capture with mouse not works on XP with 4.61 :(

Re: Capture Part or Full of Screen using mouse [Windows]

Posted: Mon Oct 01, 2012 8:02 pm
by RASHAD
falsam,Bisonte and KCC
Thanks guys
KCC there is a problem bet #LWA_COLORKEY and XP
Next is rework using direct draw to DeskTop
It needs some enhancement
Try it

Code: Select all

#SHCNE_ASSOCCHANGED = $8000000
#CAPTUREBLT  = $40000000
#VK_STARTKEY = $5B

UseJPEGImageEncoder()
UsePNGImageEncoder()

FWidth = GetSystemMetrics_(#SM_CXSCREEN)
FHeight = GetSystemMetrics_(#SM_CYSCREEN)

Procedure MinimizeAll()

keybd_event_(#VK_STARTKEY, 0, 0, 0)
keybd_event_(#VK_M, 0, 0, 0)
keybd_event_(#VK_M, 0, #KEYEVENTF_KEYUP, 0)
keybd_event_(#VK_STARTKEY, 0, #KEYEVENTF_KEYUP, 0)

EndProcedure

Procedure RestoreAll()

keybd_event_(#VK_STARTKEY, 0, 0, 0)
keybd_event_(#VK_SHIFT,0,0,0)
keybd_event_(#VK_M,0, 0, 0)
keybd_event_(#VK_M,0, #KEYEVENTF_KEYUP, 0)
keybd_event_(#VK_SHIFT,0,#KEYEVENTF_KEYUP,0)
keybd_event_(#VK_STARTKEY, 0, #KEYEVENTF_KEYUP, 0)

EndProcedure

Procedure HideFromTaskBar(hWnd, Flag)
  Protected TBL.ITaskbarList

  CoInitialize_(0)
  If CoCreateInstance_(?CLSID_TaskBarList, 0, 1, ?IID_ITaskBarList, @TBL) = #S_OK
    TBL\HrInit()
    If Flag
      TBL\DeleteTab(hWnd)
    Else
      TBL\AddTab(hWnd)
    EndIf
    TBL\Release()
  EndIf
  CoUninitialize_()

  DataSection
    CLSID_TaskBarList:
    Data.l $56FDF344
    Data.w $FD6D, $11D0
    Data.b $95, $8A, $00, $60, $97, $C9, $A0, $90
    IID_ITaskBarList:
    Data.l $56FDF342
    Data.w $FD6D, $11D0
    Data.b $95, $8A, $00, $60, $97, $C9, $A0, $90
  EndDataSection
EndProcedure

hWnd = OpenWindow(0,0,0,FWidth,FHeight,"",#PB_Window_BorderLess|#PB_Window_Invisible)
SetWindowLong_(WindowID(0),#GWL_EXSTYLE,#WS_EX_LAYERED)
If OSVersion() >= #PB_OS_Windows_Server_2008
SetWindowColor(0,#Red)
   SetLayeredWindowAttributes_(WindowID(0),#Red,0,#LWA_COLORKEY)
Else
   SetLayeredWindowAttributes_(WindowID(0),0,1,#LWA_ALPHA)
EndIf

OpenWindow(1,0,0,300,52,"Test",#WS_POPUP|#PB_Window_SystemMenu| #PB_Window_ScreenCentered|#PB_Window_Tool,WindowID(0))
ButtonGadget(1,5,5,90,40,"Capture"+Chr(10)+"Part of Screen",#PB_Button_Toggle|#BS_MULTILINE|#BS_CENTER|#BS_VCENTER|#WS_DLGFRAME)
ButtonGadget(2,105,5,90,40,"Capture"+Chr(10)+"Full Screen",#BS_MULTILINE|#BS_CENTER|#BS_VCENTER|#WS_DLGFRAME)
ButtonGadget(3,205,5,90,40,"Save As...",#BS_MULTILINE|#BS_CENTER|#BS_VCENTER|#WS_DLGFRAME)
HideFromTaskBar(WindowID(0), 1)

r.RECT
pen = CreatePen_(#PS_SOLID, 1, #Green)
brush = GetStockObject_(#NULL_BRUSH)
Repeat
  Select WaitWindowEvent()
      
      Case #PB_Event_CloseWindow
            Quit = 1
      
      Case #PB_Event_Gadget
          Select EventGadget()
           Case 1                 
                 If GetGadgetState(1) = 1
                    HideWindow(0,0)
                 Else
                    HideWindow(0,1)
                 EndIf
                 
           Case 2
                If IsImage(0)
                   FreeImage(0)
                EndIf
                  MinimizeAll()
                  HideWindow(1,1)
                  Delay(300)
                  hBitmap = CreateImage(0,FWidth,FHeight)
                  hdc = StartDrawing(ImageOutput(0))
                  SelectObject_(hdc, hBitmap)
                  BitBlt_(hdc, 0, 0, FWidth,FHeight, GetDC_(GetDesktopWindow_()), 0, 0, #SRCCOPY | #CAPTUREBLT)
                  StopDrawing()
                  HideWindow(1,0)
                  RestoreAll()
                  DeleteDC_(hdc)              
                  ;ReleaseDC_(hWnd, hdc)
                  
                 
           Case 3
                 SFile$ = SaveFileRequester("Save image as", "Image.bmp", "bmp|*.bmp|jpg|*.jpg;*.jpeg|png|*.png", 0)
                 Ext$ = GetExtensionPart(SFile$)
                 If Ext$ = "bmp"
                    SaveImage(0,SFile$,#PB_ImagePlugin_BMP)
                 ElseIf Ext$ = "jpg"
                    SaveImage(0,SFile$,#PB_ImagePlugin_JPEG)
                 ElseIf Ext$ = "png"
                    SaveImage(0,SFile$,#PB_ImagePlugin_PNG)
                 EndIf
                 
          EndSelect
          
      Case #WM_MOUSEMOVE
            If Flag = 1
                GetCursorPos_(p.POINT)
                Rectangle_(hdc, r\left,r\top,r\right,r\bottom)
                r\right = p\x
                r\bottom = p\y
                Rectangle_(hdc, r\left,r\top,r\right,r\bottom)
            EndIf 
        
  
      Case #WM_LBUTTONDOWN
            If GetActiveWindow() = 0
                InvalidateRect_(hWnd, 0,1)
                If OSVersion() <= #PB_OS_Windows_Vista
                  SHChangeNotify_(#SHCNE_ASSOCCHANGED, $1000, 0, 0)
                  hdc = CreateDC_("DISPLAY", 0, 0, 0)
                Else
                  hdc = GetDC_(hWnd)
                EndIf                
                GetCursorPos_(p.POINT)
                SetRect_(r,p\x,p\y,p\x-1,p\y-1)                
                SelectObject_(hdc, pen)
                SelectObject_(hdc, brush)
                SetROP2_(hdc, #R2_NOTXORPEN)
                Rectangle_(hdc, r\left,r\top,r\right,r\bottom)
                Flag = 1
            EndIf
        
      Case #WM_LBUTTONUP
            SetROP2_(hdc, #R2_COPYPEN	)
            Rectangle_(hdc, r\left,r\top,r\right,r\bottom)
            If Flag = 1
              If IsImage(0)
                 FreeImage(0)
              EndIf
              width = r\right-r\left-2
              height = r\bottom-r\top-2
              If width > 0 And height > 0
                hBitmap = CreateImage(0,width,height)
                hdc = StartDrawing(ImageOutput(0))
                SelectObject_(hdc, hBitmap)
                BitBlt_(hdc, 0, 0, width, height, GetDC_(GetDesktopWindow_()), r\left+1, r\top+1, #SRCCOPY | #CAPTUREBLT)
                StopDrawing()
              EndIf
              Flag = 0              
              DeleteDC_(hdc)
              ;ReleaseDC_(hWnd, hdc)
            EndIf          

             
  EndSelect 

Until Quit = 1 Or GetAsyncKeyState_(#VK_ESCAPE)
End

Re: Capture Part or Full of Screen using mouse [Windows]

Posted: Mon Oct 01, 2012 8:23 pm
by Kwai chang caine
Yeeess !!! Works great now
Thanks a lot RASHAD for sharing your great code 8)
Believe you, this code also works with W7 ???

Re: Capture Part or Full of Screen using mouse [Windows]

Posted: Tue Oct 02, 2012 11:22 am
by RASHAD
Previous post updated for better performance

Have fun

Re: Capture Part or Full of Screen using mouse [Windows]

Posted: Tue Oct 02, 2012 12:51 pm
by rsts
Nice one.

Works fine on win 8.

cheers

Re: Capture Part or Full of Screen using mouse [Windows]

Posted: Tue Oct 02, 2012 1:38 pm
by Kwai chang caine
Just for info RASHAD, you have replaced the previous code, and now that not works a new time with VISTA and 4.61 :wink:
Impossible to select with the mouse
The old code works always fine on VISTA 8)

Re: Capture Part or Full of Screen using mouse [Windows]

Posted: Tue Oct 02, 2012 2:48 pm
by RASHAD
rsts Thanks
Well,moving to Win 8 it is fantastic OS much faster than Win 7
KCC I just updated the previous post :mrgreen:
Please check
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited