30 de julio de 2012

Códigos de Barras QR sin utilizar la API de Google.

Que tal Compañeros. Navegando por la web, encontré una dll para la generación de códigos de barra de dos dimensiones QR.

Esta Dll tiene una función llamada GenerateFile con la que de una manera simple, podemos generar el Código QR sin tantas complicaciones.

Código para generar un archivo QR:
*--------------------------------------
DECLARE INTEGER GenerateFile ;
   IN BarCodeLibrary.dll ;
   STRING cData, ;
   STRING cFileName

*- GenerateFile(Texto a codificar, Archivo a generar)
GenerateFile("href="http://comunidadvfp.blogspot.com","potalfoxQR.bmp")

*--------------------------------------

Nota del editor:

La librería tiene también otra función que permite configurar el tamaño del código y el tipo de la imagen generada. Puede no invocarse, pero si desea cambiar los valores por omisión debe invocarla antes que la función GenerateFile
*--------------------------------------
DECLARE INTEGER SetConfiguration ;
   IN BarCodeLibrary.dll ;
   INTEGER nSize, ;           && [2..12] (Default 4)
   INTEGER nImageType         && 0=BMP, 1=JPG, 2=PNG (Default 0)

*- SetConfiguration(Tamaño, Tipo de imagen)
SetConfiguration(6,2)

*--------------------------------------

El archivo dll y un código de ejemplo lo pueden descargar desde aquí

Solo basta recordarles que existe otro artículo sobre el tema de QR:


Hasta la próxima!!

Baltazar Moreno, Guadalajara, Jalisco, México

24 de julio de 2012

Arrastrar, soltar y conservar las posiciones - Parte II - Columnas de una cuadricula

Artículo original: Drag, Drop and Retain It Part II - Grid Columns
http://sandstorm36.blogspot.com.ar/2012/07/drag-drop-and-retain-it-part-ii-grid.html
Autor: Jun Tangunan
Traducido por: Luis Maria Guayán


Arrastrar, soltar y conservar las posiciones - Parte II - Columnas de una cuadricula



Debido al ejemplo de "Arrastrar, soltar y conservar posiciones" que publiqué anteriormente, una nueva solicitud se hizo dentro del foro (Nota del Traductor: Foxite Forum) y esta vez se trata de reordenar las columnas de una cuadrícula sobre la marcha y guardar esa configuración.

Yo pensaba llamar esto "Trucos de cuadrícula # 6" porque se trata de trucos de cuadrícula, pero al final me decidí a hacer esta la parte 2 parte 2 de "Arrastrar, soltar y conservar las posiciones".

De todos modos, aquí está cómo hacerlo. Siempre se debe tener algo primero para guardar la configuración y luego para recuperar, una tabla es mi mejor opción. Esto es simple y solo para que sirva de guía. Puede ser necesario que usted tenga que guardar el nombre del formulario y el nombre de la cuadrícula para algo mas completo

Aquí está el código de ejemplo, si estás interesado:
LOCAL oForm
oForm = NEWOBJECT("Form1")
oForm.SHOW
READ EVENTS
RETURN

DEFINE CLASS Form1 AS FORM
  HEIGHT = 390
  WIDTH = 500
  AUTOCENTER = .T.
  CAPTION = 'Reordenar las columnas y conservarlas'
  SHOWTIPS = .T.

  ADD OBJECT label1 AS LABEL WITH ;
    CAPTION = 'Arrastre y suelte para reordenar columnas. Luego cierre y ' + ;
    'vuelva a abrir formulario para ver si la disposición está guardada', ;
    TOP = 10, LEFT = 10, WIDTH = 480, HEIGHT = 40, WORDWRAP = .T.

  ADD OBJECT grid1 AS GRID WITH ;
    COLUMNCOUNT = 3,;
    HEIGHT = 328, LEFT = 10, TOP = 50, WIDTH = 480,;
    GRIDLINES = 3, DELETEMARK = .F.,;
    GRIDLINECOLOR = RGB(192,192,192),;
    GRIDLINES = 0, FONTNAME = 'Tahoma', FONTSIZE = 8,;
    ANCHOR = 15, ALLOWCELLSELECTION = .F.,;
    TOOLTIPTEXT = 'Drag Column to Rearrange'

  PROCEDURE LOAD
    SET TALK OFF
    SET SAFETY OFF
    CLOSE DATABASES ALL
    SELECT  company, contact, TITLE FROM (HOME(2)+"data\customer") WHERE RECNO() < 50 INTO CURSOR junk
    USE IN SELECT('customer')

    * Create/use a table to store grid column settings
    IF !FILE("gridcolumns.dbf")
      CREATE TABLE gridcolumns (ColName c(10), ColOrder I)
    ELSE
      USE gridcolumns IN 0 SHARED
    ENDIF
  ENDPROC

  PROCEDURE INIT
    IF RECCOUNT("gridcolumns") == 0
      * First run? Save the current order of the columns
      LOCAL lnloop
      WITH THISFORM.grid1
        FOR lnloop = 1 TO .COLUMNCOUNT
          lcColName =  .COLUMNS(m.lnloop).NAME
          lnOrder = .COLUMNS(m.lnloop).COLUMNORDER
          INSERT INTO gridcolumns VALUES (m.lcColName, m.lnOrder)
        NEXT
      ENDWITH
    ENDIF
    THIS._getorder()
  ENDPROC

  PROCEDURE grid1.INIT
    WITH THIS
      .RECORDSOURCETYPE = 6
      .RECORDSOURCE = 'junk'
      .Column1.Header1.CAPTION = 'Column1'
      .Column2.Header1.CAPTION = 'Column2'
      .Column3.Header1.CAPTION = 'Column3'
      .SETALL('Width',150,'Column')

      * Bind Move Events
      FOR lnloop = 1 TO .COLUMNCOUNT
        BINDEVENT(.COLUMNS(m.lnloop),'Moved',THISFORM,'_Moved')
      NEXT
    ENDWITH
  ENDPROC

  PROCEDURE _Moved
    * Save new column orders
    LOCAL lnloop
    WITH THISFORM.grid1
      FOR lnloop = 1 TO .COLUMNCOUNT
        lcColName =  ALLTRIM(.COLUMNS(m.lnloop).NAME)
        lnOrder = .COLUMNS(m.lnloop).COLUMNORDER
        REPLACE ColOrder WITH m.lnOrder FOR ALLTRIM(ColName) = m.lcColName IN gridcolumns
      NEXT
    ENDWITH
  ENDPROC

  PROCEDURE _getorder
    * Fetch Column Orderings
    SELECT gridcolumns
    LOCAL lnloop
    WITH THISFORM.grid1
      FOR lnloop = 1 TO .COLUMNCOUNT
        lcColName =  .COLUMNS(m.lnloop).NAME
        LOCATE FOR ColName = m.lcColName
        .COLUMNS(m.lnloop).COLUMNORDER = ColOrder
      NEXT
      .REFRESH
    ENDWITH
  ENDPROC

  PROCEDURE DESTROY
    CLOSE DATABASES ALL
    CLEAR EVENTS
  ENDPROC

ENDDEFINE

21 de julio de 2012

Arrastrar, soltar y conservar posiciones

Artículo original: Drag, Drop and Retain Positions
http://sandstorm36.blogspot.com/2012/07/drag-drop-and-retain-positions.html
Autor: Jun Tangunan
Traducido por: Luis Maria Guayán


Arrastrar, soltar y conservar posiciones

Aquí otro ejemplo moviendo objetos a su alrededor y conservando las posiciones en la siguiente ejecución del formulario. Esto es sólo una simple demostración de cómo podemos hacer lo siguiente:



Mientras que la parte de arrastrar y soltar parece ser fácil, además de conservar y recuperar esos valores posteriormente, lo que me llevó más tiempo de averiguar es cómo el reordenamiento de estos objetos que afectan las propiedades tabIndex de cada objeto dentro del contenedor. De todos modos, esto no está perfecto aun, pero al menos usted tendrá algo con que empezar y perfeccionar.

Copie y pegue el código a un .PRG, ejecute y tilde "Permitir mover", a continuación, arrastre los botones alrededor. Después de eso, cierre el formulario y a continuación, ejecutelo de nuevo. Vea si se mantiene las últimas posiciones cuando se cerró el formulario y si el tabindex es el adecuado.
Aquí el código del ejemplo si le interesa:
LOCAL oForm AS FORM
oForm = CREATEOBJECT('TestForm')
oForm.SHOW(1)
RETURN

DEFINE CLASS TestForm AS FORM
  AUTOCENTER = .T.
  WIDTH = 300
  HEIGHT = 440
  MINWIDTH = 200
  MINHEIGHT = 100
  CAPTION = 'Drag, Drop & Retain Positions'

  ADD OBJECT chkMove AS CHECKBOX WITH CAPTION = 'Permitir mover los objetos',;
    TOP = 400, LEFT = 5, AUTOSIZE = .T., VALUE = .F., ANCHOR = 6
  ADD OBJECT Command1 AS MyButton WITH CAPTION='One', TOP = 5, LEFT = 5
  ADD OBJECT Command2 AS MyButton WITH CAPTION='Two', TOP = 70, LEFT = 5
  ADD OBJECT Command3 AS MyButton WITH CAPTION='Three', TOP =135, LEFT = 5
  ADD OBJECT Command4 AS MyButton WITH CAPTION='Four', TOP = 200, LEFT = 5
  ADD OBJECT Command5 AS MyButton WITH CAPTION='Five', TOP = 265, LEFT = 5
  ADD OBJECT Command6 AS MyButton WITH CAPTION='Six', TOP = 330, LEFT = 5

  PROCEDURE LOAD
    CLOSE DATABASES ALL
    * Check if table is there for preserving/restoring values
    IF !FILE('DragDrops.dbf')
      CREATE TABLE dragdrops FREE (ObjectName c(40),xTop I,xLeft I,xTabIndex I)
      INDEX ON xTop+xLeft TAG xTabIndex
    ELSE
      USE dragdrops ORDER xTabIndex
    ENDIF
  ENDPROC

  PROCEDURE INIT
    * Check if first run or not, if first run, make an entry in the table
    IF RECCOUNT() == 0
      FOR EACH loCtrl IN THISFORM.CONTROLS FOXOBJECT
        INSERT INTO dragdrops VALUES (loCtrl.NAME,loCtrl.TOP,loCtrl.LEFT,0)
      NEXT
    ENDIF
    THIS._reorder()
  ENDPROC

  PROCEDURE _TabIndex
    * recreate tab indexes
    LOCAL lnTab
    lnTab = 1
    SCAN
      REPLACE xTabIndex WITH m.lnTab IN dragdrops
      lnTab = m.lnTab + 1
    ENDSCAN
  ENDPROC

  PROCEDURE _reorder
    * Reorder Tab Index
    FOR EACH loCtrl IN THISFORM.CONTROLS FOXOBJECT
      SELECT dragdrops
      LOCATE FOR UPPER(loCtrl.NAME) = UPPER(ObjectName)
      loCtrl.TABINDEX = dragdrops.xTabIndex
    NEXT
  ENDPROC

ENDDEFINE

DEFINE CLASS MyButton AS COMMANDBUTTON
  HEIGHT = 60
  WIDTH = 100

  PROCEDURE INIT
    * Get previous positions
    SELECT dragdrops
    LOCATE FOR UPPER(THIS.NAME) = UPPER(ObjectName)
    THIS.TOP = dragdrops.xTop
    THIS.LEFT = dragdrops.xLeft
  ENDPROC

  PROCEDURE MOUSEMOVE
    LPARAMETERS nButton, nShift, nXCoord, nYCoord
    IF m.nButton = 1 AND THISFORM.chkMove.VALUE = .T.
      THIS.MOVE(m.nXCoord, m.nYCoord)
      * update new coordinates
      REPLACE xTop WITH m.nYCoord, xLeft WITH m.nXCoord FOR;
        UPPER(THIS.NAME) = UPPER(ObjectName) IN dragdrops
      THISFORM._TabIndex()
    ENDIF
  ENDPROC

  PROCEDURE CLICK
    MESSAGEBOX("You've clicked "+THIS.NAME+CHR(13)+;
      "Tab Index: "+TRANSFORM(THIS.TABINDEX))
  ENDPROC

ENDDEFINE

14 de julio de 2012

Cambiar la resolución del monitor desde VFP

Una excelente función del turco Cetin Basoz que nos permite cambiar la resolución de la pantalla desde Visual FoxPro.

? SetScreenresolution(1024,768)

FUNCTION SetScreenresolution(tnWidth,tnHeight,tnFrequency)

  #DEFINE ENUM_CURRENT_SETTINGS -1
  #DEFINE CDS_UPDATEREGISTRY = 0x01
  #DEFINE CDS_TEST 0x02
  #DEFINE DISP_CHANGE_SUCCESSFUL 0
  #DEFINE DISP_CHANGE_RESTART 1
  #DEFINE DISP_CHANGE_FAILED -1
  #DEFINE DM_PELSWIDTH 0x00080000
  #DEFINE DM_PELSHEIGHT 0x00100000
  #DEFINE DM_DISPLAYFREQUENCY 0x00400000

  LOCAL lpDevMode,result
  DECLARE INTEGER EnumDisplaySettings IN win32API ;
    STRING deviceName,;
    INTEGER modeNum, ;
    STRING @ lpdevMode

  DECLARE LONG ChangeDisplaySettings IN win32API ;
    STRING lpDevMode, ;
    INTEGER dwflags

  lpdevMode = REPLICATE(CHR(0),512)

  EnumDisplaySettings(0,ENUM_CURRENT_SETTINGS,@lpdevMode)

  *!*    ? "Current settings are:",;
  *!*        CTOBIN(Substr(m.lpdevMode,109,4),"4RS"),;
  *!*        CTOBIN(Substr(m.lpdevMode,113,4),"4RS")

  * Width and Height
  lpdevMode = STUFF(m.lpdevMode,109,4,Int2DWord(m.tnWidth))
  lpdevMode = STUFF(m.lpdevMode,113,4,Int2DWord(m.tnHeight))

  IF !EMPTY(m.tnFrequency)
    lpdevMode = STUFF(m.lpdevMode,121,4,Int2DWord(m.tnFrequency)) && Frequency
    lpdevMode = STUFF(m.lpdevMode,41,4,;
      Int2DWord(BITOR(DM_PELSWIDTH,DM_PELSHEIGHT,DM_DISPLAYFREQUENCY))) && dmFields
  ELSE
    lpdevMode = STUFF(m.lpdevMode,41,4,;
      Int2DWord(BITOR(DM_PELSWIDTH,DM_PELSHEIGHT))) && dmFields
  ENDIF

  result = ChangeDisplaySettings(m.lpdevMode,CDS_TEST)

  IF !( result = DISP_CHANGE_SUCCESSFUL )
    MESSAGEBOX("Mode is not supported",0+48,'Monitor settings')
  ELSE
    ChangeDisplaySettings(m.lpdevMode,0)
    TEXT to m.lcSetting noshow
La resolución de su pantalla ha sido cambiada.
Presione [Si] para confirmar el cambio.
Se restablecerá automáticamente la resolución en 30 segundos.
    ENDTEXT

    IF MESSAGEBOX(m.lcSetting,4+64,'Monitor settings',30000) != 6
      ChangeDisplaySettings(0,0) && restore
    ENDIF

  ENDIF
ENDFUNC

FUNCTION Int2DWord(tInt)
  LOCAL lcDWord,ix
  lcDWord = ''
  FOR ix=1 TO 4
    lcDword = m.lcDword + CHR( INT(m.tInt / 256^(m.ix-1)) % 256 )
  ENDFOR
  RETURN m.lcDword
ENDFUNC