Auto Cropping 3

TariqMehmod · Nov 9, 2020

ear Experts

I have following excel file

I want to create an image based on usedcells (B3:J22)
Is it possible to crop required range then create an image.

I think GDIPLUS can do this, so I found these links but still confuse how to do this.

http://vfpimaging.blogspot.com/2006/05/crop-images-with-gdi_1348.html

https://www.levelextreme.com/Home/ShowHeader?Activator=17&ID=18584

The codes in this link crop whole screen but not required area

http://vfpimaging.blogspot.com/p/gpimage2-faqs.html#CaptureScreen

Please help

GriffMG · Nov 10, 2020

My turn... there is bound to be a problem...

Code:

* getting desktop path
loShell = CREATEOBJECT ('WScript.Shell')
lcDesktop = loShell.SpecialFolders('desktop')

* select file
lcXLS = GETFILE('XLSx')
IF EMPTY(lcXLS)
    * user has cancelled
    RETURN
ENDIF

    LOCAL oForm
    oForm = CREATEOBJECT("Form")

    WITH oForm

        .HEIGHT = 550
        .WIDTH = 360
        .AUTOCENTER=.T.
        .CAPTION=[Dashboard]
        .MINBUTTON=.F.
        .MAXBUTTON=.F.
        .ALWAYSONTOP=.T.

        .NEWOBJECT("ExcelObject","oleExcelObject")  && Add OLE object
        WITH .ExcelObject
            .LEFT = 5
            .TOP = 5
            .WIDTH = .PARENT.WIDTH - 10
            .HEIGHT = .PARENT.HEIGHT - 10
            .VISIBLE = .T.
        ENDWITH

        .NEWOBJECT("Timer1","oTimer")  		


    oForm.SHOW(1)  && form is modal, so no need for READ EVENTS
ENDWITH

DEFINE CLASS oleExcelObject AS OLECONTROL
    OLECLASS ="Excel.Sheet"  && Server name
    OLETYPEALLOWED = 0      && Linked
    DOCUMENTFILE = lcXLS && This file should exist
ENDDEFINE

DEFINE CLASS oTimer AS TIMER							&& timer
    INTERVAL=5000

    PROCEDURE TIMER
    THIS.ENABLED = .F.
    DO ScreenShot(THIS.PARENT)
    THIS.ENABLED = .T.
ENDDEFINE

PROCEDURE ScreenShot
PARAMETER oFORM
PRIVATE oFORM

#INCLUDE gpImage.h

IF NOT "gpImage" $ SET("Procedure")
    SET PROCEDURE TO gpImage ADDITIVE
ENDIF

GDIP = CREATEOBJECT("gpInit")
img = CREATEOBJECT("gpImage")
img.Capture(oFORM.HWND)
LOCAL lnTitleHeight, lnLeftBorder, lnTopBorder
lnTitleHeight = SYSMETRIC(9)
lnLeftBorder = SYSMETRIC(3)
lnTopBorder = SYSMETRIC(4)
img.Crop(lnLeftBorder, lnTitleHeight + lnTopBorder, ;
img.ImageWidth - (lnLeftBorder * 2), ;
img.ImageHeight - (lnTitleHeight + (lnTopBorder * 2)))
img.SaveasBMP(lcDesktop+'\'+"Dash")
img = NULL
GDIP = NULL
RELEASE oFORM

ENDFUNC

Regards

Griff
Keep [Smile]ing

There are 10 kinds of people in the world, those who understand binary and those who don't.

I'm trying to cut down on the use of shrieks (exclamation marks), I'm told they are !good for you.

TariqMehmod · Nov 10, 2020

Sir,

image is not uploading

But now error appears on this line

Code:

do screenshot(this.parent)

Error is
Invalid Subscript reference

Best regards

Mike Lewis · Nov 10, 2020

It should be [tt]DO ScreenShot WITH THIS.Parent[/tt].

Mike

__________________________________
Mike Lewis (Edinburgh, Scotland)

Visual FoxPro articles, tips and downloads

GriffMG · Nov 10, 2020

Sorry, rarely think proc only funct

Regards

Griff
Keep [Smile]ing

There are 10 kinds of people in the world, those who understand binary and those who don't.

I'm trying to cut down on the use of shrieks (exclamation marks), I'm told they are !good for you.

TariqMehmod · Nov 10, 2020

Sir this time no error occurs

But

Form does not release, after every five seconds images file is replaced with new one.

Please help me to release this form after after 5 seconds.

I modified this portion

Code:

 Define Class oTimer As Timer							&& timer
	Interval=5000

	Procedure Timer
	This.Enabled = .F.
	Do ScreenShot With This.Parent
	This.Enabled = .T.
	This.Parent.Release
Enddefine

But Form still not releases.

Best Regards

GriffMG · Nov 10, 2020

Code:

Define Class oTimer As Timer							&& timer
	Interval=5000

	Procedure Timer
	This.Enabled = .F.
	Do ScreenShot With This.Parent
	This.Enabled = .T.
	Quit
Enddefine

Regards

Griff
Keep [Smile]ing

There are 10 kinds of people in the world, those who understand binary and those who don't.

I'm trying to cut down on the use of shrieks (exclamation marks), I'm told they are !good for you.

TariqMehmod · Nov 10, 2020

Sir,

Regards

GriffMG · Nov 10, 2020

Try putting this near the top of your code

Code:

ON SHUTDOWN CLEAR EVENTS

Regards

Griff
Keep [Smile]ing

There are 10 kinds of people in the world, those who understand binary and those who don't.

I'm trying to cut down on the use of shrieks (exclamation marks), I'm told they are !good for you.

TariqMehmod · Nov 10, 2020

Sir here are complete codes, I run the codes, images file is created successfully but FORM still not releases.

Code:

 ON SHUTDOWN CLEAR EVENTS

* getting desktop path
loShell = CREATEOBJECT ('WScript.Shell')
lcDesktop = loShell.SpecialFolders('desktop')

* select file
lcXLS = GETFILE('XLSx')
IF EMPTY(lcXLS)
    * user has cancelled
    RETURN
ENDIF

    LOCAL oForm
    oForm = CREATEOBJECT("Form")

    WITH oForm

        .HEIGHT = 550
        .WIDTH = 360
        .AUTOCENTER=.T.
        .CAPTION=[Dashboard]
        .MINBUTTON=.F.
        .MAXBUTTON=.F.
        .ALWAYSONTOP=.T.

        .NEWOBJECT("ExcelObject","oleExcelObject")  && Add OLE object
        WITH .ExcelObject
            .LEFT = 5
            .TOP = 5
            .WIDTH = .PARENT.WIDTH - 10
            .HEIGHT = .PARENT.HEIGHT - 10
            .VISIBLE = .T.
        ENDWITH

        .NEWOBJECT("Timer1","oTimer")  		


    oForm.SHOW(1)  && form is modal, so no need for READ EVENTS
ENDWITH

DEFINE CLASS oleExcelObject AS OLECONTROL
    OLECLASS ="Excel.Sheet"  && Server name
    OLETYPEALLOWED = 0      && Linked
    DOCUMENTFILE = lcXLS && This file should exist
ENDDEFINE


Define Class oTimer As Timer		
	Interval=5000

	Procedure Timer
	This.Enabled = .F.
	Do ScreenShot With This.Parent
	This.Enabled = .T.
	Quit
Enddefine 


PROCEDURE ScreenShot
PARAMETER oFORM
PRIVATE oFORM

#INCLUDE gpImage.h

IF NOT "gpImage" $ SET("Procedure")
    SET PROCEDURE TO gpImage ADDITIVE
ENDIF

GDIP = CREATEOBJECT("gpInit")
img = CREATEOBJECT("gpImage")
img.Capture(oFORM.HWND)
LOCAL lnTitleHeight, lnLeftBorder, lnTopBorder
lnTitleHeight = SYSMETRIC(9)
lnLeftBorder = SYSMETRIC(3)
lnTopBorder = SYSMETRIC(4)
img.Crop(lnLeftBorder, lnTitleHeight + lnTopBorder, ;
img.ImageWidth - (lnLeftBorder * 2), ;
img.ImageHeight - (lnTitleHeight + (lnTopBorder * 2)))
img.SaveasBMP(lcDesktop+'\'+"Dash")
img = NULL
GDIP = NULL
RELEASE oFORM

ENDFUNC

Mike Lewis · Nov 10, 2020

No, that won't work. Remember, this is a modal form. You cannot QUIT while a modal form is active. Also, CLEAR EVENTS won't help here as there is no READ EVENTS - and no need for one.

Mike

__________________________________
Mike Lewis (Edinburgh, Scotland)

Visual FoxPro articles, tips and downloads

TariqMehmod · Nov 10, 2020

Sir can we close this form with windows handle like shown here

http://yousfi.over-blog.com/2015/03/working-with-windows-handles-and-apis-part-i.html

Regards

Mike Lewis · Nov 10, 2020

Instead of this:

Code:

    oForm.SHOW(1)  && form is modal, so no need for READ EVENTS
ENDWITH

this seems to work (but I'm not sure why):

Code:

ENDWITH
    oForm.SHOW(1)  && form is modal, so no need for READ EVENTS

And get rid of the [tt]QUIT[/tt], and replace the[tt] RELEASE oForm[/tt] with [tt]oForm.Release[/tt]

Mike

__________________________________
Mike Lewis (Edinburgh, Scotland)

Visual FoxPro articles, tips and downloads

Mike Lewis · Nov 10, 2020

Sir can we close this form with windows handle like shown here

http://yousfi.over-blog.com/2015/03/working-with-w...

You're making it too complicated again. You don't need to go to such lengths just to close a form.

Mike

__________________________________
Mike Lewis (Edinburgh, Scotland)

Visual FoxPro articles, tips and downloads

Mike Lewis · Nov 10, 2020

So here is my latest version (again, not tested because I don't have the imaging control):

Code:

* getting desktop path
loShell = CREATEOBJECT ('WScript.Shell')
lcDesktop = loShell.SpecialFolders('desktop')

* select file
lcXLS = GETFILE('XLSx')
IF EMPTY(lcXLS)
    * user has cancelled
    RETURN
ENDIF

    LOCAL oForm
    oForm = CREATEOBJECT("Form")

    WITH oForm

        .HEIGHT = 550
        .WIDTH = 360
        .AUTOCENTER=.T.
        .CAPTION=[Dashboard]
        .MINBUTTON=.F.
        .MAXBUTTON=.F.
        .ALWAYSONTOP=.T.

        .NEWOBJECT("ExcelObject","oleExcelObject")  && Add OLE object
        WITH .ExcelObject
            .LEFT = 5
            .TOP = 5
            .WIDTH = .PARENT.WIDTH - 10
            .HEIGHT = .PARENT.HEIGHT - 10
            .VISIBLE = .T.
        ENDWITH

        .NEWOBJECT("Timer1","oTimer")  		
ENDWITH

    oForm.SHOW(1)  && form is modal, so no need for READ EVENTS


DEFINE CLASS oleExcelObject AS OLECONTROL
    OLECLASS ="Excel.Sheet"  && Server name
    OLETYPEALLOWED = 0      && Linked
    DOCUMENTFILE = lcXLS && This file should exist
ENDDEFINE

DEFINE CLASS oTimer AS TIMER							&& timer
    INTERVAL=5000

    PROCEDURE TIMER
    THIS.ENABLED = .F.
    DO ScreenShot WITH this.Parent
	this.enabled = .T.
ENDDEFINE

PROCEDURE ScreenShot
LPARAMETERS oForm

#INCLUDE gpImage.h

IF NOT "gpImage" $ SET("Procedure")
    SET PROCEDURE TO gpImage ADDITIVE
ENDIF

GDIP = CREATEOBJECT("gpInit")
img = CREATEOBJECT("gpImage")
img.Capture(THISFORM.HWND)
LOCAL lnTitleHeight, lnLeftBorder, lnTopBorder
lnTitleHeight = SYSMETRIC(9)
lnLeftBorder = SYSMETRIC(3)
lnTopBorder = SYSMETRIC(4)
img.Crop(lnLeftBorder, lnTitleHeight + lnTopBorder, ;
img.ImageWidth - (lnLeftBorder * 2), ;
img.ImageHeight - (lnTitleHeight + (lnTopBorder * 2)))
img.SaveasBMP(lcDesktop+'\'+"Dash")
img = NULL
oForm.Release

ENDFUNC

__________________________________
Mike Lewis (Edinburgh, Scotland)

Visual FoxPro articles, tips and downloads

TariqMehmod · Nov 10, 2020

Sorry sir

Best Regards

Mike Lewis · Nov 10, 2020

See the code that I just posted (the post just before your last).

Mike

__________________________________
Mike Lewis (Edinburgh, Scotland)

Visual FoxPro articles, tips and downloads

GriffMG · Nov 10, 2020

Are we nearly there yet?

Regards

Griff
Keep [Smile]ing

There are 10 kinds of people in the world, those who understand binary and those who don't.

I'm trying to cut down on the use of shrieks (exclamation marks), I'm told they are !good for you.

Mike Lewis · Nov 10, 2020

Post number 57.

Mike

__________________________________
Mike Lewis (Edinburgh, Scotland)

Visual FoxPro articles, tips and downloads

GriffMG · Nov 10, 2020

And only 45/46 US Presidents later

Regards

Griff
Keep [Smile]ing

There are 10 kinds of people in the world, those who understand binary and those who don't.

I'm trying to cut down on the use of shrieks (exclamation marks), I'm told they are !good for you.

TariqMehmod · Nov 11, 2020

Sir, Finally I used these codes

Code:

 Define Class oTimer As Timer
	Interval=5000

	Procedure Timer
	This.Enabled = .F.
	Do ScreenShot With This.Parent
	This.Enabled = .T.
	This.Parent.Hide(1)
	
Enddefine

Now form hides.
Specially thanks to Respected Sir GriffMG and Mike Lewis.

With Regards

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Auto Cropping 3

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Similar threads

Log in

Part and Inventory Search

Sponsor