informe dinámico

[karinha]

amigos, alguien tendrían un informe dinámico, donde el usuario puede elegir los campos que se desea imprimir?

Gracias, saludos.

[leandro]

Se me ocurre que utilices EASY REPORT

[joseluisysturiz]

Saludos, que tal crear un array con las columnas que el usuario quiera, y luego llevarlas a un xbrowse y usar oBrw:Report().? tengo que hacer algo parecido y es la unica idea que se me viene, es mas, mi idea es que el usuario escoja las columnas y mueva de posicion las que quiera, bajo la situacion que abra unas que no podra cambiar, fue su solicitud...si consigues algo mejor y mas practico, si puede lo compartes, la otra forma seria usando fast report, gracias, saludos...

[armando.lagunas]

sigue este hilo:

http://forums.fivetechsupport.com/viewtopic.php?f=6&t=26146&hilit=runadhoc

es un generador de informes no se quien es el autor, pero es un buen trabajo

cuelgo el prg por si no esta disponible.

Code: Select all  Expand view

#include "FiveWin.ch"
#include "report.ch"
#include "Dbstruct.ch"

memvar nitem1
memvar nitem2
memvar arr1
memvar arr4
Memvar arrbase
Memvar repmes
Memvar replen
Memvar ol1bx
Memvar ol2bx
Memvar p80
Memvar p132
Memvar arrhead
Memvar indstring
Memvar bstring
Memvar arrind
Memvar olbx
Memvar indinit
Memvar ostring
Memvar tempind1
Memvar tit1
Memvar tit2
Memvar tit3
Memvar arrgrp
Memvar arrtot
Memvar arrh1
Memvar arrh2
Memvar olg1bx
Memvar olg2bx
Memvar arrname
Memvar arrtype
Memvar arrsize
Memvar old1bx
Memvar old2bx
Memvar limstring
Memvar limstring2
Memvar arrlim
Memvar arrfiles
Memvar om1bx
Memvar grace
Memvar passind
Memvar passfor
Memvar trep
Memvar olbrowbx
Memvar Publicas
Memvar oDlg
memvar rtf
function RUNADHOC()
arrtot:={}
arrgrp:={}
arrlim:={}
arrhead:={}
arrind:={}
arr4:={}
arrsize:={}
arrname:={}
arrtype:={}
arrfiles:={}
arr1:={}
arrbase:={}
arrind:={}
arrh1:={}
arrh2:={}
indstring:=''
indinit:=''
limstring:=''
limstring2:=''
tit3:=''
tit1:=''
tit2:=''
// ****************************************
//  llama a los recursos
// ****************************************
set exact on
grace := 0
// ***************************************
//  bucle principal
// ***************************************
do while .T.
// *********************************
//  initializa un numero de variables
// **********************************
   trep := .t.
   kleanup()
// ******************************
//  carga informacion sobre los campos de la base de datos
// ******************************

   if !file(Publicas:Basename)
      MsgStop("Fichero de datos no encontrado!")
      return nil
   endif

   dbUseArea(.F.,,Publicas:Basename,,.T.)

   asize(arrsize,fcount())
   asize(arrname,fcount())
   asize(arrtype,fcount())
   afields(arrname,arrtype,arrsize)
   dbclosearea()

// ****************************************************
//   carga los ficheros existentes
// ****************************************************

   asize(arrfiles,500)
   afill(arrfiles,space(12))
   adir("*.lmp",arrfiles)
   nitem1 := 0
   do while nitem1 < 500
      nitem1 := nitem1+1
      if arrfiles[nitem1] = space(12)
         exit
      endif
   enddo

   if nitem1 < 500
      nitem1 --
   endif

   asize(arrfiles,nitem1)

   if len(arrfiles) = 0
      if grace > 0
         exit
      endif
      genrep()
   else
      asort(arrfiles)
      nitem1 := 1

      DEFINE DIALOG oDlg RESOURCE "MAINREP" FONT Publicas:oWPpal:oFont

      REDEFINE BUTTON ID 8001 OF oDlg ;                     //select
              ACTION(mload(),odlg:end(0))

      REDEFINE BUTTON ID 8002 OF oDlg ;                     //CANCEL
              ACTION(oDlg:end(3000))

      REDEFINE BUTTON ID 8003 OF oDlg ;                     // print
              ACTION(mprint(),odlg:refresh())

      REDEFINE BUTTON ID 8004 of odlg ;                     // new report
              ACTION(kleanup(),genrep(),odlg:end(0))

      REDEFINE BUTTON ID 8005 of odlg ;
              ACTION(delrep(),odlg:refresh())

// ***************************************
//  escoje para el primer listbox
// ***************************************

      REDEFINE LISTBOX om1BX var nItem1 ;
              ITEMS arrfiles ;
              ID 8102 OF oDlg ;
              on dblclick(mload(),odlg:end(0))

      REDEFINE BUTTON ID 8020 OF odlg ;                     // top for chosen fields
              ACTION(om1bx:gotop(),odlg:refresh())

      REDEFINE BUTTON ID 8021 OF odlg ;                     // bottom for chosen fields
              ACTION(om1bx:gobottom(),odlg:refresh())

      ACTIVATE DIALOG oDlg CENTERED

      if odlg:nresult = 3000
         exit
      endif
   endif

enddo
return nil
// *********************************************
//  borra los arrays usados previamente
// *********************************************

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    Static Function Kleanup()
*+
*+    Called from ( adhoc.prg    )   2 - function genbmain()
*+                                   2 - function genmain()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
Static Function Kleanup()

indinit    := "No Index built yet"
indstring  := indinit
limstring  := space(120)
limstring2 := space(120)
tit1       := space(50)
tit2       := space(50)
tit3       := space(50)
asize(arrtot,0)
asize(arrgrp,0)
asize(arrlim,0)
asize(arrhead,0)
asize(arrind,0)
asize(arr4,0)

return nil

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    Static Function GENREP()
*+
*+    Called from ( adhoc.prg    )   2 - function genmain()
*+                                   1 - function mload()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
Static Function GENREP()
local nufo
local chosemes
local availmes
local oboton
rtf:=0
asize(arr1,len(arrname))
acopy(arrname,arr1)

// ****************************************
//  selecciones los ficheros para el listbox
// ****************************************

asize(arrbase,len(arr1))
acopy(arr1,arrbase)
nitem1 := 0
nitem2 := 1
replen := 0
do while nitem1 < len(arr4)
   nitem1 := nitem1+1
   nitem2 := ascan(arrname,arr4[nitem1])
   if nitem2 > 0
      if replen = 0
         replen := arrsize[nitem2]
      else
         replen := replen+1+arrsize[nitem2]
      endif
   endif
enddo

nitem1 := 0
do while nitem1 < len(arr4)
   nitem1 := nitem1+1
   nitem2 := ascan(arr1,arr4[nitem1])
   if nitem2 > 0
      adel(arr1,nitem2)
      asize(arr1,len(arr1) - 1)
   endif
enddo

nitem1 := 1
nitem2 := 1

// **********************************************
//  define el cuadro de dialogo
// **********************************************

DEFINE DIALOG oDlg RESOURCE "GENREP" FONT Publicas:oWPpal:oFont

REDEFINE say repmes ID 8301 ;
        update of oDlg

REDEFINE say chosemes ID 8201 of oDlg

REDEFINE say availmes ID 8202 of oDlg

REDEFINE BUTTON ID 8001 OF oDlg ;       //SAVE
        ACTION(Savefile(".lmp"),odlg:refresh())

REDEFINE BUTTON oboton ID 8002 OF oDlg ;       //CANCEL
        ACTION(oDlg:end())

REDEFINE BUTTON ID 8003 OF oDlg ;       // print
        ACTION(goout(arr4,nufo,rtf),odlg:refresh())

REDEFINE BUTTON ID 8004 OF oDlg ;       // Fuentes
        ACTION(nufo:=choosefont(),odlg:refresh())

REDEFINE BUTTON ID 8005 of oDlg ;       // add
        ACTION(loadrep(),odlg:refresh())

REDEFINE BUTTON ID 8006 of oDlg ;       // remove
        ACTION(loadfld(),Sysrefresh())

REDEFINE BUTTON ID 8030 OF oDlg ;       // Index
        ACTION(loadind(arr4),Sysrefresh())

REDEFINE BUTTON ID 8031 of oDlg ;       // headers
        ACTION(loadhead(arr4),Sysrefresh())

REDEFINE BUTTON ID 8032 of oDlg ;       // totals
        ACTION(loadtot(arr4),Sysrefresh())

REDEFINE BUTTON ID 8033 of oDlg ;       //titles
        ACTION(loadtit(),odlg:refresh())

REDEFINE BUTTON ID 8034 of odlg ;       // data limits
        ACTION(loadlimit(arr4),odlg:refresh())

REDEFINE BUTTON ID 8035 of odlg ;       // groups
        ACTION(loadgrp(arr4),odlg:refresh())


// ***************************************
//  escoger campos del primer listbox
// ***************************************

REDEFINE LISTBOX oL1BX var nItem2 ;
        ITEMS arr4 ;
        ID 8101 OF oDlg ;
        on dblclick(loadfld(),Sysrefresh())

REDEFINE BUTTON ID 8010 OF odlg ;       // top for chosen fields
        ACTION(ol1bx:gotop(),odlg:refresh())

REDEFINE BUTTON ID 8011 OF odlg ;       // bottom for chosen fields
        ACTION(ol1bx:gobottom(),odlg:refresh())

// *************************************
//  lista libres en el segundo listbox
// **************************************

REDEFINE LISTBOX ol2bx var nitem1 ;
        ITEMS arr1 ;
        ID 8102 of oDlg ;
        on dblclick(loadrep(),Sysrefresh())

REDEFINE BUTTON ID 8020 OF odlg ;       // top for available fields
        ACTION(ol2bx:gotop(),odlg:refresh())

REDEFINE BUTTON ID 8021 OF odlg ;       // bottom for available fields
        ACTION(ol2bx:gobottom(),odlg:refresh())

ACTIVATE DIALOG oDlg CENTERED ;
        on init(oboton:hide(),repmes:settext("Caracteres: "+alltrim(str(replen))),;
        chosemes:settext("Campos Seleccionados"),;
        availmes:settext("Campos Disponibles"))  

grace := 1

return (NIL)

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    Static Function mload()
*+
*+    Called from ( adhoc.prg    )   2 - function genmain()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
Static Function mload()

if loadfile()
   genrep()
endif
return nil

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    Static Function mprint()
*+
*+    Called from ( adhoc.prg    )   1 - function genmain()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
Static Function mprint()

if loadfile()
   goout(arr4)
endif
return nil

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    Static Function delrep()
*+
*+    Called from ( adhoc.prg    )   1 - function genbmain()
*+                                   1 - function genmain()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
Static Function delrep()

local t1
local t2
local inname
local msgtext
local msgtitle

inname := space(8)
t1     := om1bx:getpos()
if t1 > 0
   inname := om1bx:aitems[t1]
endif
if (inname = space(8)) .or. !(file(inname))
   msgtitle := "Error de Fichero!"
   msgtext  := "no Encuentro Fichero!"
   msginfo(msgtext,msgtitle)
else
   msgtitle := "Borrar Formato"
   msgtext  := "Esta usted seguro de borrar"+alltrim(inname)
   if msgyesno(msgtext,msgtitle)
      if (ferase(inname) < 0)
         msgtitle := "Error en borrado de Fichero"
         msgtext  := "No puedo borrar el fichero!"
      else
         msgtitle := "Fichero Borrado"
         msgtext  := alltrim(inname)+" Realizado!"
         om1bx:del()
      endif
      msginfo(msgtext,msgtitle)
   endif
endif

return nil

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    Static Function Savefile()
*+
*+    Called from ( adhoc.prg    )   1 - function genbrow()
*+                                   1 - function genrep()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
Static Function Savefile(inext)

local inname
local msgtext
local msgtitle
local arrchar[1]
local t1
local eor
local lummox
local lummox2
local tfile

if len(arr4) = 0
   msgtext  := "No hay campos seleccionados!"
   msgtitle := "Error de Grabacion!"
   msginfo(msgtext,msgtitle)
   return nil
endif

arrchar[1] = "."
aadd(arrchar,",")
aadd(arrchar,":")
aadd(arrchar,";")
aadd(arrchar,"[")
aadd(arrchar,"]")
aadd(arrchar,"{")
aadd(arrchar,"}")
aadd(arrchar,"'")
aadd(arrchar,'"')
aadd(arrchar,"!")
aadd(arrchar,"~")
aadd(arrchar,"`")
aadd(arrchar,"@")
aadd(arrchar,"#")
aadd(arrchar,"$")
aadd(arrchar,"%")
aadd(arrchar,"^")
aadd(arrchar,"&")
aadd(arrchar,"*")
aadd(arrchar,"(")
aadd(arrchar,")")
aadd(arrchar,"-")
aadd(arrchar,"_")
aadd(arrchar,"+")
aadd(arrchar,"=")
aadd(arrchar,"|")
aadd(arrchar,">")
aadd(arrchar,"<")
aadd(arrchar,"\")
aadd(arrchar,"/")
aadd(arrchar,"?")
inname   := space(8)
msgtext  := "Indique nombre, sin extension:"
msgtitle := "Nombre de formato grabado"
do while .t.
   inname := padr(inname,8)
   if !(msgget(msgtitle,msgtext,@inname))
      inname := space(8)
      exit
   endif
   t1 := 0
   do while t1 < len(arrchar)
      t1 := t1+1
      if (arrchar[t1] $ inname)
         msginfo("Por favor use solo caracteres alfanum‚ricos!","Error de Nombre!")
         t1 := 800
         exit
      endif
   enddo
   if t1 = 800
      loop
   endif
   inname := alltrim(inname)+inext
   if file(inname)
      msgtext := "Fichero Existe! Sobreescribir?"
      if !(msgYesNo(msgtext,msgtitle))
         loop
      endif
   else
      msgtext := "El nombre del fichera sera "+inname
      if !(msgYesNo(msgtext,msgtitle))
         loop
      endif
   endif
   exit
enddo

if inname = space(8)
   return nil
endif

eor := chr(13)+chr(10)

// *************************************************
//  abre el fichero
// *************************************************

tfile := fcreate(inname)
if tfile < 0
   msgtext  := "No puedo crear fichero!"
   msgtitle := "Error de Creacion "+upper(inname)
   msginfo(msgtext,msgtitle)
   return nil
endif

// ************************************************
//  escriber cada seccion
// ************************************************

t1 := 0
do while t1 < len(arr4)
   t1      := t1+1
   lummox  := "arr4"
   lummox  := padr(lummox,12)
   lummox2 := arr4[t1]
   lummox2 := lummox+alltrim(lummox2)+eor
   if (fwrite(tfile,lummox2) < len(lummox2))
      msgtext  := "Error al escribir en "+upper(inname)
      msgtitle := "Error en grabacion de Informe"
      msginfo(msgtext,msgtitle)
      fclose(tfile)
      ferase(inname)
      inname := space(8)
      exit
   endif
enddo

if inname = space(8)
   return nil
endif

t1 := 0
do while t1 < len(arrgrp)
   t1      := t1+1
   lummox  := "arrgrp"
   lummox  := padr(lummox,12)
   lummox2 := arrgrp[t1]
   lummox2 := lummox+alltrim(lummox2)+eor
   if (fwrite(tfile,lummox2) < len(lummox2))
      msgtext  := "Error al escribir en "+upper(inname)
      msgtitle := "Error en grabacion de Informe"
      msginfo(msgtext,msgtitle)
      fclose(tfile)
      ferase(inname)
      inname := space(8)
      exit
   endif
enddo

if inname = space(8)
   return nil
endif

t1 := 0
do while t1 < len(arrtot)
   t1      := t1+1
   lummox  := "arrtot"
   lummox  := padr(lummox,12)
   lummox2 := arrtot[t1]
   lummox2 := lummox+alltrim(lummox2)+eor
   if (fwrite(tfile,lummox2) < len(lummox2))
      msgtext  := "Error al escribir en "+upper(inname)
      msgtitle := "Error en grabacion de Informe"
      msginfo(msgtext,msgtitle)
      fclose(tfile)
      ferase(inname)
      inname := space(8)
      exit
   endif
enddo

if inname = space(8)
   return nil
endif

t1 := 0
do while t1 < len(arrhead)
   t1      := t1+1
   lummox  := "arrhead"
   lummox  := padr(lummox,12)
   lummox2 := arrhead[t1]
   lummox2 := lummox+alltrim(lummox2)+eor
   if (fwrite(tfile,lummox2) < len(lummox2))
      msgtext  := "Error al escribir en "+upper(inname)
      msgtitle := "Error en grabacion de Informe"
      msginfo(msgtext,msgtitle)
      fclose(tfile)
      ferase(inname)
      inname := space(8)
      exit
   endif
enddo

if inname = space(8)
   return nil
endif

t1 := 0
do while t1 < len(arrlim)
   t1      := t1+1
   lummox  := "arrlim"
   lummox  := padr(lummox,12)
   lummox2 := arrlim[t1]
   lummox2 := lummox+alltrim(lummox2)+eor
   if (fwrite(tfile,lummox2) < len(lummox2))
      msgtext  := "Error al escribir en "+upper(inname)
      msgtitle := "Error en grabacion de Informe"
      msginfo(msgtext,msgtitle)
      fclose(tfile)
      ferase(inname)
      inname := space(8)
      exit
   endif
enddo

if inname = space(8)
   return nil
endif

if inname = space(8)
   return nil
endif

if tit1 > space(50)
   lummox  := "tit1"
   lummox  := padr(lummox,12)
   lummox2 := tit1
   lummox2 := lummox+alltrim(lummox2)+eor
   if (fwrite(tfile,lummox2) < len(lummox2))
      msgtext  := "Error al escribir en "+upper(inname)
      msgtitle := "Errro en grabacion de Informe"
      msginfo(msgtext,msgtitle)
      fclose(tfile)
      ferase(inname)
      inname := space(8)
   endif
endif

if inname = space(8)
   return nil
endif

if tit2 > space(50)
   lummox  := "tit2"
   lummox  := padr(lummox,12)
   lummox2 := tit2
   lummox2 := lummox+alltrim(lummox2)+eor
   if (fwrite(tfile,lummox2) < len(lummox2))
      msgtext  := "Error al escribir en "+upper(inname)
      msgtitle := "Error en grabacion de Informe"
      msginfo(msgtext,msgtitle)
      fclose(tfile)
      ferase(inname)
      inname := space(8)
   endif
endif

if inname = space(8)
   return nil
endif

if tit3 > space(50)
   lummox  := "tit3"
   lummox  := padr(lummox,12)
   lummox2 := tit3
   lummox2 := lummox+alltrim(lummox2)+eor
   if (fwrite(tfile,lummox2) < len(lummox2))
      msgtext  := "Error al escribir en "+upper(inname)
      msgtitle := "Error en grabacion de Informe"
      msginfo(msgtext,msgtitle)
      fclose(tfile)
      ferase(inname)
      inname := space(8)
   endif
endif

if inname = space(8)
   return nil
endif

if (indstring > space(50)) .and. (indstring <> indinit)
   lummox  := "indstring"
   lummox  := padr(lummox,12)
   lummox2 := indstring
   lummox2 := lummox+alltrim(lummox2)+eor
   if (fwrite(tfile,lummox2) < len(lummox2))
      msgtext  := "Error al escribir en "+upper(inname)
      msgtitle := "Error en grabacion de Informe"
      msginfo(msgtext,msgtitle)
      fclose(tfile)
      ferase(inname)
      inname := space(8)
   endif
endif

if inname = space(8)
   return nil
endif

if limstring > space(50)
   lummox  := "limstring"
   lummox  := padr(lummox,12)
   lummox2 := limstring
   lummox2 := lummox+alltrim(lummox2)+eor
   if (fwrite(tfile,lummox2) < len(lummox2))
      msgtext  := "Error al escribir en "+upper(inname)
      msgtitle := "Error en grabacion de Informe"
      msginfo(msgtext,msgtitle)
      fclose(tfile)
      ferase(inname)
      inname := space(8)
   endif
endif

if inname = space(8)
   return nil
endif
if .not. fclose(tfile)
   msgtext  := "Error in closing "+upper(inname)
   msgtitle := "Errro en grabacion de Informe"
else
   msgtext  := "Report format written to "+upper(inname)
   msgtitle := "Report Format Successfully Created!"
endif

msginfo(msgtext,msgtitle)

return (nil)

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    Static Function GOOUT()
*+
*+    Called from ( adhoc.prg    )   1 - function mprint()
*+                                   1 - function genrep()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
Static Function GOOUT(arrt,nufo,rtf)

local a
local t1
local t2
local t3
local ctext
local ofont1
local ofont2
local ofont3
local oreport
local htext
local stext
local timelog
local privmsg
local oprinter
local longi
local pinta
//private oreport
// ***************************************
//  mensaje de error caso de querer imprimir
//  antes de seleccionar los campos
// ****************************************
*     if date() >= ctod('01-06-01') .and. !File('C:\PROGRAMA\BALAGUER\GESCOM.NTX')
*        msginfo('Error DBF/CDX en modulo GESCOM.NTX, es necesario organizar ficheros')
*        return nil
*     endif
if (len(arrt) = 0) .or. (arrt[1] <= space(8))
   msginfo("No hay campos seleccionados!","No puedo Imprimir")
   return nil
endif
set exact on
if !file(Publicas:Basename)
   MsgStop("Base de Datos no presente!")
   return nil
endif

sele 0
*if !netuse(Publicas:cUnidad+Publicas:cSubd+"\PROVE.DBF",,,"ADCCQAS")
*   MsgStop("La Base de datos no esta libre!")
*   return nil
*endif
   dbUseArea(.F.,,Publicas:Basename,,.T.)
 
// ****************************************
//  indexa la base de datos
// ****************************************
if (indstring <> indinit) .and. (indstring > space(8)) .or. ;
             (limstring > space(8))
   tempind1 := "CC"+substr(time(),1,2)+substr(time(),4,2)+substr(time(),7,2)+".cdx"

   if (indstring <> indinit) .and. (indstring > space(8))
      passind := indstring
   else
      passind := "Recno()"
   endif

   if limstring > space(8)
      passfor := alltrim(limstring)
   else
      passfor := "Recno() > 0"
   endif
   MsgMeter({| oMeter,oText,oDlg,lEnd | ;
              GENIndex(oMeter,oText,oDlg,@lEnd)},;
              "Reindexando fichero ...",;
              "Reindexando fichero ....")

   
    set index to &tempind1
endif

go top
// ********************************************
//  mesaje inferior
// ********************************************

//if rtf=1
//   rtfdemo()
//else
privmsg :=" "// "Los Datos estan sujetos a Privacidad"

// ********************************************
//  fuentes libres
// *********************************************
    PRINTER oprinter FROM USER
    if nufo !=nil
        DEFINE FONT oFont1 NAME (nufo[14]) ;
                      SIZE 0,(nufo[1])  
    else
        DEFINE FONT oFont1 NAME "Arial" SIZE 0,- 10
    endif

DEFINE FONT ofont2 NAME "Arial" SIZE 0,- 15        
DEFINE FONT ofont3 NAME "Arial" SIZE 0,- 12 BOLD  

// *********************************************
//  hora del informe
// *********************************************

timelog := time()

// ****************************************************
//  TITLEs proved stubborn, and would not subsitute like
//  DATA or column TITLES, so it is below sledgehammered
// *****************************************************

tit1 := alltrim(tit1)
tit2 := alltrim(tit2)
tit3 := alltrim(tit3)

if tit3 > space(50)
   REPORT oreport ;
           FONT ofont1,ofont2,ofont3 ;
           TITLE tit1,tit2,tit3 ;
           HEADER "Fecha: "+dtoc(date())+' '+ 'Hora: '+timelog LEFT ;
           FOOTER privmsg,' ',"Pagina: "+str(oreport:npage,3) CENTER ;
           PREVIEW
elseif tit2 > space(50)
   REPORT oreport ;
           FONT ofont1,ofont2,ofont3 ;
           TITLE tit1,tit2 ;
           HEADER "Fecha: "+dtoc(date())+" "+'Hora: '+timelog LEFT ;
           FOOTER privmsg,' ',"Pagina: "+str(oreport:npage,3) CENTER ;
           PREVIEW
elseif tit1 > space(50)
   REPORT oreport ;
           FONT ofont1,ofont2,ofont3 ;
           TITLE tit1 ;
           HEADER "Fecha: "+dtoc(date())+" "+'Hora: '+timelog LEFT ;
           FOOTER privmsg,' ',"Pagina: "+str(oreport:npage,3) CENTER ;
           PREVIEW
else
   REPORT oreport ;
           FONT ofont1,ofont2,ofont3 ;
           HEADER "Fecha: "+dtoc(date())+" "+'Hora: '+timelog LEFT ;
           FOOTER privmsg,' ',"Pagina: "+str(oreport:npage,3) CENTER ;
           PREVIEW
endif

t1 := 0
do while t1 < len(arrt)
   t1    := t1+1
   stext := arrt[t1]
   // ****************************
   //  chequea el tipo de datos y comprueba que no hay datos en blanco
   // *****************************

   t2 := ascan(arrname,stext)
   if t2 = 0
      msginfo("Item "+stext+"no libre!","Base de datos Incompatible!")
      loop
   endif
   if arrtype[t2] = "L"
      ctext := "if("+stext+",'Y','N')"
   elseif arrtype[t2] = "D"
      ctext := "if("+stext+">ctod(space(8)),"+stext+",'        ')"
   else
      ctext := stext
   endif

// *********************************
//  carga el titulo de la columna
// **********************************

   if .not. (t1 > len(arrhead))
      htext := arrhead[t1]
   else
      htext:=stext
*      htext := " "
   endif
   htext := alltrim(htext)
   htext := '"'+htext+'"'

   // ******************************
   //  check for totals
   // *******************************

   t2 := 0
   if len(arrtot) > 0
      t2 := ascan(arrtot,stext)
   endif
   if t2 > 0
      COLUMN TITLE &htext DATA &ctext total
   else
      COLUMN TITLE &htext DATA &ctext picture pinta SIZE longi
   endif
enddo

// *************************************
//  put in groups ....
//
//  I was having a problem getting the array
//  element subscript right -- always getting the last t3
//  value, that I just sledgehammered it.
// *************************************

t1 := 0
t3 := 0
do while t1 < len(arrgrp)
   t1    := t1+1
   ctext := arrgrp[t1]
   t2    := ascan(arr4,ctext)
   if t2 = 0
      msginfo(ctext+" Campo no seleccionado para informe","Error al seleccionar grupo")
      loop
   endif
   t3 := t3+1
   if t3 = 1
      GROUP on &ctext FOOTER oreport:agroups[1] :cvalue+;
              ":  "+str(oreport:agroups[1] :ncounter,8) eject FONT 3
   endif
   if t3 = 2
      GROUP on &ctext FOOTER oreport:agroups[2] :cvalue+;
              ":  "+str(oreport:agroups[2] :ncounter,8) eject FONT 3
   endif
   if t3 = 3
      GROUP on &ctext FOOTER oreport:agroups[3] :cvalue+;
              ":  "+str(oreport:agroups[3] :ncounter,8) eject FONT 3
   endif
   if t3 = 4
      GROUP on &ctext FOOTER oreport:agroups[4] :cvalue+;
              ":  "+str(oreport:agroups[4] :ncounter,8) eject FONT 3
   endif
   if t3 = 5
      GROUP on &ctext FOOTER oreport:agroups[5] :cvalue+;
              ":  "+str(oreport:agroups[5] :ncounter,8) eject FONT 3
   endif
   if t3 = 6
      GROUP on &ctext FOOTER oreport:agroups[6] :cvalue+;
              ":  "+str(oreport:agroups[6] :ncounter,8) eject FONT 3
   endif
   if t3 = 7
      GROUP on &ctext FOOTER oreport:agroups[7] :cvalue+;
              ":  "+str(oreport:agroups[7] :ncounter,8) eject FONT 3
   endif
   if t3 > 7
      msginfo("ATENCION. numero de grupos excesivo","el tope esta en 7")
      t3 := 8
   endif

enddo
t3 := t3+1
** GROUP on eof() ;
**               FOOTER "Total lineas en Informe: "+str(oreport:agroups[t3] :ncounter,8) ;
**               FONT 3 ;
**               eject
end REPORT

     IF oReport:lCreated
        for a = 1 to (t1)
        oReport:aColumns[a]:bDataFont := {|| 1 }
        next a
     ENDIF
   oReport:Margin(1,RPT_TOP,RPT_INCHES)
ACTIVATE REPORT oreport;
ON STARTPAGE Bitmaps(oReport)

ofont1:end()
ofont2:end()
ofont3:end()

*endif
// *****************************************
//  close database and erase temp index, if any
// ******************************************

dbclosearea()
*
if file(tempind1)
   ferase(tempind1)
endif

return nil

STATIC Function Bitmaps(oReport)
   oReport:SayBitmap(.3,.3, Publicas:rlogo,2,.5)
RETURN NIL


*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    Static Function loadrep()
*+
*+    Called from ( adhoc.prg    )   2 - function genbrow()
*+                                   2 - function genrep()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
Static Function loadrep()

local t1
local artext

t1 := ol2bx:getpos()
if t1 > 0
   artext := ol2bx:aitems[t1]
   ol1bx:add(artext)
   ol2bx:del()
endif

// ***********************************
//  Determine report size
// ***********************************

if trep
   t1 := ascan(arrname,artext)
   if replen = 0
      replen := arrsize[t1]
   else
      replen := replen+1
      replen := replen+arrsize[t1]
   endif

   repmes:settext("Caracteres: "+alltrim(str(replen)))

   if replen < 81
      p80 := .f.
   elseif replen < 133
      p132 := .f.
   endif
*   if (replen > 132) .and. !(p132)
*      msginfo("La Impresion requiere > 132 columnas!","Ancho Superado!")
*      p132 := .t.
*   elseif (replen > 80) .and. !(p80)
*      msginfo("La Impresion requiere > 80 columnas!","Recuerde cambiar la impresion a Landscape!")
*      p80 := .t.
*   endif
endif

return (NIL)

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    Static Function loadfld()
*+
*+    Called from ( adhoc.prg    )   2 - function genbrow()
*+                                   2 - function genrep()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
Static Function loadfld()

local t1
local artext
t1 := ol1bx:getpos()
if t1 > 0
   artext := ol1bx:aitems[t1]
   if artext > space(1)
      ol2bx:add(artext)
      ol1bx:del()
      if trep
         t1 := ascan(arrbase,artext)
         if replen > arrsize[t1]
            replen -= (1+arrsize[t1])
         else
            replen := 0
         endif
         repmes:settext("Caracteres: "+alltrim(str(replen)))
         if replen < 81
            p80 := .f.
         elseif replen < 132
            p132 := .f.
         endif
      endif
   endif
endif

return nil

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    Static Function loadind()
*+
*+    Called from ( adhoc.prg    )   1 - function genbrow()
*+                                   1 - function genrep()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
Static Function loadind(arrt)

local nitem
local odlg

// **********************************
//  check to see if any fields have been selected
// ***********************************

if (len(arrt) = 0) .or. (arrt[1] <= space(8))
   msginfo("No hay campos seleccionados!","No puedo indexar!")
   return nil
endif

bstring := indstring

do while .t.

   nitem := 1
   asize(arrind,len(arrt))
   acopy(arrt,arrind)

   DEFINE DIALOG odlg RESOURCE "INDBOX" FONT Publicas:oWPpal:oFont

   REDEFINE say ostring ID 9201 ;
           update OF odlg

   REDEFINE BUTTON ID 9001 OF odlg ;    // select
           ACTION(selectind(),odlg:refresh())

   REDEFINE BUTTON ID 9002 OF odlg ;    // cancel
           ACTION(odlg:end(3000))

   REDEFINE BUTTON ID 9004 OF odlg ;    // kill
           ACTION(odlg:end(1000))

   REDEFINE BUTTON ID 9005 of odlg ;    // save
           ACTION(odlg:end(0))

   REDEFINE LISTBOX olbx var nitem ;
           ITEMS arrind ;
           ID 9101 of odlg ;
           on dblclick(selectind(),odlg:refresh())

   ACTIVATE DIALOG odlg CENTERED ;
           on init(ostring:settext(bstring))

   if odlg:nresult = 0
      indstring := bstring
   elseif odlg:nresult = 1000
      bstring := indinit
      loop
   endif

   exit

enddo
return nil

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    Static Function loadhead()
*+
*+    Called from ( adhoc.prg    )   1 - function genbrow()
*+                                   1 - function genrep()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
Static Function loadhead(arrt)

local t1
local t2
local odlg
local ctext
local intext
local otext
local ogettext
t1 := len(arrt)

if (t1 = 0) .or. (arrt[t1] <= space(8))
   msginfo("No ha seleccionado campos!","No puedo preparar la Cabecera!")
   return nil
endif
asize(arrhead,t1)

t1 := 0
do while t1 < len(arrt)
   t1    := t1+1
   ctext := arrt[t1]
   if !empty(arrhead[t1])
      intext := arrhead[t1]
      intext := padr(intext,50)
   else
      intext := space(50)
   endif

   DEFINE DIALOG odlg RESOURCE "KENHEADER" FONT Publicas:oWPpal:oFont

   REDEFINE say ID 205 OF odlg
   REDEFINE say otext ID 210 of odlg
   REDEFINE get intext ID 1002 of odlg

   REDEFINE BUTTON ID 1010 of odlg ;
           ACTION(odlg:end(0))
   REDEFINE BUTTON ID 1020 of odlg ;
           ACTION(odlg:end(3000))

   ACTIVATE DIALOG odlg CENTERED ;
           on init(otext:settext(ctext))

   if odlg:nresult = 3000
      exit
   endif
   arrhead[t1] = alltrim(intext)
enddo

return nil

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    Static Function loadtot()
*+
*+    Called from ( adhoc.prg    )   1 - function genrep()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
Static Function loadtot(arrin)

local odlg
local otext1
local chosemes
local availmes
local nitem1
local nitem2
local t1
local t2
local arrt[1]

asize(arrt,len(arrin))
acopy(arrin,arrt)

if (len(arrt) = 0) .or. (arrt[1] <= space(8))
   msginfo("No hay campos para este informe!","No Puedo preparar el Total!")
   return nil
endif

// ********************************************
//  check for numeric values in the selected fields
// *********************************************

t1 := 1
do while (arrt[t1] <> nil)
   t2 := ascan(arrname,arrt[t1])
   if (t2 = 0)
      adel(arrt,t1)
   elseif (arrtype[t2] <> "N")
      adel(arrt,t1)
   else
      t1 := t1+1
   endif
   if t1 > len(arrt)
      exit
   endif
enddo

asize(arrt,t1 - 1)
if len(arrt) = 0
   msginfo("No hay campo numerico seleccionado!","No puedo prepar el Total")
   return nil
endif

asize(arrh2,len(arrtot))
acopy(arrtot,arrh2)
asize(arrh1,len(arrt))
acopy(arrt,arrh1)

// ***********************************
//  remove from select list anything already selected
// ************************************

nitem1 := 0
do while nitem1 < len(arrh2)
   nitem1 := nitem1+1
   nitem2 := ascan(arrh1,arrh2[nitem1])
   if nitem2 > 0
      adel(arr1,nitem2)
      asize(arrh1,len(arrh1) - 1)
   endif
enddo

// ********************************
//  main loop
// ********************************

do while .t.

   nitem1 := 1
   nitem2 := 1

   DEFINE DIALOG oDlg RESOURCE "KENGROUP" FONT Publicas:oWPpal:oFont

   odlg:cCaption := "Seleccionar Totales"

   REDEFINE say otext1 ID 8301 of odlg

   REDEFINE say chosemes ID 8201 of oDlg

   REDEFINE say availmes ID 8202 of oDlg

   REDEFINE BUTTON ID 8001 OF oDlg ;    //SAVE
           ACTION(odlg:end(0))

   REDEFINE BUTTON ID 8002 OF oDlg ;    //CANCEL
           ACTION(oDlg:end(3000))

   REDEFINE BUTTON ID 8003 of odlg ;    // kill
           ACTION(odlg:end(1000))

   REDEFINE BUTTON ID 8005 of oDlg ;    // add
           ACTION(ltot1(),odlg:refresh())

   REDEFINE BUTTON ID 8006 of oDlg ;    // remove
           ACTION(ltot2(),Sysrefresh())

   // ***************************************
   //  first list box -- items chosen
   // ***************************************

   REDEFINE LISTBOX oLg2BX var nItem2 ;
           ITEMS arrh2 ;
           ID 8101 OF oDlg ;
           on dblclick(ltot2(),Sysrefresh())

   REDEFINE BUTTON ID 8010 OF odlg ;    // top for chosen fields
           ACTION(olg2bx:gotop(),odlg:refresh())

   REDEFINE BUTTON ID 8011 OF odlg ;    // bottom for chosen fields
           ACTION(olg2bx:gobottom(),odlg:refresh())

   // *************************************
   //  second list box - available
   // **************************************

   REDEFINE LISTBOX olg1bx var nitem1 ;
           ITEMS arrh1 ;
           ID 8102 of oDlg ;
           on dblclick(ltot1(),Sysrefresh())

   REDEFINE BUTTON ID 8020 OF odlg ;    // top for available fields
           ACTION(olg1bx:gotop(),odlg:refresh())

   REDEFINE BUTTON ID 8021 OF odlg ;    // bottom for available fields
           ACTION(olg1bx:gobottom(),odlg:refresh())

   ACTIVATE DIALOG oDlg CENTERED ;
           on init(otext1:settext("Seleccione campos para total por grupo y gran Total."),;
           chosemes:settext("Campos Elegidos"),;
           availmes:settext("Campos libres"))

   if odlg:nresult = 1000
      asize(arrh1,len(arrt))
      acopy(arrt,arrh1)
      asize(arrh2,0)
      loop
   endif

   if odlg:nresult < 3000
      asize(arrtot,len(arrh2))
      acopy(arrh2,arrtot)
   endif

   exit

enddo

return nil

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    Static Function loadtit()
*+
*+    Called from ( adhoc.prg    )   1 - function genrep()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
Static Function loadtit()

local odlg
local otit1
local otit2
local otit3
local osay

otit1 := padr(tit1,40)
otit2 := padr(tit2,40)
otit3 := padr(tit3,40)

DEFINE DIALOG odlg RESOURCE "KENTITLE" FONT Publicas:oWPpal:oFont

REDEFINE say osay ID 205 of odlg

REDEFINE get otit1 ID 1001 OF odlg
REDEFINE get otit2 id 1002 OF odlg
REDEFINE get otit3 id 1003 OF odlg

REDEFINE BUTTON ID 1010 of odlg ;       // save
        ACTION(odlg:end(0))

REDEFINE BUTTON id 1020 of odlg ;       // cancel
        ACTION(odlg:end(3000))

ACTIVATE DIALOG odlg CENTERED ;
        on init(osay:settext("Entre hasta 3 lineas para titulo:"))

if odlg:nresult < 3000
   tit1 := otit1
   tit2 := otit2
   tit3 := otit3
endif

return nil

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    Static Function loadgrp()
*+
*+    Called from ( adhoc.prg    )   1 - function genrep()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
Static Function loadgrp(arrt)

local odlg
local otext1
local chosemes
local availmes
local nitem1
local nitem2

if (len(arrt) = 0) .or. (arrt[1] <= space(8))
   msginfo("No hay campos para este Informe!","No puedo preparar Grupo!")
   return nil
endif

asize(arrh2,len(arrgrp))
acopy(arrgrp,arrh2)
asize(arrh1,len(arrt))
acopy(arrt,arrh1)

// ****************************************
//  remove from the selection array anything
//  already selected
// ****************************************

nitem1 := 0
do while nitem1 < len(arrh2)
   nitem1 := nitem1+1
   nitem2 := ascan(arrh1,arrh2[nitem1])
   if nitem2 > 0
      adel(arr1,nitem2)
      asize(arrh1,len(arrh1) - 1)
   endif
enddo

// ***************************************
//  main loop
// ***************************************

do while .t.

   nitem1 := 1
   nitem2 := 1

   DEFINE DIALOG oDlg RESOURCE "KENGROUP" FONT Publicas:oWPpal:oFont

   REDEFINE say otext1 ID 8301 of odlg

   REDEFINE say chosemes ID 8201 of oDlg

   REDEFINE say availmes ID 8202 of oDlg

   REDEFINE BUTTON ID 8001 OF oDlg ;    //SAVE
           ACTION(odlg:end(0))

   REDEFINE BUTTON ID 8002 OF oDlg ;    //CANCEL
           ACTION(oDlg:end(3000))

   REDEFINE BUTTON ID 8003 of odlg ;    // kill
           ACTION(odlg:end(1000))

   REDEFINE BUTTON ID 8005 of oDlg ;    // add
           ACTION(lgrp1(),odlg:refresh())

   REDEFINE BUTTON ID 8006 of oDlg ;    // remove
           ACTION(lgrp2(),Sysrefresh())

   // ***************************************
   //  first list box -- items chosen
   // ***************************************

   REDEFINE LISTBOX oLg2BX var nItem2 ;
           ITEMS arrh2 ;
           ID 8101 OF oDlg ;
           on dblclick(lgrp2(),Sysrefresh())

   REDEFINE BUTTON ID 8010 OF odlg ;    // top for chosen fields
           ACTION(olg2bx:gotop(),odlg:refresh())

   REDEFINE BUTTON ID 8011 OF odlg ;    // bottom for chosen fields
           ACTION(olg2bx:gobottom(),odlg:refresh())

   // *************************************
   //  second list box - available
   // **************************************

   REDEFINE LISTBOX olg1bx var nitem1 ;
           ITEMS arrh1 ;
           ID 8102 of oDlg ;
           on dblclick(lgrp1(),Sysrefresh())

   REDEFINE BUTTON ID 8020 OF odlg ;    // top for available fields
           ACTION(olg1bx:gotop(),odlg:refresh())

   REDEFINE BUTTON ID 8021 OF odlg ;    // bottom for available fields
           ACTION(olg1bx:gobottom(),odlg:refresh())

   ACTIVATE DIALOG oDlg CENTERED ;
           on init(otext1:settext("Recuerde tener indexado por el campo del grupo seleccionado!"),;
           chosemes:settext("Grupos Seleccionado"),;
           availmes:settext("Campos Disponibles"))

   if odlg:nresult = 1000
      asize(arrh1,len(arrt))
      acopy(arrt,arrh1)
      asize(arrh2,0)
      loop
   endif

   if odlg:nresult < 3000
      asize(arrgrp,len(arrh2))
      acopy(arrh2,arrgrp)
   endif

   exit

enddo

return nil

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    Static Function loadfile()
*+
*+    Called from ( adhoc.prg    )   1 - function mbrow()
*+                                   1 - function mbload()
*+                                   1 - function mprint()
*+                                   1 - function mload()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
Static Function loadfile()

local t1
local t2
local lummox
local lummox2
local msgtext
local msgtitle
local mainstr
local eor
local inname

// *****************************
//  get filename from listbox variables
// *****************************

inname := space(8)
t1     := om1bx:getpos()
if t1 > 0
   inname := alltrim(om1bx:aitems[t1])
endif
if !(inname > space(8))
   msgtitle := "File Open Error"
   msgtext  := "Unable to load selected format!"
   msginfo(msgtext,msgtitle)
   return .f.
endif

// ******************************
//  open file
// ******************************

t1 := fopen(inname)
if t1 < 0
   msgtext  := "No puedo leer el formato Seleccionado!"
   msgtitle := "File Read Error!"
   msginfo(msgtext,msgtitle)
   return .f.
endif

// *****************************
//  read data as one huge string
//  and close file
// *****************************

eor := chr(13)+chr(10)

mainstr := freadstr(t1,6400)

fclose(t1)

if len(mainstr) = 0
   msgtext  := "No puedo leer el Formato Seleccionado!"
   msgtitle := "Error de Lectura de Fichero!"
   msginfo(msgtext,msgtitle)
   return .f.
endif

// ******************************
//  break string back into arrays and variables
// *******************************

t1 := 0
do while t1 < len(mainstr)
   t2      := 0
   lummox  := space(1)
   lummox2 := space(1)
   lummox  := alltrim(lummox)
   lummox2 := alltrim(lummox2)
   do while .t.
      t1 := t1+1
      if substr(mainstr,t1,2) = eor
         t1 := t1+1
         exit
      endif
      t2 := t2+1
      if t2 < 13
         lummox := lummox+substr(mainstr,t1,1)
      else
         lummox2 := lummox2+substr(mainstr,t1,1)
      endif
   enddo

   lummox  := alltrim(lummox)
   lummox2 := alltrim(lummox2)
   if lummox = "arr4"
      aadd(arr4,lummox2)
   elseif lummox = "arrhead"
      aadd(arrhead,lummox2)
   elseif lummox = "arrtot"
      aadd(arrtot,lummox2)
   elseif lummox = "arrgrp"
      aadd(arrgrp,lummox2)
   elseif lummox = "indstring"
      indstring := lummox2
   elseif lummox = "tit1"
      tit1 := lummox2
   elseif lummox = 'tit2'
      tit2 := lummox2
   elseif lummox = 'tit3'
      tit3 := lummox2
   elseif lummox = 'limstring'
      limstring  := lummox2
      limstring2 := lummox2
   elseif lummox = "arrlim"
      aadd(arrlim,lummox2)
   endif
enddo
return .t.

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    Static Function loadlimit()
*+
*+    Called from ( adhoc.prg    )   1 - function genbrow()
*+                                   1 - function genrep()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
Static Function loadlimit(arrt)

local nitem1
local nitem2
local chosemes
local availmes
local otext1
local odlg

asize(arrh1,len(arrt))
if len(arrlim) > 0
   asize(arrh2,len(arrlim))
   acopy(arrlim,arrh2)
else
   asize(arrh2,0)
endif
acopy(arrt,arrh1)

nitem1 := 1
nitem2 := 1

limstring2 := limstring

do while .t.

   DEFINE DIALOG oDlg RESOURCE "KENLIMIT" FONT Publicas:oWPpal:oFont

   odlg:cCaption := "Definir los limites de los datos"

   REDEFINE say otext1 ID 8301 of odlg

   REDEFINE say chosemes ID 8201 of oDlg

   REDEFINE say availmes ID 8202 of oDlg

   REDEFINE BUTTON ID 8001 OF oDlg ;    //SAVE
           ACTION(odlg:end(0))

   REDEFINE BUTTON ID 8002 OF oDlg ;    //CANCEL
           ACTION(oDlg:end(3000))

   REDEFINE BUTTON ID 8003 of odlg ;    // kill
           ACTION(odlg:end(1000))

   REDEFINE BUTTON ID 8004 of odlg ;    // connector
           ACTION(loadconn(),SYSrefresh())

   REDEFINE BUTTON ID 8005 of odlg ;    // select
           ACTION(loadlim(),otext1:settext(limstring2),odlg:refresh())

   // ***************************************
   //  first list box -- items chosen
   // ***************************************

   REDEFINE LISTBOX oLd2BX var nItem2 ;
           ITEMS arrh2 ;
           ID 8101 OF oDlg

   // *************************************
   //  second list box - available
   // **************************************

   REDEFINE LISTBOX old1bx var nitem1 ;
           ITEMS arrh1 ;
           ID 8102 of oDlg ;
           on dblclick(loadlim(),otext1:settext(limstring2),Sysrefresh())

   REDEFINE BUTTON ID 8020 OF odlg ;    // top for available fields
           ACTION(old1bx:gotop(),odlg:refresh())

   REDEFINE BUTTON ID 8021 OF odlg ;    // bottom for available fields
           ACTION(old1bx:gobottom(),odlg:refresh())

   ACTIVATE DIALOG oDlg CENTERED ;
           on init(otext1:settext(limstring2),;
           chosemes:settext("Condiciones"),;
           availmes:settext("Campos Preparados"))

   if odlg:nresult = 1000
      asize(arrh1,len(arrt))
      acopy(arrt,arrh1)
      limstring2 := space(120)
      asize(arrh2,0)
      loop
   endif

   if odlg:nresult < 3000
      limstring := limstring2
      asize(arrlim,len(arrh2))
      acopy(arrh2,arrlim)
   endif

   exit
enddo

return (nil)

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    Static Function GENIndex()
*+
*+    Called from ( adhoc.prg    )   1 - function gobrow()
*+                                   1 - function goout()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
Static Function GENIndex(oMeter,oText,oDlg,lEnd)
oMeter:nTotal := lastrec()
index on &(passind) to &(tempind1) for &(passfor) ;
                  eval(oMeter:Set(recno()),oText:SetText("Indexando Registro "+alltrim(str(recno()))),;
                  SysRefresh(),!lEnd)

return (NIL)

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    Static Function selectind()
*+
*+    Called from ( adhoc.prg    )   2 - function loadind()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
Static Function selectind()

local t1,pepe,info
dbUseArea(.F.,,Publicas:Basename,,.T.)
pepe:=(alias())->(Dbstruct())
t1 := olbx:getpos()
if t1 > 0
   if bstring = indinit
     do case
      case type(olbx:aitems[t1])= "D"
       bstring:="dtos("+olbx:aitems[t1]+")"
      case type(olbx:aitems[t1])= "N"
       bstring:="str("+olbx:aitems[t1]+",9)"
      otherwise
       bstring := olbx:aitems[t1]
     endcase
     else
     do case
      case type(olbx:aitems[t1])= "D"
        bstring := alltrim(bstring)+"+"+ "dtos("+olbx:aitems[t1]+")"      
      case type(olbx:aitems[t1])= "N"
        bstring := alltrim(bstring)+"+"+"str("+olbx:aitems[t1]+",9)"
      otherwise
        bstring := alltrim(bstring)+"+"+olbx:aitems[t1]
     endcase
   endif
   ostring:settext(bstring)
   olbx:del()
endif
dbclosearea()
return nil

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    Static Function ltot1()
*+
*+    Called from ( adhoc.prg    )   2 - function loadtot()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
Static Function ltot1()

local t1
local artext

t1 := olg1bx:getpos()
if t1 > 0
   artext := olg1bx:aitems[t1]
   olg2bx:add(artext)
   olg1bx:del()
endif

return nil

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    Static Function ltot2()
*+
*+    Called from ( adhoc.prg    )   2 - function loadtot()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
Static Function ltot2()

local t1
local artext
t1 := olg2bx:getpos()
if t1 > 0
   artext := olg2bx:aitems[t1]
   if artext > space(1)
      olg1bx:add(artext)
      olg2bx:del()
   endif
endif
return nil

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    Static Function lgrp1()
*+
*+    Called from ( adhoc.prg    )   2 - function loadgrp()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
Static Function lgrp1()

local t1
local artext

t1 := olg1bx:getpos()
if t1 > 0
   artext := olg1bx:aitems[t1]
   olg2bx:add(artext)
   olg1bx:del()
endif

return nil

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    Static Function lgrp2()
*+
*+    Called from ( adhoc.prg    )   2 - function loadgrp()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
Static Function lgrp2()

local t1
local artext
t1 := olg2bx:getpos()
if t1 > 0
   artext := olg2bx:aitems[t1]
   if artext > space(1)
      olg1bx:add(artext)
      olg2bx:del()
   endif
endif
return nil

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    Static Function loadconn()
*+
*+    Called from ( adhoc.prg    )   1 - function loadlimit()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
Static Function loadconn(conn)

local arrconn[4]
local odlg
local nitem1
local t1
local arrtext
local olbx

arrconn[1] = "AND    "
arrconn[2] = "OR     "
arrconn[3] = "AND NOT"
arrconn[4] = "OR NOT "

DEFINE DIALOG oDlg RESOURCE "KENCONN" FONT Publicas:oWPpal:oFont

odlg:cCaption := "Seleccionar Conector"

REDEFINE BUTTON ID 8001 OF oDlg ;       //Select
        ACTION(odlg:end(olbx:getpos()))

REDEFINE BUTTON ID 8002 OF oDlg ;       //CANCEL
        ACTION(oDlg:end(3000))

// *************************************
//  list box - available data relations
// **************************************

REDEFINE LISTBOX olbx var nitem1 ;
        ITEMS arrconn ;
        ID 8102 of oDlg ;
        on dblclick(odlg:end(olbx:getpos()))

REDEFINE BUTTON ID 8020 OF odlg ;       // top for available fields
        ACTION(olbx:gotop(),odlg:refresh())

REDEFINE BUTTON ID 8021 OF odlg ;       // bottom for available fields
        ACTION(olbx:gobottom(),odlg:refresh())

ACTIVATE DIALOG oDlg CENTERED

// ******************************************
//  load connector to item based on index in arrconn
// ******************************************

if odlg:nresult < 3000
   old2bx:gobottom()
   t1      := old2bx:getpos()
   arrtext := old2bx:aitems[t1]
   if odlg:nresult = 1
      arrtext := arrtext+" .and. "
   elseif odlg:nresult = 2
      arrtext := arrtext+" .or. "
   elseif odlg:nresult = 3
      arrtext := arrtext+" .and. .not. "
   else
      arrtext := arrtext+" .or. .not. "
   endif
   old2bx:modify(arrtext)

   // ****************************************
   //  reload the display variable to show the current limits selected
   // ****************************************

   t1 := 0
   do while t1 < old2bx:len()
      t1 := t1+1
      if t1 = 1
         limstring2 := old2bx:aitems[t1]
      else
         limstring2 := alltrim(limstring2)+" "+old2bx:aitems[t1]
      endif
   enddo

endif

return nil

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+    Static Function loadlim()
*+
*+    Called from ( adhoc.prg    )   2 - function loadlimit()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
Static Function loadlim()

local arroper[7]
local t1
local nitem1
local t2
local arrtext
local msgtext
local msgret
local innum
local intext
local indate
local gostring
local odlg
local olbx
local opertext
local t3

gostring := space(30)

// *********************************************
//  check to see if a connector has been selected
//  for the next item
// **********************************************

old2bx:gobottom()
t1 := old2bx:getpos()
if t1 > 0
   arrtext := old2bx:aitems[t1]
   if .not. ((".and." $ arrtext) .or. (".or." $ arrtext))
      msginfo("Debe seleccionar primero un conector!","Error de Seleccion!")
      return nil
   endif
endif

// ********************************************
//  load the currently selected item
// ********************************************

t1 := old1bx:getpos()
if t1 > 0
   arrtext := old1bx:aitems[t1]
   if arrtext <= space(1)
      t1 := 0
   endif
endif

if t1 = 0
   msginfo("Campo no disponible!","Error de Seleccion!")
   return nil
endif

t2 := ascan(arrname,arrtext)
if t2 = 0
   msginfo("Field no longer in Database!","Selection Error!")
   return nil
endif

// ******************************************
//  select relation, if field is a logical
// *******************************************

if arrtype[t2] = "L"
   msgtext := alltrim(arrtext)+" = Verdadero/Si or Falso/No?"
   msgret  := msgYesNo(msgtext,"Seleccione un valor logico")
   if msgret
      gostring := alltrim(arrtext)+" = .t."
   else
      gostring := alltrim(arrtext)+" = .f."
   endif
endif

// ********************************************
//  select relation for a non logical field
// *********************************************

if (arrtype[t2] <> "L") .and. (arrtype[t2] <> "U") .and. (arrtype[t2] <> "A")
   arroper[1] = "=  Igual                   "
   arroper[2] = ">  Mayor que               "
   arroper[3] = "<  Menor que               "
   arroper[4] = "<= Menor o igual que       "
   arroper[5] = ">= Mayor o igual que       "
   arroper[6] = "$  que contenga la cadena  "
   arroper[7] = "<> Distinto de             "

   nitem1 := 1

   DEFINE DIALOG oDlg RESOURCE "KENCONN" FONT Publicas:oWPpal:oFont

   odlg:cCaption := "Seleccione Relacion de Datos para "+alltrim(arrtext)

   REDEFINE BUTTON ID 8001 OF oDlg ;    //Select
           ACTION(odlg:end(0))

   REDEFINE BUTTON ID 8002 OF oDlg ;    //CANCEL
           ACTION(oDlg:end(3000))

   // *************************************
   //  list box - available data relations
   // **************************************

   REDEFINE LISTBOX olbx var nitem1 ;
           ITEMS arroper ;
           ID 8102 of oDlg ;
           on dblclick(odlg:end(0))

   REDEFINE BUTTON ID 8020 OF odlg ;    // top for available fields
           ACTION(olbx:gotop(),odlg:refresh())

   REDEFINE BUTTON ID 8021 OF odlg ;    // bottom for available fields
           ACTION(olbx:gobottom(),odlg:refresh())

   ACTIVATE DIALOG oDlg CENTERED

   // ***************************************
   //  process return from dialog selection
   // ***************************************

   if odlg:nresult > 0
      return nil
   endif

   // **************************************
   //  get the data relation operator
   // **************************************

   opertext := arroper[nitem1]
   opertext := substr(opertext,1,2)
*** nuevo
  if nitem1=6
   gostring := alltrim(opertext)+" "+"Upper("+alltrim(arrtext)+")"
  else
****
   gostring := alltrim(arrtext)+" "+alltrim(opertext) // donde buscar+operador
**** nuevo
  endif
**** nuevo
   // ******************************************
   //  determine data type and load msgget text
   // ******************************************


   if arrtype[t2] = "C" .OR. arrtype[t2] = "M"
     if nitem1=6
      intext  := space(25)
     else
      intext  := space(arrsize[t2])
     endif
      msgtext := "Indique un Valor de Caracter"
      if .not. (msgget(msgtext,gostring,@intext))
         return nil

      else

*** nuveo
       if nitem1=6
         gostring :="'"+alltrim(Upper(intext))+"' "+gostring
        else
*** nuveo
         gostring := gostring+"  '"+alltrim(Upper(intext))+"'"
**** nuevo
        endif
***** nuevo
      endif
   elseif arrtype[t2] = "D"
      indate  := ctod(space(8))
      msgtext := "Indique un valor de Fecha"
      if .not. (msgget(msgtext,gostring,@indate))
         return nil
      else
         gostring := gostring+" CTOD('"+dtoc(indate)+"')"
      endif
   elseif arrtype[t2] = "N"
      innum   := 0.00
      msgtext := "Indique un valor num‚rico"
      if .not. (msgget(msgtext,gostring,@innum))
         return nil
      else
         gostring := gostring+" val('"+alltrim(str(innum))+"')"
      endif
   else
      msginfo("Tipo de dato desconocido!","Ooops.  Error.")
      return nil
   endif

endif

// *******************************************
//  check to see if something selected, and load
// ********************************************

if gostring > space(20)
   old2bx:add(gostring)
   *old1bx:del()
   if limstring2 > space(8)
      limstring2 := limstring2+" "+gostring
   else
      limstring2 := gostring
   endif
endif

return (nil)

[karinha]

Gracias señores.

[joseluisysturiz]

Gracias señores.

Karinha, resolvistes algo..? gracias, saludos...

[Silvio.Falconi]

if you search there is a good class TInforme by alanit .José Luis Sánchez Navarro.. I use this from 5 years very good!!



p.s. viewtopic.php?f=6&t=20860&hilit=tinforme

[karinha]

if you search there is a good class TInforme by alanit .José Luis Sánchez Navarro.. I use this from 5 years very good!!



p.s. viewtopic.php?f=6&t=20860&hilit=tinforme

Obrigado Silvio. Parabéns, você está bem mais colaborativo.

Thanks Silvio. Congratulations, you are much more collaborative.

Gracias Silvio. Felicitaciones, usted es mucho más colaborativo.

Grazie Silvio. Congratulazioni, sono molto più collaborativo.

Regards, saludos.