PrintScreen x VFP

[Marcos Guedes]

Segue uma rotina que encontrei no seguinte endereço:
tek-tips.com/faqs.cfm?fid=4912

Criei uma pequena adaptação que consite no seguinte:

1. Crie um arquivo com o nome "printscreen.prg" e adicione o seguinte conteúdo:

Código:

LPARAMETERS lcfilename as String

DO lesdeclarations

PRIVATE hmemdc, hmembmp, lnwidth, lnheight, lnbitsperpixel,;
   lnbytesperscan, lcbfilehdr, lcbihdr, lpbitsarray, lnbitssize,;
   lcrgbquad, lnrgbquadsize, lcbinfo, lnfilesize

STORE "" TO lcbihdr, lcbinfo, lcrgbquad
STORE 0 TO hmemdc, hmembmp, lnwidth, lnheight, lnfilesize,;
   lnbitsperpixel, lnbytesperscan, lnrgbquadsize, lpbitsarray, lnbitssize

= makesnapshot()
= initbitmapinfo()
= initbitsarray()

#DEFINE dib_rgb_colors  0
= getdibits (hmemdc, hmembmp, 0, lnheight, lpbitsarray,;
   @lcbinfo, dib_rgb_colors)

IF bmp2file (lcfilename)
   shellexecute(0,"Print","c:\Temp\myfile.bmp","","",0)
   && An Alternative might be to view the bitmap using:
   && ShellExecute(0,"Open","c:\Temp\myfile.bmp","","",1)
ENDIF

= globalfree (lpbitsarray)
= deleteobject (hmembmp)
= deletedc (hmemdc)
RETURN  && principal

PROCEDURE  initbitmapinfo()
   #DEFINE bi_rgb  0
   #DEFINE rgbquad_size    4  && RGBQUAD
   #DEFINE bhdr_size      40  && BITMAPINFOHEADER

   * forcer le format 24 bit
   lnbitsperpixel = 24
   lnbytesperscan = lnwidth * 3

   * Largeur de la ligne devait être DWORD-aligné (4 bytes)
   *Important pour les palettes de couleur 16 et 24 bits
   IF MOD(lnbytesperscan, 4) <> 0
      lnbytesperscan = lnbytesperscan + 4 - MOD(lnbytesperscan, 4)
   ENDIF

   * initialiser la structure BitmapInfoHeader
   lcbihdr = num2dword(bhdr_size) + num2dword(lnwidth) +;
      num2dword(lnheight) + num2word(1) + num2word(lnbitsperpixel) +;
      num2dword(bi_rgb) + num2dword(0) + num2dword(0) + num2dword(0) +;
      num2dword(0) + num2dword(0)

   * créer un buffer pour la table de couleur
   IF lnbitsperpixel <= 8
      lnrgbquadsize = (2^lnbitsperpixel) * rgbquad_size
      lcrgbquad = REPLI(CHR(0), lnrgbquadsize)
   ELSE
      lnrgbquadsize = 0
      lcrgbquad = ""
   ENDIF

   * amener les deux portions ensemble
   lcbinfo = lcbihdr + lcrgbquad
   RETURN

PROCEDURE  initbitsarray()
   #DEFINE gmem_fixed  0
   lnbitssize = lnheight * lnbytesperscan
   lpbitsarray = globalalloc (gmem_fixed, lnbitssize)
   = zeromemory (lpbitsarray, lnbitssize)

FUNCTION  bmp2file (lctargetfile)
   * enrigister tous les composants sur disque
   #DEFINE generic_write          1073741824  && 0x40000000
   #DEFINE file_share_write                2
   #DEFINE create_always                  2
   #DEFINE file_attribute_normal        128
   #DEFINE invalid_handle_value          -1
   #DEFINE bfhdr_size      14  && BITMAPFILEHEADER

   LOCAL hfile, lnoffbits

   * dimension du bitmap
   lnfilesize = bfhdr_size + bhdr_size + lnrgbquadsize + lnbitssize

   * offset du bitmap bits
   lnoffbits = bfhdr_size + bhdr_size + lnrgbquadsize

   * Entete du bitmap
   lcbfilehdr = "BM" + num2dword(lnfilesize) +;
      num2dword(0) + num2dword(lnoffbits)

   * le handle du fichier destination
   hfile = createfile (lctargetfile,;
      generic_write,;
      file_share_write, 0,;
      create_always,;
      file_attribute_normal, 0)

   IF hfile <> invalid_handle_value
      * Un procédé pour stocker block apres block

      = string2file (hfile, @lcbfilehdr)          && BitmapFileHeader
      = string2file (hfile, @lcbinfo)              && BitmapInfo
      = ptr2file (hfile, lpbitsarray, lnbitssize)  && bitmap data
      = closehandle (hfile)
      RETURN .T.
   ELSE
      RETURN .F.
   ENDIF

PROCEDURE  string2file (hfile, lcbuffer)
   * Amender la filière avec le buffer
   DECLARE INTEGER WriteFile IN kernel32;
      INTEGER hFile, STRING @lpBuffer, INTEGER nBt2Write,;
      INTEGER @lpBtWritten, INTEGER lpOverlapped

   = writefile (hfile, @lcbuffer, LEN(lcbuffer), 0, 0)
   RETURN

PROCEDURE  ptr2file (hfile, lnpointer, lnbt2write)
   * Amender le block de mémoire à la filière

   DECLARE INTEGER WriteFile IN kernel32;
      INTEGER hFile, INTEGER lpBuffer, INTEGER nBt2Write,;
      INTEGER @lpBtWritten, INTEGER lpOverlapped

   = writefile (hfile, lnpointer, lnbt2write, 0, 0)
   RETURN

PROCEDURE  makesnapshot()
   #DEFINE srccopy        13369376
   LOCAL HWND, hdc, hsavedbitmap

   HWND = getfocus()
   hdc = getwindowdc(HWND)
   = getwinrect(HWND, @lnwidth, @lnheight)

   hmemdc = createcompatibledc (hdc)
   hmembmp = createcompatiblebitmap (hdc, lnwidth, lnheight)

   hsavedbitmap = selectobject (hmemdc, hmembmp)
   = bitblt (hmemdc, 0,0, lnwidth,lnheight, hdc, 0,0, srccopy)
   = selectobject (hmemdc, hsavedbitmap)
   = releasedc (HWND, hdc)
   RETURN

PROCEDURE  getwinrect(HWND, lnwidth, lnheight)
   #DEFINE max_dword  4294967295  && 0xffffffff
   LOCAL lprect, lnleft, lntop, lnright, lnbottom
   lprect = REPLI(CHR(0), 16)
   = getwindowrect (HWND, @lprect)

   lnleft  = buf2dword(SUBSTR(lprect,  1,4))
   lntop    = buf2dword(SUBSTR(lprect,  5,4))
   lnright  = buf2dword(SUBSTR(lprect,  9,4))
   lnbottom = buf2dword(SUBSTR(lprect, 13,4))

   IF lnleft > lnright
      lnleft = lnleft - max_dword
   ENDIF
   IF lntop > lnbottom
      lntop = lntop - max_dword
   ENDIF

   lnwidth  = lnright - lnleft
   lnheight = lnbottom - lntop
   RETURN

FUNCTION  num2dword (lnvalue)
   #DEFINE m0      256
   #DEFINE m1    65536
   #DEFINE m2  16777216
   LOCAL b0, b1, b2, b3
   b3 = INT(lnvalue/m2)
   b2 = INT((lnvalue - b3*m2)/m1)
   b1 = INT((lnvalue - b3*m2 - b2*m1)/m0)
   b0 = MOD(lnvalue, m0)
   RETURN CHR(b0)+CHR(b1)+CHR(b2)+CHR(b3)

FUNCTION  num2word (lnvalue)
   RETURN CHR(MOD(m.lnvalue,256)) + CHR(INT(m.lnvalue/256))

FUNCTION  buf2dword (lcbuffer)
   RETURN ASC(SUBSTR(lcbuffer, 1,1)) + ;
      ASC(SUBSTR(lcbuffer, 2,1)) * 256 +;
      ASC(SUBSTR(lcbuffer, 3,1)) * 65536 +;
      ASC(SUBSTR(lcbuffer, 4,1)) * 16777216

FUNCTION  buf2word (lcbuffer)
   RETURN ASC(SUBSTR(lcbuffer, 1,1)) + ;
      ASC(SUBSTR(lcbuffer, 2,1)) * 256

PROCEDURE  lesdeclarations
   DECLARE INTEGER GetDIBits IN gdi32;
      INTEGER hdc, INTEGER hbmp, INTEGER uStartScan,;
      INTEGER cScanLines, INTEGER lpvBits, STRING @lpbi,;
      INTEGER uUsage

   DECLARE INTEGER GlobalAlloc IN kernel32 INTEGER wFlags, INTEGER dwBytes
   DECLARE INTEGER GetWindowRect IN user32 INTEGER HWND, STRING @lpRect
   DECLARE INTEGER SelectObject IN gdi32 INTEGER hdc, INTEGER hObject
   DECLARE INTEGER ReleaseDC IN user32 INTEGER HWND, INTEGER hdc
   DECLARE INTEGER DeleteDC IN gdi32 INTEGER hdc
   DECLARE INTEGER GetFocus IN user32
   DECLARE INTEGER GetWindowDC IN user32 INTEGER HWND
   DECLARE INTEGER GlobalFree IN kernel32 INTEGER HMEM
   DECLARE INTEGER DeleteObject IN gdi32 INTEGER hObject
   DECLARE INTEGER CreateCompatibleDC IN gdi32 INTEGER hdc
   DECLARE INTEGER CloseHandle IN kernel32 INTEGER hObject

   DECLARE RtlZeroMemory IN kernel32 AS ZeroMemory;
      INTEGER DEST, INTEGER numBytes

   DECLARE INTEGER CreateCompatibleBitmap IN gdi32;
      INTEGER hdc, INTEGER nWidth, INTEGER nHeight

   DECLARE INTEGER BitBlt IN gdi32;
      INTEGER hDestDC, INTEGER x, INTEGER Y,;
      INTEGER nWidth, INTEGER nHeight, INTEGER hSrcDC,;
      INTEGER xSrc, INTEGER ySrc, INTEGER dwRop

   DECLARE INTEGER CreateFile IN kernel32;
      STRING lpFileName, INTEGER dwDesiredAccess,;
      INTEGER dwShareMode, INTEGER lpSecurityAttr,;
      INTEGER dwCreationDisp, INTEGER dwFlagsAndAttrs,;
      INTEGER hTemplateFile
   DECLARE INTEGER ShellExecute IN shell32;
      INTEGER HWND,;
      STRING  lpOperation,;
      STRING  lpFile,;
      STRING  lpParameters,;
      STRING  lpDirectory,;
      INTEGER nShowCmd

2. No mesmo diretório, crie um arquivo com o nome "print_screen.prg" e adicione o conteúdo abaixo:

Código:

DEFINE CLASS print_screen AS CUSTOM

   FUNCTION capturar AS logical
      LPARAMETERS caminhoimagem AS STRING
      LOCAL capturado AS logical
      TRY
         DO "printscreen.prg" WITH m.caminhoimagem
         m.capturado = .T.
      CATCH
         m.capturado = .F.
      ENDTRY
      RETURN m.capturado
   ENDFUNC

ENDDEFINE

3. Para salvar o PrintScreen da tela, basta fazer o seguinte:

Código:

obj = NEWOBJECT("print_screen")
?obj.capturar("F:\imagem.bmp")
obj = null

[Marcos Guedes]

Este armazena o printscreen na área de transferência (support.microsoft.com/kb/255279/pt-br):

Código:

opscreen = NEWOBJECT("p_screen")
opscreen.screencapture()
opscreen = NULL

DEFINE CLASS p_screen AS CUSTOM OLEPUBLIC
   NAME = "p_screen"
   screenprinted = .F.

   PROCEDURE screencapture
      THIS.screenprinted = .T.
      
      DECLARE INTEGER keybd_event IN Win32API ;
         INTEGER, INTEGER, INTEGER, INTEGER
         
      vk_snapshot = 44
      =keybd_event(vk_snapshot, 1, 0, 0)
      
      RELEASE keybd_event, vk_snapshot
   ENDPROC

ENDDEFINE

[Marcos Guedes]

Outro exemplo muito bom postado no Grupo fox br (br.groups.yahoo.com/group/foxbrasil/) por César Chalom:

- Salva o Desktop inteiro:

Código:

DO SYSTEM.APP

WITH _SCREEN.SYSTEM.drawing

   lobmp = _SCREEN.SYSTEM.drawing.BITMAP.fromscreen()
   lobmp.SAVE("F:\Tela.png", .imaging.imageformat.png)

ENDWITH

- Salva apenas um "Form" específico (Experimente colocando o código num botão):

Código:

DO System.App

With _Screen.System.Drawing
  loBmp = _Screen.System.Drawing.Bitmap.FromScreen(Thisform.Hwnd)
  loBmp.Save("c:\Tela2.png", .Imaging.ImageFormat.Png)
EndWith

Obs: É necessário acompanhar o arquivo System.app junto com o projeto.
Para adiqüirí-lo, acesso o link abaixo:
vfpx.codeplex.com/Release/ProjectReleases.aspx?ReleaseId=15083

[hugo]

marcos

baixei o arquivo la neste link
[Você precisa estar registrado e conectado para ver este link.]

devo criar um .exe? nao faco nada?

dai dentro da pasta onde esta o system.app eu coloquei
um arquivo chamado grava.prg

mais ta dando erro, o que me indica?

agradeco

[Marcos Guedes]

marcos

baixei o arquivo la neste link
[Você precisa estar registrado e conectado para ver este link.]

devo criar um .exe? nao faco nada?

dai dentro da pasta onde esta o system.app eu coloquei
um arquivo chamado grava.prg

mais ta dando erro, o que me indica?

agradeco

O que está dando erro?
Os exemplos de Print Screen?

[hugo]

o marcos, desculpa cara, eu vou abandonar isto

vou falar pros caras que nao tem jeito

so queria acionar um tecla tipo um bot, era pra ser algo
simples mais pelo que vi tem 7 cabecas

odeio dizer isto, mais desisto disto
sei la, acho que to sem paciencia hoje

desculpa mesmo!

obrigado pelo tempo que tentou me ajudar!

valeu

[alceu11]

FUNCIONA HUGO tudo que fiz pegar os 3 codigos que o marcos postou no dia 20/7/2010 as 14:4hs
Vai aqui o seu Sistema Ajax,
Entra no sitema vai em cadastro de senha,
depois click imprimir a tela vai gravar uma imagem.bmp. so nao fiz para gravar um nome diferente para cada tela.

link do fonte
[Você precisa estar registrado e conectado para ver este link.]

[Você precisa estar registrado e conectado para ver este link.]

segue a imagem que imprimir da sua tela de senha que vc abandonou o projeto
eu sinto muito por ter abandonado o projeto

veja o botao imprimir a tela , o codigo esta no projeto e codigo

[Você precisa estar registrado e conectado para ver esta imagem.]

[Você precisa estar registrado e conectado para ver esta imagem.]



[Você precisa estar registrado e conectado para ver este link.]

[alceu11]

sEGUE UMA NOVA MUDANCA AGORA ABRINDO A IMAGEM NO WORD
codigo vc tem 25 segundos para salvar no word ele abrira na barra ferramentas ,veja o codigo no botao imprimir a tela

[Você precisa estar registrado e conectado para ver este link.]

Salvei a tela num aquirvo doc. conforme o topico que esta word armando.
mais ainda acho que devia abrir o paint, nao sei como abri o paint no fox

[Você precisa estar registrado e conectado para ver esta imagem.]
[Você precisa estar registrado e conectado para ver este link.]

Agora mereco reputacao? preciso pegar a 5a.estrela!!

o link da imagem do word
[Você precisa estar registrado e conectado para ver este link.]

codigo em 26/4/2010 as 2358hs Marcos

Código:


PUBLIC ow AS WORD.APPLICATION, ;
  lcbmp AS STRING, livfpwinstate AS INTEGER

*-- Store WindowState of _SCREEN and minimize
livfpwinstate = _SCREEN.WINDOWSTATE
_SCREEN.WINDOWSTATE= 1
ow = CREATEOBJECT( 'Word.Application' )

*-- Alter the path to the bitmap file as needed.
lcbmp = _samples + '\TASTRADE\BITMAPS\BEVERAGE.BMP'
WITH ow AS WORD.APPLICATION
  .WINDOWSTATE= 1 && wdWindowStateMaximize
  .VISIBLE = 1
  .documents.ADD
  .APPLICATION.ACTIVATE
  WITH .activedocument.pagesetup AS WORD.pagesetup
      .topmargin = 12.25
      .bottommargin = 12.25
      .leftmargin = 12.25
      .rightmargin = 12.25
  ENDWITH
  .SELECTION.inlineshapes.addpicture( lcbmp, .F., .T. )
  .SELECTION.endkey( 6 )
  .SELECTION.moveleft( 1, 1, 1 )
  .SELECTION.inlineshapes( 1 ).WIDTH = 190
  .SELECTION.inlineshapes( 1 ).HEIGHT = 210
  .SELECTION.endkey( 6 )
  .SELECTION.homekey( 6 ) && Go to top of doc
  =INKEY( 5 ) && Wait five seconds.
  .QUIT( 0 ) && Quit w/o saving. Pass -1 to save.
ENDWITH

*-- Restore _SCREEN
_SCREEN.WINDOWSTATE = livfpwinstate
*
*-------- End Code


Marcos vai longe, este garoto tem futuro

[Marcos Guedes]

o marcos, desculpa cara, eu vou abandonar isto

vou falar pros caras que nao tem jeito

so queria acionar um tecla tipo um bot, era pra ser algo
simples mais pelo que vi tem 7 cabecas

odeio dizer isto, mais desisto disto
sei la, acho que to sem paciencia hoje

desculpa mesmo!

obrigado pelo tempo que tentou me ajudar!

valeu

Hugo, vai aí um conselho amigo...
Aproveita o fim de semana e quando estiveres com a cabeça fria, posta com carinho o que você precisa pois certamente é possível.
Os códigos que postei neste tópico já fazem praticamente tudo, eu acho.

[hugo]

Alceu, reputado cara! Muito obrigado!

xxxxxxxxxxxxxxxxxxxxxxxxxx

Marcos, agradeco tambem cara! o que acontece é que pra quem
ja entende o VFP da pra ir! Hoje to num dia pessimo! Tipo aqueles
dias que talvez era melhor ficar debaixo da coberta ate o dia
acabar!

xxxxxxxxxxxxxxxxxxxxxxxxxx

obrigado por tudo galera!

nos momentos dificeis voces estao presentes!




Professor alceu, hoje nao to com cabeca! achei muito legal
o que fez ai por mim cara! vou mexer nisto amanha!



Valeu