clear the Clipboard

[Dorneles]

How to clear the Clipboard ( "Clipboard") of winxp, I am using __KEYBOARD (CHR (300)), to copy the screen, but when the Clipboard has no more space, the __KEYBOARD (CHR (300)) to working.

[Antonio Linares]

Please review fwh\samples\TestClip.prg

[Dorneles]

Antonio, if I open the area of transfer after using oClp:Clear(), this clean, but after a while the app not save the screen, this message:
Shut one or more application to free up more memory and try again.
But if you leave the app, and return back to work.

Code: Select all  Expand view  RUN


  DEFINE ICON oIcon   FILE "IMG.ICO"
 
  DEFINE WINDOW oApp  ICON oIcon
 
  DEFINE CLIPBOARD oClp OF oApp
                             
  DEFINE TIMER oTmrIdx INTERVAL   10000 ACTION ( waitIdx( oTmrIdx,oTray,oIcon,oClp) ) OF oApp
  ACTIVATE TIMER oTmrIdx
     
  ACTIVATE WINDOW oApp ;
           ON INIT oTray := TTrayIcon():New(oApp,oIcon,"",{|nRow,nCol|MenuTray(nRow,nCol,oTray,oIcon)},{|nRow,nCol|MenuTray(nRow,nCol,oTray,oIcon)}) ;
           VALID oTray:End() ;
           ON RIGHT CLICK oTray:SetIcon( oIcon, "Another" )


RETURN NIL

FUNCTION WaitIdx( oTmrIdx,oTray,oIcon,oClp)   

  local lFileExists := .f., cDir := CurDrive()+":\"+GetCurDir()+''
  LOCAL Dir, vArq, vNum, nBytes
 
  oTmrIdx:Deactivate()

  __KEYBOARD(CHR(300))
  SalvaTela("Tela",oIcon)
  syswait(1)
  oClp:Clear()
 
  Release All
  RESALLFREE()
  SYSREFRESH()
  CLEAR MEMORY

  oTmrIdx:Activate() 



[/b]

[Antonio Linares]

Whats the source code for SalvaTela() ?

[Dorneles]

Code: Select all  Expand view  RUN

static function SalvaTela(cFileName,oIcon)
****************************************
LOCAL oTClip, hBitmap, fBit, Result := .f.
LOCAL oBmpImage


   Default cFileName := "Tela.JPG"

   cFileName := AllTrim(cFileName)

   if AT('.jpg',lower(cFilename)) == 0
      cFileName += '.JPG'
   end

   if file("Tela.BMP")
      FERASE("Tela.BMP")
   end


   oTClip := TClipBoard():New() //New(WndMain())
   syswait(.1)
   hBitmap := oTClip:GetBitMap()
   syswait(.3)
   oTClip:Close()
   oTClip:End()
   Result := (hBitmap != 0)

   if Result

      fBit:=dibfrombitmap(hBitmap)
      SysWait(.1)
     
      dibwrite("Tela.BMP",fBit)
     
   
      FISaveImg( "Tela.BMP", "Tela.JPG", 2, 70 )

      Ferase("Tela.BMP")
      Result := File("Tela.JPG")
   else
      ?"error: not save"
   end

Return Result


[Antonio Linares]

You have to release the bitmap and the dib, thats why you are consuming your sistem memory!

Code: Select all  Expand view  RUN

  if Result

      fBit:=dibfrombitmap(hBitmap)
      DeleteObject( hBitmap )
      SysWait(.1)
     
      dibwrite("Tela.BMP",fBit)
      GlobalFree( fBit )
   
      FISaveImg( "Tela.BMP", "Tela.JPG", 2, 70 )

      Ferase("Tela.BMP")
      Result := File("Tela.JPG")
   else
      ?"error: not save"
   end


[Rossine]

Olá Antonio,

No exemplo abaixo quando clico em "Salvar" a função "FISaveImg" sempre me retorna falso e o arquivo "TELA.JPG" é gerado com tamanho 0, porque ?

Code: Select all  Expand view  RUN

#include "fivewin.ch"

*************
function Main
*************

   local oDlg, oIco, cTest := "Hello world!   ", oClp

   DEFINE ICON oIco FILE "\fwh\icons\fivewin.ico"

   DEFINE DIALOG oDlg TITLE "I am a DialogBox" COLOR "W+/B" ;
      ICON oIco

   @ 1, 3 GET cTest

   @ 3, 5 BUTTON "&Salvar" SIZE 40, 12 ;
      ACTION SALVA( oDlg, oClp ) DEFAULT

   @ 3, 16 BUTTON "&Cancel" SIZE 40, 12 ACTION oDlg:End()

   DEFINE CLIPBOARD oClp OF oDlg

   ACTIVATE DIALOG oDlg CENTERED ;
      VALID MsgYesNo( "Do you want to end ?" )

   oCLp:end()

return NIL

**************
function SALVA( oDlg, oClp )
**************

__KEYBOARD(CHR(300))

  SalvaTela( "Tela" )
  syswait(1)
  oClp:Clear()
 
* Release All
* RESALLFREE()
  SYSREFRESH()
* CLEAR MEMORY

return NIL

*************************
static function SalvaTela( cFileName )
*************************

LOCAL oTClip, hBitmap, fBit, Result := .f.
LOCAL oBmpImage


   Default cFileName := "Tela.JPG"

   cFileName := AllTrim(cFileName)

   if AT('.jpg',lower(cFilename)) == 0
      cFileName += '.JPG'
   end

   if file("Tela.BMP")
      FERASE("Tela.BMP")
   end

   oTClip := TClipBoard():New() //New(WndMain())
   syswait(.1)
   hBitmap := oTClip:GetBitMap()
   syswait(.3)
   oTClip:Close()
   oTClip:End()
   Result := (hBitmap != 0)

   if Result

      fBit := dibfrombitmap( hBitmap )
      SysWait(.1)
      dibwrite( "Tela.BMP", fBit )
      GlobalFree( fBit )
      DeleteObject( hBitmap )
     
msgstop(       FISaveImg( "Tela.BMP", "Tela.JPG", 2, 70 )  )

      Ferase("Tela.BMP")
      Result := File("Tela.JPG")
   else
      ?"error: not save"
   end

Return Result

static function FISAVEIMG( cSrcFile, cDstFile, nDstFormat, nQuality )

   local nSrcFormat, hDib, hDib2, lOk

   DEFAULT nQuality := 0

   hLib = LoadLibrary( "freeimage.dll" )

   nSrcFormat = FIGETFILETYPE( cSrcFile, 0 )

   hDib = FILOAD( nSrcFormat, cSrcFile, 0 )
   hDib2 = FICNV24( hDib )
   lOk = FISAVE( nDstFormat, hDib2, cDstFile, nQuality )

   FIUNLOAD( hDib )
   FIUNLOAD( hDib2 )

   FreeLibrary( hLib )

return lOk

//----------------------------------------------------------------------------//

DLL32 FUNCTION FIGETFILETYPE( cFileName AS LPSTR, nSize AS LONG ) AS LONG ;
      PASCAL FROM "_FreeImage_GetFileType@8" LIB hLib

DLL32 FUNCTION FILOAD( nFormat AS LONG, cFileName AS LPSTR, nFlags AS LONG ) AS LONG ;
      PASCAL FROM "_FreeImage_Load@12" LIB hLib

DLL32 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 FIUNLOAD( hDib AS LONG ) AS VOID ;
      PASCAL FROM "_FreeImage_Unload@4" LIB hLib

DLL32 FUNCTION FICNV24( hDib AS LONG ) AS LONG ;
      PASCAL FROM "_FreeImage_ConvertTo24Bits@4" LIB hLib

//----------------------------------------------------------------------------//


[Antonio Linares]

Rossine,

Has comprobado que Tela.bmp esté correcto ?

[Rossine]

Antonio,

É gerado o arquivo TELA.BMP no tamanho de 1.920.054, mas não consigo abrí-lo com o ms-paint (paint).

O paint me retorna a seguinte mensagem:

"O Paint não pode ler este arquivo. Este não é um arquivo de bitmap válido ou não há suporte para o formato atualmente."

Saludos,

Rossine.

[Antonio Linares]

Rossine,

has comprobado que despues de hacer:

__KEYBOARD(CHR(300))

haya una copia correcta de la imagen en el clipboard ?

Por lo que comentas parece que el bitmap esta corrupto...

[Rossine]

Antonio,

has comprobado que despues de hacer:
__KEYBOARD(CHR(300))
haya una copia correcta de la imagen en el clipboard ?

Sim, após: __KEYBOARD(CHR(300)) ... executei o "PAINT" e colei a imagem que estava no clipboard.

Este exemplo roda bem aí com você ?

Saludos,

[Rossine]

Antonio,

has comprobado que despues de hacer:
__KEYBOARD(CHR(300))
haya una copia correcta de la imagen en el clipboard ?

Sim, após: __KEYBOARD(CHR(300)) ... executei o "PAINT" e colei a imagem que estava no clipboard.


Baixe o arquivo TELA.BMP aqui:
http://geocities.yahoo.com.br/qiinformatica2000/TELA.ZIP

Este exemplo roda bem aí com você ?

Saludos,

[Rossine]

Antonio,

has comprobado que despues de hacer:
__KEYBOARD(CHR(300))
haya una copia correcta de la imagen en el clipboard ?

Sim, após: __KEYBOARD(CHR(300)) ... executei o "PAINT" e colei a imagem que estava no clipboard normalmente.


Baixe o arquivo TELA.BMP aqui:
http://geocities.yahoo.com.br/qiinformatica2000/TELA.ZIP

Este exemplo roda bem aí com você ?

Saludos,

[Rossine]

Olá,

É possível fazer isto funcionar ?

Gracias,

Rossine.