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.