Hola
Se puede hacer capturando el Desktop y convirtiendolo a gris con FreeImage, luego sacando una caja de diálogo por encima.
Este es el código para los grises:
- Code: Select all Expand view
#include "fivewin.ch"
#define CBM_INIT 4 && should move to prg header
#define DIB_RGB_COLORS 0 && should move to prg header
static hBmp
static oWnd
static hLib
function main()
local oBrush
hBmp := nil
hLib := LoadLibrary( "freeimage.dll" )
DEFINE BRUSH oBrush STYLE "NULL"
DEFINE WINDOW oWnd STYLE nOr( WS_POPUP ) BRUSH oBrush
ACTIVATE WINDOW oWnd MAXIMIZED ON INIT Proceso() ;
ON PAINT Pinta( hDC )
FreeLibrary( hLib )
DeleteObject( hBmp )
return nil
function Proceso()
local hDib
local hInfoH, hBits, hInfo
local hWnd, hDC
// se puede hacer mas elegante pero esto es mas fácil
DibWrite( "screen.bmp", DibFromBitmap( WndBitmap( oWnd:hWnd )))
hDib := fiLoad( 0, "screen.bmp", 0 )
hDib := FI_2GREY( hDib )
hInfoH := fiGetInfoHeader( hDib )
hInfo := fiGetInfo( hDib )
hBits := fiGetBits( hDib )
hWnd := oWnd:hWnd
hDC := oWnd:GetDC()
hBmp := CreateDIBitmap( hDC, hInfoH, CBM_INIT, hBits, hInfo,DIB_RGB_COLORS )
oWnd:ReleaseDC()
oWnd:Refresh()
return nil
function pinta( hDC )
if hBmp != nil
DrawBitmap( hDC, hBmp, 0, 0 )
endif
return nil
DLL32 STATIC FUNCTION FI_2GREY( hDib AS LONG ) AS LONG;
PASCAL FROM "_FreeImage_ConvertToGreyscale@4" LIB hLib
DLL32 STATIC FUNCTION FILOAD( nFormat AS LONG, cFileName AS LPSTR,nFlags AS LONG ) AS LONG;
PASCAL FROM "_FreeImage_Load@12" LIB hLib
DLL32 STATIC FUNCTION FIGETINFOHEADER( hDib AS LONG ) AS LONG;
PASCAL FROM "_FreeImage_GetInfoHeader@4" LIB hLib
DLL32 STATIC FUNCTION FIGETINFO( hDib AS LONG ) AS LONG;
PASCAL FROM "_FreeImage_GetInfo@4" LIB hLib
DLL32 STATIC FUNCTION FIGETBITS( hDib AS LONG ) AS LONG;
PASCAL FROM "_FreeImage_GetBits@4" LIB hLib
DLL32 STATIC FUNCTION CREATEDIBITMAP( hDC AS LONG, hInfoH AS LONG,nFlags AS LONG, hBits AS LONG, hInfo AS LONG, nUsage AS LONG ) AS LONG;
PASCAL FROM "CreateDIBitmap" LIB "gdi32.dll"
Un saludo.
Paco Garcia