GenMenu.PRG soporta personalizar directamente mediante SKIP FOR .F.

Una barra de menú puede tener una cláusula SKIP FOR, especificada en cuadro diálogo Opciones de la barra. GENMENU agrega simplemente un SKIP FOR, más el contenido de esta cláusula al final de la declaración DEFINE BAR que es generada.

Puesto que no todas las cláusulas DEFINE BAR estan soportadas en este diálogo, mucha gente utiliza esta cláusula para "engañar" a GENMENU en emitir dichas cláusulas adicionales.

La expresión siguiente es un ejemplo de cómo se agregaría una cláusula FONT.

.F. FONT 'Arial'

Previamente, GENMENU generó un código como el siguiente:

DEFINE BAR .... SKIP FOR .F. FONT 'Arial'

Así pues, una cláusula "inútil" SKIP FOR se agrega al comando DEFINE BAR, que es probable que impacte en el rendimiento. Puesto que Microsoft decidido para no apoyar las nuevas cláusulas MRU/INVERT de DEFINE BAR a través del Diseñador del menú, es probable que los desarrolladores utilizarán aun mas este truco.

El cambio realizado a GENMENU en VFP7 es comprobar si la expresión "SKIP FOR" comienza con ".F." y si es así, excluye el "SKIP FOR .F." a la línea. De esta manera, a partir de VFP7 la línea resultante generada por GENMENU se parecerá a esto:

DEFINE BAR .... FONT 'Arial'

VFP Tips & Tricks - Drew Speedie

ExecScript()

La nueva función ExecScript() en VFP 7.0 permite que usted ejecute una secuencia de código "al vuelo".

El ejemplo de abajo también hace uso de la nueva sintaxis TEXT TO para crear la cadena de comandos.

Simule esto es su código PRG o método:

*
* código normal del PRG o método aquí ...
* 

*
* cree una cadena de comandos "al vuelo" 
*
TEXT TO lcCode NOSHOW
LOCAL lcOutput,xx
lcOutput = SPACE(0)
FOR xx = 1 to 10
  lcOutput = lcOutput + ;
  "Line " + TRANSFORM(xx) + ;
  CHR(13) + CHR(10)
ENDFOR
RETURN lcOutput
ENDTEXT
*
* ejecute los comandos aquí 
*
LOCAL lcRetVal
lcRetVal = EXECSCRIPT(lcCode)
*
* continúe ejecutando el PRG o método... 
* 

Solamente tenga cuidado que ExecScript es relativamente lento.

[037] VFP Tips & Tricks - Drew Speedie

Obtener el ID de un tamaño de papel

Como obtener el ID numerico de un formulario de impresión.

Clase EnumPrinterFormsClass de Sergey Berezniker (originalmente publicada en Universalthread
http://www.universalthread.com/wconnect/wc.dll?2,84,13,5 FAQ ID: 22445).

NOTA: Necesita VFP8 o superior

************************************************************
* Funcion: PrintFormID
* Obtiene el ID de un formulario de impresión
* Parametros:
*     tcImpresora  - Nombre de la Impresora, "" tomar los forms del PC
*     tcFormulario - Nombre del formulario personalizado previamente creado
*     tlsilencioso - En modo silencioso
* Ejemplos:
*   lnret = PrintFormID("", "100x80")
*   lnret = PrintFormID("HP Laser", "100x80",.T.)
* Retorno
*      >0 - correcto, devuelve el ID del formulario
*      -1 - Error, no se pudo obtener la lista de formularios de impresion
*      -2 - Error, formulario no encontrado
* Notas
* Creación           : 14/02/2006 Pablo Roca
* Ultima Modificacion: 14/02/2006 Pablo Roca
************************************************************
FUNCTION PrintFormID(tcImpresora, tcFormulario, tlsilencioso)
  LOCAL loPrintForm, lnret, i
  LOCAL loForm, lnForm, lcLabel
  LOCAL lalineas(1), lcst, llret
  lcst = ""
  lnForm = 0
  loPrintForm = NEWOBJECT("EnumForms", "EnumPrinterFormsClass.fxp")
  * obtenemos la lista de formularios
  IF NOT loPrintForm.GetFormList(tcImpresora)
    * no se puede obtener la lista de formularios
    lnret = -1
    IF !tlsilencioso
      MESSAGEBOX("No se pudo obtener la lista de formularios de impresión.",16,"ATENCION")
    ENDIF
  ELSE
    * recorremos la lista de formularios buscando nuestro formulario
    FOR i=1 TO loPrintForm.oFormList.Count
      loForm = loPrintForm.oFormList.Item(i)
      IF loForm.FormName = tcFormulario
        lnForm = loForm.FormID
        EXIT
      ENDIF
    ENDFOR
    IF lnForm <> 0
      lnret = lnForm
    ELSE
      * formulario no encontrado
      lnret = -2
      IF !tlsilencioso
        MESSAGEBOX("Formulario ("+tcFormulario+") no encontrado.",16,"ATENCION")
      ENDIF
    ENDIF
  ENDIF

  loPrintForm = NULL
  RETURN lnret
ENDFUNC

Ahora la clase EnumPrinterForms:

*--------------------------------------------
* EnumPrinterFormsClass.prg
DEFINE CLASS EnumForms AS Custom
  HIDDEN hHeap, nInch2mm, nCm2mm, nCoefficient
  * Specified a Printer name for which the list of supported forms is retrieved
  *   If empty, retrieved the list of formds defined on local PC
  cPrinterName = ""
  * The form attributes are stored in in thousandths of millimeters
  * It can be coverted by class to inches ("English") or centimeters ("Metric")
  cUnit = "Internal"
  * Specified how to round result of conversion
  nRound = 0
  * Conversion Coefficients
  nInch2mm = 25.4
  nCm2mm = 10
  nCoefficient = 0
  * Error code and Error message returned by Win API
  nApiErrorCode = 0
  cApiErrorMessage = ""
  * Error message returned by class itself (none-API error)
  cErrorMessage = ""
  hHeap = 0
  * Collection of Print Forms retrieved
  oFormList = Null
  PROCEDURE Init(tcUnit, tnRound)
    IF PCOUNT() >= 1 AND INLIST(tcUnit, "English", "Metric")
      This.cUnit = PROPER(tcUnit)
    ENDIF
    IF PCOUNT() = 2
      This.nRound = tnRound
    ENDIF
    This.oFormList = CREATEOBJECT("Collection")
    * Load DLLs
    This.LoadApiDlls()
    * Allocate a heap
    This.hHeap = HeapCreate(0, 4096*10, 0)
    * Calculate conversion coefficient
    DO CASE
      CASE PROPER(This.cUnit) = "English"
        This.nCoefficient = This.nInch2mm * 1000
      CASE PROPER(This.cUnit) = "Metric"
        This.nCoefficient = This.nCm2mm * 1000
      OTHERWISE
        This.cUnit = "Internal"
        This.nCoefficient = 1
    ENDCASE
  ENDPROC

  PROCEDURE Destroy
    IF This.hHeap <> 0
      HeapDestroy(This.hHeap)
    ENDIF
  ENDPROC

  PROCEDURE GetFormList(tcPrinterName)
    LOCAL lhPrinter, llSuccess, lnNeeded, lnNumberOfForms, lnBuffer, i
    IF PCOUNT() > 0
      This.cPrinterName = tcPrinterName
    ENDIF
    This.ClearErrors()
    * Open a printer
    lhPrinter = 0
    lcPrinterName = This.cPrinterName
    IF EMPTY(lcPrinterName)
      lnResult = OpenPrinter(0, @lhPrinter, 0)
    ELSE
      lnResult = OpenPrinter(@lcPrinterName, @lhPrinter, 0)
    ENDIF
    IF  lnResult = 0
      This.cErrorMessage = "Unable to get printer handle for '" ;
        + This.cPrinterName + "'."
      This.nApiErrorCode = GetLastError()
      This.cApiErrorMessage = This.ApiErrorText(This.nApiErrorCode)
      RETURN .F.
    ENDIF
    lnNeeded = 0
    lnNumberOfForms = 0
    * Get the size of the buffer required to fit all forms in lnNeeded
    IF EnumForms(lhPrinter, 1,  0, 0, ;
        @lnNeeded,    @lnNumberOfForms  ) = 0
      IF GetLastError() <> 122   && The buffer too small error
        This.cErrorMessage = "Unable to Enumerate Forms."
        This.nApiErrorCode = GetLastError()
        This.cApiErrorMessage = This.ApiErrorText(This.nApiErrorCode)
        RETURN .F.
      ENDIF
    ENDIF
    * Get the list of forms
    lnBuffer = HeapAlloc(This.hHeap, 0, lnNeeded)
    llSuccess = .T.
    IF EnumForms(lhPrinter, 1, lnBuffer, @lnNeeded, ;
        @lnNeeded,    @lnNumberOfForms  ) = 0
      This.cErrorMessage = "Unable to Enumerate Forms."
      This.nApiErrorCode = GetLastError()
      This.cApiErrorMessage = This.ApiErrorText(This.nApiErrorCode)
      llSuccess = .F.
    ENDIF
    IF llSuccess
      * Put list of the forms into collection with Form number (i) as a key
      * A collection here can be replaced with an array or a cursor.
      FOR i=1 TO lnNumberOfForms
        loOneForm = This.OneFormObj()
        WITH loOneForm
          lnPointer = lnBuffer + (i-1) * 32
          .FormID    = i
          .FormFlags = This.Long2NumFromBuffer(lnPointer)
          .FormName = This.StrZFromBuffer(lnPointer+4)
          .Width    = ROUND(This.Long2NumFromBuffer(lnPointer+8)  / ;
            This.nCoefficient, This.nRound)
          .Height   = ROUND(This.Long2NumFromBuffer(lnPointer+12) / ;
            This.nCoefficient, This.nRound)
          .Left = ROUND(This.Long2NumFromBuffer(lnPointer+16) / ;
            This.nCoefficient, This.nRound)
          .Top = ROUND(This.Long2NumFromBuffer(lnPointer+20) / ;
            This.nCoefficient, This.nRound)
          .Right = ROUND(This.Long2NumFromBuffer(lnPointer+24) / ;
            This.nCoefficient, This.nRound)
          .Bottom = ROUND(This.Long2NumFromBuffer(lnPointer+28) / ;
            This.nCoefficient, This.nRound)
        ENDWITH
        This.oFormList.Add(loOneForm, TRANSFORM(i))
      ENDFOR
    ENDIF
    =HeapFree(This.hHeap, 0, lnBuffer )
    =ClosePrinter(lhPrinter)
    RETURN llSuccess
    * Create an object with forms attributes

  PROCEDURE OneFormObj
    LOCAL loOneForm
    loOneForm = NEWOBJECT("Empty")
    ADDPROPERTY(loOneForm, "FormFlags", 0)
    ADDPROPERTY(loOneForm, "FormId", 0)
    ADDPROPERTY(loOneForm, "FormName", "")
    ADDPROPERTY(loOneForm, "Width", 0)
    ADDPROPERTY(loOneForm, "Height", 0)
    ADDPROPERTY(loOneForm, "Left", 0)
    ADDPROPERTY(loOneForm, "Top", 0)
    ADDPROPERTY(loOneForm, "Right", 0)
    ADDPROPERTY(loOneForm, "Bottom", 0)
    RETURN loOneForm
  ENDPROC

  PROCEDURE ClearErrors
    This.cErrorMessage = ""
    This.nApiErrorCode = 0
    This.cApiErrorMessage = ""
  ENDPROC

  * Retrieve zero-terminated string from a buffer into VFP variable
  PROCEDURE StrZFromBuffer(tnPointer)
    LOCAL lcStr, lnStrPointer
    lcStr = SPACE(256)
    lnStrPointer = 0
    = RtlCopy(@lnStrPointer, tnPointer, 4)
    lstrcpy(@lcStr, lnStrPointer)
    RETURN LEFT(lcStr, AT(CHR(0),lcStr)-1)
  ENDPROC

  * Convert Long integer into VFP numeric variable
  PROCEDURE Long2NumFromBuffer(tnPointer)
    LOCAL lnNum
    lnNum = 0
    = RtlCopy(@lnNum, tnPointer, 4)
    RETURN lnNum
  ENDPROC

  * Converts VFP number to the Long integer
  FUNCTION Num2LOng(tnNum)
    DECLARE RtlMoveMemory IN WIN32API AS RtlCopyLong ;
      STRING @Dest, Long @Source, Long Length
    LOCAL lcString
    lcString = SPACE(4)
    =RtlCopyLong(@lcString, BITOR(tnNum,0), 4)
    RETURN lcString
  ENDFUNC

  * Convert Long integer into VFP numeric variable
  FUNCTION Long2Num(tcLong)
    DECLARE RtlMoveMemory IN WIN32API AS RtlCopyNum ;
      Long @Dest, String @Source, Long Length
    LOCAL lnNum
    lnNum = 0
    =RtlCopyNum(@lnNum, tcLong, 4)
    RETURN lnNum
  ENDFUNC

  HIDDEN PROCEDURE ApiErrorText
    LPARAMETERS tnErrorCode
    Local lcErrBuffer
    lcErrBuffer = REPL(CHR(0),1024)
    =FormatMessage(0x1000 ,.NULL., tnErrorCode, 0, @lcErrBuffer, 1024,0)
    RETURN LEFT(lcErrBuffer, AT(CHR(0),lcErrBuffer)- 1 )
  ENDPROC

  HIDDEN PROCEDURE LoadApiDlls
    DECLARE INTEGER OpenPrinter IN winspool.drv;
      STRING  @pPrinterName,;
      INTEGER @phPrinter,;
      INTEGER pDefault
    DECLARE INTEGER ClosePrinter IN winspool.drv;
      INTEGER hPrinter
    DECLARE LONG EnumForms IN winspool.drv AS EnumForms ;
      LONG hPrinter, LONG Level, LONG pForm, ;
      LONG cbBuf, LONG @pcbNeeded, ;
      LONG @ pcReturned
    DECLARE INTEGER HeapCreate IN Win32API;
      INTEGER dwOptions, INTEGER dwInitialSize,;
      INTEGER dwMaxSize
    DECLARE INTEGER HeapAlloc IN Win32API;
      INTEGER hHeap, INTEGER dwFlags, INTEGER dwBytes
    DECLARE lstrcpy IN Win32API;
      STRING @lpstring1, INTEGER lpstring2
    DECLARE INTEGER HeapFree IN Win32API;
      INTEGER hHeap, INTEGER dwFlags, INTEGER lpMem
    DECLARE HeapDestroy IN Win32API;
      INTEGER hHeap
    DECLARE RtlMoveMemory IN WIN32API AS RtlCopy ;
      Long @Dest, Long Source, Long Length
    DECLARE lstrcpy IN Win32API;
      STRING @lpstring1, INTEGER lpstring2
    DECLARE INTEGER GetLastError IN kernel32
    Declare Integer FormatMessage In kernel32.dll ;
      Integer dwFlags, String @lpSource, ;
      Integer dwMessageId, Integer dwLanguageId, ;
      String @lpBuffer, Integer nSize, Integer Arguments
  ENDPROC

ENDDEFINE

Pablo Roca

Tratar campos FechaHora (DateTime) como Fecha (Date)

El tema era que quería tratar los datos de tipo T (FechaHora) como los de tipo D (Fecha), ya que atacaba a una B.D. que no tenía tipo de dato Fecha, la solución como siempre en la ayuda ;)

Yo utilizo los objetos CursorAdapter, pues lo que he hecho ha sido usar las propiedades: UseCursorSchema con valor .T., y la propiedad CursorSchema con el valor de los campos del SELECT a ejecutar en el mismo orden de aparición de los campos.

Ej:

oCursor.Alias = "MiAlias"
oCursor.DataSourceType = "ODBC" && Tipo ODBC por ejemplo.
oCursor.DataSource = ghndODBC && handle de conexión Odbc.
oCursor.SelectCmd = "SELECT Id, CampoCar, CampoFechaHora FROM Tabla WHERE Id = ?pnId"
oCursor.CursorSchema = "Id I, CampoCar C(30), CampoFechaHora D"
oCursor.UseCursorSchema = .T.
oCursor.CursorFill()

Con esto y si no me he equivocado en el código obtendríamos un cursor con el tipo Fecha en vez del tipo FechaHora. Esta misma solución me ha servido para pasar campos del tipo coma flotante (Float) a campos numéricos con un número determinado de posiciones decimales.

Rafael Cano

Conocer el valor de campo autonumérico

Una labor fundamental cuando se utiliza el nuevo tipo de dato (VFP8 y posteriores)... El caso es clásico cuando se desea saber cuál fué el último valor de un campo identificador para utilizarlo como llave foránea en tablas relacionadas.

A partir de VFP9 se cuenta con una función nativa que hace muy fácil su uso: GetAutoIncValue() .

lnLastID = GetAutoIncValue() 
IF LastID > 0
     *** Utilizar este valor
ENDIF

Esta función tiene un punto débil, ya que sólo te dará los valores de el último autoincremental, cosa que podría ser contraproducente (o inútil) si utilizas varios autoincrementales en una misma tabla (cosa que es posible), para esto, y también para ayudar a aquellos que cuenta todavía con la versión 8, pongo a disposición una rutina que podría ser utilizada para subsanar este pequeño problema:

**************************************************************************
* Function: LastID
* Obtener el último ID (Autoincremental) de un cursor, según el campo indicado
* Parameters: tcAlias ---> Alias del cursor 
*             tcField ---> Campo Autoincremental
* Returns:
*      + Entero positivo mayor o igual a cero si se le ha proporcionado
*        correctamente el alias y campo (debe ser autoincremental).
*      + .NULL. en caso de haber error, o no cumplir con los
*        requerimentos
* Developer: Esparta Palma (esparta@gmail.com) http://www.PortalFox.com
**************************************************************************

FUNCTION LastID(tcAlias AS String,;
                tcField AS String ) AS Integer
  LOCAL luReturn
  luReturn = .NULL.
  *** Revisar si existe el alias
  IF (SELECT(tcAlias)>0) AND (AFIELDS(LaFields,tcAlias) > 0)
    LOCAL lnRow
    *** Buscar la columna del campo a obtener su ultimo ID
    lnRow = ASCAN(laFields,tcField,1,0,1,1+8)
    *** Si el campo existe y es del tipo AutoInc
    IF (lnRow > 0) AND (laFields[lnRow,18] > 0)
      luReturn = laFields[lnRow,17]-1
    ENDIF
  ENDIF
  RETURN luReturn
ENDFUNC 

Su modo de uso es el siguiente:

lnLastID = LastID("TuTabla","TuCampoIncremental")
IF NOT NULL(lnLastID)
  *** Utilizar este valor
ENDIF

Espero les sea de utilidad.

Espartaco Palma Martínez

Mover controles y ajustar tamaño en tiempo de ejecución

A cuantos nos ha pasado querer permitirle mover controles al usuario y que el usuario pueda cambiar el tamaño del objeto.

Esta utilidad muestra un ejemplo de ello, si quieren que se guarde esta información para que el usuario cargue las ventanas con las caracteristias que él a colocado, pues solo hagan una tabla en la que guarden el control y sus propiedades, en el Init del Form, carguen estas propiedades y en el Unload, guarden las nuevas.

Espero les sea de utilidad.

Alejandro Magaña

PUBLIC loForm1
loForm1 = CREATEOBJECT("Form1")
loForm1.SHOW(1)

DEFINE CLASS Form1 AS FORM
  TOP = 0
  LEFT = 0
  HEIGHT = 225
  WIDTH = 276
  AUTOCENTER = .T.
  CAPTION = "Mover y ajustar controles"
  xoffset = 0
  yoffset = 0
  NAME = "Form1"
  ADD OBJECT command10 AS COMMANDBUTTON WITH ;
    TOP = 68, LEFT = 84, ;
    HEIGHT = 49, WIDTH = 84, ;
    CAPTION = "Mi botón", NAME = "Command10"
  ADD OBJECT check1 AS CHECKBOX WITH ;
    TOP = 20, LEFT = 54, ;
    HEIGHT = 17, WIDTH = 60, ;
    CAPTION = "Mover", NAME = "Check1"
  ADD OBJECT check2 AS CHECKBOX WITH ;
    TOP = 20, LEFT = 161, ;
    HEIGHT = 17, WIDTH = 60, ;
    CAPTION = "Ajustar", NAME = "Check2"
  ADD OBJECT label1 AS LABEL WITH ;
    CAPTION = [Para mover el botón deberá activar la ] + ;
    [casilla "Mover", y para ajustar su Height y ] + ;
    [Width, active la casilla "Ajustar"], ;
    HEIGHT = 60, LEFT = 6, ;
    TOP = 161, WIDTH = 267, ;
    NAME = "Label1", WORDWRAP = .T.
  PROCEDURE ajustar
    LPARAMETERS oSource, nXCoord, nYCoord, nPosicion
    IF nPosicion = 1
      oSource.WIDTH = nXCoord - oSource.LEFT
    ELSE
      oSource.HEIGHT = nYCoord - oSource.TOP
    ENDIF
  ENDPROC
  PROCEDURE DRAGDROP
    LPARAMETERS oSource, nXCoord, nYCoord
    oSource.LEFT = nXCoord - THISFORM.XOffset
    oSource.TOP = nYCoord - THISFORM.YOffset
  ENDPROC
  PROCEDURE command10.DRAGDROP
    LPARAMETERS oSource, nXCoord, nYCoord
    THIS.PARENT.DRAGDROP(oSource, nXCoord, nYCoord)
  ENDPROC
  PROCEDURE command10.CLICK
    MESSAGEBOX("Left: "+TRANSFORM(THIS.LEFT)+CHR(13)+;
      "Top: "+TRANSFORM(THIS.TOP)+CHR(13)+;
      "Width: "+TRANSFORM(THIS.WIDTH)+CHR(13)+;
      "height: "+TRANSFORM(THIS.HEIGHT))
  ENDPROC
  PROCEDURE command10.MOUSEMOVE
    LPARAMETERS nButton, nShift, nXCoord, nYCoord
    IF THISFORM.Check1.VALUE = 1
      IF nButton = 1 && Left button
        THISFORM.XOffset = nXCoord - THIS.LEFT
        THISFORM.YOffset = nYCoord - THIS.TOP
        THIS.DRAG
      ENDIF
    ENDIF
    IF THISFORM.check2.VALUE = 1
      THISFORM.XOffset = nXCoord - THIS.LEFT
      THISFORM.YOffset = nYCoord - THIS.TOP
      DO CASE
        CASE BETWEEN(THISFORM.XOffSet,THIS.WIDTH - 8,THIS.WIDTH + 8)
          THIS.MOUSEPOINTER = 9
          IF nButton = 1
            THISFORM.Ajustar(THIS,nXCoord,nYCoord,1)
          ENDIF
        CASE BETWEEN(THISFORM.YOffSet,THIS.HEIGHT - 8,THIS.HEIGHT + 8)
          THIS.MOUSEPOINTER = 7
          IF nButton = 1
            THISFORM.Ajustar(THIS,nXCoord,nYCoord,2)
          ENDIF
        OTHERWISE
          THIS.MOUSEPOINTER = 0
      ENDCASE
    ENDIF
  ENDPROC
  PROCEDURE check1.CLICK
    IF THIS.VALUE = 1
      THIS.PARENT.check2.VALUE = 0
    ENDIF
  ENDPROC
  PROCEDURE check2.CLICK
    IF THIS.VALUE = 1
      THIS.PARENT.check1.VALUE = 0
    ENDIF
  ENDPROC
ENDDEFINE

Limpiar/blanquear un campo General

Para limpiar/blanquear el contenido de un campo General, Ud. no puede usar el comando REPLACE o GATHER para intentar actualizarlo con algún valor vacio.

Solo use el comando BLANK:

BLANK FIELDS CampoGeneral

VFP Tips & Tricks - Drew Speedie