Este ejemplo nos permitirá conocer a través de una función API si el usuario que está actualmente logueado en Windows es "Administrador", es muy importante conocerlo puesto que existen procesos que sólo pueden realizarlos este tipo de usuarios.



Declare Integer IsUserAnAdmin
In shell32


? "Usted es usuario
Administrador: " + Iif(IsUserAnAdmin()
= 1, "SI",
"NO")

Este ejemplo de combo es uno de los mejores que he visto; es muy parecido a un control de DevExpress que uso en .NET



Este Combo muestra los datos en un Grid, permitiendo seleccionar los elementos que desees y devuelve una lista de la posición (Recno) de los elementos seleccionados.



Adicionalmente incluye un tooltiptext de tipo balloontip realizado en base a funciones API, sencillamente fantástico.

Cuando mandamos reportes a
la Impresora algunas veces queremos personalizar esta operación; pero
siempre nos muestras la ventanita "Imprimiendo". Esta es la
forma de omitir esa ventana

DECLARE INTEGER GetDesktopWindow IN WIN32API

DECLARE INTEGER LockWindowUpdate IN WIN32API INTEGER lnHandle

 

hWin = GetDeskTopWindow()

 

LockWindowUpdate(hWin) 
&& Bloquea actualización de la pantalla

       REPORT FORM NombreReporte.frx TO PRINTER

LockWindowUpdate(0)      && No
actualiza la pantalla

Cuando mandamos reportes a
la Impresora algunas veces queremos personalizar esta operación; pero
siempre nos muestras la ventanita "Imprimiendo". Esta es la
forma de omitir esa ventana

#define SM_CXSCREEN 0          
&& Ancho de Screen en Píxeles 

#define SM_CYSCREEN 1          
&& Alto de Screen en Píxeles 

#define SM_CXFULLSCREEN 16 &&
Ancho área de cliente

#define SM_CYFULLSCREEN 17 && Alto área de cliente

DECLARE INTEGER GetSystemMetrics IN Win32API;

INTEGER nIndex



? GetSystemMetrics(SM_CXSCREEN)

? GetSystemMetrics(SM_CYSCREEN)

? GetSystemMetrics(SM_CXFULLSCREEN)

? GetSystemMetrics(SM_CYFULLSCREEN)

Ha copiado una nueva fuente
y desea instalarla? o desea quitar una fuente que ya ha sido instalada?.

He observado algunos
procedimientos de VB para ver como lo hacen pero creo que se complican
mucho, en esta caso a través de GETFILE( ), obtenemos la fuente a
instalar.

Declare Long AddFontResource in "gdi32";

String lpFileName 



Declare Long RemoveFontResource in "gdi32";

String lpFileName 



filename=getfile(_ttf_) 



Instalar = AddFontResource(FileName) <>0 



&& Desinstalar = RemoveFontResource(FileName) <> 0 



? Instalar 

Muestra el cuadro de diálogo para cambiar el password del
protector de pantalla de Window. 

Declare integer PwdChangePassword in "mpr"; 

String lpcRegkeyname, Long hwnd,Long uiReserved1, Long uiReserved2



=PwdChangePassword ("SCRSAVE", thisform.hwnd, 0, 0)

A través de la función ConfigurePort podemos
presentar las propiedades del los puertos pasados como

parámetro
y configurar
así sus valores.

Declare integer ConfigurePort in "winspool.drv"; 

String pName, Long hwnd, String pPortName



=ConfigurePort("", 0 , "COM1:")

=ConfigurePort("", 0 , "LPT1:"))

Permite copiar un archivo a un determinado directorio o carpeta compartida en la
red, además enviarlo directamente al puerto paralelo.

DECLARE INTEGER CopyFile IN KERNEL32.DLL ;

STRING @SourceFileName, ;

STRING @DestFileName, ;

INTEGER bFailIfExists



IF CopyFile(_C:autoexec.bat_,_LPT1:_,0) # 0

    =messagebox("Copiado")

ELSE

    =messagebox("No") copiado")


ENDIF

Esta función nos permite
rellenar figuras; es decir, podemos establecer el color y textura de fondo
de cualquier figura. A la función CreateHatchBrush() se le pasan dos parámetros
el primero la textura y forma que tendrá el relleno (estos van desde 0
hasta 5), el segundo es el color de relleno. Utilizamos además otras
funciones como la SelectObject() la cual selecciona y realiza las
diferentes acciones sobre el objeto. La función GetDC() y Rentangle() ya
fueron estudiadas.

PARA
VISUAL FOX PRO 7.0

&& Se registran las diferentes
funciones

Declare integer CreateHatchBrush in "gdi32.dll" ;

Long nIndex, Long crColor

Declare integer SelectObject IN "gdi32.dll" ;

Long hdc, Long hObject





Declare integer GetDC in "user32.dll" Long hWnd 



Declare integer Rectangle in "gdi32.dll" ;

Long hdc, Long X1, Long Y1, Long X2, Long Y2

&& Obtengo el DC

nDc = Getdc(thisform.HWnd)



&& Creo el relleno con las características

hbrush = CreateHatchBrush(5, RGB(255, 255, 0)) 



&& Selecciono la ventana y establezco la forma de
relleno

holdbrush = SelectObject(nDc, hbrush)



&& Creo un rectángulo

retval = Rectangle(nDc, 10, 20, 175, 100)



&& Aplico al rectángulo el relleno seleccionado

retval = SelectObject(ndc, holdbrush) 

PARA
VISUAL FOX PRO 6.0 Y 5.0

&& Se registran las diferentes
funciones

Declare integer CreateHatchBrush in
"gdi32.dll" ;

Long nIndex, Long crColor

Declare integer GetActiveWindow in win32api

Declare integer SelectObject IN
"gdi32.dll" ;

Long hdc, Long hObject





Declare integer GetDC in "user32.dll" Long hWnd 



Declare integer Rectangle in "gdi32.dll" ;

Long hdc, Long X1, Long Y1, Long X2, Long Y2

&& Obtengo el DC

nDc = Getdc(GetActiveWindow())



&& Creo el relleno con las características

hbrush = CreateHatchBrush(5,
RGB(255, 255, 0)) 



&& Selecciono la ventana y establezco la forma de
relleno

holdbrush = SelectObject(nDc,
hbrush)



&& Creo un rectángulo

retval = Rectangle(nDc, 10, 20, 175, 100)



&& Aplico al rectángulo el relleno seleccionado

retval = SelectObject(ndc,
holdbrush) 

Devuelve la ruta del programa ejecutable
asociado a una determinada extensión

LOCAL lcRetVal,
lcFileExt, lcFileName, lnFileHandle,;lcDirectory, lcResBuff

STORE "" TO lcRetVal, lcFileExt, lcFileName, lcDirectory



tcExt = "SCX" && Extensión a buscar





lcFileExt = UPPER( ALLTRIM( tcExt ))



* Intenta crear un archivo con la extensión pasada

lcFileName = "dav." + lcFileExt

lnFileHandle = FCREATE( lcFileName )



IF lnFileHandle < 1

     * No puede crear el archivo

     ERROR "No es posible crear el archivo temporal" ;

                 
+ CHR(13) + "Este es necesario para poder continuar"

     RETURN lcRetVal

ENDIF

FCLOSE( lnFileHandle )





lcResBuff = SPACE(128)



DECLARE INTEGER FindExecutable IN SHELL32 ;

STRING @cFileName, ;

STRING @cDirectory, ;

STRING @cBuffer



* llama a la función Findexecutable

lnRetVal = FindExecutable( @lcFileName, @lcDirectory, @lcResBuff)



lcMsgTxt = ""

* Determina el valor retornado por la función

DO CASE

       CASE lnRetVal = 0

       lcMsgTxt = "insuficientes recursos"

CASE lnRetVal = 2

       lcMsgTxt = "Archivo especificado no se encuentra"

CASE lnRetVal = 3

       lcMsgTxt = "Ruta especificada no se encuentra"

CASE lnRetVal = 11

       lcMsgTxt = "Invalido formato del EXE"

CASE lnRetVal = 31

       lcMsgTxt = "No esta asociada a ningun archivo la extensión " + lcFileExt

OTHERWISE

      * Obtiene la ruta y exe asociado a la extensión

      lcRetVal = LEFT(lcResBuff, AT(CHR(0), lcResBuff) - 1)

ENDCASE

* Borra el archivo creado

DELETE FILE (lcFileName)



IF ! EMPTY( lcMsgTxt )

      MESSAGEBOX( lcMsgTxt, 16, "Fallo la búsqueda" )

ENDIF



? lcRetVal

Determina si una ventana ventana existe o también
puede ser implementada para conocer si nuestra aplicación esta ejecutándose. Se le debe
pasar el "Caption"  de la ventana a buscar.

DECLARE INTEGER FindWindow IN Win32API;

STRING @lpClassName, ;

STRING @lpWindowName



&&Debe estar abierta la
ventana Windows

lcApplicationTitle = "WINDOWS"   

lnHWnd = FindWindow(0, @lcApplicationTitle)

* si desea probar abra la
ventana del directorio  windows


IF lnHWnd <> 0

      =messagebox("si existe la ventana windows")

ELSE

      =messagebox("no existe la ventana windows")

Endif

Devuelve
el Handle (manejador o identificador único) de la ventana
activa

DECLARE INTEGER GetActiveWindow IN user32 

DECLARE INTEGER GetWindowDC IN user32 INTEGER hwnd 

?
GetActiveWindow() 

Devuelve
la ruta del directorio actual de trabajo

DECLARE INTEGER GetCurrentDirectory IN Win32API ;

INTEGER nSize, ;

STRING @cBuffer

*** Call the function

lcSysDir = REPLICATE(CHR(0),255)

lnBuffer = 255



lnDirLen = GetCurrentDirectory( lnBuffer, @lcSysDir )

lcRetVal = LEFT( lcSysDir, lnDirLen )



?lcRetval

Permite conocer y configurar la velocidad del doble
click del mouse; esto es la velocidad al hacer doble click.

Declare integer GetDoubleClickTime in "user32" () As Long



? GetDoubleClickTime()  && Determina la velocidad al hacer dbclick

Declare integer SetDoubleClickTime in "user32";

Long wCount



=SetDoubleClickTime(817) 

&& Configura la velocidad del db click a 817
(lento)