to José Lalin - TCaptureBitmap

[Ingo JH]

Dear José Lalin,
could you extentent the component TCaptureBitmap that the hardcopy keeps the
same proportion of height and width as the original?
Regrds Ingo

[jlalin]

Ingo,
> could you extentent the component TCaptureBitmap that the hardcopy keeps
> the same proportion of height and width as the original?
I am very busy right now but you can add this code to your application and
modify it. Once you get it working sent it to me and I will update the
component ASAP.
CLASS TCaptureBitmap FROM XCaptureBitmap
METHOD Hardcopy( lPreview, cTitle )
ENDCLASS
METHOD Hardcopy( lPreview, cTitle ) CLASS XCaptureBitmap
LOCAL lOk := .F.
LOCAL oPicture
IF !Empty( ::Handle )
DEFAULT lPreview TO .T., ;
cTitle TO "Hardcopy"
Application:lBusy := .T.
Printer:lPreview := lPreview
Printer:nPreviewShowMode := smMAXIMIZE
Printer:nPrintQuality := DMRES_HIGH
Printer:cJobTitle := cTitle
Printer:nOrientation := DMORIENT_LANDSCAPE
Printer:StartDoc()
Printer:oCanvas:nMapMode := mmPIXELS
Printer:StartPage()
oPicture := TPicture():New()
oPicture:CreateIndirect( IMG_BITMAP, ::Handle )
Printer:oCanvas:DrawPicture( { 100, 100, Printer:PaperRes()[1],
Printer:PaperRes()[2] }, oPicture )
oPicture:Destroy()
Printer:EndPage()
Printer:EndDoc()
Application:lBusy := .F.
IF lPreview
Printer:Preview()
ENDIF
lOk := .T.
ENDIF
RETURN lOk
Regards,
José Lalí­n

[jlalin]

Ingo,
> METHOD Hardcopy( lPreview, cTitle ) CLASS XCaptureBitmap
Change it to METHOD Hardcopy( lPreview, cTitle ) CLASS TCaptureBitmap
Regards,
José Lalí­n

[Ingo JH]

José,
thanks for the code. It helps me to do it this way:
CLASS TCaptureBitmap FROM XCaptureBitmap
METHOD Hardcopy( lPreview, cTitle, nProportion ) // nProportion =
oForm:nHeigth / oForm:nWidth
ENDCLASS
METHOD Hardcopy( lPreview, cTitle, nProportion ) CLASS TCaptureBitmap
LOCAL lOk := .F.
LOCAL oPicture
IF !Empty( ::Handle )
DEFAULT lPreview TO .T., ;
cTitle TO "Hardcopy",;
nProportion TO 1
Application:lBusy := .T.
Printer:lPreview := lPreview
Printer:nPreviewShowMode := smMAXIMIZE
Printer:nPrintQuality := DMRES_HIGH
Printer:cJobTitle := cTitle
Printer:nOrientation := IIF(nProportion <1, DMORIENT_LANDSCAPE,
DMORIENT_PORTRAIT)
Printer:StartDoc()
Printer:oCanvas:nMapMode := mmPIXELS
Printer:StartPage()
oPicture := TPicture():New()
oPicture:CreateIndirect( IMG_BITMAP, ::Handle )
Printer:oCanvas:DrawPicture( { 100, 100, Printer:PaperRes()[1]-100,;
(Printer:PaperRes()[1]-100)*nProportion }, oPicture )
oPicture:Destroy()
Printer:EndPage()
Printer:EndDoc()
Application:lBusy := .F.
IF lPreview
Printer:Preview()
ENDIF
lOk := .T.
ENDIF
RETURN lOk
Regards Ingo

[Ingo JH]

José,
I had to correct my changes:
METHOD Hardcopy( lPreview, cTitle, nProportion ) CLASS TCaptureBitmap
LOCAL lOk := .F.
LOCAL oPicture
LOCAL nHeight , nWidth
IF !Empty( ::Handle )
DEFAULT lPreview TO .T., ;
cTitle TO "Hardcopy",;
nProportion TO 1
Application:lBusy := .T.
Printer:lPreview := lPreview
Printer:nPreviewShowMode := smMAXIMIZE
Printer:nPrintQuality := DMRES_HIGH
Printer:cJobTitle := cTitle
Printer:nOrientation := IIF(nProportion < 1, DMORIENT_LANDSCAPE,
DMORIENT_PORTRAIT)
Printer:StartDoc()
Printer:oCanvas:nMapMode := mmPIXELS
Printer:StartPage()
oPicture := TPicture():New()
oPicture:CreateIndirect( IMG_BITMAP, ::Handle )
nWidth := Printer:PaperRes()[1]-100
nHeight := Printer:PaperRes()[2]-100
IF nHeight > nWidth
nHeight := nWidth * nProportion
ELSE
nWidth := nHeight / nProportion
ENDIF
Printer:oCanvas:DrawPicture( { 100, 100, nWidth, nHeight}, oPicture)
oPicture:Destroy()
Printer:EndPage()
Printer:EndDoc()
Application:lBusy := .F.
IF lPreview
Printer:Preview()
ENDIF
lOk := .T.
ENDIF
RETURN lOk
Regards Ingo

[jlalin]

Ingo,
many thanks! I will try to update the component ASAP.
Regards,
José Lalí­n

[Ingo JH]

//---------------------------------------------------------- --------------------
CLASS TForm FROM XForm
METHOD WMKeyDown( nKey, nFlags )
ENDCLASS
//---------------------------------------------------------- --------------------
METHOD WMKeyDown( nKey, nFlags ) CLASS TForm
LOCAL uRet,nProportion := 1
IF ( uRet := ::OnKeyDown( nKey, nFlags ) ) != Nil
RETURN uRet
ENDIF
IF nKey == VK_F12
WITH OBJECT TCaptureBitmap():New()
:Capture( Self )
nProportion := ::nHeight/::nWidth
:Hardcopy( .T., "Screenshot "+::cText, nProportion )
END
RETURN 0
ENDIF
RETURN Super:WMKeyDown( nKey, nFlags )
//---------------------------------------------------------- --------------------
CLASS TCaptureBitmap FROM XCaptureBitmap
METHOD Hardcopy( lPreview, cTitle, nProportion )
ENDCLASS
//---------------------------------------------------------- --------------------
METHOD Hardcopy( lPreview, cTitle, nProportion ) CLASS TCaptureBitmap
LOCAL lOk := .F.
LOCAL oPicture
LOCAL nHeight , nWidth
IF !Empty( ::Handle )
DEFAULT lPreview TO .T., ;
cTitle TO "Hardcopy",;
nProportion TO 1
Application:lBusy := .T.
Printer:lPreview := lPreview
Printer:nPreviewShowMode := smMAXIMIZE
Printer:nPrintQuality := DMRES_HIGH
Printer:cJobTitle := cTitle
Printer:nOrientation := IIF(nProportion < 1, DMORIENT_LANDSCAPE,;
DMORIENT_PORTRAIT)
Printer:StartDoc()
Printer:oCanvas:nMapMode := mmPIXELS
Printer:StartPage()
oPicture := TPicture():New()
oPicture:CreateIndirect( IMG_BITMAP, ::Handle )
nWidth := Printer:PaperRes()[1]-100
nHeight := Printer:PaperRes()[2]-100
IF nHeight > nWidth
nHeight := nWidth * nProportion
ELSE
nWidth := nHeight / nProportion
ENDIF
Printer:oCanvas:DrawPicture( { 100, 100, nWidth, nHeight}, oPicture)
oPicture:Destroy()
Printer:EndPage()
Printer:EndDoc()
Application:lBusy := .F.
IF lPreview
Printer:Preview()
ENDIF
lOk := .T.
ENDIF
RETURN lOk
--

[jlalin]

Ingo,
> here is the code I implemented at last in my projecct.
many thanks!
> I have to thank you very much for your great work and your helpfulness and
> patience.
Your welcome!
BTW, I did some little changes to make it even simpler to use. Now all the
calculations are done inside the method and we just need to pass .T. or .F.
to keep the image aspect ratio:
IF nKey == VK_F12
WITH OBJECT TCaptureBitmap():New()
:Capture( Self )
:Hardcopy( .T., "Screenshot "+::cText, .T. )
END
It would be great if you can test it.
CLASS TCaptureBitmap FROM XCaptureBitmap
PUBLIC:
METHOD Hardcopy( lPreview, cTitle, lKeekProportion )
ENDCLASS
METHOD Hardcopy( lPreview, cTitle, lKeepProportion ) CLASS TCaptureBitmap
LOCAL lOk := .F.
LOCAL oPicture
LOCAL nHeight, nWidth
LOCAL aRect, nWndWidth, nWndHeight
LOCAL nProportion := 0
IF !Empty( ::Handle )
DEFAULT lPreview TO .T., ;
cTitle TO "Hardcopy", ;
lKeepProportion TO .T.
IF lKeepProportion
aRect := GetClientRect( ::hWho )
nWndWidth := aRect[3] - aRect[1]
nWndHeight := aRect[4] - aRect[2]
nProportion := nWndHeight / nWndWidth
ENDIF
Application:lBusy := .T.
Printer:lPreview := lPreview
Printer:nPreviewShowMode := smMAXIMIZE
Printer:nPrintQuality := DMRES_HIGH
Printer:cJobTitle := cTitle
Printer:nOrientation := IIF( nProportion < 1, DMORIENT_LANDSCAPE,
DMORIENT_PORTRAIT )
Printer:StartDoc()
Printer:oCanvas:nMapMode := mmPIXELS
Printer:StartPage()
oPicture := TPicture():New()
oPicture:CreateIndirect( IMG_BITMAP, ::Handle )
nWidth := Printer:PaperRes()[1] - 100
nHeight := Printer:PaperRes()[2] - 100
IF nHeight > nWidth
nHeight := nWidth * nProportion
ELSE
nWidth := nHeight / nProportion
ENDIF
Printer:oCanvas:DrawPicture( { 100, 100, nWidth, nHeight }, oPicture )
oPicture:Destroy()
Printer:EndPage()
Printer:EndDoc()
Application:lBusy := .F.
IF lPreview
Printer:Preview()
ENDIF
lOk := .T.
ENDIF
RETURN lOk
Regards,
José Lalí­n

[jlalin]

Ingo,
Oops! I meant you're welcome...
Regards,
José Lalí­n