12 de octubre de 2017

Como crear texto como un archivo de imagen con GdiPlusX

Artículo original: How to create text as image file with GdiPlusX
http://weblogs.foxite.com/vfpimaging/archive/2007/11/24/5428.aspx
Autor: Cesar Ch.
Traducido por: Luis María Guayán


Más que una vez que he visto a la gente pedir como crear imágenes que contengan algún texto. El ejemplo de abajo es realmente muy simple.

  • Crear una fuente
  • Medir el espacio que el texto necesitará
  • Crear una imagen con el tamaño necesario
  • Dibujar el texto
  • Guardar en el disco

IMPORTANTANTE

Para ejecutar se requiere VFP9 y GdiPlusX.

Por favor, asegúrese de que tiene la última versión, porque VFPPaint utiliza algunas de las funciones que se han añadido recientemente.

https://github.com/VFPX/GDIPlusX

DO LOCFILE("System.prg")

WITH _SCREEN.System.Drawing
   LOCAL lcText
   lcText = "GdiPlusX is Cool !!!"

   * Crear una fuante
   LOCAL loFont as xfcFont
   loFont = _screen.system.Drawing.Font.New("Verdana", 32, .FontStyle.BoldItalic)

   LOCAL loTmpBmp as xfcBitmap
   loTmpBmp = .Bitmap.New(1,1)

   * Recuperar el objeto gráfico
   LOCAL loTmpGfx AS xfcGraphics
   loTmpGfx = .Graphics.FromImage(loTmpBmp)

   * Medir la cadena
   * tomar el tamaño necesario para el texto
   LOCAL loSize as xfcSize
   loSize = loTmpGfx.MeasureString(lcText, loFont)

   LOCAL loNewBmp as xfcBitmap
   loNewBmp = .Bitmap.New(loSize.Ceiling)

   LOCAL loNewGfx as xfcGraphics
   loNewGfx = .Graphics.FromImage(loNewBmp)

   * Hacer el fondo amarillo
   loNewGfx.Clear(.Color.Yellow)

   * Crear un pincel sólido
   LOCAL loBrush as xfcSolidBrush
   loBrush = .SolidBrush.New(.Color.FromRGB(255,0,0)) && Rojo

   * Crear un objeto StringFormat para dibujar el texto centrado en la imagen
   LOCAL loStringFmt as xfcStringFormat
   loStringFmt = .StringFormat.New()
   loStringFmt.Alignment = .StringAlignment.Center

   * Crear un ractángulo con las medidas del Bitmap
   LOCAL loRect as xfcRectangleF
   loRect = loNewBmp.GetBounds()

   * Dibujar la cadena
   loNewGfx.DrawString(lcText, loFont, loBrush, loRect, loStringFmt)

   * Finalmente guardar la imagen
   loNewBmp.Save("c:\MyText.Png", .Imaging.ImageFormat.Png)

   * Mostrar la imagen
   RUN /N Explorer.exe c:\Mytext.Png
ENDWITH


7 de octubre de 2017

Multiselección en un Grid

Esta la saque de http://www.tek-tips.com/faqs.cfm?fid=433. Aquí la pongo traducida:

¿Cómo agregar la funcionalidad de multiselección en un Grid?
faq184-433
Posted: 29 Jan 01 (Edited 30 Sep 06)

Si desean agregar la funcionalidad multiselección a un Grid para que emule la del explorador de Windows, intenten lo siguiente:

Subclaseen un Grid en una librería de clases y agregen 4 nuevas propiedades:

  • lMultiSelect con valor .F.
  • nActiveRow con valor 0 (cero)
  • nLastRow con valor 0 (cero)
  • nRecs2Change con valor 0 (cero)

Y un nuevo método:

  • mSelectRecords()

Asegurense de que RecordSource del Grid no este indexado, lo crean con una sentencia SELECT-SQL. El RecordSource necesita un campo logico adicional, "Selected".

En el evento AfterRowColChange() pongan:

THIS.mSelectRecords()

En el método mSelectRecords() del Grid pongan:

LOCAL lcSelected,lcRecordSource

#DEFINE VK_lSHIFT 0x10 && Relocate to a header file
#DEFINE VK_lCONTROL 0x11 && Relocate to a header file

DECLARE INTEGER GetKeyState IN WIN32API INTEGER && Relocate to where WinAPI calls are declared

WITH THIS
  .nActiveRow = .ACTIVEROW && Assign value to class property
  lcSelected = .RECORDSOURCE + [.selected] && Assign value to local variable
  lcRecordSource = .RECORDSOURCE && Assign value to local variable

  DO CASE
    CASE GetKeyState(VK_lSHIFT)    < 0    ;
        OR GetKeyState(VK_lSHIFT) > 1 && Check for shift key press

      DO CASE
        CASE .nLastRow > .nActiveRow && Last recd below current recd in grid

          .nRecs2Change = .nLastRow - .nActiveRow && Calculate no of recds to change

          REPLACE (lcSelected) WITH .T. IN (lcRecordSource) && Replace current recd
          FOR i = 1 TO .nRecs2Change
            REPLACE (lcSelected) WITH .T. IN (lcRecordSource)
            SKIP IN (lcRecordSource)
          ENDF

        CASE .nLastRow < .nActiveRow && Last recd above current recd in grid

          .nRecs2Change = .nActiveRow - .nLastRow && Calculate no of recds to change
          REPLACE  (lcSelected) WITH .T. IN (lcRecordSource) && Replace current recd

          GO .nLastRow IN (lcRecordSource) && Goto the last recd
          FOR i = 1 TO .nRecs2Change
            REPLACE (lcSelected) WITH .T. IN (lcRecordSource)
            SKIP IN (lcRecordSource)
          ENDF
      ENDC

      .lMultiSelect = .T.

    CASE GetKeyState(VK_lCONTROL) < 0 ;
        OR GetKeyState(VK_lCONTROL) > 1 && Check for control key press

      REPLACE (lcSelected) WITH .T. IN (lcRecordSource)

      .lMultiSelect = .T.

    OTHERWISE && Neither shift or ctrl pressed
      DO CASE
        CASE .lMultiSelect
          REPLACE (lcSelected) WITH .F. ;
            ALL IN (lcRecordSource) && Update all recds
        CASE .nLastRow    # 0
          TRY
            GO .nLastRow IN (lcRecordSource)
          CATCH
            GO BOTTOM IN (lcRecordSource)
          ENDTRY
          REPLACE (lcSelected) WITH .F. IN (lcRecordSource)
      ENDCASE

      GO .nActiveRow IN (lcRecordSource) && Change new value
      REPLACE (lcSelected) WITH .T. IN (lcRecordSource)

      .lMultiSelect = .F.
  ENDC

  IF RECCOUNT(lcRecordSource) > 0
    DO CASE && Set colours according to OS
      CASE UPPER(OS(1)) = [WINDOWS 5.00] && Win 2K
        .SETALL([DynamicBackColor], ;
          "IIF(&lcSelected, RGB(10,36,106), RGB(255,255,255))", ;
          [Column])
      CASE UPPER(OS(1)) = [WINDOWS 5.01] && Win XP
        .SETALL([DynamicBackColor], ;
          "IIF(&lcSelected, RGB(49,106,197), RGB(255,255,255))", ;
          [Column])
    ENDCASE

    .SETALL([DynamicForeColor], ; && All OS
      "IIF(&lcSelected, RGB(255,255,255), RGB(0,0,0))", ;
      [Column])

    .nLastRow = .nActiveRow && Mark current row for next time through
  ENDIF
ENDWITH

Seran seleccionados solos registros que se cliqueen con Mayusculas o Control. Usando los cursores direccionales no seleccionara registros.

Programaticamente pueden determinar si hay selecciones multiples de registros con:

IF THISFORM.grid1.lMultiSelect
  *!* Code
ENDIF

Otra solucion mas simple es agregar un campo numerico al cursor que esta en el RecordSource del Grid. Por ejemplo mselec n(5).

En el Init del Form poner:

THISFORMSET.frm_enviaryrecibir.grd_recibidos.SETALL("dynamicbackcolor", ;
  "IIF(mselec = 1,RGB(49,106,197), RGB(255,255,255))", "Column")
THISFORMSET.frm_enviaryrecibir.grd_recibidos.SETALL("dynamicforecolor", ;
  "IIF(mselec = 1,RGB(255,255,255), RGB(0,0,0))", "Column")

Y en el Click del Grid:

LOCAL lcSelected,lcRecordSource

#DEFINE VK_lSHIFT 0x10 && Relocate to a header file
#DEFINE VK_lCONTROL 0x11 && Relocate to a header file

DECLARE INTEGER GetKeyState IN WIN32API INTEGER && Relocate to where WinAPI calls are declared
DO CASE
  CASE GetKeyState(VK_lSHIFT) < 0 OR GetKeyState(VK_lSHIFT) > 1 && Check for shift key press
    IF mselec = 0
      REPLACE mselec WITH 1
    ELSE
      REPLACE mselec WITH 0
    ENDIF

  CASE GetKeyState(VK_lCONTROL) < 0 OR GetKeyState(VK_lCONTROL) > 1 && Check for control key press
    IF mselec = 0
      REPLACE mselec WITH 1
    ELSE
      REPLACE mselec WITH 0
    ENDIF
ENDCASE

con esto cada vez que hagan Click con Mayúscula o Control presionado van a seleccionar los registros y el Grid los pinta.

Para poder hacer algo con la selección hacen:

SELEC MICURSOR
SCAN FOR mselec = 1
  *! mi codigo para la seleccion
ENDSCAN

Suerte!!!!

Carlos Caremi

4 de octubre de 2017

Regenerar Indices de las Tablas de un DBC

Quizás no sea la gran cosa, pero, a todos nos pasa que tenemos que regenerar indices, y reindexar nuestras tablas... etc etc etc.

En la empresa donde trabajo usamos este proceso cuando las sucursales reciben los DBF en las transferencias de datos, entonces los CDX están en las sucursales y solo enviamos los DBF (en un archivo comprimido, gracias a PortalFox).

Necesitamos abrir los DBF en forma exclusiva. Y este código solo tiene en cuenta indice primarios y regulares, se puede retocar para quienes necesiten.

Bueno, vamos al código... 'databaseconteiner.DBC' es el nombre del Contenedor de las Tablas...

SELECT * FROM databaseconteiner.DBC ;
  WHERE OBJECTTYPE = 'Table' ;
  INTO CURSOR TABLAS
*
SELECT TABLAS
SCAN
  TABLA1 = TABLAS.OBJECTNAME
  USE &TABLA1 IN 0 EXCLUSIVE
  SELECT &TABLA1
  WAIT WINDOWS 'Tabla ' + ALLTRIM(TABLA1) + ' (' + TRANSFORM(RECNO('TABLAS')) + ;
    '/' + TRANSFORM(RECCOUNT('TABLAS')) + ')' NOWAIT
  FOR I=1 TO TAGCOUNT()
    IF !EMPTY(TAG(I))
      INDICE = SYS(14,I)
      NOMBRE = TAG(I)
      PRINCI = PRIMARY(I)
      IF PRINCI
        ALTER TABLE &TABLA1 DROP PRIMARY KEY
        ALTER TABLE &TABLA1 ADD PRIMARY KEY &INDICE TAG &NOMBRE
      ELSE
        INDEX ON &INDICE TAG &NOMBRE ADDITIVE
      ENDIF
    ELSE
      REINDEX
      EXIT
    ENDIF
    REINDEX
  ENDFOR
  PACK
ENDSCAN

Guillermo Gastón Giménez

1 de octubre de 2017

El alcance de CREATEOBJECT

Artículo original: The scope of CREATEOBJECT
http://www.foxpert.com/KnowlBits_200701_3.htm
Autor: Christof Wollenhaupt
Traducido por: Ana María Bisbé York


En ocasiones, uno llega a entender que algunas cosas son absolutamente desaprovechadas. Una de ellas es el alcance de CREATEOBJECT(). La primera vez que usted instancia un objeto desde una clase, Visual FoxPro crea una plantilla del objeto con todas los valores de las propiedades definidas en la clase. Si la definición de clases contiene una expresión para alguna de las propiedades, Visual FoxPro la evalúa en ese momento. Para futuras instancias, Visual FoxPro utiliza el valor de la expresión evaluada anteriormente.

Ahora, la parte desaprovechada de este artículo: Todas las propiedades de clases son evaluadas en el ámbito del procedimiento o método que instancia el objeto. Esto significa, que en las expresiones de propiedades de clases puede acceder a todas las variables locales en ese procedimiento:

Local lcVar, loRef
lcVar = "Hi"
loRef = CreateObject("Test")
? loRef.cTest

Define Class Test as Custom
 cTest = m.lcVar
EndDefine