FiveTech Support Forums

  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()

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

  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

#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

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