Re: Screenshot-Captura_Pantallas
Posted: Mon Oct 03, 2016 4:24 pm
To Roberto:
What is : "#pragma TEXTHIDDEN(1) " and what does it do ??
Thx,
Serge
What is : "#pragma TEXTHIDDEN(1) " and what does it do ??
Thx,
Serge
Exclusive forum for HMG, a Free / Open Source xBase WIN32/64 Bits / GUI Development System
http://hmgforum.com/
OK, my two cent:Roberto Lopez wrote:Well...
...
Happy Capturing!!!
Enjoy!
Code: Select all
/*
Re: Screenshot-Captura_Pantallas
Postby Roberto Lopez ยป 03 Oct 2016 17:14
Well...
Be careful, since I've modified certain BOS Taurus functions to use handles instead window names.
Maybe you must rename some of such functions.
BT_WINHANDLE
BT_FILLRECTISNIL
BT_ADJUSTWIDTHHEIGHTRECT
BT_CLIENTAREAWIDTH
BT_CLIENTAREAHEIGHT
BT_BITMAPSAVEFILE
BT_BITMAPRELEASE
BT_BITMAPCAPTURECLIENTAREA
( added RL to BTs )
*/
#include <hmg.ch>
PROC Main()
DEFINE WINDOW frmCS_Main ;
AT 0,0 ;
WIDTH 120 HEIGHT 90 ;
TITLE 'Capture Screen' ;
MAIN
ON KEY ESCAPE ACTION ThisWindow.Release
@ 10, 10 BUTTON btnCapture CAPTION "Capture !" ACTION CaptureSystem()
END WINDOW
frmCS_Main.Center
frmCS_Main.Activate
RETU // CaptScrn.Main()
/*
<...>
DEFINE TIMER Timer_1 ;
INTERVAL 30000 ;
ACTION CaptureSystem()
<...>
*/
*------------------------------------------------------------------------------*
FUNCTION CaptureSystem()
*------------------------------------------------------------------------------*
LOCAL cFileName
frmCS_Main.Minimize()
frmCS_Main.Hide
cBaseDir := ''
dDate := DATE()
cYear := ALLTRIM( STR( YEAR( dDate ) ) )
cMonth := ALLTRIM( STRZERO(MONTH( dDate ) , 2 ) )
cDay := ALLTRIM( STRZERO(DAY ( dDate ) , 2 ) )
cTime := TIME()
cHour := LEFT ( cTime , 2 )
cMinutes := SUBSTR( cTime , 4 , 2 )
cSeconds := RIGHT ( cTime , 2)
cFileName := cBaseDir + cYear + '-' + cMonth + '-' + cDay + '-' + cHour + '-' + cMinutes + '-' + cSeconds
xSAVEWINDOWBYHANDLE ( BT_SCR_GETDESKTOPHANDLE() , cFileName + '.' + 'jpg' , 0 , 0 , 1366 , 768 )
frmCS_Main.Restore()
frmCS_Main.Show
MsgDebug( cFileName )
FTPUP(cFileName + '.jpg' )
DELETE FILE (cFileName + '.jpg' )
RETURN NIL
*._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-
PROCEDURE FTPUP(cFileName)
#pragma TEXTHIDDEN(1)
cNetServer := 'your server addres here'
cServer := cNetServer + ':your server port here'
cUser := "your username"
cPassword := "your password"
#pragma TEXTHIDDEN(0)
cUrl := "ftp://" + cUser + ":" + cPassword + "@" + cServer
oUrl := tUrl():New( cUrl )
oFTP := tIPClientFtp():New( oUrl, .F. )
oFTP:nConnTimeout := 20000
oFTP:bUsePasv := .T.
/* We check if the user has an @ to force the userid */
IF At( "@", cUser ) > 0
oFTP:oUrl:cServer := cServer
oFTP:oUrl:cUserID := cUser
oFTP:oUrl:cPassword := cPassword
ENDIF
IF oFTP:Open( cUrl )
oFtp:UploadFile( cFileName )
oFTP:Close()
ELSE
cStr := "Could not connect to the FTP server" + " " + oURL:cServer
IF oFTP:SocketCon == NIL
cStr += Chr( 13 ) + Chr( 10 ) + "Connection uninitialized"
ELSEIF hb_InetErrorCode( oFTP:SocketCon ) == 0
cStr += Chr( 13 ) + Chr( 10 ) + "Server Response:" + " " + oFTP:cReply
ELSE
cStr += Chr( 13 ) + Chr( 10 ) + "Connection Failed:" + " " + hb_InetErrorDesc( oFTP:SocketCon )
ENDIF
*MSGSTOP(cStr)
ENDIF
RETURN
*._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-
*------------------------------------------------------------------------------*
FUNCTION XSAVEWINDOWBYHANDLE ( nHandle , cFileName , nRow , nCol , nWidth , nHeight )
*------------------------------------------------------------------------------*
LOCAL hBitmap
hBitmap := BTRL_BITMAPCAPTURECLIENTAREA ( nHandle , nRow, nCol, nWidth, nHeight)
IF hBitmap <> 0
IF UPPER(RIGHT( cFileName , 4 ) ) == '.GIF'
BTRL_BITMAPSAVEFILE (hBitmap, cFileName , BT_FILEFORMAT_GIF )
ELSEIF UPPER(RIGHT( cFileName , 4 ) ) == '.JPG'
BTRL_BITMAPSAVEFILE (hBitmap, cFileName , BT_FILEFORMAT_JPG )
ELSEIF UPPER(RIGHT( cFileName , 4 ) ) == '.PNG'
BTRL_BITMAPSAVEFILE (hBitmap, cFileName , BT_FILEFORMAT_PNG )
ELSEIF UPPER(RIGHT( cFileName , 4 ) ) == '.BMP'
BTRL_BITMAPSAVEFILE (hBitmap, cFileName , BT_FILEFORMAT_BMP )
ENDIF
BTRL_BITMAPRELEASE (hBitmap)
ENDIF
RETURN hBitmap
*._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-
Function BTRL_BITMAPCAPTURECLIENTAREA ( nHandle , Row, Col, Width, Height)
LOCAL New_hBitmap
LOCAL Max_Width := BTRL_CLIENTAREAWIDTH( nHandle )
LOCAL Max_Height := BTRL_CLIENTAREAHEIGHT( nHandle )
BTRL_FILLRECTISNIL (@Row, @Col, @Width, @Height, 0, 0, Max_Width, Max_Height)
BTRL_ADJUSTWIDTHHEIGHTRECT (Row, Col, @Width, @Height, Max_Width, Max_Height)
New_hBitmap := BT_BMP_CAPTURESCR ( nHandle , Col, Row, Width, Height, BT_BITMAP_CAPTURE_DESKTOP)
Return New_hBitmap
*._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-
Function BTRL_BITMAPSAVEFILE (hBitmap, cFileName, nTypePicture)
LOCAL lRet
nTypePicture := IF (Valtype(nTypePicture) == "U", BT_FILEFORMAT_BMP, nTypePicture)
lRet := BT_BMP_SAVEFILE (hBitmap, cFileName, nTypePicture)
Return lRet
*._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-
Function BTRL_BITMAPRELEASE (hBitmap)
BT_BMP_RELEASE (hBitmap)
Return Nil
*._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-
Function BTRL_CLIENTAREAWIDTH ( nHandle )
LOCAL Width := BT_SCR_GETINFO ( nHandle , BT_SCR_CLIENTAREA, BT_SCR_INFO_WIDTH)
Return Width
*._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-
Function BTRL_CLIENTAREAHEIGHT ( nHandle )
LOCAL Height := BT_SCR_GETINFO ( nHandle , BT_SCR_CLIENTAREA, BT_SCR_INFO_HEIGHT)
Return Height
*._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-
Function BTRL_FILLRECTISNIL (Row, Col, Width, Height, Row_value, Col_value, Width_value, Height_value)
Row := IF (Valtype(Row) =="U", Row_value, Row)
Col := IF (Valtype(Col) =="U", Col_value, Col)
Width := IF (Valtype(Width) =="U", Width_value, Width)
Height := IF (Valtype(Height) =="U", Height_value, Height)
Return Nil
*._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-
Function BTRL_ADJUSTWIDTHHEIGHTRECT (Row, Col, Width, Height, Max_Width, Max_Height)
Width := IF ((Col + Width > Max_Width), (Max_Width - Col), Width)
Height := IF ((Row + Height > Max_Height), (Max_Height - Row), Height)
Return Nil
*._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-
Function BTRL_WINHANDLE (Win)
LOCAL hWnd := IF (ValType(Win)=="N", Win, GetFormHandle(Win))
Return hWnd
*._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-
Basically, the content between #pragma TEXTHIDDEN(1) and #pragma TEXTHIDDEN(0) are not visible looking at the exe file (ie: with an hex editor).serge_girard wrote:To Roberto:
What is : "#pragma TEXTHIDDEN(1) " and what does it do ??
Thx,
Serge
Meesgici wrote:Does anyone can test on his own server ?
This is the line to un-comment:Roberto Lopez wrote:And... un-comment the error message display line to see what's going on...
Code: Select all
*MSGSTOP(cStr)
And... please replace:Roberto Lopez wrote: This is the line to un-comment:Code: Select all
*MSGSTOP(cStr)
Code: Select all
oFtp:UploadFile( cFileName )
Code: Select all
IF ! oFtp:UploadFile( cFileName )
MSGINFO('Upload Error!')
ELSE
MSGINFO('Upload Ok!')
ENDIF
Thank you very much,Roberto Lopez wrote: This is the line to un-comment:
...
And... please replace:
...
If you have not so much experience with FTP, I recommend you: "Quick and Easy FTP Server":esgici wrote:Thank you very much,Roberto Lopez wrote: This is the line to un-comment:
...
And... please replace:
...
now I can see: my connection info has some problem
( In fact I haven't enough experience on that field )
Tomorrow I hope to find some remedies.
Regards
Viva HMG
Thank you very muchRoberto Lopez wrote:...
If you have not so much experience with FTP, I recommend you:...
...
The lite version supports up to three users, this is enough for testing.