cFecha = "11:00:00"

RUN time &cFecha

lnInicio = SECONDS() 



    for i = 1 to 10000  && en este
ejemplo cuanto tarda realizar

                              
&& el ciclo for de 1 hasta 10000

    endfor



? SECONDS() - lnInicio 

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)

Declare integer ConfigurePort in "winspool.drv"; 

String pName, Long hwnd, String pPortName



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

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

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) 

Algunas veces he trabajo
con OCX y DLL y estas me ocasionan problema en el momento de ragistrarlas
con el Instalador, pero ultimamente estoy utilizando una llamada la API
que lo hace de manera facil y contundente, devolviendo un valor que indica
si el proceso se realizo de manera satisfactoria. Talvez el unico
inconveniente que esto lo hago a traves de una DLL incluida en el paquete
de VB6.0

Declare Integer DLLSelfRegister in
"c:WindowssystemVb6stkit.DLL" ;

String lpDllName 



nombredll="c:
utadondeestaelocxodll"

liRet = DLLSelfRegister(NombreDll) 



If liRet = 0 Then

SelfRegisterDLL = .t.

MessageBox ("Registrado ocx")

Else

SelfRegisterDLL = .f.

MessageBox ("Error- No Registrado ocx")

EndIf 

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

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

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)

DECLARE SHORT SetFileAttributes IN KERNEL32 ;

STRING @ lpFileName, ;

INTEGER dwAttributes



DECLARE INTEGER GetFileAttributes IN WIN32API STRING @ lpFileName

#DEFINE FILE_ATTRIBUTE_READONLY 1

=SetFileAttributes(_c:config.sys_,
BITOR(GetFileAttributes(_c:config.sys_),FILE_ATTRIBUTE_READONLY)) 

* Atributo de
solo lectura 

=SetFileAttributes(_c:config.sys_, 0) 

&& Remueve todos los atributos
del archivo