Estimados Amigos del foro, alguién tendrá un ejemplo de grabar una imagen del portapapeles directamente a un archivo gráfico, especialmente en formato JPG,
Muchas Gracias por Vuestra Ayuda,
Saludos,
Grabar Portapapeles (clipboard) directo a un archivo de Imga
Grabar Portapapeles (clipboard) directo a un archivo de Imga
GUSTAVO PREDIGER
Con mi exemplo si,
Mira mas informacion en mi post en http://www.fivetechsoft.com/forums/view ... hp?t=13646
Executable http://www.5volution.com/downloads/clipbord.exe
Code: Select all
#include "FiveWin.ch"
#include "dll.ch"
#DEFINE WM_SYSCOMMAND 274 // &H112
#DEFINE SC_TASKLIST 61744 //&HF130
#DEFINE SC_SCREENSAVE 61760 // &HF140
#DEFINE SW_HIDE 0 // &H0
#DEFINE SW_SHOWNA 8 // &H8
#DEFINE SW_SHOW 5 // &H5
#DEFINE SW_SHOWNORMAL 1
#DEFINE SC_MONITORPOWER 61808 //&HF170 Gracias a Ramon Ramirez por la info
#DEFINE SM_CLEANBOOT 67
#DEFINE GWL_EXSTYLE (-20)
#DEFINE WS_EX_LAYERED 0x00080000
#DEFINE LWA_ALPHA 0x00000002
#DEFINE LWA_COLORKEY 0x00000001
#DEFINE GW_CHILD 5
#DEFINE GW_HWNDNEXT 2
#DEFINE RT_BITMAP 2
#DEFINE MB_ICONEXCLAMATION 48
#DEFINE CBM_INIT 4 && should move to prg header
#DEFINE DIB_RGB_COLORS 0 && should move to prg header
static hLib, hDib
Function Main(_tempo_)
Local oB, oApp, oIcon, oTimer, cImgFile := "service.bmp", oClp
public cUsuario := space(15), cImage, cIMGAlerta, oEsconde
lStatus := .f.
cPath := cFilePath( GetModuleFileName( GetInstance() ) )
_tempo_ := VerifyINI( "SERVICE", "TEMPO" , "360", cPath+"service.ini" )
cImage := VerifyINI( "SERVICE", "IMAGEM", "NAO", cPath+"service.ini" )
cIMGAlerta := VerifyINI( "SERVICE", "ALERTA", "SIM", cPath+"service.ini" )
HDSerial := HDSerial()
// if !file("service.dbf")
// DbCreate("service.dbf",{ { "Usuario" , "C", 15, 0},;
// { "Data" , "D", 8, 0},;
// { "Hora" , "C", 8, 0},;
// { "Imagem" , "C", 30, 0} } )
// endif
// USE service NEW SHARED
//---------------
ServiceProcess(1)
//---------------
DEFINE BRUSH oB COLOR CLR_HGRAY
DEFINE ICON oIcon FILE "LOGO.ICO"
DEFINE CLIPBOARD oClp OF oApp
DEFINE WINDOW oApp FROM 0,0 to 1,1 pixel TITLE "Service" BRUSH oB STYLE WS_POPUP ICON "racer.ico"
DEFINE TIMER oTimer OF oApp INTERVAL (val(_tempo_)*1000) ACTION GravaProcess( cImgFile, oApp )
ACTIVATE TIMER oTimer
ACTIVATE WINDOW oApp ON INIT (Shell_NotifyIcon( 0, "racer.ico" ), oApp:Hide()) //VALID (oEsconde:End(), .t.)
ShowWindow( FindWindow(nil,'Program Manager'), SW_SHOW)
ShowWindow(FindWindow( 'Shell_TrayWnd',nil), SW_SHOWNA)
Return NIL
//-------------------------------------
Function GravaProcess( cImgFile, oWnd )
//-------------------------------------
local lUsaClipBoard := .f.
if cImage = "SIM"
hWnd := FindWindow(nil,'Program Manager')
if lUsaClipBoard
WndCopy( hWnd, .f., .t. )
//
oClipBoard := TClipBoard():New( 2 ) // 1-text, 2-bitmap
oClipBoard:Open()
hBmp := oClipBoard:GetData()
oClipBoard:Close()
else
hBmp := WndBitmap( hWnd )
endif
fErase(cImgFile)
hDib := DibFromBitmap( hBmp )
DibWrite( cImgFile, hDib )
GlobalFree( hDib )
GlobalFree( hBmp )
//
// WaitRun( "nconvert -out jpeg -q 100 -D "+cImgFile, 0 )
ep := cFilePath( GetModuleFileName( GetInstance() ) )
oCopyImage := TOleAuto():New( "CopyImage.CopyImage.1" )
oCopyImage:CopyFile( ep + cImgFile, ep + strtran( cImgFile, "bmp", "jpeg" ), 90, 90 )
oCopyImage := nil
//
// dbSelectArea( "service" )
// dbAppend()
// service->usuario := NetName()
// service->data := Date()
// service->hora := Time()
// service->imagem := StrTran( cImgFile, ".bmp", ".jpg" )
// dbNetReglock()
endif
if cIMGAlerta = "SIM"
Ballon("Capturei mais uma imagem",2)
endif
dbSelectArea( "acessos" )
dbGoTop()
lStatus := acessos->Status
Return NIL
//-------------------------------------
Function ServiceProcess( mode )
//-------------------------------------
Local nProcessId := 0
Default mode := 0
nProcessId := GCP( )
If Abs( nProcessId ) > 0
RSProcess( nProcessId, mode )
Endif
RETURN
//-------------------------------------
Function Ballon(cBallonMsg,nBallonTime)
//-------------------------------------
local oDlgBallon, oBrush
default cBallonMsg := "Nova mensagem chegando..."
DEFINE WINDOW oDlgBallon ;
FROM GetSysMetrics(1),GetSysMetrics(0)-300 TO 200,200 PIXEL ;
COLOR nRGB(255,255,255),nRGB(255,255,230) ;
NO CAPTION BORDER NONE
@ 5, 5 GET cBallonMsg MEMO OF oDlgBallon SIZE 195,195 PIXEL COLOR nRGB(000,000,000),nRGB(255,255,230) NOBORDER NO MODIFY NO VSCROLL
// ACTIVATE WINDOW oDlgBallon ON INIT ( LayeredWindow( oDlgBallon, 070 ), MoveDLG(oDlgBallon,nBallonTime) )
ACTIVATE WINDOW oDlgBallon ON INIT MoveDLG(oDlgBallon,nBallonTime)
return nil
//-------------------------------------
Function LayeredWindow( oWnd, nLay )
//-------------------------------------
// SetWindowLong( oWnd:hWnd, GWL_EXSTYLE, GetWindowLong( oWnd:hWnd, GWL_EXSTYLE ) | WS_EX_LAYERED )
SetWindowLong( oWnd:hWnd, GWL_EXSTYLE, WS_BORDER )
SetWindowLong( oWnd:hWnd, GWL_EXSTYLE, WS_EX_LAYERED )
SetLayeredWindowAttributes( oWnd:hWnd, 0, ( 255 * nLay ) / 100, LWA_ALPHA )
Return NIL
//-------------------------------------
Function dbNetCommit( tempo )
//-------------------------------------
private sempre
dbCommit()
dbRUnlock() // tenta incluir registro
if RLock() // se conseguiu
mensagem(" Aguarde... Tentando liberar o registro")// se nao conseguiu
sempre = (tempo = 0) // fica tentando inclusao
for i = 1 to 10 // ate o tempo esgotar ou
dbRUnlock() // o usuario se encher...
if .not. neterr()
return .t.
endif
inkey(.5) && espera 1/2 segundo
tempo = tempo - .5
next
endif
return (.f.) && nao bloqueado
//-------------------------------------
Function dbNetAppend( tempo )
//-------------------------------------
private sempre
dbappend() // tenta incluir registro
if .not. neterr() // se conseguiu
return (.t.) // retorna verdadeiro
endif
mensagem(" Aguarde... Tentando Acesso aos Arquivos ") // se nao conseguiu
sempre = (tempo = 0) // fica tentando inclusao
do while (sempre .or. tempo > 0) .and. inkey()<>27 // ate o tempo esgotar ou
dbappend() // o usuario se encher...
if .not. neterr()
return .t.
endif
inkey(.5) && espera 1/2 segundo
tempo = tempo - .5
enddo
return (.f.) && nao bloqueado
//-------------------------------------
Function dbNetReglock( tempo )
//-------------------------------------
private sempre
if rlock()
return (.t.) && bloqueado
endif
dbUnlockAll()
mensagem(" Aguarde... Tentando Acesso aos Arquivos ")
sempre = (tempo = 0)
do while (sempre .or. tempo > 0) .and. inkey()<>27
if rlock()
return (.t.) && bloqueado
endif
inkey(.5) && espera 1/2 segundo
tempo = tempo - .5
enddo
return (.f.) && nao bloqueado
//-------------------------------------
Function MoveDLG(oDlgBallon,oDlgTime)
//-------------------------------------
oDlgAltura := GetSysMetrics(1)
for i = 1 to 20
oDlgAltura := oDlgAltura - i
oDlgBallon:Move( oDlgAltura, 100, 200, 200, .t. )
SysWait(.02)
next
SysWait(oDlgTime)
for i = 1 to 20
oDlgAltura := oDlgAltura + i
oDlgBallon:Move( oDlgAltura, 100, 200, 200, .t. )
SysWait(.02)
next
oDlgBallon:end()
return
//-------------------------------------
Function HDSERIAL()
//-------------------------------------
return substr(alltrim(str(nSerialHD())),1,8)
//-------------------------------------
Function MENSAGEM( MENSAGEM, TEMPO )
//-------------------------------------
if tempo <> NIL
MsgStop( OemToAnsi(MENSAGEM) )
else
MsgRun( OemToAnsi(MENSAGEM) )
endif
//-------------------------------------
Function Ping(DestinationAddress)
//-------------------------------------
local IcmpHandle,Replicas
local RequestData:="Testando ping",;
RequestSize:=15,;
RequestOptions:="",;
ReplyBuffer:=space(278),;
ReplySize:=278,;
Timeout:=500 && Milisegundos de espera
default DestinationAddress := "10.10.10.3"
DestinationAddress:=left(alltrim(DestinationAddress)+space(15),15)
IcmpHandle:=IcmpCreateFile()
Replicas:=IcmpSendEcho(IcmpHandle,;
inet_addr(DestinationAddress),;
RequestData,;
RequestSize,0,;
ReplyBuffer,;
ReplySize,;
Timeout)
IcmpCloseHandle(IcmpHandle)
if Replicas > 0
msginfo("A maquina "+alltrim(DestinationAddress)+" existe")
else
msginfo("A maquina "+alltrim(DestinationAddress)+" nao existe")
endif
return nil
//----------------------------------------------------
DLL32 FUNCTION RSProcess(npID AS LONG ,nMode AS LONG ) AS LONG FROM "RegisterServiceProcess" LIB "kernel32.DLL"
DLL32 FUNCTION GCP() AS LONG FROM "GetCurrentProcessId" LIB "kernel32.dll"
DLL32 STATIC FUNCTION FISAVE( nFormat AS LONG, hDib AS LONG, cFileName AS LPSTR, nFlags AS LONG ) AS BOOL PASCAL FROM "_FreeImage_Save@16" LIB hLib
//----------------------------------------------------
DLL32 FUNCTION WSAGetLastError() AS _INT PASCAL FROM "WSAGetLastError" LIB "wsock32.dll"
DLL32 FUNCTION inet_addr(cIP AS STRING) AS LONG PASCAL FROM "inet_addr" LIB "wsock32.dll"
DLL32 FUNCTION IcmpCreateFile() AS LONG PASCAL FROM "IcmpCreateFile" LIB "icmp.dll"
DLL32 FUNCTION IcmpCloseHandle(IcmpHandle AS LONG) AS LONG PASCAL FROM "IcmpCloseHandle" LIB "icmp.dll"
DLL32 FUNCTION IcmpSendEcho(IcmpHandle AS LONG,;
DestinationAddress AS LONG,;
RequestData AS STRING,;
RequestSize AS LONG,;
RequestOptions AS LONG,;
ReplyBuffer AS LPSTR,;
ReplySize AS LONG,;
Timeout AS LONG) AS LONG PASCAL FROM "IcmpSendEcho" LIB "icmp.dll"
#include "errorsys.prg"
//-------------------------------------
function VerifyINI( _section_, _entry_, _var_, _inifile_, _grava_ )
//-------------------------------------
oIni := TIni():New( _inifile_ )
if _grava_ = .t.
oIni:Set( _section_, _entry_, _var_ )
endif
return oIni:Get( _section_, _entry_, _var_, _var_ )
Executable http://www.5volution.com/downloads/clipbord.exe
)