Mostrando las entradas con la etiqueta API. Mostrar todas las entradas
Mostrando las entradas con la etiqueta API. Mostrar todas las entradas

19 de enero de 2021

Aplicaciones de terceros desde nuestros formularios

Artículo original: 3rd party apps from within our forms
https://sandstorm36.blogspot.com/2014/05/3rd-party-apps-from-within-our-forms.html
Autor: Jun Tangunan
Traducido por: Luis María Guayán


Ahora es la 1:30 AM y todavía no puedo volver a dormir, así que hagamos que mi tiempo sea un poco útil. Inspirado por lo que Bernard Bout ha mostrado AQUI, hoy decidí ver de que forma se puede haceruna instancia de Excel. Por favor, lea en enlace anterior antes de proceder a continuar como voy a tratar de separar las cosas para nuestra mejor comprensión.

Las herramientas más básicas del oficio

  • un Shape en nuestro formulario
  • SetParent
  • WinExec
  • FindWindow
  • SetWindowPos

Bernard nos dió un gran punto de partida porque los ingredientes básicos ya están ahí. Y estoy de acuerdo y aprecio que Bernard no haya mostrado todos los trucos porque si los ha hecho, no trataré de entender algunos de ellos y simplemente usaré el truco a ciegas; y no los comprenderé mejor.

Comencemos la deconstrucción y reconstrucción:

¿WinExec es la única forma?

No. Está ya que es uno de los comandos más simples para abrir una aplicación de terceros. Pero hay alternativas como RUN, ShellExecute(), Scripting y algunas más.

Me he dado cuenta de que el objetivo principal y el primer paso es abrir el archivo o la aplicación de cualquiera de las formas posibles y, dado que mi objetivo aquí es Excel, me gusta la automatización cuando se trata de Excel, entonces es la automatización.

¿Donde está la ventana?

El segundo paso después de abrir la aplicación de terceros es controlar la ventana de esa aplicación tratando de encontrarla. Y eso se puede hacer a través de Winapi con FindWindow() de esta manera:

nHwnd = FindWindow(NULL, "Untitled - Notepad")

Donde nHwnd es el identificador de ventana de la aplicación de terceros que queremos. Lo anterior dice, en términos sencillos, busque una instancia de Bloc de Notas recién abierta y sin guardar entre las ventanas abiertas y obtenga el identificador de su ventana para que podamos trabajar más en ella. Ese título es lo que verá como título cuando abra un Bloc de Notas solo.

Si VFP no puede encontrar el identificador de la ventana, nHwnd devolverá 0.

Intente con un formato de archivo xlsx

Como estaba haciendo la automatización, el primer intento se realiza en un archivo xlsx:

Local loExcel As excel.Application, lcFile
loExcel = Createobject('excel.application')
lcFile = Getfile('xls,xlsx')
If !Empty(m.lcFile)
      loExcel.Workbooks.Open(m.lcFile)
      * Get a handle on its Window
      nHwnd = FindWindow('XLMain',Alltrim(Justfname(m.lcFile))+' - Microsoft Excel')
Endif

¡Y falla, no pasó nada! Tarde me doy cuenta de que a pesar de lo que se muestra en la pantalla en la barra de título de Excel 2007, internamente todavía lo está haciendo de la manera anterior como esta:

nHwnd = FindWindow('XLMain','Microsoft Excel - '+Alltrim(Justfname(m.lcFile)))

No hace falta decir que lo anterior funciona. ¡Hasta aquí todo bien!

Intente con un formato de archivo xls

Luego intenté abrir un formato de archivo xls y ¡vuelve a fallar! ¡¡¡Maldito!!! Recordé que cuando abres un archivo xls en Excel 2007, se agregará un título adicional de [Modo de compatibilidad]. Esa es una forma de recordarnos visualmente que actualmente estamos trabajando en un formato de archivo antiguo. Hmmm ... pedazo de alcornoque, lo haré así entonces:

* Attempt to open without that compatibility mode caption
nHwnd = FindWindow(Null, "Microsoft Excel - "+Alltrim(Justfname(m.lcFile)))
If m.nHwnd = 0
      * Failed, so attempt to open with that added compatibility mode caption
      nHwnd = FindWindow('XLMain', 'Microsoft Excel - +Alltrim(Justfname(m.lcFile))+' [Compatibility Mode]')
Endif

Y no se abre correctamente. Quiero decir, se abre pero se abre fuera de mi aplicación por sí solo. ¡¡¡Maldito sea !!!

Perdí mi tiempo tratando de encontrar la combinación correcta en el título interno de la barra de título de Excel aplicando los casos reales de nombre de archivo usando FSO ... todavía no tuve suerte (me di cuenta al final a través de repetidas pruebas, aunque ese caso de caracteres como adecuado, superior e inferior no lo afecte), mezclando y reubicando las palabras en el pie de foto ... de nuevo no tuve suerte ... y estaba a punto de rendirme porque ya he perdido casi 2 horas solo para ese estúpido título interno (hey yo estaba frustrado, ¡LOL!) y estba a punto de archivar todo el proyecto cuando se me ocurrió una idea. ¡¡¡¡Diablos!!!! Estoy haciendo automatización, entonces, ¿qué me impide hacer esto?

nHwnd = FindWindow('XLMain', loExcel.Caption)

Y listo !!!! ¡Una forma muy flexible de asegurarse de encontrar el título correcto de un archivo de Excel abierto sin importar si está en modo de compatibilidad o no, o en cualquier versión de Excel que esté usando! ¡Excelente! Por supuesto, dicho enfoque no se limita a Excel.

Shape de mi corazón

Ahora vamos a la otra parte. Lo que también he notado es que el truco usa un Shape. Y cuando leí y vi el truco por primera vez, mi presunción es que Excel o cualquier aplicación de terceros aparece mágicamente en dicho Shape transformando dicho Shape en esa aplicación de terceros. Pero como ahora estoy tratando de separar las cosas, me doy cuenta de que con o sin ese Shape, podemos abrir esas aplicaciones de terceros dentro de nuestra aplicación.

Entonces, ¿para qué es ese Shape? Dicho Shape invisible/visible (su elección) en el formulario existe solo por una razón. Eso no es para mostrar la aplicación de terceros, sino para servir como una manera fácil de establecer las coordenadas de esas aplicaciones de terceros desde nuestro formulario, ya que es más fácil cambiar el tamaño de un Shape e indicar a dicha aplicación de terceros que "siga" las coordenadas de ese Shape, que hacerlo por código, de forma repetida y a prueba y error.

Cree un Shape, dimensione y colóquelo en el formulario a su gusto, escóndelo si lo desea e indique a la aplicación de terceros que siga sus coordenadas. Muy ingenioso por aquellos que originalmente pensaron en la idea.

¡Excel no se puede hacer clic, no se puede editar y está muy loco!

Para simplificar las cosas, me doy cuenta de que con VFP, aunque "nosotros" podemos ver los objetos, internamente no puede ser visto por VFP. Al igual que cuando agregamos mediante códigos algunos objetos en un Grid, tenemos que hacerlo Visible, de lo contrario, puede verlos pero no puede funcionar correctamente en él. Entonces:

loExcel.Visible = .T.

Entonces, si desea que esto se destaque dentro de nuestro formulario solo con fines de visualización pura, establezca la propiedad Visible en .F.

loExcel.Visible = .F.

Y eso es todo. Todo lo que el usuario puede hacer es desplazarse hacia abajo y hacia arriba para ver su contenido. :)

¿Que hay en el menu?

Pero una vez que haya hecho visible Excel, entonces todo el archivo de Excel estará dentro de nuestro formulario con todo su esplendor como cinta, barra de fórmulas, pestañas de la hoja de trabajo, etc. Bueno, algunos de ustedes pueden quererlo de esa manera, pero yo no. Así que tengo que esconderlos. Simplemente verifique los códigos más adelante para saber cómo hacerlo.

¡Dimensióname!

No es sorprendente que el cambio de tamaño del formulario deje la aplicación de terceros en sus coordenadas originales. Pero esto es fácil, revisa los códigos.

Hacer zoom, guardar, detectar y algo más

Solo revisa los códigos ... Estoy empezando a tener sueño, finalmente...

Resumen:

Hay dos o más cosas que estoy buscando pero que todavía no he podido encontrar una solución y que tampoco me siento cómodo dejando esos asuntos sin resolver. Y lo básico de esos deseos son:

  • Ocultar la barra de título de Excel
  • No permitir arrastrar y soltar

Incluso jugar con uFlags de SetWindowPos no me dio los resultados esperados. Sin embargo, pude utilizar una buen Flag cuando intentamos abrir un nuevo archivo de Excel para que Excel no destruya lentamente sus objetos frente a nuestros ojos cuando lo cerramos.

Seguiré jugando con esto y si encuentro formas, actualizaré esto. O dado que el plan, como de costumbre, es publicar este foro interno de Foxite, que se encuentra entre los foros de desarrolladores más amigables que he visto, con suerte alguien que haya jugado con esto antes que yo (lo siento, siempre llego tarde) pueda compartir con nosotros cómo solucionar esos problemas; luego editaré esta publicación para incluir sus códigos y al colaborador.

El día siguiente:

¡Encontré el eslabón perdido, LOL! El truco para ocultar la barra de título de Excel es, en lugar de buscar propiedades ocultas de Excel para ocultarlas, manipularlo directamente usando estas dos WinAPI, es decir, GetWindowLong y SetWindowLong. Esos son posibles porque ya tenemos el Handle de la ventana. ¡Compruebe en los códigos a continuación cómo se hace!

Códigos:

loTest = Createobject("Form1")
loTest.Show(1)

Define Class Form1 As Form
      AutoCenter= .T.
      Height = 493
      Width = 955
      Caption = 'Excel within our Form'
      _nHwnd = .F.
      _oExcel = .F.

      Add Object Shape1 As Shape With ;
            Top = 36, Left = 6, Height= 445, Width = 936,;
            BackColor = Rgb(255,255,255), BorderColor = Rgb(0,128,192)

      Add Object label1 As Label With ;
            Top = 15, Left = 6, Caption = 'Preview', FontBold = .T.,;
            FontName = 'Calibri', FontSize = 12, AutoSize = .T.

      Add Object label2 As Label With ;
            Top = 12, Left = 836, Caption = 'Zoom', FontBold = .T.,;
            FontName = 'Calibri', FontSize = 12, AutoSize = .T.,;
            Anchor = 9

      Add Object cmdOpen As CommandButton With ;
            Top = 8, Left = 312, Caption = '\<Open', Width = 84, Height = 24

      Add Object cmdSave As CommandButton With ;
            Top = 8, Left = 399, Caption = '\<Save', Width = 84, Height = 24

      Add Object cmdClose As CommandButton With ;
            Top = 8, Left = 486, Caption = '\<Close', Width = 84, Height = 24

      Add Object chkShowTabs As Checkbox With ;
            Top = 12, Left = 732, Caption = 'Show \<Tabs', AutoSize = .T.,;
            Anchor = 9

      Add Object SpinZoom As Spinner With ;
            Top = 10, Left = 882, KeyboardLowValue = 10, SpinnerLowValue = 10,;
            Value = 100, Anchor = 9, Width = 60

      Procedure Load
            Declare Integer SetParent In user32;
                  INTEGER hWndChild,;
                  INTEGER hWndNewParent

            Declare Integer FindWindow In user32;
                  STRING lpClassName, String lpWindowName

            Declare Integer SetWindowPos In user32;
                  INTEGER HWnd,;
                  INTEGER hWndInsertAfter,;
                  INTEGER x,;
                  INTEGER Y,;
                  INTEGER cx,;
                  INTEGER cy,;
                  INTEGER uFlags

            Declare Integer GetWindowLong In User32;
                  Integer HWnd, Integer nIndex

            Declare Integer SetWindowLong In user32 ;
                  Integer HWnd,;
                  INTEGER nIndex,;
                  Integer dwNewLong
      Endproc

      Procedure Resize
            Thisform._SetCoord()
      Endproc

      Procedure Destroy
            If Type('thisform._oexcel') = 'O'
                  This._Clear()
            Endif
      Endproc

      Procedure cmdOpen.Click
            If Type('thisform._oexcel') = 'O'
                  Thisform._Clear()
            Endif
            Thisform._linkapp()
      Endproc

      Procedure cmdSave.Click
            If Type('thisform._oexcel') = 'O'
                  Thisform._oExcel.activeworkbook.Save()
                  Messagebox('Changes made are saved!',64,'Save')
            Else
                  Messagebox('Nothing to save yet!',64,'Opppppssss!')
            Endif
      Endproc

      Procedure cmdClose.Click
            If Type('thisform._oexcel') = 'O'
                  Thisform._Clear()
            Endif
      Endproc

      Procedure SpinZoom.InteractiveChange
            Thisform._oExcel.ActiveWindow.Zoom=Thisform.SpinZoom.Value
      Endproc

      Procedure chkShowTabs.Click
            Thisform._oExcel.ActiveWindow.DisplayWorkbookTabs=This.Value
      Endproc

      Procedure _Clear
            With This
                  With  .Shape1
                        * Show shape
                        .Visible = .T.
                        * Hide window via uFlags
                        SetWindowPos(This._nHwnd, 1, .Left, .Top, .Width, .Height,0x0080)
                  Endwith

                  With ._oExcel
                        * Restore those we have hidden
                        .DisplayFormulaBar = .T.
                        .DisplayStatusBar = .T.
                        .ActiveWindow.DisplayWorkbookTabs=.T.
                        .ActiveWindow.DisplayHeadings=.T.

                        .activeworkbook.Close()
                        .Visible = .F.
                        .Quit
                  Endwith
                  ._oExcel = .F.
            Endwith
      Endproc

      Procedure _HideRibbon
            Local loRibbon
            loRibbon =This._oExcel.CommandBars.Item("Ribbon")
            If m.loRibbon.Height > 0
                  This._oExcel.ExecuteExcel4Macro('Show.Toolbar("Ribbon",False)')
            Endif
      Endproc

      Procedure _linkapp
            Local loExcel As excel.Application, lcFile
            loExcel = Createobject('excel.application')
            lcFile = Getfile('xls,xlsx')
            If !Empty(m.lcFile)
                  loExcel.Workbooks.Open(m.lcFile)

                  * This is so we can tap into it on other methods/events
                  This._oExcel = loExcel

                  With loExcel
                        .Visible = .T.
                        .DisplayAlerts = .F.
                        .Application.ShowWindowsInTaskbar=.F.

                        .DisplayFormulaBar = .F.
                        .DisplayDocumentActionTaskPane=.F.
                        .DisplayStatusBar = .F.

                        * Ensure scroll bars are shown
                        .ActiveWindow.DisplayVerticalScrollBar=.T.
                        .ActiveWindow.DisplayHorizontalScrollBar=.T.

                        * Hide Workbook Tabs
                        .ActiveWindow.DisplayWorkbookTabs=Thisform.chkShowTabs.Value

                        .ActiveWindow.DisplayHeadings=.F.
                        .ActiveWindow.WindowState = -4137  && xlMaximized
                        .ActiveWindow.Zoom=Thisform.SpinZoom.Value

                        * Get a handle on Window
                        nHwnd = FindWindow('XLMain', .Caption)
                  Endwith

                  * Add this so we can work on other methods
                  This._nHwnd = m.nHwnd

                  * Hide Ribbon
                  Thisform._HideRibbon()


                  * Hide the title bar, disallow drag and drop of the excel window
                  Local lnStyle

                  * Get the current style of the window
                  lnStyle = GetWindowLong(nHwnd, -6)

                  * Set the new style for the window
                  SetWindowLong(nHwnd, -16, Bitxor(lnStyle, 0x00400000))

                  * force it inside our form
                  SetParent(nHwnd,Thisform.HWnd)

                  * Size it
                  Thisform._SetCoord()

                  * Hide shape
                  Thisform.Shape1.Visible = .F.
            Endif
      Endproc

      Procedure _SetCoord
            * size it based on Invisible shape
            With This.Shape1
                  SetWindowPos(This._nHwnd, 0, .Left, .Top, .Width, .Height, 2)
            Endwith
      Endproc

Enddefine

Palabras de despedida:

En primer lugar, muchas gracias a Bernard Bout, cuya publicación me sirve de inspiración para este enfoque. Un agradecimiento especial a Yousfi Benameur quien nos compartió también antes de los códigos para ocultar la cinta de Excel en Office 2007.

Siempre que estoy haciendo este estilo de redacción, estoy apuntando a que los lectores que son nuevos en esto intenten comprender el propósito de cada paso / objeto / código. ¿Cuál es el propósito de WinExec aquí, por qué necesitamos conocer el título, cuál es el propósito de la forma en el formulario, etc.?

Otra es que mis lectores provienen de diferentes partes del mundo donde el inglés no es el idioma nativo y supongo que mi enfoque de redacción es una de las razones por las que mi Blog todavía recibe nuevas páginas vistas de vez en cuando. Aunque espero no aburrirte de esta manera. :)

Hora de dormir....


9 de septiembre de 2020

Comprobar si una DLL ya está cargada

El programa IsAPIFunction.PRG en una pequeña función que puede hacer mas rápido algún código, comprobando si una función API específica ha sido ya declarada, antes de preocuparse en declararla de nuevo.

*
*  IsAPIFunction.PRG
*  RETURN un valor lógico indicando si el nombre de la función pasada 
*  como parámetro en una función API de Windows (en una Windows .DLL)
*  que está actualmente cargada por el comando DECLARE
*
*  Author:  Drew Speedie
*
*  Esta función usa:
*  1- La función ADLLS() introducida en VFP 7.0
*  2- El sexto parámetro opcional agregado a la 
*     función ASCAN() en VFP 7.0
*
*  Ejemplos:
*!*  IF NOT X7ISAPIF("MessageBeep")
*!*    DECLARE Long MessageBeep IN USER32.DLL Long uType
*!*  ENDIF
*!*  MessageBeep(0)
*
*!*  IF NOT X7ISAPIF("MessageBeepWithAlias")
*!*    DECLARE Long MessageBeep IN USER32.DLL AS MessageBeepWithAlias Long uType
*!*  ENDIF
*!*  MessageBeep(0)
*
*!*  IF NOT X7ISAPIF("MessageBeepWithAlias","MessageBeep")
*!*    DECLARE Long MessageBeep IN USER32.DLL AS MessageBeepWithAlias Long uType
*!*  ENDIF
*!*  MessageBeep(0)
*
*
*  lParameters
*    tcFunctionAlias: El alias de la función API
*                     Por omisión, el alias es el mismo que el
*                     nombre de la función pero se puede hacer:
*                     DECLARE DLL .. AS 
*    tcFunctionName:  Si pasa tcFunctionAlias y necesita estar seguro
*                     que esta función solo retorna .T. cuando
*                     tcFunctionAlias es el alias para una declaración
*                     para un nombre de función específico, pase el 
*                     nombre de la fucnción en este parámetro
*
LPARAMETERS tcFunctionAlias, tcFunctionName
LOCAL laDLLs[1], lnRow
IF ADLLS(m.laDLLs) = 0
  RETURN .F.
ENDIF
lnRow = ASCAN(laDLLs,m.tcFunctionAlias,1,-1,2,15)
IF m.lnRow = 0
  RETURN .F.
ENDIF
IF PCOUNT() = 1 ;
    OR NOT VARTYPE(m.tcFunctionName) = "C" ;
    OR EMPTY(m.tcFunctionName)
  RETURN .T.
ENDIF
*
*  tcFunctionName fue pasado
*
RETURN UPPER(ALLTRIM(m.laDLLs[m.lnRow,1])) == UPPER(ALLTRIM(m.tcFunctionName))

Por favor note que el programa IsAPIFunction.PRG requiere VFP 7.0 o superior para ejecutarse, pero puede ser modificado para correr en la versión anterior de VFP, modificando al lógica de ASCAN(), para no para usar el ASCAN() con los parámetros agregados en VFP 7.0.

VFP Tips & Tricks - Drew Speedie

18 de febrero de 2020

Obtener configuracion regional mediante API

Rutina para obtener la configuracion regional de Windows mediante API.

DIMENSION aDatos(1)
? GetConfiRegi( @aDatos )
DISPLAY MEMORY LIKE aDatos

*-------------------------------------------------------
* Retorna en una array pasado por referencia, algunos
* valores de la configuración regional
* PARAMETROS: aDatos
* USO:  DIMENSION aDatos(1)
*       GetConfiRegi( @aDatos )
* DEVUELVE: aDatos(1) = Símbolo decimal
*    aDatos(2) = Símbolo separador de miles
*    aDatos(3) = Número de dígitos decimales
*    aDatos(4) = Símbolo de signo negativo
*    aDatos(5) = Formato de números negativos
*-------------------------------------------------------
FUNCTION GetConfiRegi(aDatos)
  #DEFINE LOCALE_USER_DEFAULT  0x400 && 1024
  #DEFINE LOCALE_SDECIMAL  0xE
  #DEFINE LOCALE_STHOUSAND  0xF
  #DEFINE LOCALE_IDIGITS 0x11
  #DEFINE LOCALE_SNEGATIVESIGN  0x51
  #DEFINE LOCALE_INEGNUMBER  0x1010
  LOCAL sRetval AS STRING, nRET AS LONG
  IF PCOUNT() < 1 THEN
    RETURN .F.
  ENDIF
  DECLARE LONG GetLocaleInfo IN WIN32API  LONG LOCALE, ;
    LONG LCTYPE, STRING LPLCDATA, LONG CCHDATA
  DIMENSION aDatos(5)
  FOR nRET = 1 TO 5
    m.aDatos(nRET) = ""
  NEXT
  m.sRetval = REPLICATE(CHR(0),256)
  * Símbolo decimal
  m.nRET = GetLocaleInfo(LOCALE_USER_DEFAULT, ;
    LOCALE_SDECIMAL, @sRetval, LEN(m.sRetval))
  IF m.nRET > 0 THEN
    m.aDatos(1) = LEFT(m.sRetval,m.nRET-1)
  ENDIF
  m.sRetval = REPLICATE(CHR(0),256)
  * Símbolo separador de miles
  m.nRET = GetLocaleInfo(LOCALE_USER_DEFAULT, ;
    LOCALE_STHOUSAND, @sRetval,LEN(m.sRetval))
  IF m.nRET > 0 THEN
    m.aDatos(2) = LEFT(m.sRetval,m.nRET-1)
  ENDIF
  m.sRetval = REPLICATE(CHR(0),256)
  * Número de dígitos decimales
  m.nRET = GetLocaleInfo(LOCALE_USER_DEFAULT, ;
    LOCALE_IDIGITS, @sRetval,LEN(m.sRetval))
  IF m.nRET > 0 THEN
    m.aDatos(3) = LEFT(m.sRetval,m.nRET-1)
  ENDIF
  m.sRetval = REPLICATE(CHR(0),256)
  * Símbolo de signo negativo
  m.nRET = GetLocaleInfo(LOCALE_USER_DEFAULT, ;
    LOCALE_SNEGATIVESIGN, @sRetval,LEN(m.sRetval))
  IF m.nRET > 0 THEN
    m.aDatos(4) = LEFT(m.sRetval,m.nRET-1)
  ENDIF
  m.sRetval = REPLICATE(CHR(0),256)
  * Formato de números negativos
  m.nRET = GetLocaleInfo(LOCALE_USER_DEFAULT, ;
    LOCALE_SNEGATIVESIGN, @sRetval,LEN(m.sRetval))
  IF m.nRET > 0 THEN
    m.aDatos(5) = LEFT(m.sRetval,m.nRET-1)
    DO CASE
      CASE m.aDatos(5) = "0"
        m.aDatos(5) = "(1.1)"
      CASE m.aDatos(5) = "1"
        m.aDatos(5)= " -1.1"
      CASE m.aDatos(5) = "2"
        m.aDatos(5) = "- 1.1"
      CASE m.aDatos(5) = "3"
        m.aDatos(5) = "1.1-"
      CASE m.aDatos(5) = "4"
        m.aDatos(5) = "1.1 -"
    ENDCASE
  ENDIF
ENDFUNC
*-------------------------------------------------------

9 de enero de 2019

Detectar si una impresora es de matriz de puntos

Con esta función pueden averiguar si una impresora es de matriz de puntos.

CLEAR
DIMENSION asPrn[1]
FOR nPrn = 1 TO APRINTERS(asPrn)
  sPrn = asPrn[nPrn, 1]
  ? PADR(sPrn,50), " ", IIF(IsDotPrinter (sPrn), "Matriz", "")
NEXT
RETURN

FUNCTION IsDotPrinter (sPrn)
  LOCAL nBins, sBuff
  #DEFINE DC_BINS 6
  #DEFINE DMBIN_TRACTOR 8
  
  DECLARE LONG DeviceCapabilities IN WinSpool.drv ;
    STRING @ sPrinter, STRING @ sPort, ;
    INTEGER nCapability, STRING @ sReturn, STRING @ pDevMode
  sBuff = SPACE(512)
  * Lista de words de bandejas
  nBins = DeviceCapabilities (sPrn, NULL, DC_BINS, @sBuff, NULL)
  IF nBins > 0
    sBuff = PADR(sBuff, nBins)
  ENDIF
  CLEAR DLLS DeviceCapabilities
  RETURN CHR(DMBIN_TRACTOR) $ sBuff
ENDFUNC

Mario Lopez

23 de octubre de 2018

Cambia la resolución de la pantalla

*!* Cambia la resolución de la pantalla
*!* Sintaxis: ChangeRes(tnWidth, tnHeight)
*!* Valor devuelto: llRetVal
*!* Argumentos: tnWidth, tnHeight
*!* tnWidth especifica la nueva anchura de la pantalla en pixels
*!* tnHeight especifica la nueva altura de la pantalla en pixels

FUNCTION ChangeRes
    LPARAMETERS tnWidth, tnHeight
    LOCAL lnWidth, lnHeight, lnModeNum, lcDevMode
    *!* Valores
    lnModeNum  = 0
    lcDevMode  = REPLICATE(CHR(0), 156)
    lnWidth    = IIF(EMPTY(tnWidth), 800, tnWidth)
    lnHeight   = IIF(EMPTY(tnHeight), 600, tnHeight)
    *!* Instrucciones DECLARE DLL para cambiar resolución
    DECLARE INTEGER EnumDisplaySettings   IN Win32API STRING lpszDeviceName,;
 INTEGER iModeNum, STRING @lpDevMode
    DECLARE INTEGER ChangeDisplaySettings IN Win32API STRING @lpDevMode ,;
 INTEGER dwFlags
    *!* Bucle para obtener todos los modos disponibles
    DO WHILE EnumDisplaySettings(NULL, lnModeNum, @lcDevMode) <> 0
        lnModeNum = lnModeNum +1
    ENDDO
    *!* Configurar la structura DevMode
    lcDevMode = STUFF(lcDevMode,  41, 4, LongToStr(1572864))
    lcDevMode = STUFF(lcDevMode, 109, 4, LongToStr(tnWidth))  && Ancho
    lcDevMode = STUFF(lcDevMode, 113, 4, LongToStr(tnHeight))  && Alto
    *!* Cambiar resolucion
    ChangeDisplaySettings(@lcDevMode, 1)
ENDFUNC

*!* Convierte un long integer a un 4-byte character string
*!* Sintaxis: LongToStr(lnLongVal)
*!* Valor devuelto: lcRetStr
*!* Argumentos: lnLongVal
*!* lnLongVal especifica el long integer a convertir
FUNCTION LongToStr
    LPARAMETERS lnLongVal
    LOCAL lnCnt, lcRetStr
    lcRetStr = ''
    FOR lnCnt = 24 TO 0 STEP -8
        lcRetStr = CHR(INT(lnLongVal/(2^lnCnt))) + lcRetStr
        lnLongVal = MOD(lnLongVal, (2^lnCnt))
    NEXT
    RETURN lcRetStr
ENDFUNC

11 de septiembre de 2018

Vaciar el contenido de un directorio (archivos y carpetas)

Como podemos vaciar una carpeta y todo su contenido (Modificado)

*-----------------------------------------------------------------
* FUNCTION EmptyDir(tcRoot, tlNotAsk)
*-----------------------------------------------------------------
* Vacia todo el contenido (archivos y carpetas) del directorio
* "tcRoot" pasado como parámetro
* PARAMETROS:
*   tcRoot = Directorio a vaciar
*   tlNotAsk = .T. - No pregunta antes de vaciar el directorio
* USO:
*   =EmptyDir("C:TEMP", .F.)
*-----------------------------------------------------------------
FUNCTION EmptyDir(tcRoot, tlNotAsk)
  PRIVATE lnI, lnCant, laAux, lcSubDir
  tcRoot = ADDBS(tcRoot)
  IF NOT tlNotAsk
    IF 1 <> MESSAGEBOX("¿Esta Ud. seguro de borrar " + ;
        "todos los archivos y carpetas de" +CHR(13) + ;
        tcRoot + "?", 1+32+256, "Atención")
      RETURN
    ENDIF
  ENDIF

  ********************************
  **** Agregado por Leonel Ortega ***
  ********************************
  miComm = "attrib -r -h "+(tcRoot + "*.*")+" /S /D"
  =wScript(miComm,2)
  ********************************

  DELETE FILE (tcRoot + "*.*")
  lnCant = ADIR(laAux, tcRoot + "*.", "D")
  FOR lnI = 1 TO lnCant
    IF "D" $ laAux[lnI, 5]
      IF laAux[lnI, 1] == "." OR laAux[lnI, 1] == ".."
        LOOP
      ELSE
        lcSubDir = ADDBS(tcRoot + laAux[lnI, 1])
        =EmptyDir(lcSubDir, .T.)
        RMDIR (lcSubDir)
      ENDIF
    ENDIF
  ENDFOR
  RETURN
ENDFUNC

********************************
**** Agregado por Leonel Ortega ***
********************************
FUNCTION wScript
 LPARAMETER eComm, eWindowType
 IF pCount()=0
  WAIT WINDOW 'Faltan parametros en WScript' TIMEOUT 2
 ENDIF

 IF pCount()=1
  eWindowType = 1
 ENDIF

 LOCAL loWshShell
 loWshShell = CREATEOBJECT("WScript.shell")
 loWshShell.RUN( eComm ,eWindowType,.T.)  && el 2 es minimizado, 1 es Normal

ENDFUNC
********************************

20 de julio de 2018

Evitar que un programa activado desde VFP se cargue más de una vez y visualizarla

La misma función que hemos visto en el caso anterior puede ser usada para evitar que un programa externo se cargue mós de una vez. Un ejemplo sencillo es el de la calculadora de Windows.

Imaginemos que en nuestra aplicación demos la posibilidad de utilizar la calculadora. Pondríamos una línea come esta:

RUN /N CALC.EXE

Pero si esta línea la ejecutamos más de una vez, se cargarás la calcuadora una y otra vez.

* Antes de activar la calculadora:
IF NOT F_ActivaWin("Calculadora")
    * La calculadora no está cargada:
    RUN /N CALC.EXE
ENDIF

* Y ESTA ES LA FUNCION QUE LO HACE TODO:
*-----------------------------
FUNCTION F_ActivaWin(cCaption)
*-----------------------------
LOCAL nHWD
DECLARE INTEGER FindWindow IN WIN32API ;
STRING cNULL, ;
STRING cWinName

DECLARE SetForegroundWindow IN WIN32API ;
INTEGER nHandle

DECLARE SetActiveWindow IN WIN32API ;
INTEGER nHandle

DECLARE ShowWindow IN WIN32API ;
INTEGER nHandle, ;
INTEGER nState

nHWD = FindWindow(0, cCaption)
IF nHWD > 0
    * VENTANA YA ACTIVA
    * LA "LLAMAMOS":
    ShowWindow(nHWD,9)

    * LA PONEMOS ENCIMA
    SetForegroundWindow(nHWD)

    * LA ACTIVAMOS
    SetActiveWindow(nHWD)
    RETURN .T.
ELSE
    * VENTANA NO ACTIVA
    RETURN .F.
ENDIF

Pablo Roca

9 de julio de 2018

Evitar que una aplicación se cargue más de una vez y visualizarla en tal caso

En muchos casos es importante que nuestras aplicaciones puedan estar cargadas una sola vez. Los motivos pueden ser muchos: un programa VFP ocupa muchos recursos del sistema, en algunos casos puedo necesitar abrir los archivos en modo exclusivo, etc.

Utilizando las APIs que Windows pone a disposición, se puede controlar si existe una ventana con un nombre determinado. Si nosotros controlamos esto antes de asignar el título a la ventana de nuestro programa, podemos saber nuestra aplicación ya estaba cargada desde antes.

Lo úmico que necesitamos hacer es lo siguiente:

En nuestras primeras líneas de programa ponemos estas líneas de código:

* Antes de ponerle el título a nuestra ventana:
IF F_ActivaWin("Mi programa")
    * El programa ya estaba activo:
    RETURN && Termina el programa
ENDIF

* Empezamos a definir las características de la ventana principal
* siempre y cuando sea necesario visualizarla.
WITH _SCREEN
    * PREPARO LA VENTANA PRINCIPAL
    * .WIDTH = ...
    * .HEIGHT = ...
    * ETC, ETC
    * 
    *
    .CAPTION = "Mi programa"    && Título de la ventana
    .VISIBLE = .T.
ENDWITH

* Y ESTA ES LA FUNCION QUE LO HACE TODO:
*-----------------------------
FUNCTION F_ActivaWin(cCaption)
*-----------------------------
LOCAL nHWD
DECLARE INTEGER FindWindow IN WIN32API ;
STRING cNULL, ;
STRING cWinName

DECLARE SetForegroundWindow IN WIN32API ;
INTEGER nHandle

DECLARE SetActiveWindow IN WIN32API ;
INTEGER nHandle

DECLARE ShowWindow IN WIN32API ;
INTEGER nHandle, ;
INTEGER nState

nHWD = FindWindow(0, cCaption)
IF nHWD > 0
    * VENTANA YA ACTIVA
    * LA "LLAMAMOS":
    ShowWindow(nHWD,9)

    * LA PONEMOS ENCIMA
    SetForegroundWindow(nHWD)

    * LA ACTIVAMOS
    SetActiveWindow(nHWD)
    RETURN .T.
ELSE
    * VENTANA NO ACTIVA
    RETURN .F.
ENDIF

Pablo Roca

18 de junio de 2018

Manipular Ventanas desde VFP - Parte 2

En Esta Ocasion envio un Formulario que permite modificar el tamaño y la posicion de una ventana cualquiera desde VFP, y para variar por medio de APIs.

DEFINE CLASS cambia_ventanas AS form
 Height = 158
 Width = 351
 ShowWindow = 2
 DoCreate = .T.
 AutoCenter = .T.
 BorderStyle = 2
 Caption = "Manipulando Ventanas 2"
 TitleBar = 0
 Name = "Cambia_Ventanas"

 ADD OBJECT salir AS commandbutton WITH ;
  Top = 120, ;
  Left = 176, ;
  Height = 27, ;
  Width = 84, ;
  FontBold = .T., ;
  Caption = "Salir", ;
  TabIndex = 13, ;
  ForeColor = RGB(239,58,58), ;
  Name = "Salir"

 ADD OBJECT texto AS textbox WITH ;
  Height = 23, ;
  Left = 98, ;
  TabIndex = 3, ;
  Top = 36, ;
  Width = 240, ;
  Name = "texto"

 ADD OBJECT label1 AS label WITH ;
  AutoSize = .T., ;
  FontBold = .T., ;
  Caption = "Caption", ;
  Height = 17, ;
  Left = 14, ;
  Top = 39, ;
  Width = 45, ;
  TabIndex = 2, ;
  ForeColor = RGB(50,41,218), ;
  Name = "Label1"

 ADD OBJECT cx AS textbox WITH ;
  Alignment = 3, ;
  Value = 0, ;
  Format = "k", ;
  Height = 23, ;
  InputMask = "999,999", ;
  Left = 98, ;
  TabIndex = 5, ;
  Top = 60, ;
  Width = 72, ;
  Name = "cX"

 ADD OBJECT label2 AS label WITH ;
  AutoSize = .T., ;
  FontBold = .T., ;
  Caption = "Posicicion X", ;
  Height = 17, ;
  Left = 14, ;
  Top = 63, ;
  Width = 72, ;
  TabIndex = 4, ;
  ForeColor = RGB(50,41,218), ;
  Name = "Label2"

 ADD OBJECT cy AS textbox WITH ;
  Alignment = 3, ;
  Value = 0, ;
  Format = "k", ;
  Height = 23, ;
  InputMask = "999,999", ;
  Left = 266, ;
  TabIndex = 7, ;
  Top = 60, ;
  Width = 72, ;
  Name = "cY"

 ADD OBJECT label4 AS label WITH ;
  AutoSize = .T., ;
  FontBold = .T., ;
  Caption = "Posicicion Y", ;
  Height = 17, ;
  Left = 194, ;
  Top = 63, ;
  Width = 71, ;
  TabIndex = 6, ;
  ForeColor = RGB(50,41,218), ;
  Name = "Label4"

 ADD OBJECT ancho AS textbox WITH ;
  Alignment = 3, ;
  Value = 0, ;
  Format = "k", ;
  Height = 23, ;
  InputMask = "999,999", ;
  Left = 98, ;
  TabIndex = 9, ;
  Top = 86, ;
  Width = 72, ;
  Name = "ancho"

 ADD OBJECT label3 AS label WITH ;
  AutoSize = .T., ;
  FontBold = .T., ;
  Caption = "Ancho", ;
  Height = 17, ;
  Left = 14, ;
  Top = 89, ;
  Width = 38, ;
  TabIndex = 8, ;
  ForeColor = RGB(50,41,218), ;
  Name = "Label3"

 ADD OBJECT alto AS textbox WITH ;
  Alignment = 3, ;
  Value = 0, ;
  Format = "k", ;
  Height = 23, ;
  InputMask = "999,999", ;
  Left = 266, ;
  TabIndex = 11, ;
  Top = 86, ;
  Width = 72, ;
  Name = "alto"

 ADD OBJECT label5 AS label WITH ;
  AutoSize = .T., ;
  FontBold = .T., ;
  Caption = "Alto", ;
  Height = 17, ;
  Left = 194, ;
  Top = 89, ;
  Width = 24, ;
  TabIndex = 10, ;
  ForeColor = RGB(50,41,218), ;
  Name = "Label5"

 ADD OBJECT label6 AS label WITH ;
  FontBold = .T., ;
  FontSize = 12, ;
  Alignment = 2, ;
  BackStyle = 0, ;
  Caption = "Manipulando Ventanas 2", ;
  Height = 26, ;
  Left = 3, ;
  Top = 4, ;
  Width = 346, ;
  TabIndex = 1, ;
  ColorSource = 0, ;
  ForeColor = RGB(26,62,206), ;
  BackColor = (thisform.backcolor), ;
  Name = "Label6"

 ADD OBJECT cambiar AS commandbutton WITH ;
  Top = 120, ;
  Left = 90, ;
  Height = 27, ;
  Width = 84, ;
  FontBold = .T., ;
  Caption = "Cambiar", ;
  TabIndex = 12, ;
  ForeColor = RGB(239,58,58), ;
  Name = "Cambiar"

 PROCEDURE salir.Click
  thisform.Release
 ENDPROC

 PROCEDURE cambiar.Click
  Local handle As Long
  Declare Long MoveWindow In "user32" Long HWnd, Long x, Long Y, Long nWidth, Long nHeight, Long bRepaint
  Declare Long FindWindow In "User32" String Clase, String texto
  Declare long IsWindowEnabled IN "user32" long HWnd 
  With Thisform
   handle = FindWindow(.Null.,Alltrim(.texto.Value))
   If handle =0
    Wait Window "Ventana No Encontrada..."
    Return
   Endif
   MoveWindow(handle, .cX.Value, .cY.Value, .ancho.Value, .alto.Value, 1)
   IsWindowEnabled(handle)
  Endwith
 ENDPROC

ENDDEFINE

Saludos.

Jorge Mota

11 de junio de 2018

Manipular ventanas desde VFP - Parte 1

En esta ocasión envío un pequeño programa que nos permite habilitar /deshabilitar cualquier ventana buscándola por medio de su Caption, y también podemos cambiar el Caption de cualquier ventana!!!

Al Deshabilitar una ventana no podremos dar Click ni escribir nada en esa ventana, ni siquiera restaurarla o maximizarla, cerrarla, moverla, minimizarla, etc. (útil si queremos que no puedan cerrar X ventana mientras corremos un proceso)

Solo hay que tener cuidado cuando busquen la ventana, tiene que ir exactamente igual que como aparece en el título de la misma, mayúsculas y minúsculas.

Aquí el código:

Public oFormulario
oFormulario=Newobject("Ventanas")
oFormulario.Show
Return

Define Class Ventanas As Form
 Top = 118
 Left = 121
 Height = 177
 Width = 465
 DoCreate = .T.
 Caption = "Manipulando Ventanas desde VFP"
 Name = "Manipula_Ventanas"

 Add Object deshabilita As CommandButton With ;
  Top = 136, ;
  Left = 24, ;
  Height = 27, ;
  Width = 84, ;
  Caption = "Deshabilitar", ;
  TabIndex = 5, ;
  Name = "deshabilita"

 Add Object Titulo_ventana As TextBox With ;
  BackStyle = 1, ;
  Height = 23, ;
  Left = 24, ;
  TabIndex = 2, ;
  Top = 30, ;
  Width = 420, ;
  Name = "Titulo_ventana"

 Add Object Habilitar As CommandButton With ;
  Top = 136, ;
  Left = 108, ;
  Height = 27, ;
  Width = 84, ;
  Caption = "Habilitar", ;
  TabIndex = 6, ;
  Name = "Habilitar"

 Add Object label1 As Label With ;
  AutoSize = .T., ;
  FontBold = .T., ;
  BackStyle = 0, ;
  Caption = "Titulo de La Ventana ", ;
  Height = 17, ;
  Left = 24, ;
  Top = 6, ;
  Width = 120, ;
  TabIndex = 1, ;
  Name = "Label1"

 Add Object Nuevo_Titulo As TextBox With ;
  BackStyle = 1, ;
  Height = 23, ;
  Left = 24, ;
  TabIndex = 3, ;
  Top = 77, ;
  Width = 420, ;
  Name = "Nuevo_Titulo"

 Add Object Cambiar As CommandButton With ;
  Top = 136, ;
  Left = 192, ;
  Height = 27, ;
  Width = 84, ;
  Caption = "Cambiar", ;
  TabIndex = 7, ;
  Name = "Cambiar"

 Add Object Estado As Label With ;
  AutoSize = .T., ;
  BackStyle = 0, ;
  Caption = "Estado de la Ventana:", ;
  Height = 17, ;
  Left = 24, ;
  Top = 112, ;
  Width = 122, ;
  TabIndex = 4, ;
  Name = "Estado",;
  Tag ="Estado de la Ventana:"

 Add Object label3 As Label With ;
  AutoSize = .T., ;
  FontBold = .T., ;
  BackStyle = 0, ;
  Caption = "Nuevo Titulo para la Ventana ", ;
  Height = 17, ;
  Left = 24, ;
  Top = 58, ;
  Width = 166, ;
  TabIndex = 1, ;
  Name = "Label3"

 Procedure Load
  Declare Long IsWindowEnabled In "user32" Long handle
  Declare Long EnableWindow In "user32" Long handle, Long fEnable
  Declare Integer FindWindow In WIN32API String cNULL, String cWinName
  Declare Long SetWindowText In "user32" Long handel, String lpString
 Endproc

 Procedure deshabilita.Click
  Local Estado, retval As Long, handle As Long
  handle = FindWindow(.Null.,Alltrim(Thisform.Titulo_ventana.Value))
  If handle=0 Or Empty(Thisform.Titulo_ventana.Text)
   Wait Window 'Ventana no Encontrada'
   Return
  Endif
  retval = EnableWindow(handle, 0)
  Estado= IsWindowEnabled(handle)
  If Estado=0
   Thisform.Estado.Caption =Alltrim(Thisform.Estado.Tag)+' Deshabilitada'
  Else
   Thisform.Estado.Caption =Alltrim(Thisform.Estado.Tag)+' Habilitada'
  Endif
 Endproc

 Procedure Habilitar.Click
  Local Estado, retval As Long, handle As Long
  handle = FindWindow(.Null.,Alltrim(Thisform.Titulo_ventana.Value))
  If handle=0 Or Empty(Thisform.Titulo_ventana.Text)
   Wait Window 'Ventana no Encontrada'
   Return
  Endif
  retval = EnableWindow(handle, 1)
  Estado= IsWindowEnabled(handle)
  If Estado=0
   Thisform.Estado.Caption =Alltrim(Thisform.Estado.Tag)+' Deshabilitada'
  Else
   Thisform.Estado.Caption =Alltrim(Thisform.Estado.Tag)+' Habilitada'
  Endif
 Endproc

 Procedure Cambiar.Click
  Local Estado, retval As Long, handle As Long
  handle = FindWindow(.Null.,Alltrim(Thisform.Titulo_ventana.Value))
  If handle=0
   Wait Window 'Ventana no Encontrada'
   Return
  Endif
  If Empty(Thisform.Nuevo_Titulo.Text) Or Empty(Thisform.Titulo_ventana.Text)
   Wait Window 'Debe escribir un Caption valido'
   Return
  Endif
  SetWindowText(handle, Alltrim(Thisform.Nuevo_Titulo.Text))
  Estado= IsWindowEnabled(handle)
  If Estado=0
   Thisform.Estado.Caption =Alltrim(Thisform.Estado.Tag)+' Deshabilitada'
  Else
   Thisform.Estado.Caption =Alltrim(Thisform.Estado.Tag)+' Habilitada'
  Endif
 Endproc
Enddefine

Saludos.

Jorge Mota

16 de abril de 2018

Mensaje tipo Messenger

Antes de comenzar cambiamos la propiedad ShowWindow A 2 (Formulario de nivel superior)

Ahora declaramos la API que vamos a utilizar la colocamos en el evento Load del formulario:

DECLARE integer SetWindowPos IN "user32";
  integer hwnd, integer hWndInsertAfter,;  
  integer x,integer y,integer cx,integer cy,integer wFlags 

Si queremos darle un grado de transparencia declaramos estas.

Declare Integer SetWindowLong In "user32" ;
  Integer HWnd, Integer nIndex, Integer dwNewLong

Declare Integer SetLayeredWindowAttributes In "user32" ;
  Integer HWnd, Integer crey, ;
  Integer bAlpha, Integer dwFlags

Bueno ahora en el evento Init colocamos lo siguiente.

*- esto nos permitira abrir el formulario sin que nos afecte otra ventana.
=SetWindowPos(this.HWnd, -1, 0, 0, 0, 0, 1 + 2 )

*-- Con estas define el grado de transparencia del formulario
SetWindowLong(THISFORM.hWnd, -20, 0x00080000)
*-- Cambia el valor (200) para ajustar el nivel de transparencia. 
SetLayeredWindowAttributes(THISFORM.hWnd, 0, 200, 2) 

Bien ahora vamos a darle una pequeña animación.

En el evento Active del form colocamos lo siguiente.

*-- Ubico el formulario 
tleft = (_screen.Width -this.Width)
ttlef = (tleft + this.Width)
this.Move (ttlef,ttop,this.Width,this.Height)
FOR i = 1 TO tleft  && muevo el form 
  ttlef = ttlef - 1
  this.Move (ttlef,ttop,this.Width,this.Height)
  IF ttlef = tleft 
    EXIT 
  ENDIF  
ENDFOR

Ahora el sonido en el mismo evento.

lcWaveFile =""
*-- defino la ruta del sonido a emitir  
lcWaveFile = ruta + "Librerias\newemail.wav" 

DECLARE INTEGER PlaySound ;
  IN WINMM.dll  ;
  STRING cWave, ;
  INTEGER nModule, ;
  INTEGER nType

PlaySound(lcWaveFile,0,1)

Y listo ya tenemos nuestro mensaje tipo Messenger el diseño corre por cuenta de ustedes.

by FreeCalls

13 de marzo de 2018

Programa usando la Función ShellExecute

Codigo usando la Función ShellExecute para llamar al programa de correo predeterminado, el cual en mi caso es Mozilla-Mail.

Primero Declaro la Función en un Prg que he definido como Principal:

DECLARE INTEGER ShellExecute IN shell32.dll ;
  INTEGER hndWin, STRING cAction, STRING cFileName, ;
  STRING cParams, STRING cDir, INTEGER nShowWin

Luego en un botón de comando en un form, llamo a la función asi:

LOCAL dir1,correo
dir1 = ALLTRIM(Thisform.txtEmail.Value)
correo = "mailto:" + dir1
if not empty(dir1)
  ShellExecute(0,"open",correo,"","",1)
  ***//mozilla.exe -compose "to=foo@nowhere.net"//
else
  MESSAGEBOX("No hay Dirección de Correo",0,"E-mail")
endif

Espero que les sea de utilidad

Hasta pronto.

Josue Nahum Montufar

18 de noviembre de 2017

Obtener la ruta (path) en formato largo

En alguna ocasión puede que obtengamos un nombre de archivo en formato corto, por ejemplo "c:\Docum~1\Usuario\Misdoc~1\" y convertirlo a "c:\Documents and Settings\Usuario\Mis documentos\". A continuación una función API para llegar a ello.

DECLARE integer GetLongPathName IN WIN32API ;
 string @ lpszShortPath, string @ lpszLongPath, integer cchBuffer

#define MAXPATH 267
STORE SPACE(MAXPATH) TO lpszLongPath
lcPath = "C:\DOCUME~1\epalma\Misdoc~1\"
lnLen = GetLongPathName(m.lcPath,@lpszLongPath,MAXPATH)
if lnLen > 0
 ? SUBSTR(lpszLongPath,1,lnLen)
else
 ? Ruta Inválida'
endif

Çetin Basöz
MS Foxpro MVP, MCP

16 de junio de 2017

Poner la ventana principal de VFP en el primer plano

Función API para poner la Ventana Principal de VFP en el primer plano fijo, situa nuestra aplicación por encima de cualquier otra que se encuentre abierta en Windows.

***************************************************************************
***************************************************************************
*
*   Función    : VentanaTopMost
*   Proposito  : Pasar la ventana Principal de VFP al primer plano fijo
*                Situar nuestra aplicación siempre encima de todas las 
*                demas ventanas de windows
*   Parametros : 1 - Pasar la ventana Principal de VFP al primer plano fijo
*                0 - Quitar la ventana Principal de VFP del primer plano fijo
*   Regresa    : Nada
*   Ejemplo    : =VentanaTopMost(1)
*     
***************************************************************************
***************************************************************************
FUNCTION VentanaTopMost(n_Estado)
DECLARE Integer SetWindowPos IN WIN32API ;
      Integer  nWnd, ;
      Integer  nWndInsertAfter, ;
      Integer  nTop, ;
      Integer  nLeft, ;
      Integer  nHeight, ;
      Integer  nWidth, ;
      Integer  nFlags
 
DECLARE INTEGER FindWindow IN WIN32API ;
STRING cNULL, ;
STRING cWinName
      
#define SWP_NOSIZE          1
#define SWP_NOMOVE          2
#define HWND_TOPMOST       -1
#define HWND_NOTOPMOST     -2
 
*--- se obtiene el manejador de la ventana principal
n_FoxHwnd = FindWindow( 0, _SCREEN.Caption )
 
*--- si el parametro es 1
IF n_Estado = 1
 
   *--- pasar a primer plano fijo
   =SetWindowPos(n_FoxHwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE + SWP_NOMOVE )
 
ENDIF
 
*--- si el parametro es 0
IF n_Estado = 0
 
   *--- la quita del primer plano fijo
   =SetWindowPos(n_FoxHwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOSIZE + SWP_NOMOVE )
 
ENDIF

ENDFUNC
***************************************************************************
***************************************************************************

Carlos Tarello (Puebla, Mexico)

8 de junio de 2017

Opciones alternativa a la función FILE()

Como se ha visto últimamente en los foros de noticias de microsoft, la función FILE() tiene algunos "errores" que pueden afectar el comportamiento de nuestros programas, aquí encontrarás algunos métodos adicionales.

Normalmente, la función File() la utilizamos para revisar si existe un archivo en cierta ruta, pero el comportamiento de la misma función tiene sus detalles que están documentados en la ayuda:

"Si el archivo no puede encontrarse en el directorio predeterminado, se buscará en la ruta de acceso de Visual FoxPro establecida con SET PATH. "

Que significa esto? Que aunque se le indique la ruta completa de un archivo a buscar, la función File() buscará también ese mismo archivo dentro de la ruta establecida por PATH, dándole un tiempo adicional en hacer su labor. Por ejemplo:

Caso 1.

Intentamos buscar el archivo "HolaMundo.txt" en una ruta especifica:

? FILE("c:\miApp\miDirectorio\HolaMundo.txt")

Si el archivo no existe en ese directorio devolverá .F., pero..., si algún archivo llamado "HolaMundo.txt" se encuentra en algunas de las rutas establecidas por el comando SET PATH, o en el directorio de trabajo de la aplicación, entonces devolverá .T., cuestión que puede afectar en gran medida el comportamiento de nuestro sistema.

Caso 2

Buscamos el archivo "HolaMundo.txt" sin poner ruta completa para hacer validaciones de X tipo:

IF File("HolaMundo.txt")
   Messagebox("... blah blah blah....")
ENDIF

Si por alguna razón, nuestro archivo se encuentra en cualquier otra localidad establecida por SET PATH, la función también devolverá .T., una vez más, caso dificil de controlar, si suponemos que podemos tener cientos de rutas establecidas.

Como es de imaginarse, los inconvenientes que puede ocasionar este comportamient normal de la función FILE() puede ser algo engorroso.

Muy bien, que hay por hacer? Hasta el momento, gracias a la colaboración que ha surgido en los mensajes de los newsgroup de microsoft, tenemos lo siguiente:

Opción 1

Quitar las rutas establecidas por SetPath antes de utilizar la función File():

Function SureFile
  LParameters tcFileName
  Local lcOldPath
  Local llRetValue 
       lcOldPath = SET("PATH")
       SET PATH TO
          llRetValue = File(m.tcFileName)
       SET PATH TO &lcOldPath
      Return llRetValue
EndFunction

Opcion 2

Utilizar la función ADIR(), la cual, no presenta el inconveniente de la tan mencionada función FILE().

Function SureFile
  LParameters tcFileName
  RETURN (ADIR(laDummy, m.tcFileName) > 0)
EndFunction

Opcion 3

Utilizando la función SYS(2000):

Function SureFile
  LParameters tcFileName
  RETURN NOT EMPTY(SYS(2000,m.tcFileName))
ENdFunction

Opcion 4

Utilizar una API para llevar a cabo la labor:

*** En tu programa de inicio, solo una vez *****
declare Integer GetFileAttributes in win32api string @
****************************************

Function SureFile
   LParameters tcFileName
       return (GetFileAttributes(@m.tcFileName)  <> -1)
EndFunction

Esta última opción es la que he visto funciona un poco más rapido que las anteriores, ya que no hay que re-establecer ningún setting, ni crear ningún arreglo, ni buscar nada que no sea exactamente lo que deseamos.

Así pues, pongo a consideración las opciones disponibles, hagamos nuestras y pruebas y si tienen algún comentario al respecto, comentemoslo ya sea aquí, o en los newsgroups de microsoft (son públicos y gratuitos).

Espero que la información les sea de utilidad.

Espartaco Palma Martínez

7 de noviembre de 2016

Obtener la dirección MAC (Mac Address)

Como obtener la dirección MAC (dirección de la tarjeta Ethernet) ...

Uso:

direccion = MacAddress()
FUNCTION MacAddress
Local pGUID,rGUID,lnSize
Declare integer CoCreateGuid in 'OLE32.dll' ;
  string @pguid
Declare integer StringFromGUID2 in 'OLE32.dll' ;
  string rguid, string @lpsz, integer cchMax
pGUID=replicate(chr(0),16)
rGUID=replicate(chr(0),80)

If "5." $ OS() && 2000/XP
  Declare integer UuidCreateSequential in 'RPCRT4.dll'  string @ Uuid
  Return substr( iif( UuidCreateSequential(@pGUID) = 0 ;
    and StringFromGUID2(pGUID,@rGUID,40) # 0, ;
    StrConv(left(rGUID,76),6), "" ), 26,12)
Else
  Return substr( iif( CoCreateGuid(@pGUID) = 0 ;
    and StringFromGUID2(pGUID,@rGUID,40) # 0, ;
    StrConv(left(rGUID,76),6), "" ), 26,12)
Endif
Cetin Basoz

14 de octubre de 2016

¿Es el Usuario un Administrador?

Rutina para determinar si el Usuario actual de Windows es Administrador.

#DEFINE NO_ERROR 0
 
DECLARE INTEGER IsUserAnAdmin IN shell32
 
DECLARE INTEGER WNetGetUser IN mpr;
    INTEGER lpName, STRING @lpUserName, INTEGER @lpnLength
 
LOCAL lcUser, lnBufsize
lnBufsize = 250
lcUser = Repli(Chr(0), lnBufsize)
 
IF WNetGetUser(0, @lcUser, @lnBufsize) = NO_ERROR
    ? "Nombre de Usuario:", SUBSTR(lcUser, 1, AT(Chr(0),lcUser)-1)
    ? "Es Administrador:", Iif(IsUserAnAdmin()=0, "No", "Si")
ENDIF

Saludos.

Jesus Caro V

14 de septiembre de 2016

Saber por Api, si podemos Abrir Un Archivo de Forma Exclusiva

Esta Api, nos permite saber si un archivo lo podemos abrir de manera Exclusiva

Si Devuelve .T., esta bloqueado por otra aplicacion, util para saber si esta en uso.

? EstaBloqueado("c:\atisaappreg01.dbf")

Function EstaBloqueado(cArchivo)
 Declare Long _lopen In "kernel32" as lOpen String lpPathName, Long iReadWrite
 Declare Long _lclose In "kernel32" as lClose Long hFile
 Local hFile As Long
 hFile = -1
 hFile = lOpen(cArchivo, 0x10)
 Result = hFile = -1
 lClose (hFile)
 Return Result
Endfunc

Jorge Mota

25 de agosto de 2016

Usando WSH para enviar secuencias de tecla en VFP

Muchas veces encontramos resuelta cierta funcionalidad que necesitamos para nuestra aplicación en algún software y nos preguntamos ¿cómo podría integrarlo a mi sistema?

En muchos casos la respuesta la encontramos en las API que dicho software pone a nuestra disposición o a veces un control ActiveX que podemos instanciar en nuestros formularios. Pero existen otros casos en los cuales no tenemos una respuesta positiva y tenemos dos alternativas: desarrollamos la funcionalidad requerida o intentamos automatizar el uso de dicho soft.

Veamos entonces como podemos utilizar la potencia del Windows Scripting Host para enviar la secuencia de teclas necesarias a otra aplicación para resolver cierta funcionalidad.

A modo de ejemplo automatizaremos una operación matemática en la aplicación Calculator de Windows. Para ello escriba el siguiente código:

MODIFY COMMAND SendKeys
Copie y pegue el código que se muestra a continuación:
* Listado Completo
Local lnHWND, loWSH

* Declaramos funciones de las API de Windows
DECLARE LONG FindWindow IN WIN32API AS FindWindow STRING @a, STRING @b
DECLARE LONG SetForegroundWindow IN WIN32API LONG

* Buscamos una instancia de la aplicación para obtener su Handler
lnHWND = FindWindow(0, "Calculator")
If lnHWND = 0
    * Si no se está ejecutando, la ejecutamos
    Run /N Calc.EXE
    * Y obtenemos su Handler
    lnHWND = FindWindow(0, "Calculator")
Endif

* Instanciamos el Windows Scripting Host
loWSH = CreateObject("WScript.Shell")

* Enviamos la aplicación a primer plano
SetForegroundWindow(lnHWND)

* Por último enviamos la secuencia de teclas
loWSH.SendKeys("140{+}200")
loWSH.SendKeys("{enter}") 
Secuencias de Escape

En la siguiente línea loWSH.SendKeys("140{+}200") vemos que el signo de suma está encerrado entre llaves. Esto se debe a que está definiendo una secuencia de escape, indicándole al WSH que debe enviar el caracter "+", y debe hacerse de esta forma ya que un signo "+" sin llaves estaría indicando que se debe enviar la pulsación de la tecla SHIFT (por ejemplo: "+casa", enviaría "Casa"). Vea Material Adicional para obtener la lista completa de secuencias de escape.

Conclusión

Si bien el ejemplo es muy sencillo y probablemente nunca se nos va a ocurrir automatizar la calculadora para hacer una suma, vale la pena analizarlo ya que muestra claramente el uso del método SendKeys del WSH.

Material Adicional

Refiérase a http://msdn.microsoft.com/library/default.asp?url=/library/en-us/script56/html/wsmthsendkeys.asp para consultar las secuencias de escape definidas para el método SendKeys del WSH.

Acerca del autor

Esteban Bruno nació el 25 de marzo de 1973 en Buenos Aires, Argentina. En el año 1992 se recibió de Analista Programado en la Comisión Argentina de Informática, y en 1998 egresó de la Universidad CAECE con el título de Licenciado en Sistemas. Desde el año 1990 ha trabajado en el área de desarrollo en diferentes empresas y utilizando una amplia gama de lenguanjes (Cobol, C, Clipper, FoxBase, FoxPro desde 2.5 para DOS hasta Visual FoxPro 9, Visual Basic, ASP, Java, etc.) y tecnologías. Es socio del MUG Argentina (Microsoft User Group) y actualmente se desempeña como Analista Funcional en IMR S.A. y dirige el Dpto. de Sistemas de TASSO S.R.L. Contacto: bruno@tasso.com.ar

19 de agosto de 2016

Conversion de Rutas (Path) de largas a cortas y viceversa

Este ejemplo muestra como convertir una ruta larga (formato Windows) a una ruta corta (formato 8.3 MS-DOS) y como revertirlo, llevarla de formato de ruta corta a ruta larga.

*######################################################
*# Llevado de Visual Basic a Visual Foxpro por Int21
*######################################################

*#########################################################
*# Declaracion de las API'S
*#########################################################
DECLARE INTEGER GetShortPathName IN kernel32 ;
STRING @lpszLongPath , STRING @lpszShortPath, INTEGER @cchBuffer
DECLARE INTEGER GetLongPathName IN kernel32 ;
STRING @lpszShortPath, STRING @lpszLongPath, INTEGER @cchBuffer

*#########################################################
*# Convertir una Ruta Larga dentro del equivalente 8.3 de ruta corta
*#########################################################
LOCAL lLen, GetShortPath, sLongPath, La_Ruta
lLen = 0
GetShortPath = ""
sLongPath = "C:\Documents and Settings\Morfeus\Escritorio\Long__-__S1227648262002"
*#### Establecer el buffer para la llamada  a la API
GetShortPath = SPACE(1024)
*#### Llamada a la API, Retirar los Caracteres no deseados y devolver la Ruta
lLen = GetShortPathName(@sLongPath, @GetShortPath, LEN(GetShortPath))
La_Ruta = LEFT(GetShortPath, lLen)
WAIT WINDOWS La_Ruta

*#########################################################
*# Convertir una Ruta Corta en su equivalente de Ruta Larga
*#########################################################
LOCAL lLen, sShortPath, LaRuta
lLen = 0
sShortPath = "C:\Docume~1\Morfeus\Escrit~1\Long__~1"
LaRuta = ""
*#### Establecer el Buffe rpara la llamada a la API
GetLongPath = SPACE(1024)
*#### Llamada a la Api, Retirar los caracteres no deseados y devolver la Ruta
lLen = GetLongPathName(@sShortPath, @GetLongPath, LEN(GetLongPath))
LaRuta = LEFT(GetLongPath, lLen)
WAIT WINDOWS LaRuta