The provided code in ScrnShot.Prg is a FiveWin/Harbour program containing several functions for capturing screenshots and converting files into JPEG images.
#include "fivewin.ch"
#define GW_CHILD 5
#define GW_HWNDNEXT 2
//----------------------------------------------------------------------------//
function PdfToJpeg( cPDF )
local cExe := "c:\Tracker Software\PDF Viewer\PDFXCview.exe"
local cTitle := cFileNoExt( cPDF ) //+ " - PDF-XChange Viewer"
local cCmd, oIni
local hWnd, hBmp, hBmp2, hDib, cBuf, nWait := 2
local lRet := .f.
oIni := TIni():New( "PDFXCVIEW.INI" )
cExe := oIni:Get( "PDFXCVIEW", "FULLPATH", cExe )
if ! File( cExe )
cExe := cGetFile( "PDFXCView.Exe |PDFXCView.Exe|", "Select Installed Location", ;
nil, "c:\" )
endif
if Empty( cExe ) .or. ! File( cExe )
return .f.
endif
oIni:Set( "PDFXCVIEW", "FULLPATH", cExe )
if File( cExe ) .and. File( cPDF )
// cCmd := cExe + ' /A "fullscreen=yes"' + ' ' + LFN2SFN( cPDF )
cCmd := cExe + ' /A "fullscreen=yes"' + ' "' + cPDF + '"'
// cCmd := cExe + ' /A "Zoom=150"' + ' ' + cPDF
WinExec( cCmd )
SysWait( 3 )
do while nWait < 12 .and. Empty( hWnd := FindWnd( cTitle ) )
SysWait( nWait )
nWait += 1
enddo
if ! Empty( hWnd )
SetFocus( hWnd )
SetForeGroundWindow( hWnd )
SysRefresh()
SysWait( 0.1 )
hBmp := WndBitmap( hWnd )
SendMessage( hWnd, WM_CLOSE )
hBmp2 := BmpTrim( hBmp )
DeleteObject( hBmp )
hDib := DibFromBitmap( hBmp2 )
cBuf := DibToStr( hDib )
GlobalFree( hDib )
DeleteObject( hBmp2 )
lRet := BmpBufToJpg( cFileSetExt( cPDF, "jpg" ), cBuf )
cBuf := nil
endif
endif
return lRet
//----------------------------------------------------------------------------//
function FindWnd( cTitle )
local hWnd := GetWindow( GetDesktopWindow(), GW_CHILD )
local aGetWindowText := {}
*----------------------------------------------------------
while hWnd != 0
if len (alltrim( GetWindowText( hWnd ) ) ) > 0
AADD( aGetWindowText, left( Upper( GetWindowText( hWnd ) ), len( ALLTRIM( cTitle) ) ) )
endif
if Upper( cTitle ) $ left( Upper( GetWindowText( hWnd ) ), len( ALLTRIM( cTitle) ) )
return hWnd
endif
hWnd = GetWindow( hWnd, GW_HWNDNEXT )
end
// xbrowse( aGetWindowText )
return nil
//----------------------------------------------------------------------------//
static function BmpTrim( hBmp ) // Trim black sides on left and right
local hOldBmp, hDC, hDCMem, hBmpTrim
local nLeft := 0, nRight := 0
local nHeight, nWidth, ny
*----------------------------------------------------------
nWidth := nBmpWidth( hBmp )
nHeight := nBmpHeight( hBmp )
hDC := GetDC( GetDeskTopWindow() )
hDCMem := CreateCompatibleDC( hDC )
hOldBmp := SelectObject( hDCMem, hBmp )
ny := Int( nHeight / 2 )
do while nLeft < .4 * nWidth .and. GetPixel( hDCMem, nLeft, ny ) == 0
nLeft++
enddo
nRight := nWidth - 1
do while nRight > .6 * nWidth .and. GetPixel( hDCMem, nRight, ny ) == 0
nRight--
enddo
SelectObject( hDCMem, hOldBmp )
DeleteDC( hDCMem )
ReleaseDC( GetDesktopWindow(), hdc )
hBmpTrim := CropImage( hBmp, 0, nLeft, nHeight, nRight )
return hBmpTrim
//----------------------------------------------------------------------------//
function WordToJpeg( cFile )
local oWord, oDoc, hWnd, hBmp,hBmp2, hDib, cBuf
local lRet := .f.
local nWidth := GetSysMetrics( 0 )
local nHeight := GetSysMetrics( 1 )
if nWidth > 1920
nWidth := 1124 //1920
endif
oWord := CreateObject("Word.Application")
if ( oWord := WinWordObj() ) == nil
// MsgInfo( "Can not load MS Word OLE" )
else
oWord:Caption := "TEMPWINHOTEL"
if Empty( hWnd := FindWnd( "TEMPWINHOTEL" ) )
// MsgInfo( "MS Word not active" )
else
oDoc := oWord:Documents:Open( cFile )
oWord:ActiveDocument:ActiveWindow:View:ReadingLayout := .t.
oWord:Visible := .t.
oWord:WindowState := 1 // Maximize
SetFocus( hWnd )
SetForeGroundWindow( hWnd )
SysRefresh()
SysRefresh()
SysWait( 0.9 )
hBmp := WndBitmap( hWnd )
oDoc:Close()
oWord:Quit()
/*
hBmp := DocBmpTrim( hBmp )
hDib := DibFromBitmap( hBmp )
cBuf := DibToStr( hDib )
*/
hBmp2 := DocBmpTrim( hBmp )
DeleteObject( hBmp )
//CropImage( hOringalBmp, nTop, nLeft, nBottom, nRight ) --> hCroppedBmp.
hBmp2 := CropImage( hBmp2, 150, 40, nHeight,nWidth )
hDib := DibFromBitmap( hBmp2 )
cBuf := DibToStr( hDib )
GlobalFree( hDib )
DeleteObject( hBmp )
lRet := BmpBufToJpg( cFileSetExt( cFile, "jpg" ), cBuf )
cBuf := nil
// Without some message, GPF is occuring
SysWait(0.2)
SysRefresh()
endif
endif
//FindAllWnd( )
return lRet
//----------------------------------------------------------------------------//
static function DocBmpTrim( hBmp )
local hOldBmp, hDC, hDCMem, hBmpTrim
local nLeft := 1, nRight := 0, nTop := 1, nBottom := 0
local nBmpHeight, nBmpWidth, ny, nx
local nColor := 0
local lTrimmed := .f.
*----------------------------------------------------------
nBmpWidth := nBmpWidth( hBmp )
nBmpHeight := nBmpHeight( hBmp )
nRight := nBmpWidth - 2
nBottom := nBmpHeight - 2
hDC := GetDC( GetDeskTopWindow() )
hDCMem := CreateCompatibleDC( hDC )
hOldBmp := SelectObject( hDCMem, hBmp )
ny := Int( nBmpHeight / 2 )
nx := Int( nBmpWidth / 2 )
if ( nColor := GetPixel( hDCMem, 1, nY ) ) == GetPixel( hDCMem, nBmpWidth - 2, nY )
else
nColor := -1
endif
if nColor >= 0
do while nLeft < .4 * nBmpWidth .and. GetPixel( hDCMem, nLeft, ny ) == nColor
nLeft++
enddo
do while nRight > .4 * nBmpWidth .and. GetPixel( hDCMem, nRight, ny ) == nColor
nRight--
enddo
nTop := 2
nBottom := nBmpHeight - 3
nX := Int( ( nLeft + nRight ) / 2 )
nColor := GetPixel( hDCMem, nX, 2 )
do while nTop < .4 * nBmpHeight .and. GetPixel( hDCMem, nX, nTop ) == GetPixel( hDCMem, 2, nTop )
nTop++
enddo
do while nBottom > .6 * nBmpHeight .and. GetPixel( hDCMem, nX, nBottom ) == GetPixel( hDCMem, 2, nBottom )
nBottom--
enddo
lTrimmed := .t.
endif
SelectObject( hDCMem, hOldBmp )
DeleteDC( hDCMem )
ReleaseDC( GetDesktopWindow(), hdc )
if lTrimmed
hBmpTrim := CropImage( hBmp, nTop, nLeft, nBottom, nRight - 800 )
DeleteObject( hBmp )
endif
return If( lTrimmed, hBmpTrim, hBmp )
//----------------------------------------------------------------------------//
static function BmpBufToJpg( cJpeg, cBuf )
local hMem, nFormat, hDib, hDib2, lRet := .f.
local nQuality := 0 // Default
if LoadFreeImage() <= 32
MsgAlert( "freeimage.dll not found" )
return .f.
endif
hMem := FI_OpenMemory( cBuf, Len( cBuf ) )
nFormat := FI_GetFileTypeFromMemory( hMem, 0 )
hDib := FI_LoadFromMemory( nFormat, hMem, 0 )
cBuf := nil // to release memory
FI_CloseMemory( hMem )
hDib2 := FICnv24( hDib )
FIUnload( hDib )
lRet := FISave( 2, hDib2, cJpeg, nQuality )
FIUnload( hDib2 )
return lRet
//----------------------------------------------------------------------------//
function RTFToJpeg( cPDF )
local oPrn
local cExe := "c:\Program Files\Windows NT\Accessories\wordpad.exe"
local cTitle := cFileNoExt( cPDF ) //+ " - PDF-XChange Viewer"
local cCmd, oIni, hCroppedBmp
local hWnd, hBmp, hBmp2, hDib, cBuf, nWait := 2
local lRet := .f.
local cFile
local nWidth := GetSysMetrics( 0 )
local nHeight := GetSysMetrics( 1 )
if nWidth > 1920
nWidth := 1920
endif
if File( cPDF )
cCmd := cExe + ' ' + cPDF + ''
WinExec( cCmd )
SysWait( 3 )
do while nWait < 12 .and. Empty( hWnd := FindWnd( cTitle ) )
SysWait( nWait )
nWait += 1
enddo
if ! Empty( hWnd )
SetFocus( hWnd )
SetForeGroundWindow( hWnd )
SysRefresh()
SysWait( 0.1 )
hBmp := WndBitmap( hWnd )
SendMessage( hWnd, WM_CLOSE )
hBmp2 := BmpTrim( hBmp )
DeleteObject( hBmp )
//CropImage( hOringalBmp, nTop, nLeft, nBottom, nRight ) --> hCroppedBmp.
hBmp2 := CropImage( hBmp2, 150, 420, nHeight,nWidth-420 )
hDib := DibFromBitmap( hBmp2 )
cBuf := DibToStr( hDib )
GlobalFree( hDib )
DeleteObject( hBmp2 )
lRet := BmpBufToJpg( cFileSetExt( cPDF, "jpg" ), cBuf )
cBuf := nil
endif
endif
return lRet
//----------------------------------------------------------------------------//
function FindAllWnd( )
local hWnd := GetWindow( GetDesktopWindow(), GW_CHILD )
local aGetWindowText := {}
*----------------------------------------------------------
while hWnd != 0
if len (alltrim( GetWindowText( hWnd ) ) ) > 0
AADD( aGetWindowText, { GetWindowText( hWnd ), hWnd } )
endif
hWnd = GetWindow( hWnd, GW_HWNDNEXT )
end
xbrowse( aGetWindowText )
return nil
//----------------------------------------------------------------------------//
function MSGToJpeg( cMSG )
local cTitle := ""
local hWnd, hBmp, hBmp2, hDib, cBuf, nWait := 2
local lRet := .f.
local nWidth := GetSysMetrics( 0 )
local nHeight := GetSysMetrics( 1 )
local aClass := {}
cTitle := msgGetTitle( cMSG )
return nil
if nWidth > 1920
nWidth := 1920
endif
if File( cMSG )
ShellExecute( 0, 'Open', cMSG )
SysWait( 3 )
do while nWait < 5 .and. Empty( hWnd := FindWnd( cTitle ) )
SysWait( nWait )
nWait += 1
enddo
if ! Empty( hWnd )
SetFocus( hWnd )
SetForeGroundWindow( hWnd )
SysRefresh()
SysWait( 0.8 )
// for a test
EnumChildWindows( hWnd,;
{ | hWnd, nLParam | AADD( aClass,{ GetClassName( hWnd ), hWnd } ), .T. },; // .T. means continue
0 ) // optional supplied value
xbrowse( aClass )
// for a test end
hBmp := WndBitmap( hWnd )
SendMessage( hWnd, WM_CLOSE )
hBmp2 := BmpTrim( hBmp )
DeleteObject( hBmp )
// hBmp2 := CropImage( hBmp2, 150, 420, nHeight,nWidth-420 )
hDib := DibFromBitmap( hBmp2 )
cBuf := DibToStr( hDib )
GlobalFree( hDib )
DeleteObject( hBmp2 )
lRet := BmpBufToJpg( cFileSetExt( cMSG, "jpg" ), cBuf )
cBuf := nil
endif
endif
return lRet
//----------------------------------------------------------------------------//
//coldprinter := StandardDruckerUmstellen( cDruckerName )
function StandardDruckerUmstellen( cDruckerName )
local coldprinter := prnGetName() // default printer
*----------------------------------------------------------
if len( ALLTRIM( cDruckerName ) ) > 0
WriteProfString( "windows", "device", cDruckerName ) // change to new printer
SetPrintDefault( cDruckerName )
PrinterInit()
SysRefresh()
endif
return( coldprinter )
//------------------------------------------------------------------------------------------//
function change2default_printer( coldprinter )
WriteProfString( "windows", "device",coldprinter) // default printer
SetPrintDefault(coldprinter)
PrinterInit()
SysRefresh()
return nil
//------------------------------------------------------------------------------------------//
#pragma BEGINDUMP
#include <hbapi.h>
#include <hbapiitm.h>
#include <windows.h>
void hb_evalBlock( PHB_ITEM pCodeBlock, ... );
static PHB_ITEM pCodeBlock = NULL;
BOOL CALLBACK static EnumChildProc( HWND hWnd, LPARAM lParam )
{
PHB_ITEM pHWnd = hb_itemPutNL( NULL, ( LONG ) hWnd );
PHB_ITEM pParam = hb_itemPutNL( NULL, ( LONG ) lParam );
if( pCodeBlock )
hb_evalBlock( pCodeBlock, pHWnd, pParam, 0 );
hb_itemRelease( pHWnd );
hb_itemRelease( pParam );
return hb_parl( -1 );
}
HB_FUNC( ENUMCHILDWINDOWS )
{
HWND hWnd = ( HWND ) hb_parnl( 1 );
LPARAM lParam = ( LPARAM ) hb_parnl( 3 );
pCodeBlock = hb_param( 2, HB_IT_BLOCK );
hb_retl( EnumChildWindows( hWnd, EnumChildProc, lParam ) );
pCodeBlock = NULL;
}
#pragma ENDDUMP
