Free hand captures as bitmaps

Published on by Yousfi Benameur

This code provides a free hand capture of any  visible  desktop window region  by hand (with mouse).

It uses exclusively windows APIs and a table as cursor to gather the captured points.

The idea is to fire a top level form made alpha transparent (to see behind) and to capture any region  with mouse.The captured region is confined  by mouse as a simple drawing.

the gdi32 APIs does the job from the cursor built.(CreateRectRgn,CreatePolygonRgn, CombineRgn,setwindowRgn...)

the captured region is then sent to the clipboard by the API keybd_event who is equivalent to PRTSCREEN key

then the gdiplus APIs restore the clipboard as a normal image (can save as png,jpg,bmp,gif or ,tif...or even other gdiplus formats not enumerated in code(emf,..))

Select the code an d paste into a prg and run.can build a project to produce an executable.

-i put 2 years ago,  in foxite  this capture utility you can download (the rgion capture is made with gdiplusX , another solution):http://www.foxite.com/downloads/default.aspx?id=222
this make all known captures(window,screen,rectangular zône,free hand,roundrectangle...)

Can use r/R to reduce the transparent window and ESC to exit application.

 


*Begin Code

if  !_vfp.startmode=0
On Shutdown Quit   && in case you build exe from project
endi

Set Exact On
Set Safe Off
_Screen.AddProperty("yrest",.F.)
_Screen.AddProperty("ytype","jpg")
Publi m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Set Defa To (yrep)

Publi yform
yform=Newobject("ycap_fh")
yform.Show
Read Events
sleep(500)

If _Screen.yrest=.T.
    =yrestore_image(_Screen.ytype)
Endi
Return
*

Define Class ycap_fh As Form
    BorderStyle = 0
    Top = 0
    Left = 0
    Height = 768
    Width = 1024
    ShowWindow = 2
    Caption = "Form1"
    Movable = .F.
    FillStyle = 0
    KeyPreview = .T.
    TitleBar = 0
    FillColor = Rgb(255,166,166)
    posx = 0
    posy = 0
    hrgn = .F.
    hrgnbase = .F.
    xtjpeg = 90
    yext = "jpg"
    Name = "yFreeHand"

    Procedure yregionOn
        This.hrgnbase=0
        This.hrgn=0
        This.hrgnbase = CreateRectRgn(0,0,Thisform.Width,Thisform.Height)
        #Define Alternate 1
        #Define WINDING 2
        lcPoints = Space(0)
        Sele ycurs
        Scan
            lcPoints = lcPoints + Thisform.num2dword(x) + Thisform.num2dword(Y)
        Endscan
        This.hrgn   =CreatePolygonRgn(@lcPoints,Reccount() ,WINDING)


        #Define RGN_XOR 3  &&make the region transparent
        Local m.yy
        m.yy=  CombineRgn(This.hrgnbase, This.hrgnbase, This.hrgn, RGN_XOR)
        Local m.xx
        m.xx = SetWindowRgn(Thisform.HWnd, This.hrgnbase, "TRUE")  &&.t. dont work ?

        DeleteObject(This.hrgn)
        DeleteObject(This.hrgnbase)
        Thisform.Cls  &&clear red drawing
        sleep(300)
  
        Clear Dlls "CreateRectRgn","CreatePolygonRgn","CombineRgn","SetWindowRgn"

        &&capture window
        Declare Integer keybd_event In Win32API ;
            INTEGER, Integer, Integer, Integer
        VK_SNAPSHOT = 44    && from the winuser.h
        VK_LMENU = 164
        KEYEVENTF_KEYUP = 2
        KEYEVENTF_EXTENDEDKEY = 1

        *The following commands copy the active form window to the
        *clipboard (the equivalent of ALT+PrintScrn):
        DoEvents
        keybd_event( VK_LMENU,    0, KEYEVENTF_EXTENDEDKEY, 0 )  && key down
        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
        sleep(300)

        Thisform.Release
    Endproc

    Procedure num2dword
        Lparameters lnValue

        #Define m0 0x0000100
        #Define m1 0x0010000
        #Define m2 0x1000000
        If lnValue < 0
            lnValue = 0x100000000 + lnValue
        Endif
        Local b0, b1, b2, b3
        b3 = Int(lnValue/m2)
        b2 = Int((lnValue - b3*m2)/m1)
        b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
        b0 = Mod(lnValue, m0)
        Return Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)
    Endproc

    Procedure ytranspa
        #Define LWA_COLORKEY 1
        #Define LWA_ALPHA 2
        #Define GWL_EXSTYLE -20
        #Define WS_EX_LAYERED 0x80000
        Declare Integer GetActiveWindow In user32
        yHWnd=Thisform.HWnd

        &&transparency
        Local nExStyle, nRgb, nAlpha, nFlags
        yHWnd=Thisform.HWnd
        nExStyle = GetWindowLong(yHWnd, GWL_EXSTYLE)
        nExStyle = Bitor(nExStyle, WS_EX_LAYERED)
        = SetWindowLong(yHWnd, GWL_EXSTYLE, nExStyle)

        nRgb=Rgb(255,0,255)
        nAlpha=128
        nFlags=2
        = SetLayeredWindowAttributes(yHWnd, m.nRgb, m.nAlpha, m.nFlags)
        *Messagebox("Press r/R to reduce the window,ESC to release!",0+32+4096,"",1000)
    Endproc

    Procedure KeyPress
        Lparameters nKeyCode, nShiftAltCtrl
        If nKeyCode=27  &&release form
            Thisform.Release
        Endi

        If nKeyCode=114  Or nKeyCode=82  &&r/R reduce
            Thisform.WindowState=1
        Endi
    Endproc

    Procedure Init
        Thisform.yext=Inputbox("save captures as: jpg,png,bmp,gif,tif","","jpg")

        If Empty(Thisform.yext)
            Thisform.yext=[jpg] &&&
        Endi

        If  ! Inlist(Lower(Thisform.yext),;
"jpg","png","bmp","gif","tif")
            Thisform.yext=[jpg]  &&&
        Endi

        _Screen.WindowState=1   &&reduce vfp window to see behind

        If !Directory(m.yrep+"captures")
            Md (m.yrep+"captures")
        Endi

        Publi xtype,cl,ca
        xtype=5 &&free hand
        cl=0
        ca=.T.

        With Thisform
            .Left=0
            .Top=0
            .Width=Sysmetric(1)
            .Height=Sysmetric(2)+Sysmetric(9)+Sysmetric(4)
            .hrgnbase=0
            .hrgn=0
        Endwith
        Thisform.SetAll("mousepointer",15,"commandbutton")
        Thisform.ytranspa()
    Endproc


    Procedure Destroy
        This.hrgn=0
        This.hrgnbase=0

        With _Screen
            .yrest=.T.
            .ytype=Thisform.yext
        Endwith
        Clea Events
    Endproc

    Procedure Load
        Close Data All
        Declare Integer Sleep In kernel32 Integer
        Declare Integer CreateRectRgn In gdi32;
            INTEGER nLeftRect, Integer nTopRect,;
            INTEGER nRightRect, Integer nBottomRect

        Declare Integer CombineRgn In gdi32;
            INTEGER hrgnDest, Integer hrgnSrc1,;
            INTEGER hrgnSrc2,;
            INTEGER fnCombineMode

        Declare Long SetWindowRgn In WIN32API Long HWnd, Long hRgn, String bRedraw
        Declare Integer CreatePolygonRgn In gdi32 String@ pPoints, Integer nPoints, Integer nfillmode    &&vfp declaration
        Declare Integer DeleteObject In gdi32   Integer hObject

        Declare Integer OpenClipboard In user32  Integer HWnd
        Declare Integer EmptyClipboard  In user32
        Declare Integer CloseClipboard In user32
        =OpenClipboard(0)
        * Handle to the window to be associated with the open clipboard
        * If this parameter is NULL, the open clipboard is associated with the current task.

        =EmptyClipboard()  &&empty the clipboard
        =CloseClipboard() &&mandatory to work with clipboard

        Declare Integer GetClipboardData            In User32 Integer
        Declare Integer GdipCreateBitmapFromHBITMAP In GDIPlus.Dll Integer, Integer, Integer @
        Declare Integer GdipSaveImageToFile         In GDIPlus.Dll Integer,String,String @,String @

        Declare Integer GetWindowLong In user32;
            INTEGER HWnd, Integer nIndex

        Declare Integer SetWindowLong In user32;
            INTEGER HWnd, Integer nIndex, Integer dwNewLong

        Declare Integer SetLayeredWindowAttributes In user32;
            INTEGER HWnd, Integer crKey,;
            SHORT bAlpha, Integer dwFlags

        Create Cursor ycurs (x i,Y i)  &&to record (x,y)p oints
    Endproc

    Procedure MouseDown
        Lparameters nButton, nShift, nXCoord, nYCoord
        If nButton=1  And cl=0 And ca=.T. And xtype=5
            Thisform.Cls
            x0=nXCoord
            y0=nYCoord
            This.MousePointer=2
            Thisform.ForeColor=255
            Thisform.DrawWidth=3
            Thisform.DrawStyle=0
            Thisform.PSet(x0,y0)    && point drawing origin
        Endi
    Endproc

    Procedure MouseMove
        Lparameters nButton, nShift, nXCoord, nYCoord
        If nButton=0
            Thisform.MousePointer=0
        Endi

        If  nButton=1 And cl=1 And ca=.T.  And !xtype=5
            Thisform.DrawWidth=3
            Thisform.Box(x0,y0,nXCoord,nYCoord)
            t0=Seconds()
            Do While Seconds()-t0<=0.05
            Enddo
            Thisform.Cls
        Endi

        If nButton=1  And cl=0 And ca=.T. And xtype=5
            x0=nXCoord
            y0=nYCoord
            This.MousePointer=2
            Thisform.ForeColor=255
            Thisform.DrawWidth=3
            Thisform.DrawStyle=0
            Thisform.Line(x0,y0)
            &&point in visible form area
            If Between(x0,0,Thisform.Width) And Between(y0,0,Thisform.Height)
                Insert Into ycurs Values (x0,y0)
            Endi
        Endi
    Endproc

    Procedure MouseUp
        Lparameters nButton, nShift, nXCoord, nYCoord
        If  nButton=1 And cl=0 And ca=.T. And  xtype=5   &&free hand
            Thisform.MousePointer=0
            cl=1
            Sele ycurs
            Locate
            Insert Into ycurs Values (x,Y)  &&close curve
            = SetLayeredWindowAttributes(Thisform.HWnd, 0, 0,0)   &&opaque
            Thisform.yregionOn()
            DoEvents
        Endi
    Endproc

Enddefine
* Enddefine ycap_fh

 

Function yrestore_image
    Lparameters xtype
    If Pcount()=0
        xtype="jpg"
    Endi
    xtype=Lower(xtype)
    Declare Integer OpenClipboard               In User32 Integer
    Declare Integer CloseClipboard              In User32
    Declare Integer GetClipboardData            In User32 Integer
    Declare Integer GdipCreateBitmapFromHBITMAP In GDIPlus.Dll Integer, Integer, Integer @
    Declare Integer GdipSaveImageToFile         In GDIPlus.Dll Integer,String,String @,String @

    Do Case
        Case xtype="png"  &&png
            lqEncoderClsID_PNG=0h06F47C55041AD3119A730000F81EF32E &&PNGFormat

        Case xtype="jpg"  &&jpg
            lqEncoderClsID_JPG=0h01F47C55041AD3119A730000F81EF32E &&JPGFormat

        Case xtype="bmp"  &&bmp
            lqEncoderClsID_BMP=0h00F47C55041AD3119A730000F81EF32E &&BMPFormat

        Case xtype="gif" &&gif
            lqEncoderClsID_GIF=0h02F47C55041AD3119A730000F81EF32E &&GIFFormat

        Case xtype="tif" &&tiff
            lqEncoderClsID_TIF=0h05F47C55041AD3119A730000F81EF32E &&TIFFormat

    Endcase

    #Define CF_BITMAP 2
    #Define CF_DIB 8
    #Define IMAGE_BITMAP 0

    * restore image saved before in  local clipboard
    =OpenClipboard(0)
    hBitmap = GetClipboardData(CF_BITMAP)
    hDib = GetClipboardData(CF_DIB)
    =CloseClipboard()

    If hBitmap=0
        Messagebox("no captured image in clipboard!",16+4096)
        Return .F.
    Endi
    Local m.x
    m.x=Strtran(Ttoc(Datetime()),"\","_")
    m.x=Strtran(m.x," ","_")
    m.x=Strtran(m.x,';','_')
    m.x=Strtran(m.x,':','_')
    m.x=Strtran(m.x,'/','_')
    lcOutputFile0=m.yrep+"captures\ytemp_"+m.x+"."+xtype

    uBitmap=0
    GdipCreateBitmapFromHBITMAP(hBitmap,2,@uBitmap)
    lcOutputFile=Strconv(m.lcOutputFile0+Chr(0),5)
    GdipSaveImageToFile(uBitmap,lcOutputFile,Eval("lqEncoderClsID_"+xtype),Null)
    Messagebox("Image saved in captures folder",0+32+4096,500)
    *run/n explorer /select, &lcoutputfile0
Endfunc

*End Code

to do:limit the window to the captured zône only instead screen window...(searching an API for this operation).
to do:limit the window to the captured zône only instead screen window...(searching an API for this operation).
to do:limit the window to the captured zône only instead screen window...(searching an API for this operation).
to do:limit the window to the captured zône only instead screen window...(searching an API for this operation).

to do:limit the window to the captured zône only instead screen window...(searching an API for this operation).

To be informed of the latest articles, subscribe:
Comment on this post