Enhanced ImageCapture (an Imaging Capturing Tool)

I am currently working on a new project where I needed to capture images again for the Sellers to be used on their ID and on forms, so I fished out ImageCapture.prg which Gelson L. Bremm shared to us:  http://weblogs.foxite.com/vfpimaging/2006/03/20/capture-screen-portions/

But this time I decided to attempt to enhance it for my needs so I changed some approaches and used GDIPlus-X for the saving of the image instead of the original approach he has implemented.  Doing so, I was able to cut around 60% of the original codes too.   Check this for GDIPlus-X: https://github.com/VFPX/GDIPlusX in case you needed to download it.

Likewise incorporated here is a simple trick on form nudging capability so you can use the keyboard arrows to position the capture form which is easier than purely using mouse.  Also, when you adjust the form width and height, there is no need for you to worry adjusting the capture coordinates as well as that will also auto-adjust based on both form height and width set.

Here is the enhanced version of that:

* Enhanced version of ImageCapture.prg (May 3, 2018)

* Original Developer:  German L. Bremm

* http://weblogs.foxite.com/vfpimaging/2006/03/20/capture-screen-portions/

Lparameters toObject, cFileOutput

Public gToObject, gcFileOutput

gToObject = m.toObject

gcFileOutput = m.cFileOutput

Public oCapturaImg

oCapturaImg = Createobject("ImgCapture")

oCapturaImg.Show()

Define Class ImgCapture As Form

      Name = "ImgCapture"

      Height = 332

      Width = 300

      AutoCenter = .T.

      Caption = "Position over the Image you want to Capture"

      MaxButton = .F.

      MinButton = .F.

      AlwaysOnTop = .T.

      ShowWindow = 2

      BorderStyle = 0

      BackColor = Rgb(60,60,60)

      _nBorder = Sysmetric(10)

      _nTitleBarHeight = Sysmetric(9)

      _nFormWidth = 0

      _nFormHeight = 0

      Add Object cmdSnap As CommandButton With;

            Height = 28,;

            Caption = '\<Grab Image',;

            Width = 142,;

            Left = 5,;

            FontName = 'Arial',;

            FontSize = 14,;

            FontBold = .T.

      Procedure Init

            Declare Integer CombineRgn In "GDI32" Integer hDestRgn, Integer hRgn1, Integer hRgn2, Integer nMode

            Declare Integer CreateRectRgn In "GDI32" Integer X1, Integer Y1, Integer X2, Integer Y2

            Declare Integer SetWindowRgn In "user32" Integer HWnd, Integer hRgn, Integer nRedraw

            This.Resize()

      Endproc

      Procedure Resize

            With This

                  .cmdSnap.Left = .Width-.cmdSnap.Width-4

                  .cmdSnap.Top = .Height-.cmdSnap.Height-5

                  .cmdSnap.Tag = Allt(Str(.cmdSnap.Left))

                  .SetTransparent()

            Endwith

      Endproc

      Procedure SetTransparent

            Local lnInnerRgn, lnOuterRgn, lnRgnHandle

            With This

                  ._nFormWidth = .Width + (._nBorder * 2)

                  ._nFormHeight = .Height + ._nTitleBarHeight + ._nBorder

                  lnOuterRgn = CreateRectRgn(2, 2, ._nFormWidth+2, ._nFormHeight+2)

                  lnInnerRgn = CreateRectRgn(._nBorder+6,._nTitleBarHeight+8,._nFormWidth-._nBorder-4,._nFormHeight-._nBorder-34)

                  lnRgnHandle= CreateRectRgn(0, 0, 0, 0)

                  CombineRgn(m.lnRgnHandle, m.lnOuterRgn, m.lnInnerRgn, 4) 

                  SetWindowRgn(.HWnd , m.lnRgnHandle, .T.)

                  .BorderStyle = 1

            Endwith

      Endproc

      Procedure CopyToFile

            Do Locfile("system.app")

            Local locapturebmp As xfcbitmap, lcImage

            lcImage = m.gcFileOutput

            If Empty(m.lcImage)

                  lcImage = Getpict("png")

            Endif

            Clear Resources

            With _Screen.System.drawing

                  * Coordinates are X, Y, Width and Height

                  locapturebmp = .Bitmap.fromscreen(Thisform.HWnd,;

                        thisform._nBorder+6,;

                        thisform._nTitleBarHeight+8,;

                        thisform._nFormWidth-Thisform._nBorder-10,;

                        thisform._nFormHeight-Thisform._nBorder-Thisform.cmdSnap.Height-36,;

                        .F.)

                  locapturebmp.Save(m.lcImage, .imaging.imageformat.png,.imaging.imageformat.png)

            Endwith

            * Update target Image object

            gToObject.Picture = m.lcImage

            CLEAR RESOURCES m.lcImage

      Endproc

      Procedure KeyPress

            Lparameters nKeyCode, nShiftAltCtrl

            * Use Keyboard arrows to nudge frame

            Do Case

            Case m.nKeyCode = 24  && move down

                  Thisform.Top = Thisform.Top + 1

            Case m.nKeyCode = 5  && move up

                  Thisform.Top = Thisform.Top - 1

            Case m.nKeyCode = 19  && move left

                  Thisform.Left = Thisform.Left - 1

            Case m.nKeyCode = 4  && move right

                  Thisform.Left = Thisform.Left + 1

            Endcase

      Endproc

      Procedure cmdSnap.Click

            This.BackColor = Rgb(255,0,0)

            This.Caption = 'Capturing...'

            Thisform.CopyToFile()

            Thisform.Release()

      Endproc

      Procedure Destroy

            oCapturaImg = Null

            gToObject = Null

            gcFileOutput = Null

            Release oCapturaImg

            Release gToObject

            Release gcFileOutput

            Release CombineRgn

            Release CreateRectRgn

            Release SetWindowRgn

      Endproc

Enddefine

If you notice, I am passing two parameters.  First parameter is the image object to show the result of the capturing and the second one is the fullpath and name of the file to be saved.  Calling it is like this:

Do Form snagface With thisform.Image1, csrGrid.sellerid

So I can call that from anywhere on my form and immediately after grabbing an image, it gets displayed on an Image object.  And here is how it looks like (using my favorite cat as the model):

Darn, I really love that cat's expression.  Always makes me smile. :)

Special thanks to both Gelson L. Bremm and Cesar Chalom for this and other tools Cesar has shared to us.