ClarionWiki - Contribuciones del usuario [es]

Codigo Util

2015-12-15T15:25:45Z

Carlos Barroso: /* Transacciones, TCF, Logout, Commit, Rollback */

En esta sección se incluyen rutinas de código que nos resultaron útiles en más de una ocasión.

== PDF con cualquier versión de Clarion ==
Después de mucho rebuscar algo gratis que haga esto, hoy pude componer algo:
1º) Aporte de Fernando Cerini para "capturar" los .wmf de los reportes de Clarion:

En el embed PrintPreview.Open, despues de Parent call

get(SELF.ImageQueue,POINTER(SELF.ImageQueue))
LOOP a# = 1 to RECORDS(SELF.ImageQueue)
get(SELF.ImageQueue,a#)
COPY(SELF.ImageQueue, 'c:\temp\Pagina' & a# &'.WMF')
IF ERRORCODE() THEN MESSAGE(ERROR()).
END

En mi caso, con Clarion 5.0 ABC el embed point fue Previewer.Open, después del Parent call

2º) Instalar OpenOffice y seguir las instrucciones de
http://www.xml.com/pub/a/2006/01/11/from-microsoft-to-openoffice.html
para crear la macro.
La verdad, no pude cambiar el nombre de Module1 a Conversiones o algo así, pero no importó mucho.

3º) Cree un batch con la línea

"C:\Archivos de Programa\OpenOffice.org 2.3\program\soffice" -invisible macro:///Standard.Module1.SaveAsPDF(c:\temp\pagina8.wmf)

Es lo que dice el instructivo mencionado en el punto 2º) acomodado a mi instalación de OpenOffice, lo corrí y funcionó a la primera prueba.

4º) Sólo queda hacer la llamada mediante RUN en el código de Clarion y santo remedio.

Espero sea de ayuda para alguien.
Saludos
Ezequiel

== Como filtrar un Tree ==
Una tecnica de Saul Perez Quezada para filtrar Arboles (generados con el template Relacion Tree), con filtros en runtime que son complejos, y que no podemos hacer con un simple SetFilter().

Alguien ha posteado una pregunta sobre como Filtrar arboles, yo en lo personal he dejado de usar arboles, por que son bastante lentos y deficientes, pero en algunas aplicaciones es bastante util, de manera que comparto la experiencia y les subo una pequeña explicacion de como filtrar Arboles (generados con el template Relacion Tree), con filtros en runtime que son complejos, y que no podemos hacer con un simple SetFilter(), ya que no existe esto en la propiedad.

Saludos y espero les sirva.

Como filtrar un Tree con solamente tablas:

Dentro del Template para armar los arboles, tiene dentro de Primary y Secondary files la opcion de filtrar, agregando un filtro, pero muchas veces dicho filtro no es tan simple de armar, o necesitamos estarlo cambiando en runtime.

Aqui les presento un caso y como su solucion, esperando que les sirva...

Tengo tres tablas:

Abuelos
Padres
Hijos

Y en la tabla hijos, tengo un campo que define en que nivel de escuela en que va cada hijo: Pre-escolar, Primaria, Secundaria, Bachillerato, Universidad, PostGrado, Maestria y Doctorado.

En la ventana requiero que el usuario pueda filtrar por el nivel escolar, pero con las siguientes condiciones:

1.- El usuario puede seleccionar si quiere ver cualquier combinacion de estudios, es decir, que pueda ver los de primaria y universidad solamente o todos, o ninguno...
2.- Si selecciona un filtro donde resulte que un abuelo o padre no tiene hijos que cumplan la condicion, entonces no debe mostrarnos a esos abuelos y padres...

Considerando que el Tree template, muestra siempre los niveles de acuerdo al filtro que se arma, pues podria convertirse algo engorroso, estar cambiando el filtro, ya que no es una propiedad del relacion tree, tal como sucede con el browse class, sino que el tree filtra a base de If's interpuestos al llenar el queue...

Usando el template y solo poniendo los filtros de NIVELESCOLAR = LOC:MINIVEL, solo mostraria los hijos de un nivel, asi que este metodo no nos servira...

La idea seria entonces que como filtro usaremos una condicion matematica, si la condicion es Verdadera, entonces mostrara el hijo, de lo contrario no lo mostrara.

Asi que con el comando EVALUATE, evaluaremos un filtro, dentro del secondary files, opcion filter, si el filtro es bueno (igual a 1), entonces nos mostrara la info de lo contrario no...

Por ejemplo:

En el secondary files en buscamos la tabla de Hijos y le escribimos en el filtro:

0<EVALUATE(Filtro) ! Si el filtro es valido, entonces nos mostrara el resultado, de lo contrario no...

Declaramos un check box por cada cada condicion, con su respectiva variable: Preescolar, Primaria, Secundaria, etc... que sea tipo byte, con valor true = 1 y valor false = 0

! En el acepted del check box Preescolar... y cada condicion...
Do Filtrar
Display

! En procedure routines
Filtrar Routine
Clear(Filtro) ! Variable para filtrar

If Preescolar Then Filtro = 'HIJ:NIVELESCOLAR=''Preescolar''' ..

If Filtro And Primaria
Filtro = Clip(Filtro) & ' And HIJ:NIVELESCOLAR=''Primaria'''
ElsIf Filtro And Primaria
Filtro = 'HIJ:NIVELESCOLAR=''Primaria'''
End
! Esto se repite con todas las condiciones...
...
...

! Despues de armar el filtro, refrescar el browse...

DO REL4::RefreshTree ! Esta rutina la genera el template, se debe buscar en los modulos su nombre correcto.
POST(EVENT:NewSelection,?RelTree)

Exit

Hasta ahora, lo que se ha logrado es que cuando el usuario seleccione un tipo nivel escolar, nos mostrara o no los hijos, pero resulta, que ahora lo que necesito es que solo me muestre los abuelos que tienen nietos, y los padres que tienen hijos, es entonces por que no tiene caso que el arbol se llene con Mil abuelos, si solo 30 de ellos tienen nietos...

Para hacer debemos entender como se llena el queue del tree, basicamente, el tree, tantas vueltas como combinaciones de nuestra estructura tengamos, es decir, suponiendo que tenemos 3 abuelos, 3 padres, con 3 hijos cada uno, lo que hace el template es:

Por cada Abuelo Barre (con Loop) la tabla Padres por completo 1 vez y selecciono los que me corresponden y por cada padre barro la tabla hijos (con Loop) por completo y selecciono los que me corresponden...

Entonces esta estructura daria 3 x 3 x 3 = 27 vueltas. (Ahora imaginen lo que tarda en entre tablas de 10000 registros...)

Bueno, siguiendo esta idea, entonces lo que necesitamos, es interceptar cada vuelta en el punto donde no queremos que se ingrese al queue y hacer un break.

Conociendo esto buscamos en nuestros embeds, embedido llamado:

RelacionTree After Next Primary File y RelationTree After Next Secondary File...

Aqui buscamos el archivo que requerimos excluir en algunos casos, que es Padres e Hijos, le escribimos en el caso de Padres:

PAD:AbueloId = ABU:AbueloId
If Access:Padres.Fetch(FK AbueloId) ! Si no existen padres que sean dependientes de este abuelo
Break ! hacer el break al Loop del armado del tree...
End

Y el caso de los hijos repetimos la condicion:

HIJ:PadreId = PAD:PadreId
If Access:Hijos.Fetch(FK PadreId) ! Si no existen hijos que sean dependientes de este abuelo
Break ! hacer el break al Loop del armado del tree...
End

El efecto sera que no nos mostrara aquellos padres y abuelos que no tengan hijos.

Si requerimos algo mas complejo podemos usar una vista, en vez de una Fetch a una tabla, pero obviamente se alentara esto cada vez mas y mas al llenar el Arbol.

Nota
Si usamos un motor de SQL, una alternativa mucho mas eficiente es declarar un Vista en nuestro motor y diccionario que sirva de base para llenar el Arbol, con esto aumentaria considerablemente la velocidad.

== Reemplazar caracteres en un string ==
Una rutina generica para reemplazar todas las instancias de un string dentro de otro

Replace PROCEDURE(string find,string replace,*cstring into)
Locate LONG,AUTO
CODE
IF UPPER(find)<>UPPER(replace)
LOOP
Locate = INSTRING(UPPER(find),UPPER(into),1,1)
IF ~Locate THEN RETURN .
into = SUB(into,1,Locate-1) & replace &SUB(into,Locate+LEN(find),LEN(into))
END
END

Para llamarlo:

Replace('Busacr','Reemplazar',Loc:miString)

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Contar los threads abiertos ==
Este código fue posteado por Jeff Slarve
ChildThreadCount Procedure!,Long
Ndx Long
Count Long
T &Window
W &Window
Code

Count = 0
SetTarget
T &= System{PROP:Target}
Loop Ndx = 1 to MaxThreads
SetTarget(,Ndx)
W &= System{PROP:Target}
If NOT W &= T
Count += 1
end
end
SetTarget
Return Count

== Permitir solo una instancia del EXE en ejecucion ==
En Inside the global map:

INCLUDE('CWUTIL.INC'),ONCE

En Global Program Setup:

IF NOT BeginUnique('MiAPP.exe')
BEEP(BEEP:SystemExclamation)
YIELD()
CASE MESSAGE('El programa ya esta ejecutando..','Ho, ho...',ICON:Asterisk,BUTTON:OK,BUTTON:OK,0)
OF BUTTON:OK
HALT()
END
END

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Cambiar los atributos de un archivo ==
(Del FAQ de SoftVelocity)
1. En Global Embeds

A. Before Global Includes:

LPCSTR EQUATE(CSTRING)
DWORD EQUATE(ULONG)

B. Global Data: Equates de los artributos

FILE_ATTRIBUTE_READONLY EQUATE(00000001h)
FILE_ATTRIBUTE_HIDDEN EQUATE(00000002h)
FILE_ATTRIBUTE_SYSTEM EQUATE(00000004h)
FILE_ATTRIBUTE_ARCHIVE EQUATE(00000020h)
FILE_ATTRIBUTE_NORMAL EQUATE(00000080h)
FILE_ATTRIBUTE_TEMPORARY EQUATE(00000100h)

C. Inside Global Map:

Module('Win32.lib')
SetFileAttributes(*CSTRING, ULONG), BOOL, RAW, PASCAL, NAME('SetFileAttributesA')
GetFileAttributes(*CSTRING), ULONG, RAW, PASCAL, NAME('GetFileAttributesA')
END

2. En el codigo:

filename CSTRING(50)

filename = 'test.txt'
y# = GetFileAttributes(filename) ! Leer atributos
y# = SetFileAttributes(filename, FILE_ATTRIBUTE_READONLY)

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Crear directorios ==
Hay 2 opciones:

1- Con Clarion (no sé si estarán estas funciones en versiones anteriores de Clarion)

En "Inside the Global map"
Include('clib.clw')

En Local Data
MiDir Cstring(256)
Ret Long

En tu embed
MiDir = 'Dirtest'
Ret = MkDir(MiDir)

2- Con API
En Global Embeds - inside global map:

MODULE('')
DirAccess(*CSTRING,SHORT=0),SHORT,RAW,NAME('_access'),PROC
MkDir(*CSTRING),SHORT,RAW,NAME('_mkdir'),PROC
DirRename(*CSTRING, *CSTRING), SHORT, RAW, NAME('_rename'),PROC
RmDir(*CSTRING),SHORT,RAW,NAME('_rmdir'),PROC
END

Y en tu embebido podés poner lo siguiente:

Var='O:\test' ! Ojo tiene que ser Cstring
IF DirAccess(Var)<>0 !Si no existe
MkDir(Var) !Crearlo
END

También se puede usar DirRename y RmDir para renombrar o borrar

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Modificar la posicion de un informe ==

Este código permite modificar la posición inicial vertical y horizontal de un informe. Es útil cuando trabajamos con un formulario preimpreso o una hoja membretada y necesitamos desplazar la impresión sin necesidad de reconfigurar el programa.

El punto embebido donde se ubica es After Open the Report.

!=====================================================
! MODIFICAR LA POSICION DEL INFORME
! El pie de página modificarlo sólo si se usa:
! Por ejemplo se pone ahí el Nro de página o algo así.
! No es necesario cambiar los atributos de las bandas
! de detalle adicionales que se usan en el informe.
!-----------------------------------------------------
DesplazamientoX = getini('Parametros',|
'DesplazamientoX','','.\prog.ini')
DesplazamientoY = getini('Parametros',|
'DesplazamientoY','','.\prog.ini')

if DesplazamientoX or DesplazamientoY then
SETTARGET(Report)
x# = report{prop:Xpos}
y# = report{prop:Ypos}
x# += DesplazamientoX
y# += DesplazamientoY
target{prop:Xpos} = x#
target{prop:Ypos} = y#
settarget

SETTARGET(Report,?Encabezado)
x# = ?Encabezado{prop:Xpos}
y# = ?Encabezado{prop:Ypos}
x# += DesplazamientoX
y# += DesplazamientoY
?Encabezado{prop:Xpos} = x#
?Encabezado{prop:Ypos} = y#
settarget

SETTARGET(Report,?PiePagina)
x# = ?PiePagina{prop:Xpos}
y# = ?PiePagina{prop:Ypos}
x# += DesplazamientoX
y# += DesplazamientoY
?PiePagina{prop:Xpos} = x#
?PiePagina{prop:Ypos} = y#
SETTARGET
end

== Generar un informe a partir de una cola en memoria ==

(Sin pasar por el template)

Se puede definir en el módulo en la parte de DATA el reporte necesario y mandarlo a imprimir.

En DATA SECTION

WMFQue QUEUE
PageImage STRING(64)
END
ReportRunDate LONG
ReportRunTime LONG
!!> Report (portrait)
Report REPORT,AT(1000,2000,6000,7000),THOUS,PRE(RPT),FONT('Arial',10)
HEADER,AT(1000,1000,6000,1000)
END
Detail DETAIL
END
FOOTER,AT(1000,9000,6000,1000)
END
FORM,AT(1000,1000,6000,9000)
END
END

Luego, en el botón que imprime, poner el siguiente código:

ReportRunDate = today()
ReportRunDate = today()
ReportRunTime = clock()
OPEN(Report)
LOOP x# = 1 to records(ColaError)
get(ColaError,x#)
PRINT(rpt:DetalleUno)
END
ENDPAGE(Report)
ReportPreview(WMFQue)
IF GlobalResponse = RequestCompleted
Report{PROP:FlushPreview} = True
END
CLOSE(Report)
FREE(WMFQue)

Este proceso usa el Print Preview de Clarion para visualizar el informe, por consiguiente, la apariencia es totalmente normal para el usuario

== Proceso BATCH que funcione sincronizado con el TIMER de la ventana. ==

En un proceso BATCH hecho a mano se puede operar en forma similar al report o al proccess, para eso hay que definir una pantalla que tenga el atributo TIMER (un valor de 1 es suficiente). El código fuente quedaría de la siguiente manera:

open(PantaTrabaja)
Accept
case event()
of event:openwindow
Display()
! Abrir pantalla, Abrir archivos, hacer el set
! Inicial
of event:timer
?Mensaje{prop:text} = 'Procesando...'
display(?Mensaje)
loop 2 times
next(archivo)
if errorcode() then
FinArchivo = true
Break
end
! HACER AQUÍ ALGÚN PROCESO..
end
of event:closewindow
Setcursor()
Close(PantaTrabaja)
Break
End!case

case field()
of ?BotonCancelar
if event() = event:accepted then
message('Proceso cancelado por el usuario.')
post(event:closewindow)
end
End
end!accept

== Drop Combo a mano, con opción a todos y recuerdo de último elegido ==

En muchos de mis informes, cuando pido parámetros asumo lo siguiente, por ejemplo: Si el código de cliente es igual a 0 (cero) se imprimen todos los clientes, sino, se imprime uno solo. Este código permite armar lo mismo con un DropCombo, agregando la opción TODOS LOS XXXX (código Cero).

1. Definir una cola con la siguiente estructura ( por ejemplo ):

Cola QUEUE,PRE(col)
descri STRING(20)
codigo SHORT
END

2. Definir una variable local llamada por ejemplo

Combo1 STRING(20)

3. En la pantalla definir una drop combo a mano, en el campo FROM poner el nombre de la COLA, y en el USE poner Combo1 ( no poner ?Combo1 )

4. Cargar la cola según corresponda después de abrir archivos, poniendo como último dato el código 0 y el texto 'TODOS LOS REGISTROS' y hacer un ADD(Cola,1) para que quede al principio.

5. Definir una variable global ( o local estática) que va a guardar el resultado elegido:

Glo:codigo short

6. En el evento open window, ANTES de abrir la ventana va el siguiente código

loop x# = 1 to records(Cola)
get(Cola,x#)
if col:codigo = glo:codigo then break.
end
Combo1 = col:descri
?Combo1{prop:selected} = x#

7. Al hacer esto, el combo se abre posicionado en el último elemento elegido o en TODOS LOS REGISTROS si es la primera vez.

== En un report, poner los totales en otra página ==

En algún informe, se puede solicitar como parámetro la opción de imprimir los totales correspondientes en una página nueva. Para ello, después de abrir el report:

if glo:totpag then
settarget(report)
?TituloTotalCategoria{prop:pagebefore} = 1
end

== En un report, cambiar el color de un campo según alguna condición ==

Si durante la impresión de un informe se desea cambiar algún atributo (tal como el color) de un campo puede hacer lo siguiente (antes de imprimir el detalle):

if cl:impotota <> cl:totacalc
settarget(report)
?ARC:importe{PROP:FONTCOLOR} = COLOR:RED
settarget(ProgressWindow)
else
settarget(report)
?ARC:importe{PROP:FONTCOLOR} = COLOR:NONE
settarget(ProgressWindow)
end
print(rpt:Detalle) ! Imprimir la línea de detalle

== Cerrar todas las ventanas abiertas ==
LOOP Thrd# = 2 TO 64 !1 es el Frame
POST(Event:CloseWindow,,Thrd#)
END

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Abrir cualquier archivo con ShellExecute ==
Hay varios templates gratis que implementan Shellexecute, por ejemplo:
http://www.sterlingdata.com/shellex.htm

Para hacerlo con codigo:

En Global-embed 'Inside the Global Map':
Module('Win32.lib')
ShellExecute(Long,*CString,*CString,*CString,*CString,Short),UShort,PASCAL,RAW,NAME('ShellExecuteA')
END

En Local Data
LOC:Handle LONG
LOC:Op CSTRING (255)
LOC:File CSTRING (255)
LOC:Path CSTRING (255)
LOC:Param CSTRING (255)
LOC:Show LONG
LOC:RetHandle LONG

En el embed
LOC:Handle = 0{PROP:Handle}
LOC:Op = 'Open'
LOC:File = 'C:\TEST.TXT'
LOC:Path = PATH()
LOC:Param = ' '
LOC:Show = 1
LOC:RetHandle = ShellExecute(LOC:Handle,LOC:Op,LOC:File,LOC:Param,LOC:Path,LOC:Show)
If LOC:Rethandle <> 0 Then
Message('Error','Error',Icon:Exclamation)
End

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Abrir una pagina WEB con ShellExecute ==
(Ver declaraciones del API y variables en el ejemplo anterior)

En el embed
LOC:Handle = 0{PROP:Handle}
LOC:Op = 'Open'
LOC:File = 'http://www.templatesclarion.com.ar'
LOC:Path = ' '
LOC:Param = ' '
LOC:Show = 1
LOC:RetHandle = ShellExecute(LOC:Handle,LOC:Op,LOC:File,LOC:Param,LOC:Path,LOC:Show)

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Convertir un LONG a un String Binario ==
binario='' !binario es CSTRING
LOOP F# = 1 TO 32
IF BAND(abinario, 1) !abinario es LONG
binario = '1' & binario
ELSE
binario = '0' & binario
END
abinario = abinario / 2
if abinario = 0 then break.
END

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Convertir un string binario a LONG ==
Para volver del CSTRING al LONG seria simplemente
X# = EVALUATE (binario & 'b')

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Copiar la QUEUE (solo lo que se esta viendo) de un browse a Excel ==
Copiar='' !Cstring de 4.000.000
LOOP C#= 1 TO BRW1.View{Prop:Fields}
!Primero una fila con los titulos
Copiar= Copiar & ?Browse:1{PropList:Header,C#} & '<9>'
END
Copiar= Copiar &'<13,10>'

LOOP F# = 1 TO RECORDS(BRW1.Q)
LOOP C#= 1 TO BRW1.View{Prop:Fields}
GET(BRW1.Q, F#)
Copiar= Copiar & FORMAT(WHAT(BRW1.Q, C#), ?Browse:1{PropList:Picture,C#}) & '<9>'
END
Copiar= Copiar &'<13,10>'
END
SETCLIPBOARD(Copiar)

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Copiar el VIEW (cuidado: se lee todo) de un browse a Excel ==
Copiar='' !CSTRNG de 4.000.000
LOOP C#= 1 TO BRW1.View{Prop:Fields}
Copiar= Copiar & ?Browse:1{PropList:Header,C#} & '<9>'
END
Copiar= Copiar &'<13,10>'

SET (BRW1.View)
LOOP
NEXT(BRW1.View)
IF ERRORCODE() THEN BREAK.
BRW1.SetQueueRecord
LOOP C#= 1 TO BRW1.View{Prop:Fields}
Copiar= Copiar & FORMAT(WHAT(BRW1.Q, C#), ?Browse:1{PropList:Picture,C#}) & '<9>'
END
Copiar= Copiar &'<13,10>'
END
SETCLIPBOARD(Copiar)

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

Para que no lea todo el contenido del archivo, sino que procese estrictamente lo mismo que muestra el browse, basta con agregar la antes del BRW1.SetQueueRecord el llamado a BRW1.ValidateRecord().
...
LOOP
NEXT(BRW1.View)
IF ERRORCODE() THEN BREAK.
IF BRW1.ValidateRecord() THEN CYCLE.
BRW1.SetQueueRecrod
...

Daniel Ruzo

== Mostrar iconos en un listbox desde una queue ==
Ejemplo: marcar en una cola de memoria si un empleado tiene entrada y/o salida

Primero agregar los iconos al Project

En el Codigo:

cola_empleados queue, pre(que)
nombre string(30)
entro long
entro_ico long
salio long
salio_ico long
end

En el list:

primer campo: nombre

segundo campo: entro, picture @p p, iconized, transparente

tercer campo: salio, picture @p p, iconized, transparente

En el init de la pantalla:

?list{prop:iconlist,1} = '~no.ico'
?list{prop:iconlist,2} = '~si.ico'

Donde cargo la cola y la muestro:

if condicion (si NO hay entrada)
que:entro_ico = 1 ! icono de no
else
que:entro_ico = 2 !icono de si
end
if condicion (si NO hay salida)
que:salio_ico = 1 ! icono de no
else
que:salio_ico = 2 !icono de si
end
! otras asignaciones
add(cola_empleados)
!
display(?list)

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Calcular Días Hábiles ==

Ante todo necesitas una tabla de feriados, con al menos un campo llamado,
por ej., diaferiado y una clave por dicho campo.

Luego podés hacer lo siguiente

habiles# = 0
loop dia# = FechaInicial to FechaFinal
if (Dia# % 7) = 0 then cycle. ! porque es domingo
if (Dia# % 7) = 6 then cycle. ! porque es sabado
!
! busco si es feriado
!
clear(feriado:record)
feriado:diaferiado = dia#
if access:feriado.fetch(Feriado:PorDia) = level:benign then cycle. !porque es feriado
!
habiles# += 1
end!loop
corridos# = fechafinal - fechainicial

Si los cálculos que vas a realizar son muchos y continuos, sería conveniente
que la tabla de feriados la cargues en una queue y realices las búsquedas
sobre ella.

Adrian Gallegos - Mega Sistemas S.R.L.

Otra opción: Días Hábiles del mes - Rutina que quita los días sábados y domingos del mes

CONTAR_DIAS ROUTINE
LOC:DIAS = 0
tope# = 1
LOOP UNTIL DAY(LOC:FECHA) = tope#
CASE LOC:FECHA % 7
of 0 ! Domingo
LOC:FECHA = LOC:FECHA - 1
CYCLE
of 6 ! sabado
LOC:FECHA = LOC:FECHA - 1
CYCLE
ELSE
LOC:DIAS += 1
LOC:FECHA = LOC:FECHA - 1
END !CASE
END !LOOP
IF LOC:FECHA % 7 = 0 or LOC:FECHA % 7 = 6 THEN !si el primero es feriado
! nada
else
LOC:DIAS += 1
END !IF

Julio César Britez

== Último día del mes y cantidad de días (Lunes, Martes, etc) entre 2 Fechas ==
Incluye el truco de saber el último día del mes: en la parte " Date(4,1,2005)-1 " significa que le resto 1 al primer día del mes siguiente, lo cual es una forma de obtener el último día del mes actual...

Loop Fecha# = Date(3,1,2005) TO (Date(4,1,2005)-1)
EXECUTE (Fecha# % 7) + 1
Domingo# +=1
Lunes# +=1
Martes# +=1
Miercoles# +=1
Jueves# +=1
Viernes# +=1
Sabado# +=1
END
END

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Fecha en Español (por ejemplo en el Frame)==
Si quieres que funcione independientemente de como este configurado windows,
lo mejor es poner este embed, al final de WindowManager.Init

EXECUTE (TODAY() % 7) + 1
Dia"= 'Domingo'
Dia"= 'Lunes'
Dia"= 'Martes'
Dia"= 'Miercoles'
Dia"= 'Jueves'
Dia"= 'Viernes'
Dia"= 'Sabado'
END

EXECUTE (MONTH(TODAY()))
Mes" = 'Enero'
Mes" = 'Febrero'
Mes" = 'Marzo'
Mes" = 'Abril'
Mes" = 'Mayo'
Mes" = 'Junio'
Mes" = 'Julio'
Mes" = 'Agosto'
Mes" = 'Septiembre'
Mes" = 'Octubre'
Mes" = 'Noviembre'
Mes" = 'Diciembre'
END
AppFrame{Prop:StatusText,1} = CLIP(Dia") & ' ' & DAY(TODAY()) & ' de ' &
CLIP(Mes")

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

Dia" = Choose(((TODAY() % 7) + 1),'Domingo','Lunes','Martes','Miercoles','Jueves','Viernes','Sabado')

Javier A. Junca Barreto [http://www.sicya.com (SICyA Software - Colombia)]

== Obtener la fecha del server ==
Este código lee la fecha del servidor, usando el truco de crear un archivo en el servidor y leer la fecha y hora de los atributos:

!Data
LOC:TMP STRING(254),STATIC
TMP FILE,DRIVER('Ascii'),CREATE,NAME(LOC:TMP)
RECORD RECORD
LIN STRING(1)
.
.
FILS QUEUE(File:queue),PRE(FIL)
END

CODE
LOC:TMP = PATH()&'\TMP'&RANDOM(10000,99999)&'.TMP'
CREATE(TMP)
IF NOT ERRORCODE()
DIRECTORY(FILS,LOC:TMP,0)
REMOVE(TMP)
GET(FILS,1)
IF TODAY() <> FIL:DATE OR ABS(CLOCK()-FIL:TIME) > 100
!FECHA DIFERENTE O 1 SEGUNDO DE DESFASE
SETTODAY(FIL:DATE)
SETCLOCK(FIL:TIME)
END
ELSE
REMOVE(TMP)
END

Carlos Gutierrez

''Con SQL''

La sugerencia de Carlos es muy buena. Si estás usando SQL o drivers ODBC, la otra opción es preguntarle la fecha al motor de base de datos.

La forma genérica de hacerlo es:
temp{prop:sql}='SELECT {fn curdate() }'

''Con NET TIME''

Posteado por Diego Sánchez al foro.
Run('NET TIME \\Server_Name /SET /Y')
Reemplazar "Server_Name" por el nombre del servidor o equipo del cual se desea obtener la hora
Fue posteado originalmente por un NICOLAS VEILLEUX nveilleux@nbautomation.com, en el foro comp.lang.clarion

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Llamar a un Stored Procedure ==
El código sería mas o menos asi:
L:Query = 'CALL NombreDelStored (''' & FORMAT(ParamFecha,@D12) & ''', ''' &
FORMAT(OtraFecha,@D12) & ''', ' & OtroParam1 &', ' & OtroParam2 &', ' &
OtroParam3 &' )'

ResSQL{prop:sql} = L:Query
Loop Until Access:ResSql.Next()
MiVariable = R:Campo1
etc = R:Campo2
....
END

En la tabla auxiliar ResSQL obtienes el resultado del último SELECT que
tenga el Stored Procedure.

Para mas detalles ver el documento sobre SQL Embebido [http://templatesclarion.com.ar/downloads/ (Templates Clarion)]

También recomiendo leer el help "MSSQL Accelerator Calling a Stored
Procedure". Ahi está explicado además el uso de valores de retorno y parámetros de salida.

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Encriptación básica ==
Encriptación / desencriptación básica de un campo usando el metodo XOR.
!la primera vez encripta
!al volver a aplicar el algoritmo con la misma
!Clave de encriptado: desencripta
X# = 1
loop Y# = 1 to Len(Campo)
Campo [Y#] = chr(bxor(val(Campo[Y#]), val(ClaveEncriptado[X#])))
X# += 1
if X# > len (ClaveEncriptado) then X# = 1.
end
display

!Campo y ClaveEncriptado son campos CString

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Generar un archivo de Texto a máxima velocidad==
Estas son las APIs para generar un archivo de texto sin necesidad de declararlo en el Diccionario.

Además es muy rápido, ideal para exportaciones.

En Global - Inside Global map:

MODULE('Windows API')
_lcreat(*CSTRING,SIGNED),SIGNED,PASCAL,RAW
_hwrite(SIGNED,*CSTRING,LONG),LONG,PASCAL,RAW
_lclose(SIGNED),SIGNED,PASCAL
END

Por ejemplo para guardar el contenido de un control Text

IF NOT FILEDIALOG('Guardar como',FileName,'Text|*.TXT|Source|*.CLW',FILE:Save + FILE:LongName)
CYCLE
END
F# = _lcreat(FileName,0)
X# = _hwrite(F#,Texto,LEN(Texto))
X# = _lclose(F#)

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Efecto BLINK en un campo ==
Tienes que crear un timer en la ventana, para eso ponle cada cuanto se va a
ejecutar en la propiedad timer de la ventana. Son centesimas de seg, asi que
si le pones 50 por ejemplo tu campo va a titilar 2 veces por segundo.

Luego cierra la ventana, vuelve a entrar y vas a encontrar un evento timer
de la ventana en los embeds.

Window Events --> Timer
if ?campo{prop:background} = COLOR:WHITE
?campo{prop:background} = COLOR:SILVER
else
?campo{prop:background} = COLOR:WHITE
end

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Función para calcular dígito verificador en CUIT ==
- La siguiente función devuelve el numero de CUIT con el dígito verificador
correcto.
- El parámetro que recibe es el numero de CUIT a revisar incluyendo el
dígito verificador.

...
CuitCliente='20-15433984-6'
IF Cuit(CuitCliente)=CuitCliente THEN
MESSAGE('Digito verificador correcto')
ELSE
MESSAGE('Digito verificador incorrecto')
END
...

Cuit PROCEDURE(cuit1)
cuit2 STRING(255)
digver LONG
lon LONG
fac LONG
car STRING(1)

CODE
cuit2=cuit1
digver=0
fac=2
lon=LEN(CLIP(cuit2))
LOOP i#=lon-1 TO 1 BY -1
car=SUB(cuit2,i#,1)
IF car<'0' OR car>'9' THEN
CYCLE
.
digver=digver+(car*fac)
fac+=1
IF fac>7 THEN
fac=2
.
.
digver=11-(digver%11)
IF digver>9 THEN
digver=0
.
cuit2=SUB(cuit2,1,lon-1) & FORMAT(digver,@n01)
RETURN(cuit2)

Este codigo esta en la documentacion del template de Impresoras Fiscales
(BIGSYS TEMPLATES) del amigo Juan Carlos Rodríguez

== Validar Email ==
Puedes hacerlo con MATCH, el cual devuelve 1 o 0 si el mail no es valido.
Ejemplo:

X# = MATCH(UPPER(CLIP(locemail)),|
'^[-A-Z0-9._]+@{{[-A-Z0-9._]+.}+[A-Z][A-Z][A-Z]?[A-Z]?$', Match:Regular)

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Restar Horas==
Para sacar la diferencia entre horas es simplemente:
resultado = hora2 - hora + 1

El +1 es porque sino que faltaria un segundo cuando muestres el resultado (en formato @T6, por ej)

Si Hora2 es del dia siguiente, la cuenta seria:
resultado = (hora2 +(100*60*60*24)) - hora + 1

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Digito Verificador para 5 digitos ==

Si tenes un numero de 5 digitos y deses verificar que el mismo es ingresado correctamente podes usar este codigo que genera un digito verificador

Crea una funcion que tenga un parametro (numero a verificar) y retorne el digito verificador correspondiente ejem: DigitoV5(LONG xNumero),BYTE

loc:Numero = xNumero

loc:Valor = (loc:Numero[1]*5) + |
(loc:Numero[2]*4) + |
(loc:Numero[3]*3) + |
(loc:Numero[4]*2) + |
(loc:Numero[5]*7)

IF (loc:Valor%5) + 1 = 0 OR (loc:Valor%5) + 1 = 1
loc:Digito = 0
ELSE
loc:Digito = 6 - ((loc:Valor%5) + 1)
END

RETURN loc:Digito

Ruben Garcia [http://www.dipsarg.com (DiPS)]

== Digito Verificador para Cualquier Longitud ==

Si no sabes que longitud puede tener el numero a verificar podes probar verificarla con este codigo

Crea una funcion cuyo parametro es el numero a verificar y retorne el digito verificador. Ej. DigitoV(STRING xNumero),BYTE

!Inicializa
loc:Numero = xNumero
loc:Valor = 0
loc:Multiplo = 1

!Barrido y calculo
LOOP loc:Posicion = LEN(CLIP(loc:Numero)) TO 1 BY -1
loc:Multiplo += 1
IF loc:Multiplo > 7
loc:Multiplo = 2
END
loc:Valor += loc:Numero[loc:Posicion] * loc:Multiplo
END

loc:Digito = loc:Valor % 11

IF loc:Digito = 10
loc:Digito = 0
END

RETURN loc:Digito

Ruben Garcia [http://www.dipsarg.com (DiPS)]

== Autoincremento Manual ==

Esto se utiliza cuando tenemos una tabla en la cual queremos manejar la clave de auto incremento

CLEAR(MASTER)
SET(MAS:ClavePorID, MAS:ClavePorID)
ACCES:MASTER.Previous()
IF MAS:Id = 0 THEN
MAS:Id = 1
ELSE
MAS:Id = MAS:Id +1
END

!!!MAS:Id TENDRÍA EL VALOR DEL PROXIMO NUMERO.-

Gracias [mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

Nota: El mecanismo descrito es "confiable" sólo para aplicaciones que usan TPS y en modo single-user. Para Multiusuario y SQL hay que tener cuidado con las lecturas simultáneas del último valor.
También puede simplificarse el "if ... then ... else ..." como "MAS:Id = MAS:Id +1" (si es cero, será 1, no hace falta chequearlo)

== Desabilitar menu desde cualquier procedimiento ==
Una opcion seria usando NOTIFY.
En el Frame
Window Events
Notify
DISABLE = VariableGlobal

En cualquier procedimiento que se necesite deshabilitar un menu

VariableGlobal = Nro de Use del Menu
NOTIFY (999, 1)

Puede ser 999 o cualquier cosa ya que no estoy usando ese parametro.
(bueno, en realidad podria usar ese parametro en lugar de la global...)
1 es el Tread del Frame

Como desde los otros procedimientos no existen los use del los items de menu
(o sea ?menuitem) lo que hay que hacer es ponerles un numero a cada uno.
Esto se logra poniendolos de esta manera ?use, numero en la definicion del
menu.

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

==Formatear fechas en SQL ==
Les paso una función que utilizo para trabajar con las fechas en el SQL parecido al format de clarion. Es muy útil.

CREATE FUNCTION dbo.FormatDateTime
(
@dt DATETIME,
@format VARCHAR(16)
)
RETURNS VARCHAR(64)
AS
BEGIN
DECLARE @dtVC VARCHAR(64)
SELECT @dtVC = CASE @format

WHEN 'LONGDATE' THEN

DATENAME(dw, @dt)
+ ',' + SPACE(1) + DATENAME(m, @dt)
+ SPACE(1) + CAST(DAY(@dt) AS VARCHAR(2))
+ ',' + SPACE(1) + CAST(YEAR(@dt) AS CHAR(4))

WHEN 'LONGDATEANDTIME' THEN

DATENAME(dw, @dt)
+ ',' + SPACE(1) + DATENAME(m, @dt)
+ SPACE(1) + CAST(DAY(@dt) AS VARCHAR(2))
+ ',' + SPACE(1) + CAST(YEAR(@dt) AS CHAR(4))
+ SPACE(1) + RIGHT(CONVERT(CHAR(20),
@dt - CONVERT(DATETIME, CONVERT(CHAR(8),
@dt, 112)), 22), 11)

WHEN 'SHORTDATE' THEN

LEFT(CONVERT(CHAR(19), @dt, 0), 11)

WHEN 'SHORTDATEANDTIME' THEN

REPLACE(REPLACE(CONVERT(CHAR(19), @dt, 0),
'AM', ' AM'), 'PM', ' PM')

WHEN 'UNIXTIMESTAMP' THEN

CAST(DATEDIFF(SECOND, '19700101', @dt)
AS VARCHAR(64))

WHEN 'YYYYMMDD' THEN

CONVERT(CHAR(8), @dt, 112)

WHEN 'YYYY-MM-DD' THEN

CONVERT(CHAR(10), @dt, 23)

WHEN 'YYMMDD' THEN

CONVERT(VARCHAR(8), @dt, 12)

WHEN 'YY-MM-DD' THEN

STUFF(STUFF(CONVERT(VARCHAR(8), @dt, 12),
5, 0, '-'), 3, 0, '-')

WHEN 'MMDDYY' THEN

REPLACE(CONVERT(CHAR(8), @dt, 10), '-', SPACE(0))

WHEN 'MM-DD-YY' THEN

CONVERT(CHAR(8), @dt, 10)

WHEN 'MM/DD/YY' THEN

CONVERT(CHAR(8), @dt, 1)

WHEN 'MM/DD/YYYY' THEN

CONVERT(CHAR(10), @dt, 101)

WHEN 'DDMMYY' THEN

REPLACE(CONVERT(CHAR(8), @dt, 3), '/', SPACE(0))

WHEN 'DD-MM-YY' THEN

REPLACE(CONVERT(CHAR(8), @dt, 3), '/', '-')

WHEN 'DD/MM/YY' THEN

CONVERT(CHAR(8), @dt, 3)

WHEN 'DD/MM/YYYY' THEN

CONVERT(CHAR(10), @dt, 103)

WHEN 'HH:MM:SS 24' THEN

CONVERT(CHAR(8), @dt, 8)

WHEN 'HH:MM 24' THEN

LEFT(CONVERT(VARCHAR(8), @dt, 8), 5)

WHEN 'HH:MM:SS 12' THEN

LTRIM(RIGHT(CONVERT(VARCHAR(20), @dt, 22), 11))

WHEN 'HH:MM 12' THEN

LTRIM(SUBSTRING(CONVERT(
VARCHAR(20), @dt, 22), 10, 5)
+ RIGHT(CONVERT(VARCHAR(20), @dt, 22), 3))

ELSE

'Invalid format specified'

END
RETURN @dtVC
END
GO

Ejemplos:

DECLARE @now DATETIME
SET @now = GETDATE()

PRINT dbo.FormatDateTime(@now, 'LONGDATE')
PRINT dbo.FormatDateTime(@now, 'LONGDATEANDTIME')
PRINT dbo.FormatDateTime(@now, 'SHORTDATE')
PRINT dbo.FormatDateTime(@now, 'SHORTDATEANDTIME')
PRINT dbo.FormatDateTime(@now, 'UNIXTIMESTAMP')
PRINT dbo.FormatDateTime(@now, 'YYYYMMDD')
PRINT dbo.FormatDateTime(@now, 'YYYY-MM-DD')
PRINT dbo.FormatDateTime(@now, 'YYMMDD')
PRINT dbo.FormatDateTime(@now, 'YY-MM-DD')
PRINT dbo.FormatDateTime(@now, 'MMDDYY')
PRINT dbo.FormatDateTime(@now, 'MM-DD-YY')
PRINT dbo.FormatDateTime(@now, 'MM/DD/YY')
PRINT dbo.FormatDateTime(@now, 'MM/DD/YYYY')
PRINT dbo.FormatDateTime(@now, 'DDMMYY')
PRINT dbo.FormatDateTime(@now, 'DD-MM-YY')
PRINT dbo.FormatDateTime(@now, 'DD/MM/YY')
PRINT dbo.FormatDateTime(@now, 'DD/MM/YYYY')
PRINT dbo.FormatDateTime(@now, 'HH:MM:SS 24')
PRINT dbo.FormatDateTime(@now, 'HH:MM 24')
PRINT dbo.FormatDateTime(@now, 'HH:MM:SS 12')
PRINT dbo.FormatDateTime(@now, 'HH:MM 12')
PRINT dbo.FormatDateTime(@now, 'goofy')

Posteado al foro por Omar Squiabro

== Anular Tecla Escape ==

Hay veces que se necesita que el usuario salga de una FORM o de una ventana solo cuando pulse un determinado boton o se halla completado alguna condicion. Y en estos casos puede suceder que si el usuario pulsa la tecla ESC cause algun problema

Primero hay que activar la alerta de la tecla esc en el INIT de la ventana

ALERT(EscKey)

Despues en el evento alertkey

IF KEYCODE() = EscKey
SELECT(?UnDeterminadoCampo) !1= al primero
RETURN Level:Notify
END

Si el codigo embebido es puesto despues del codigo generado por clarion reemplazar el RETURN por CYCLE

Ruben Garcia [http://www.programaya.com (DiPS)]

== Convertir Número Hexadecimal a Binario ==
A veces, y sobre todo al trabajar con estados de puertos de comunicaciones, necesitamos convertir numeros hexadecimales a binario para establecer errores o tratar envios y recepciones.
Esta función hace justamente esto de forma sencilla.

HexaABinario PROCEDURE(PAR:Nhexa) ! (String),String
HBinario String(4),dim(16) !Equivalencias
RetuBina String(100) !Variable Retorno

CODE
HBinario[01] = '0000' ! 0h
HBinario[02] = '0001' ! 1h
HBinario[03] = '0010' ! 2h
HBinario[04] = '0011' ! 3h
HBinario[05] = '0100' ! 4h
HBinario[06] = '0101' ! 5h
HBinario[07] = '0110' ! 6h
HBinario[08] = '0111' ! 7h
HBinario[09] = '1000' ! 8h
HBinario[10] = '1001' ! 9h
HBinario[11] = '1010' ! Ah 65
HBinario[12] = '1011' ! Bh 66
HBinario[13] = '1100' ! Ch 67
HBinario[14] = '1101' ! Dh 68
HBinario[15] = '1110' ! Eh 69
HBinario[16] = '1111' ! Fh 70
CLEAR(RetuBina)
PAR:NHexa = UPPER(PAR:NHexa) !Aseguro letras en mayusculas
LOOP I# = 1 to LEN(CLIP(PAR:NHexa))
IF NUMERIC(PAR:NHexa[I#]) THEN !Si es numero es <= 9
!Asigno equivalente
RetuBina = CLIP(RetuBina) & HBinario[PAR:NHexa[I#]+1]
ELSE
!Asigno equivalente tomando,por ejemplo, 65 - 54 = 11 para "A"
RetuBina = CLIP(RetuBina) & HBinario[VAL(PAR:NHexa[I#])-54]
END
END
!Retorno la cadena binaria sin ceros a la izquierda
RETURN(SUB(RetuBina, INSTRING('1',RetuBina), LEN(CLIP(RetuBina))))

Bueno, espero les sea de utilidad!

Mario A. Wojcik

== Transacciones, TCF, Logout, Commit, Rollback ==

Solucion al tema del TCF, crearlo, verlo, etc.

Paso 1
En el punto embebido del FRAME (windowsManager init (priority 6100) o sea antes que se abra ningun archivo,
Insertar el siguiente codigo:
<pre>
GLO:Datos:TCF = 'TCF=' & CLIP(GLO:WorkDir) & '\' & 'AR.TCF'
Send(CLIENTES,GLO:Datos:TCF)
</pre>
Nota 1:
No es necesario definir en ningun lado el archivo .TCF ni su estructura porque de todo se encarga el driver.
Nota 2:
no enviar (SEND) los datos para el .TCF desde el diccionario, según los autores, esto no funciona.
Nota 3: Solo es necesario un archivo .TCF para toda la aplicación.

Listo, el archivo de control de transacciones ya esta creado y sin dudas funcionara.
Para que todo quede completo deberiamos hacer:
<pre>
LOGOUT(1,CabeceraFactura,DetalleFactura) !Comienza la transaccion
DO ErrHandler !Chequear errores
ADD(CabeceraFactura) !Agregar registro al padre
DO ErrHandler !
LOOP X# = 1 TO RECORDS(DetailQue) !Procesar los registros almacenados
GET(DetailQue,X#) !traer uno de la Cola
DO ErrHandler !
Det:Record = DetailQue !Asignar al record buffer
ADD(DetalleFactura) !Hacer el Add al archivo
DO ErrHandler !
END
COMMIT !Terminar la transaccion, todo OK
ASSERT(~ERRORCODE())

ErrHandler ROUTINE !Runina de manejo de errores
IF NOT ERRORCODE() THEN EXIT. !Sale si no hay errores
Err" = ERROR() !Guarda el mensaje de error
ROLLBACK !Anula la transaccion
ASSERT(~ERRORCODE())
BEEP !Avisa al usuario
MESSAGE('Transaction Error - ' & Err")
RETURN
</pre>
Lo anterior es copia de la ayuda del manual de Clarion 6.3

Para verificar que exista realmente el archivo .TCF podemos usar en cualquier punto de la aplicación lo siguiente:

Poner un string variable en pantalla y en un boton:

Loc:Tcf = SEND(CLIENTES, 'TCF')
DISPLAY()
<pre>
Eso deberia ser todo. Por lo menos para mi funciona.

Carlos Barroso
DBA Oracle
Programador Clarion </pre>

Codigo Util

2015-12-15T15:24:51Z

Carlos Barroso: /* Transacciones, TCF, Logout, Commit, Rollback */

Codigo Util

2015-12-15T15:23:30Z

Carlos Barroso: /* Transacciones, TCF, Logout, Commit, Rollback */

En esta sección se incluyen rutinas de código que nos resultaron útiles en más de una ocasión.

== PDF con cualquier versión de Clarion ==
Después de mucho rebuscar algo gratis que haga esto, hoy pude componer algo:
1º) Aporte de Fernando Cerini para "capturar" los .wmf de los reportes de Clarion:

En el embed PrintPreview.Open, despues de Parent call

get(SELF.ImageQueue,POINTER(SELF.ImageQueue))
LOOP a# = 1 to RECORDS(SELF.ImageQueue)
get(SELF.ImageQueue,a#)
COPY(SELF.ImageQueue, 'c:\temp\Pagina' & a# &'.WMF')
IF ERRORCODE() THEN MESSAGE(ERROR()).
END

En mi caso, con Clarion 5.0 ABC el embed point fue Previewer.Open, después del Parent call

2º) Instalar OpenOffice y seguir las instrucciones de
http://www.xml.com/pub/a/2006/01/11/from-microsoft-to-openoffice.html
para crear la macro.
La verdad, no pude cambiar el nombre de Module1 a Conversiones o algo así, pero no importó mucho.

3º) Cree un batch con la línea

"C:\Archivos de Programa\OpenOffice.org 2.3\program\soffice" -invisible macro:///Standard.Module1.SaveAsPDF(c:\temp\pagina8.wmf)

Es lo que dice el instructivo mencionado en el punto 2º) acomodado a mi instalación de OpenOffice, lo corrí y funcionó a la primera prueba.

4º) Sólo queda hacer la llamada mediante RUN en el código de Clarion y santo remedio.

Espero sea de ayuda para alguien.
Saludos
Ezequiel

== Como filtrar un Tree ==
Una tecnica de Saul Perez Quezada para filtrar Arboles (generados con el template Relacion Tree), con filtros en runtime que son complejos, y que no podemos hacer con un simple SetFilter().

Alguien ha posteado una pregunta sobre como Filtrar arboles, yo en lo personal he dejado de usar arboles, por que son bastante lentos y deficientes, pero en algunas aplicaciones es bastante util, de manera que comparto la experiencia y les subo una pequeña explicacion de como filtrar Arboles (generados con el template Relacion Tree), con filtros en runtime que son complejos, y que no podemos hacer con un simple SetFilter(), ya que no existe esto en la propiedad.

Saludos y espero les sirva.

Como filtrar un Tree con solamente tablas:

Dentro del Template para armar los arboles, tiene dentro de Primary y Secondary files la opcion de filtrar, agregando un filtro, pero muchas veces dicho filtro no es tan simple de armar, o necesitamos estarlo cambiando en runtime.

Aqui les presento un caso y como su solucion, esperando que les sirva...

Tengo tres tablas:

Abuelos
Padres
Hijos

Y en la tabla hijos, tengo un campo que define en que nivel de escuela en que va cada hijo: Pre-escolar, Primaria, Secundaria, Bachillerato, Universidad, PostGrado, Maestria y Doctorado.

En la ventana requiero que el usuario pueda filtrar por el nivel escolar, pero con las siguientes condiciones:

1.- El usuario puede seleccionar si quiere ver cualquier combinacion de estudios, es decir, que pueda ver los de primaria y universidad solamente o todos, o ninguno...
2.- Si selecciona un filtro donde resulte que un abuelo o padre no tiene hijos que cumplan la condicion, entonces no debe mostrarnos a esos abuelos y padres...

Considerando que el Tree template, muestra siempre los niveles de acuerdo al filtro que se arma, pues podria convertirse algo engorroso, estar cambiando el filtro, ya que no es una propiedad del relacion tree, tal como sucede con el browse class, sino que el tree filtra a base de If's interpuestos al llenar el queue...

Usando el template y solo poniendo los filtros de NIVELESCOLAR = LOC:MINIVEL, solo mostraria los hijos de un nivel, asi que este metodo no nos servira...

La idea seria entonces que como filtro usaremos una condicion matematica, si la condicion es Verdadera, entonces mostrara el hijo, de lo contrario no lo mostrara.

Asi que con el comando EVALUATE, evaluaremos un filtro, dentro del secondary files, opcion filter, si el filtro es bueno (igual a 1), entonces nos mostrara la info de lo contrario no...

Por ejemplo:

En el secondary files en buscamos la tabla de Hijos y le escribimos en el filtro:

0<EVALUATE(Filtro) ! Si el filtro es valido, entonces nos mostrara el resultado, de lo contrario no...

Declaramos un check box por cada cada condicion, con su respectiva variable: Preescolar, Primaria, Secundaria, etc... que sea tipo byte, con valor true = 1 y valor false = 0

! En el acepted del check box Preescolar... y cada condicion...
Do Filtrar
Display

! En procedure routines
Filtrar Routine
Clear(Filtro) ! Variable para filtrar

If Preescolar Then Filtro = 'HIJ:NIVELESCOLAR=''Preescolar''' ..

If Filtro And Primaria
Filtro = Clip(Filtro) & ' And HIJ:NIVELESCOLAR=''Primaria'''
ElsIf Filtro And Primaria
Filtro = 'HIJ:NIVELESCOLAR=''Primaria'''
End
! Esto se repite con todas las condiciones...
...
...

! Despues de armar el filtro, refrescar el browse...

DO REL4::RefreshTree ! Esta rutina la genera el template, se debe buscar en los modulos su nombre correcto.
POST(EVENT:NewSelection,?RelTree)

Exit

Hasta ahora, lo que se ha logrado es que cuando el usuario seleccione un tipo nivel escolar, nos mostrara o no los hijos, pero resulta, que ahora lo que necesito es que solo me muestre los abuelos que tienen nietos, y los padres que tienen hijos, es entonces por que no tiene caso que el arbol se llene con Mil abuelos, si solo 30 de ellos tienen nietos...

Para hacer debemos entender como se llena el queue del tree, basicamente, el tree, tantas vueltas como combinaciones de nuestra estructura tengamos, es decir, suponiendo que tenemos 3 abuelos, 3 padres, con 3 hijos cada uno, lo que hace el template es:

Por cada Abuelo Barre (con Loop) la tabla Padres por completo 1 vez y selecciono los que me corresponden y por cada padre barro la tabla hijos (con Loop) por completo y selecciono los que me corresponden...

Entonces esta estructura daria 3 x 3 x 3 = 27 vueltas. (Ahora imaginen lo que tarda en entre tablas de 10000 registros...)

Bueno, siguiendo esta idea, entonces lo que necesitamos, es interceptar cada vuelta en el punto donde no queremos que se ingrese al queue y hacer un break.

Conociendo esto buscamos en nuestros embeds, embedido llamado:

RelacionTree After Next Primary File y RelationTree After Next Secondary File...

Aqui buscamos el archivo que requerimos excluir en algunos casos, que es Padres e Hijos, le escribimos en el caso de Padres:

PAD:AbueloId = ABU:AbueloId
If Access:Padres.Fetch(FK AbueloId) ! Si no existen padres que sean dependientes de este abuelo
Break ! hacer el break al Loop del armado del tree...
End

Y el caso de los hijos repetimos la condicion:

HIJ:PadreId = PAD:PadreId
If Access:Hijos.Fetch(FK PadreId) ! Si no existen hijos que sean dependientes de este abuelo
Break ! hacer el break al Loop del armado del tree...
End

El efecto sera que no nos mostrara aquellos padres y abuelos que no tengan hijos.

Si requerimos algo mas complejo podemos usar una vista, en vez de una Fetch a una tabla, pero obviamente se alentara esto cada vez mas y mas al llenar el Arbol.

Nota
Si usamos un motor de SQL, una alternativa mucho mas eficiente es declarar un Vista en nuestro motor y diccionario que sirva de base para llenar el Arbol, con esto aumentaria considerablemente la velocidad.

== Reemplazar caracteres en un string ==
Una rutina generica para reemplazar todas las instancias de un string dentro de otro

Replace PROCEDURE(string find,string replace,*cstring into)
Locate LONG,AUTO
CODE
IF UPPER(find)<>UPPER(replace)
LOOP
Locate = INSTRING(UPPER(find),UPPER(into),1,1)
IF ~Locate THEN RETURN .
into = SUB(into,1,Locate-1) & replace &SUB(into,Locate+LEN(find),LEN(into))
END
END

Para llamarlo:

Replace('Busacr','Reemplazar',Loc:miString)

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Contar los threads abiertos ==
Este código fue posteado por Jeff Slarve
ChildThreadCount Procedure!,Long
Ndx Long
Count Long
T &Window
W &Window
Code

Count = 0
SetTarget
T &= System{PROP:Target}
Loop Ndx = 1 to MaxThreads
SetTarget(,Ndx)
W &= System{PROP:Target}
If NOT W &= T
Count += 1
end
end
SetTarget
Return Count

== Permitir solo una instancia del EXE en ejecucion ==
En Inside the global map:

INCLUDE('CWUTIL.INC'),ONCE

En Global Program Setup:

IF NOT BeginUnique('MiAPP.exe')
BEEP(BEEP:SystemExclamation)
YIELD()
CASE MESSAGE('El programa ya esta ejecutando..','Ho, ho...',ICON:Asterisk,BUTTON:OK,BUTTON:OK,0)
OF BUTTON:OK
HALT()
END
END

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Cambiar los atributos de un archivo ==
(Del FAQ de SoftVelocity)
1. En Global Embeds

A. Before Global Includes:

LPCSTR EQUATE(CSTRING)
DWORD EQUATE(ULONG)

B. Global Data: Equates de los artributos

FILE_ATTRIBUTE_READONLY EQUATE(00000001h)
FILE_ATTRIBUTE_HIDDEN EQUATE(00000002h)
FILE_ATTRIBUTE_SYSTEM EQUATE(00000004h)
FILE_ATTRIBUTE_ARCHIVE EQUATE(00000020h)
FILE_ATTRIBUTE_NORMAL EQUATE(00000080h)
FILE_ATTRIBUTE_TEMPORARY EQUATE(00000100h)

C. Inside Global Map:

Module('Win32.lib')
SetFileAttributes(*CSTRING, ULONG), BOOL, RAW, PASCAL, NAME('SetFileAttributesA')
GetFileAttributes(*CSTRING), ULONG, RAW, PASCAL, NAME('GetFileAttributesA')
END

2. En el codigo:

filename CSTRING(50)

filename = 'test.txt'
y# = GetFileAttributes(filename) ! Leer atributos
y# = SetFileAttributes(filename, FILE_ATTRIBUTE_READONLY)

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Crear directorios ==
Hay 2 opciones:

1- Con Clarion (no sé si estarán estas funciones en versiones anteriores de Clarion)

En "Inside the Global map"
Include('clib.clw')

En Local Data
MiDir Cstring(256)
Ret Long

En tu embed
MiDir = 'Dirtest'
Ret = MkDir(MiDir)

2- Con API
En Global Embeds - inside global map:

MODULE('')
DirAccess(*CSTRING,SHORT=0),SHORT,RAW,NAME('_access'),PROC
MkDir(*CSTRING),SHORT,RAW,NAME('_mkdir'),PROC
DirRename(*CSTRING, *CSTRING), SHORT, RAW, NAME('_rename'),PROC
RmDir(*CSTRING),SHORT,RAW,NAME('_rmdir'),PROC
END

Y en tu embebido podés poner lo siguiente:

Var='O:\test' ! Ojo tiene que ser Cstring
IF DirAccess(Var)<>0 !Si no existe
MkDir(Var) !Crearlo
END

También se puede usar DirRename y RmDir para renombrar o borrar

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Modificar la posicion de un informe ==

Este código permite modificar la posición inicial vertical y horizontal de un informe. Es útil cuando trabajamos con un formulario preimpreso o una hoja membretada y necesitamos desplazar la impresión sin necesidad de reconfigurar el programa.

El punto embebido donde se ubica es After Open the Report.

!=====================================================
! MODIFICAR LA POSICION DEL INFORME
! El pie de página modificarlo sólo si se usa:
! Por ejemplo se pone ahí el Nro de página o algo así.
! No es necesario cambiar los atributos de las bandas
! de detalle adicionales que se usan en el informe.
!-----------------------------------------------------
DesplazamientoX = getini('Parametros',|
'DesplazamientoX','','.\prog.ini')
DesplazamientoY = getini('Parametros',|
'DesplazamientoY','','.\prog.ini')

if DesplazamientoX or DesplazamientoY then
SETTARGET(Report)
x# = report{prop:Xpos}
y# = report{prop:Ypos}
x# += DesplazamientoX
y# += DesplazamientoY
target{prop:Xpos} = x#
target{prop:Ypos} = y#
settarget

SETTARGET(Report,?Encabezado)
x# = ?Encabezado{prop:Xpos}
y# = ?Encabezado{prop:Ypos}
x# += DesplazamientoX
y# += DesplazamientoY
?Encabezado{prop:Xpos} = x#
?Encabezado{prop:Ypos} = y#
settarget

SETTARGET(Report,?PiePagina)
x# = ?PiePagina{prop:Xpos}
y# = ?PiePagina{prop:Ypos}
x# += DesplazamientoX
y# += DesplazamientoY
?PiePagina{prop:Xpos} = x#
?PiePagina{prop:Ypos} = y#
SETTARGET
end

== Generar un informe a partir de una cola en memoria ==

(Sin pasar por el template)

Se puede definir en el módulo en la parte de DATA el reporte necesario y mandarlo a imprimir.

En DATA SECTION

WMFQue QUEUE
PageImage STRING(64)
END
ReportRunDate LONG
ReportRunTime LONG
!!> Report (portrait)
Report REPORT,AT(1000,2000,6000,7000),THOUS,PRE(RPT),FONT('Arial',10)
HEADER,AT(1000,1000,6000,1000)
END
Detail DETAIL
END
FOOTER,AT(1000,9000,6000,1000)
END
FORM,AT(1000,1000,6000,9000)
END
END

Luego, en el botón que imprime, poner el siguiente código:

ReportRunDate = today()
ReportRunDate = today()
ReportRunTime = clock()
OPEN(Report)
LOOP x# = 1 to records(ColaError)
get(ColaError,x#)
PRINT(rpt:DetalleUno)
END
ENDPAGE(Report)
ReportPreview(WMFQue)
IF GlobalResponse = RequestCompleted
Report{PROP:FlushPreview} = True
END
CLOSE(Report)
FREE(WMFQue)

Este proceso usa el Print Preview de Clarion para visualizar el informe, por consiguiente, la apariencia es totalmente normal para el usuario

== Proceso BATCH que funcione sincronizado con el TIMER de la ventana. ==

En un proceso BATCH hecho a mano se puede operar en forma similar al report o al proccess, para eso hay que definir una pantalla que tenga el atributo TIMER (un valor de 1 es suficiente). El código fuente quedaría de la siguiente manera:

open(PantaTrabaja)
Accept
case event()
of event:openwindow
Display()
! Abrir pantalla, Abrir archivos, hacer el set
! Inicial
of event:timer
?Mensaje{prop:text} = 'Procesando...'
display(?Mensaje)
loop 2 times
next(archivo)
if errorcode() then
FinArchivo = true
Break
end
! HACER AQUÍ ALGÚN PROCESO..
end
of event:closewindow
Setcursor()
Close(PantaTrabaja)
Break
End!case

case field()
of ?BotonCancelar
if event() = event:accepted then
message('Proceso cancelado por el usuario.')
post(event:closewindow)
end
End
end!accept

== Drop Combo a mano, con opción a todos y recuerdo de último elegido ==

En muchos de mis informes, cuando pido parámetros asumo lo siguiente, por ejemplo: Si el código de cliente es igual a 0 (cero) se imprimen todos los clientes, sino, se imprime uno solo. Este código permite armar lo mismo con un DropCombo, agregando la opción TODOS LOS XXXX (código Cero).

1. Definir una cola con la siguiente estructura ( por ejemplo ):

Cola QUEUE,PRE(col)
descri STRING(20)
codigo SHORT
END

2. Definir una variable local llamada por ejemplo

Combo1 STRING(20)

3. En la pantalla definir una drop combo a mano, en el campo FROM poner el nombre de la COLA, y en el USE poner Combo1 ( no poner ?Combo1 )

4. Cargar la cola según corresponda después de abrir archivos, poniendo como último dato el código 0 y el texto 'TODOS LOS REGISTROS' y hacer un ADD(Cola,1) para que quede al principio.

5. Definir una variable global ( o local estática) que va a guardar el resultado elegido:

Glo:codigo short

6. En el evento open window, ANTES de abrir la ventana va el siguiente código

loop x# = 1 to records(Cola)
get(Cola,x#)
if col:codigo = glo:codigo then break.
end
Combo1 = col:descri
?Combo1{prop:selected} = x#

7. Al hacer esto, el combo se abre posicionado en el último elemento elegido o en TODOS LOS REGISTROS si es la primera vez.

== En un report, poner los totales en otra página ==

En algún informe, se puede solicitar como parámetro la opción de imprimir los totales correspondientes en una página nueva. Para ello, después de abrir el report:

if glo:totpag then
settarget(report)
?TituloTotalCategoria{prop:pagebefore} = 1
end

== En un report, cambiar el color de un campo según alguna condición ==

Si durante la impresión de un informe se desea cambiar algún atributo (tal como el color) de un campo puede hacer lo siguiente (antes de imprimir el detalle):

if cl:impotota <> cl:totacalc
settarget(report)
?ARC:importe{PROP:FONTCOLOR} = COLOR:RED
settarget(ProgressWindow)
else
settarget(report)
?ARC:importe{PROP:FONTCOLOR} = COLOR:NONE
settarget(ProgressWindow)
end
print(rpt:Detalle) ! Imprimir la línea de detalle

== Cerrar todas las ventanas abiertas ==
LOOP Thrd# = 2 TO 64 !1 es el Frame
POST(Event:CloseWindow,,Thrd#)
END

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Abrir cualquier archivo con ShellExecute ==
Hay varios templates gratis que implementan Shellexecute, por ejemplo:
http://www.sterlingdata.com/shellex.htm

Para hacerlo con codigo:

En Global-embed 'Inside the Global Map':
Module('Win32.lib')
ShellExecute(Long,*CString,*CString,*CString,*CString,Short),UShort,PASCAL,RAW,NAME('ShellExecuteA')
END

En Local Data
LOC:Handle LONG
LOC:Op CSTRING (255)
LOC:File CSTRING (255)
LOC:Path CSTRING (255)
LOC:Param CSTRING (255)
LOC:Show LONG
LOC:RetHandle LONG

En el embed
LOC:Handle = 0{PROP:Handle}
LOC:Op = 'Open'
LOC:File = 'C:\TEST.TXT'
LOC:Path = PATH()
LOC:Param = ' '
LOC:Show = 1
LOC:RetHandle = ShellExecute(LOC:Handle,LOC:Op,LOC:File,LOC:Param,LOC:Path,LOC:Show)
If LOC:Rethandle <> 0 Then
Message('Error','Error',Icon:Exclamation)
End

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Abrir una pagina WEB con ShellExecute ==
(Ver declaraciones del API y variables en el ejemplo anterior)

En el embed
LOC:Handle = 0{PROP:Handle}
LOC:Op = 'Open'
LOC:File = 'http://www.templatesclarion.com.ar'
LOC:Path = ' '
LOC:Param = ' '
LOC:Show = 1
LOC:RetHandle = ShellExecute(LOC:Handle,LOC:Op,LOC:File,LOC:Param,LOC:Path,LOC:Show)

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Convertir un LONG a un String Binario ==
binario='' !binario es CSTRING
LOOP F# = 1 TO 32
IF BAND(abinario, 1) !abinario es LONG
binario = '1' & binario
ELSE
binario = '0' & binario
END
abinario = abinario / 2
if abinario = 0 then break.
END

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Convertir un string binario a LONG ==
Para volver del CSTRING al LONG seria simplemente
X# = EVALUATE (binario & 'b')

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Copiar la QUEUE (solo lo que se esta viendo) de un browse a Excel ==
Copiar='' !Cstring de 4.000.000
LOOP C#= 1 TO BRW1.View{Prop:Fields}
!Primero una fila con los titulos
Copiar= Copiar & ?Browse:1{PropList:Header,C#} & '<9>'
END
Copiar= Copiar &'<13,10>'

LOOP F# = 1 TO RECORDS(BRW1.Q)
LOOP C#= 1 TO BRW1.View{Prop:Fields}
GET(BRW1.Q, F#)
Copiar= Copiar & FORMAT(WHAT(BRW1.Q, C#), ?Browse:1{PropList:Picture,C#}) & '<9>'
END
Copiar= Copiar &'<13,10>'
END
SETCLIPBOARD(Copiar)

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Copiar el VIEW (cuidado: se lee todo) de un browse a Excel ==
Copiar='' !CSTRNG de 4.000.000
LOOP C#= 1 TO BRW1.View{Prop:Fields}
Copiar= Copiar & ?Browse:1{PropList:Header,C#} & '<9>'
END
Copiar= Copiar &'<13,10>'

SET (BRW1.View)
LOOP
NEXT(BRW1.View)
IF ERRORCODE() THEN BREAK.
BRW1.SetQueueRecord
LOOP C#= 1 TO BRW1.View{Prop:Fields}
Copiar= Copiar & FORMAT(WHAT(BRW1.Q, C#), ?Browse:1{PropList:Picture,C#}) & '<9>'
END
Copiar= Copiar &'<13,10>'
END
SETCLIPBOARD(Copiar)

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

Para que no lea todo el contenido del archivo, sino que procese estrictamente lo mismo que muestra el browse, basta con agregar la antes del BRW1.SetQueueRecord el llamado a BRW1.ValidateRecord().
...
LOOP
NEXT(BRW1.View)
IF ERRORCODE() THEN BREAK.
IF BRW1.ValidateRecord() THEN CYCLE.
BRW1.SetQueueRecrod
...

Daniel Ruzo

== Mostrar iconos en un listbox desde una queue ==
Ejemplo: marcar en una cola de memoria si un empleado tiene entrada y/o salida

Primero agregar los iconos al Project

En el Codigo:

cola_empleados queue, pre(que)
nombre string(30)
entro long
entro_ico long
salio long
salio_ico long
end

En el list:

primer campo: nombre

segundo campo: entro, picture @p p, iconized, transparente

tercer campo: salio, picture @p p, iconized, transparente

En el init de la pantalla:

?list{prop:iconlist,1} = '~no.ico'
?list{prop:iconlist,2} = '~si.ico'

Donde cargo la cola y la muestro:

if condicion (si NO hay entrada)
que:entro_ico = 1 ! icono de no
else
que:entro_ico = 2 !icono de si
end
if condicion (si NO hay salida)
que:salio_ico = 1 ! icono de no
else
que:salio_ico = 2 !icono de si
end
! otras asignaciones
add(cola_empleados)
!
display(?list)

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Calcular Días Hábiles ==

Ante todo necesitas una tabla de feriados, con al menos un campo llamado,
por ej., diaferiado y una clave por dicho campo.

Luego podés hacer lo siguiente

habiles# = 0
loop dia# = FechaInicial to FechaFinal
if (Dia# % 7) = 0 then cycle. ! porque es domingo
if (Dia# % 7) = 6 then cycle. ! porque es sabado
!
! busco si es feriado
!
clear(feriado:record)
feriado:diaferiado = dia#
if access:feriado.fetch(Feriado:PorDia) = level:benign then cycle. !porque es feriado
!
habiles# += 1
end!loop
corridos# = fechafinal - fechainicial

Si los cálculos que vas a realizar son muchos y continuos, sería conveniente
que la tabla de feriados la cargues en una queue y realices las búsquedas
sobre ella.

Adrian Gallegos - Mega Sistemas S.R.L.

Otra opción: Días Hábiles del mes - Rutina que quita los días sábados y domingos del mes

CONTAR_DIAS ROUTINE
LOC:DIAS = 0
tope# = 1
LOOP UNTIL DAY(LOC:FECHA) = tope#
CASE LOC:FECHA % 7
of 0 ! Domingo
LOC:FECHA = LOC:FECHA - 1
CYCLE
of 6 ! sabado
LOC:FECHA = LOC:FECHA - 1
CYCLE
ELSE
LOC:DIAS += 1
LOC:FECHA = LOC:FECHA - 1
END !CASE
END !LOOP
IF LOC:FECHA % 7 = 0 or LOC:FECHA % 7 = 6 THEN !si el primero es feriado
! nada
else
LOC:DIAS += 1
END !IF

Julio César Britez

== Último día del mes y cantidad de días (Lunes, Martes, etc) entre 2 Fechas ==
Incluye el truco de saber el último día del mes: en la parte " Date(4,1,2005)-1 " significa que le resto 1 al primer día del mes siguiente, lo cual es una forma de obtener el último día del mes actual...

Loop Fecha# = Date(3,1,2005) TO (Date(4,1,2005)-1)
EXECUTE (Fecha# % 7) + 1
Domingo# +=1
Lunes# +=1
Martes# +=1
Miercoles# +=1
Jueves# +=1
Viernes# +=1
Sabado# +=1
END
END

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Fecha en Español (por ejemplo en el Frame)==
Si quieres que funcione independientemente de como este configurado windows,
lo mejor es poner este embed, al final de WindowManager.Init

EXECUTE (TODAY() % 7) + 1
Dia"= 'Domingo'
Dia"= 'Lunes'
Dia"= 'Martes'
Dia"= 'Miercoles'
Dia"= 'Jueves'
Dia"= 'Viernes'
Dia"= 'Sabado'
END

EXECUTE (MONTH(TODAY()))
Mes" = 'Enero'
Mes" = 'Febrero'
Mes" = 'Marzo'
Mes" = 'Abril'
Mes" = 'Mayo'
Mes" = 'Junio'
Mes" = 'Julio'
Mes" = 'Agosto'
Mes" = 'Septiembre'
Mes" = 'Octubre'
Mes" = 'Noviembre'
Mes" = 'Diciembre'
END
AppFrame{Prop:StatusText,1} = CLIP(Dia") & ' ' & DAY(TODAY()) & ' de ' &
CLIP(Mes")

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

Dia" = Choose(((TODAY() % 7) + 1),'Domingo','Lunes','Martes','Miercoles','Jueves','Viernes','Sabado')

Javier A. Junca Barreto [http://www.sicya.com (SICyA Software - Colombia)]

== Obtener la fecha del server ==
Este código lee la fecha del servidor, usando el truco de crear un archivo en el servidor y leer la fecha y hora de los atributos:

!Data
LOC:TMP STRING(254),STATIC
TMP FILE,DRIVER('Ascii'),CREATE,NAME(LOC:TMP)
RECORD RECORD
LIN STRING(1)
.
.
FILS QUEUE(File:queue),PRE(FIL)
END

CODE
LOC:TMP = PATH()&'\TMP'&RANDOM(10000,99999)&'.TMP'
CREATE(TMP)
IF NOT ERRORCODE()
DIRECTORY(FILS,LOC:TMP,0)
REMOVE(TMP)
GET(FILS,1)
IF TODAY() <> FIL:DATE OR ABS(CLOCK()-FIL:TIME) > 100
!FECHA DIFERENTE O 1 SEGUNDO DE DESFASE
SETTODAY(FIL:DATE)
SETCLOCK(FIL:TIME)
END
ELSE
REMOVE(TMP)
END

Carlos Gutierrez

''Con SQL''

La sugerencia de Carlos es muy buena. Si estás usando SQL o drivers ODBC, la otra opción es preguntarle la fecha al motor de base de datos.

La forma genérica de hacerlo es:
temp{prop:sql}='SELECT {fn curdate() }'

''Con NET TIME''

Posteado por Diego Sánchez al foro.
Run('NET TIME \\Server_Name /SET /Y')
Reemplazar "Server_Name" por el nombre del servidor o equipo del cual se desea obtener la hora
Fue posteado originalmente por un NICOLAS VEILLEUX nveilleux@nbautomation.com, en el foro comp.lang.clarion

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Llamar a un Stored Procedure ==
El código sería mas o menos asi:
L:Query = 'CALL NombreDelStored (''' & FORMAT(ParamFecha,@D12) & ''', ''' &
FORMAT(OtraFecha,@D12) & ''', ' & OtroParam1 &', ' & OtroParam2 &', ' &
OtroParam3 &' )'

ResSQL{prop:sql} = L:Query
Loop Until Access:ResSql.Next()
MiVariable = R:Campo1
etc = R:Campo2
....
END

En la tabla auxiliar ResSQL obtienes el resultado del último SELECT que
tenga el Stored Procedure.

Para mas detalles ver el documento sobre SQL Embebido [http://templatesclarion.com.ar/downloads/ (Templates Clarion)]

También recomiendo leer el help "MSSQL Accelerator Calling a Stored
Procedure". Ahi está explicado además el uso de valores de retorno y parámetros de salida.

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Encriptación básica ==
Encriptación / desencriptación básica de un campo usando el metodo XOR.
!la primera vez encripta
!al volver a aplicar el algoritmo con la misma
!Clave de encriptado: desencripta
X# = 1
loop Y# = 1 to Len(Campo)
Campo [Y#] = chr(bxor(val(Campo[Y#]), val(ClaveEncriptado[X#])))
X# += 1
if X# > len (ClaveEncriptado) then X# = 1.
end
display

!Campo y ClaveEncriptado son campos CString

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Generar un archivo de Texto a máxima velocidad==
Estas son las APIs para generar un archivo de texto sin necesidad de declararlo en el Diccionario.

Además es muy rápido, ideal para exportaciones.

En Global - Inside Global map:

MODULE('Windows API')
_lcreat(*CSTRING,SIGNED),SIGNED,PASCAL,RAW
_hwrite(SIGNED,*CSTRING,LONG),LONG,PASCAL,RAW
_lclose(SIGNED),SIGNED,PASCAL
END

Por ejemplo para guardar el contenido de un control Text

IF NOT FILEDIALOG('Guardar como',FileName,'Text|*.TXT|Source|*.CLW',FILE:Save + FILE:LongName)
CYCLE
END
F# = _lcreat(FileName,0)
X# = _hwrite(F#,Texto,LEN(Texto))
X# = _lclose(F#)

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Efecto BLINK en un campo ==
Tienes que crear un timer en la ventana, para eso ponle cada cuanto se va a
ejecutar en la propiedad timer de la ventana. Son centesimas de seg, asi que
si le pones 50 por ejemplo tu campo va a titilar 2 veces por segundo.

Luego cierra la ventana, vuelve a entrar y vas a encontrar un evento timer
de la ventana en los embeds.

Window Events --> Timer
if ?campo{prop:background} = COLOR:WHITE
?campo{prop:background} = COLOR:SILVER
else
?campo{prop:background} = COLOR:WHITE
end

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Función para calcular dígito verificador en CUIT ==
- La siguiente función devuelve el numero de CUIT con el dígito verificador
correcto.
- El parámetro que recibe es el numero de CUIT a revisar incluyendo el
dígito verificador.

...
CuitCliente='20-15433984-6'
IF Cuit(CuitCliente)=CuitCliente THEN
MESSAGE('Digito verificador correcto')
ELSE
MESSAGE('Digito verificador incorrecto')
END
...

Cuit PROCEDURE(cuit1)
cuit2 STRING(255)
digver LONG
lon LONG
fac LONG
car STRING(1)

CODE
cuit2=cuit1
digver=0
fac=2
lon=LEN(CLIP(cuit2))
LOOP i#=lon-1 TO 1 BY -1
car=SUB(cuit2,i#,1)
IF car<'0' OR car>'9' THEN
CYCLE
.
digver=digver+(car*fac)
fac+=1
IF fac>7 THEN
fac=2
.
.
digver=11-(digver%11)
IF digver>9 THEN
digver=0
.
cuit2=SUB(cuit2,1,lon-1) & FORMAT(digver,@n01)
RETURN(cuit2)

Este codigo esta en la documentacion del template de Impresoras Fiscales
(BIGSYS TEMPLATES) del amigo Juan Carlos Rodríguez

== Validar Email ==
Puedes hacerlo con MATCH, el cual devuelve 1 o 0 si el mail no es valido.
Ejemplo:

X# = MATCH(UPPER(CLIP(locemail)),|
'^[-A-Z0-9._]+@{{[-A-Z0-9._]+.}+[A-Z][A-Z][A-Z]?[A-Z]?$', Match:Regular)

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Restar Horas==
Para sacar la diferencia entre horas es simplemente:
resultado = hora2 - hora + 1

El +1 es porque sino que faltaria un segundo cuando muestres el resultado (en formato @T6, por ej)

Si Hora2 es del dia siguiente, la cuenta seria:
resultado = (hora2 +(100*60*60*24)) - hora + 1

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Digito Verificador para 5 digitos ==

Si tenes un numero de 5 digitos y deses verificar que el mismo es ingresado correctamente podes usar este codigo que genera un digito verificador

Crea una funcion que tenga un parametro (numero a verificar) y retorne el digito verificador correspondiente ejem: DigitoV5(LONG xNumero),BYTE

loc:Numero = xNumero

loc:Valor = (loc:Numero[1]*5) + |
(loc:Numero[2]*4) + |
(loc:Numero[3]*3) + |
(loc:Numero[4]*2) + |
(loc:Numero[5]*7)

IF (loc:Valor%5) + 1 = 0 OR (loc:Valor%5) + 1 = 1
loc:Digito = 0
ELSE
loc:Digito = 6 - ((loc:Valor%5) + 1)
END

RETURN loc:Digito

Ruben Garcia [http://www.dipsarg.com (DiPS)]

== Digito Verificador para Cualquier Longitud ==

Si no sabes que longitud puede tener el numero a verificar podes probar verificarla con este codigo

Crea una funcion cuyo parametro es el numero a verificar y retorne el digito verificador. Ej. DigitoV(STRING xNumero),BYTE

!Inicializa
loc:Numero = xNumero
loc:Valor = 0
loc:Multiplo = 1

!Barrido y calculo
LOOP loc:Posicion = LEN(CLIP(loc:Numero)) TO 1 BY -1
loc:Multiplo += 1
IF loc:Multiplo > 7
loc:Multiplo = 2
END
loc:Valor += loc:Numero[loc:Posicion] * loc:Multiplo
END

loc:Digito = loc:Valor % 11

IF loc:Digito = 10
loc:Digito = 0
END

RETURN loc:Digito

Ruben Garcia [http://www.dipsarg.com (DiPS)]

== Autoincremento Manual ==

Esto se utiliza cuando tenemos una tabla en la cual queremos manejar la clave de auto incremento

CLEAR(MASTER)
SET(MAS:ClavePorID, MAS:ClavePorID)
ACCES:MASTER.Previous()
IF MAS:Id = 0 THEN
MAS:Id = 1
ELSE
MAS:Id = MAS:Id +1
END

!!!MAS:Id TENDRÍA EL VALOR DEL PROXIMO NUMERO.-

Gracias [mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

Nota: El mecanismo descrito es "confiable" sólo para aplicaciones que usan TPS y en modo single-user. Para Multiusuario y SQL hay que tener cuidado con las lecturas simultáneas del último valor.
También puede simplificarse el "if ... then ... else ..." como "MAS:Id = MAS:Id +1" (si es cero, será 1, no hace falta chequearlo)

== Desabilitar menu desde cualquier procedimiento ==
Una opcion seria usando NOTIFY.
En el Frame
Window Events
Notify
DISABLE = VariableGlobal

En cualquier procedimiento que se necesite deshabilitar un menu

VariableGlobal = Nro de Use del Menu
NOTIFY (999, 1)

Puede ser 999 o cualquier cosa ya que no estoy usando ese parametro.
(bueno, en realidad podria usar ese parametro en lugar de la global...)
1 es el Tread del Frame

Como desde los otros procedimientos no existen los use del los items de menu
(o sea ?menuitem) lo que hay que hacer es ponerles un numero a cada uno.
Esto se logra poniendolos de esta manera ?use, numero en la definicion del
menu.

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

==Formatear fechas en SQL ==
Les paso una función que utilizo para trabajar con las fechas en el SQL parecido al format de clarion. Es muy útil.

CREATE FUNCTION dbo.FormatDateTime
(
@dt DATETIME,
@format VARCHAR(16)
)
RETURNS VARCHAR(64)
AS
BEGIN
DECLARE @dtVC VARCHAR(64)
SELECT @dtVC = CASE @format

WHEN 'LONGDATE' THEN

DATENAME(dw, @dt)
+ ',' + SPACE(1) + DATENAME(m, @dt)
+ SPACE(1) + CAST(DAY(@dt) AS VARCHAR(2))
+ ',' + SPACE(1) + CAST(YEAR(@dt) AS CHAR(4))

WHEN 'LONGDATEANDTIME' THEN

DATENAME(dw, @dt)
+ ',' + SPACE(1) + DATENAME(m, @dt)
+ SPACE(1) + CAST(DAY(@dt) AS VARCHAR(2))
+ ',' + SPACE(1) + CAST(YEAR(@dt) AS CHAR(4))
+ SPACE(1) + RIGHT(CONVERT(CHAR(20),
@dt - CONVERT(DATETIME, CONVERT(CHAR(8),
@dt, 112)), 22), 11)

WHEN 'SHORTDATE' THEN

LEFT(CONVERT(CHAR(19), @dt, 0), 11)

WHEN 'SHORTDATEANDTIME' THEN

REPLACE(REPLACE(CONVERT(CHAR(19), @dt, 0),
'AM', ' AM'), 'PM', ' PM')

WHEN 'UNIXTIMESTAMP' THEN

CAST(DATEDIFF(SECOND, '19700101', @dt)
AS VARCHAR(64))

WHEN 'YYYYMMDD' THEN

CONVERT(CHAR(8), @dt, 112)

WHEN 'YYYY-MM-DD' THEN

CONVERT(CHAR(10), @dt, 23)

WHEN 'YYMMDD' THEN

CONVERT(VARCHAR(8), @dt, 12)

WHEN 'YY-MM-DD' THEN

STUFF(STUFF(CONVERT(VARCHAR(8), @dt, 12),
5, 0, '-'), 3, 0, '-')

WHEN 'MMDDYY' THEN

REPLACE(CONVERT(CHAR(8), @dt, 10), '-', SPACE(0))

WHEN 'MM-DD-YY' THEN

CONVERT(CHAR(8), @dt, 10)

WHEN 'MM/DD/YY' THEN

CONVERT(CHAR(8), @dt, 1)

WHEN 'MM/DD/YYYY' THEN

CONVERT(CHAR(10), @dt, 101)

WHEN 'DDMMYY' THEN

REPLACE(CONVERT(CHAR(8), @dt, 3), '/', SPACE(0))

WHEN 'DD-MM-YY' THEN

REPLACE(CONVERT(CHAR(8), @dt, 3), '/', '-')

WHEN 'DD/MM/YY' THEN

CONVERT(CHAR(8), @dt, 3)

WHEN 'DD/MM/YYYY' THEN

CONVERT(CHAR(10), @dt, 103)

WHEN 'HH:MM:SS 24' THEN

CONVERT(CHAR(8), @dt, 8)

WHEN 'HH:MM 24' THEN

LEFT(CONVERT(VARCHAR(8), @dt, 8), 5)

WHEN 'HH:MM:SS 12' THEN

LTRIM(RIGHT(CONVERT(VARCHAR(20), @dt, 22), 11))

WHEN 'HH:MM 12' THEN

LTRIM(SUBSTRING(CONVERT(
VARCHAR(20), @dt, 22), 10, 5)
+ RIGHT(CONVERT(VARCHAR(20), @dt, 22), 3))

ELSE

'Invalid format specified'

END
RETURN @dtVC
END
GO

Ejemplos:

DECLARE @now DATETIME
SET @now = GETDATE()

PRINT dbo.FormatDateTime(@now, 'LONGDATE')
PRINT dbo.FormatDateTime(@now, 'LONGDATEANDTIME')
PRINT dbo.FormatDateTime(@now, 'SHORTDATE')
PRINT dbo.FormatDateTime(@now, 'SHORTDATEANDTIME')
PRINT dbo.FormatDateTime(@now, 'UNIXTIMESTAMP')
PRINT dbo.FormatDateTime(@now, 'YYYYMMDD')
PRINT dbo.FormatDateTime(@now, 'YYYY-MM-DD')
PRINT dbo.FormatDateTime(@now, 'YYMMDD')
PRINT dbo.FormatDateTime(@now, 'YY-MM-DD')
PRINT dbo.FormatDateTime(@now, 'MMDDYY')
PRINT dbo.FormatDateTime(@now, 'MM-DD-YY')
PRINT dbo.FormatDateTime(@now, 'MM/DD/YY')
PRINT dbo.FormatDateTime(@now, 'MM/DD/YYYY')
PRINT dbo.FormatDateTime(@now, 'DDMMYY')
PRINT dbo.FormatDateTime(@now, 'DD-MM-YY')
PRINT dbo.FormatDateTime(@now, 'DD/MM/YY')
PRINT dbo.FormatDateTime(@now, 'DD/MM/YYYY')
PRINT dbo.FormatDateTime(@now, 'HH:MM:SS 24')
PRINT dbo.FormatDateTime(@now, 'HH:MM 24')
PRINT dbo.FormatDateTime(@now, 'HH:MM:SS 12')
PRINT dbo.FormatDateTime(@now, 'HH:MM 12')
PRINT dbo.FormatDateTime(@now, 'goofy')

Posteado al foro por Omar Squiabro

== Anular Tecla Escape ==

Hay veces que se necesita que el usuario salga de una FORM o de una ventana solo cuando pulse un determinado boton o se halla completado alguna condicion. Y en estos casos puede suceder que si el usuario pulsa la tecla ESC cause algun problema

Primero hay que activar la alerta de la tecla esc en el INIT de la ventana

ALERT(EscKey)

Despues en el evento alertkey

IF KEYCODE() = EscKey
SELECT(?UnDeterminadoCampo) !1= al primero
RETURN Level:Notify
END

Si el codigo embebido es puesto despues del codigo generado por clarion reemplazar el RETURN por CYCLE

Ruben Garcia [http://www.programaya.com (DiPS)]

== Convertir Número Hexadecimal a Binario ==
A veces, y sobre todo al trabajar con estados de puertos de comunicaciones, necesitamos convertir numeros hexadecimales a binario para establecer errores o tratar envios y recepciones.
Esta función hace justamente esto de forma sencilla.

HexaABinario PROCEDURE(PAR:Nhexa) ! (String),String
HBinario String(4),dim(16) !Equivalencias
RetuBina String(100) !Variable Retorno

CODE
HBinario[01] = '0000' ! 0h
HBinario[02] = '0001' ! 1h
HBinario[03] = '0010' ! 2h
HBinario[04] = '0011' ! 3h
HBinario[05] = '0100' ! 4h
HBinario[06] = '0101' ! 5h
HBinario[07] = '0110' ! 6h
HBinario[08] = '0111' ! 7h
HBinario[09] = '1000' ! 8h
HBinario[10] = '1001' ! 9h
HBinario[11] = '1010' ! Ah 65
HBinario[12] = '1011' ! Bh 66
HBinario[13] = '1100' ! Ch 67
HBinario[14] = '1101' ! Dh 68
HBinario[15] = '1110' ! Eh 69
HBinario[16] = '1111' ! Fh 70
CLEAR(RetuBina)
PAR:NHexa = UPPER(PAR:NHexa) !Aseguro letras en mayusculas
LOOP I# = 1 to LEN(CLIP(PAR:NHexa))
IF NUMERIC(PAR:NHexa[I#]) THEN !Si es numero es <= 9
!Asigno equivalente
RetuBina = CLIP(RetuBina) & HBinario[PAR:NHexa[I#]+1]
ELSE
!Asigno equivalente tomando,por ejemplo, 65 - 54 = 11 para "A"
RetuBina = CLIP(RetuBina) & HBinario[VAL(PAR:NHexa[I#])-54]
END
END
!Retorno la cadena binaria sin ceros a la izquierda
RETURN(SUB(RetuBina, INSTRING('1',RetuBina), LEN(CLIP(RetuBina))))

Bueno, espero les sea de utilidad!

Mario A. Wojcik

== Transacciones, TCF, Logout, Commit, Rollback ==

Solucion al tema del TCF, crearlo, verlo, etc.

Paso 1
En el punto embebido del FRAME (windowsManager init (priority 6100) o sea antes que se abra ningun archivo,
Insertar el siguiente codigo:
<pre>
GLO:Datos:TCF = 'TCF=' & CLIP(GLO:WorkDir) & '\' & 'AR.TCF'
Send(CLIENTES,GLO:Datos:TCF)
</pre>
Nota 1:
No es necesario definir en ningun lado el archivo .TCF ni su estructura porque de todo se encarga el driver.
Nota 2:
no enviar (SEND) los datos para el .TCF desde el diccionario, según los autores, esto no funciona.
Nota 3: Solo es necesario un archivo .TCF para toda la aplicación.

Listo, el archivo de control de transacciones ya esta creado y sin dudas funcionara.
Para que todo quede completo deberiamos hacer:
<pre>
LOGOUT(1,CabeceraFactura,DetalleFactura) !Comienza la transaccion
DO ErrHandler !Chequear errores
ADD(CabeceraFactura) !Agregar registro al padre
DO ErrHandler !
LOOP X# = 1 TO RECORDS(DetailQue) !Procesar los registros almacenados
GET(DetailQue,X#) !traer uno de la Cola
DO ErrHandler !
Det:Record = DetailQue !Asignar al record buffer
ADD(DetalleFactura) !Hacer el Add al archivo
DO ErrHandler !
END
COMMIT !Terminar la transaccion, todo OK
ASSERT(~ERRORCODE())

ErrHandler ROUTINE !Runina de manejo de errores
IF NOT ERRORCODE() THEN EXIT. !Sale si no hay errores
Err" = ERROR() !Guarda el mensaje de error
ROLLBACK !Anula la transaccion
ASSERT(~ERRORCODE())
BEEP !Avisa al usuario
MESSAGE('Transaction Error - ' & Err")
RETURN
</pre>
Lo anterior es copia de la ayuda del manual de Clarion 6.3

Para verificar que exista realmente el archivo .TCF podemos usar en cualquer punto de la aplicación lo siguiente:

Poner un string variable en pantalla y en un boton:

Loc:Tcf = SEND(CLIENTES, 'TCF')
DISPLAY()

Eso deberia ser todo. Por lo menos para mi funciona.
Carlos Barroso
DBA Oracle
Programador Clarion

Codigo Util

2015-12-15T15:22:46Z

Carlos Barroso: Solucion al tema del TCF, crearlo, verlo, etc.

En esta sección se incluyen rutinas de código que nos resultaron útiles en más de una ocasión.

== PDF con cualquier versión de Clarion ==
Después de mucho rebuscar algo gratis que haga esto, hoy pude componer algo:
1º) Aporte de Fernando Cerini para "capturar" los .wmf de los reportes de Clarion:

En el embed PrintPreview.Open, despues de Parent call

get(SELF.ImageQueue,POINTER(SELF.ImageQueue))
LOOP a# = 1 to RECORDS(SELF.ImageQueue)
get(SELF.ImageQueue,a#)
COPY(SELF.ImageQueue, 'c:\temp\Pagina' & a# &'.WMF')
IF ERRORCODE() THEN MESSAGE(ERROR()).
END

En mi caso, con Clarion 5.0 ABC el embed point fue Previewer.Open, después del Parent call

2º) Instalar OpenOffice y seguir las instrucciones de
http://www.xml.com/pub/a/2006/01/11/from-microsoft-to-openoffice.html
para crear la macro.
La verdad, no pude cambiar el nombre de Module1 a Conversiones o algo así, pero no importó mucho.

3º) Cree un batch con la línea

"C:\Archivos de Programa\OpenOffice.org 2.3\program\soffice" -invisible macro:///Standard.Module1.SaveAsPDF(c:\temp\pagina8.wmf)

Es lo que dice el instructivo mencionado en el punto 2º) acomodado a mi instalación de OpenOffice, lo corrí y funcionó a la primera prueba.

4º) Sólo queda hacer la llamada mediante RUN en el código de Clarion y santo remedio.

Espero sea de ayuda para alguien.
Saludos
Ezequiel

== Como filtrar un Tree ==
Una tecnica de Saul Perez Quezada para filtrar Arboles (generados con el template Relacion Tree), con filtros en runtime que son complejos, y que no podemos hacer con un simple SetFilter().

Alguien ha posteado una pregunta sobre como Filtrar arboles, yo en lo personal he dejado de usar arboles, por que son bastante lentos y deficientes, pero en algunas aplicaciones es bastante util, de manera que comparto la experiencia y les subo una pequeña explicacion de como filtrar Arboles (generados con el template Relacion Tree), con filtros en runtime que son complejos, y que no podemos hacer con un simple SetFilter(), ya que no existe esto en la propiedad.

Saludos y espero les sirva.

Como filtrar un Tree con solamente tablas:

Dentro del Template para armar los arboles, tiene dentro de Primary y Secondary files la opcion de filtrar, agregando un filtro, pero muchas veces dicho filtro no es tan simple de armar, o necesitamos estarlo cambiando en runtime.

Aqui les presento un caso y como su solucion, esperando que les sirva...

Tengo tres tablas:

Abuelos
Padres
Hijos

Y en la tabla hijos, tengo un campo que define en que nivel de escuela en que va cada hijo: Pre-escolar, Primaria, Secundaria, Bachillerato, Universidad, PostGrado, Maestria y Doctorado.

En la ventana requiero que el usuario pueda filtrar por el nivel escolar, pero con las siguientes condiciones:

1.- El usuario puede seleccionar si quiere ver cualquier combinacion de estudios, es decir, que pueda ver los de primaria y universidad solamente o todos, o ninguno...
2.- Si selecciona un filtro donde resulte que un abuelo o padre no tiene hijos que cumplan la condicion, entonces no debe mostrarnos a esos abuelos y padres...

Considerando que el Tree template, muestra siempre los niveles de acuerdo al filtro que se arma, pues podria convertirse algo engorroso, estar cambiando el filtro, ya que no es una propiedad del relacion tree, tal como sucede con el browse class, sino que el tree filtra a base de If's interpuestos al llenar el queue...

Usando el template y solo poniendo los filtros de NIVELESCOLAR = LOC:MINIVEL, solo mostraria los hijos de un nivel, asi que este metodo no nos servira...

La idea seria entonces que como filtro usaremos una condicion matematica, si la condicion es Verdadera, entonces mostrara el hijo, de lo contrario no lo mostrara.

Asi que con el comando EVALUATE, evaluaremos un filtro, dentro del secondary files, opcion filter, si el filtro es bueno (igual a 1), entonces nos mostrara la info de lo contrario no...

Por ejemplo:

En el secondary files en buscamos la tabla de Hijos y le escribimos en el filtro:

0<EVALUATE(Filtro) ! Si el filtro es valido, entonces nos mostrara el resultado, de lo contrario no...

Declaramos un check box por cada cada condicion, con su respectiva variable: Preescolar, Primaria, Secundaria, etc... que sea tipo byte, con valor true = 1 y valor false = 0

! En el acepted del check box Preescolar... y cada condicion...
Do Filtrar
Display

! En procedure routines
Filtrar Routine
Clear(Filtro) ! Variable para filtrar

If Preescolar Then Filtro = 'HIJ:NIVELESCOLAR=''Preescolar''' ..

If Filtro And Primaria
Filtro = Clip(Filtro) & ' And HIJ:NIVELESCOLAR=''Primaria'''
ElsIf Filtro And Primaria
Filtro = 'HIJ:NIVELESCOLAR=''Primaria'''
End
! Esto se repite con todas las condiciones...
...
...

! Despues de armar el filtro, refrescar el browse...

DO REL4::RefreshTree ! Esta rutina la genera el template, se debe buscar en los modulos su nombre correcto.
POST(EVENT:NewSelection,?RelTree)

Exit

Hasta ahora, lo que se ha logrado es que cuando el usuario seleccione un tipo nivel escolar, nos mostrara o no los hijos, pero resulta, que ahora lo que necesito es que solo me muestre los abuelos que tienen nietos, y los padres que tienen hijos, es entonces por que no tiene caso que el arbol se llene con Mil abuelos, si solo 30 de ellos tienen nietos...

Para hacer debemos entender como se llena el queue del tree, basicamente, el tree, tantas vueltas como combinaciones de nuestra estructura tengamos, es decir, suponiendo que tenemos 3 abuelos, 3 padres, con 3 hijos cada uno, lo que hace el template es:

Por cada Abuelo Barre (con Loop) la tabla Padres por completo 1 vez y selecciono los que me corresponden y por cada padre barro la tabla hijos (con Loop) por completo y selecciono los que me corresponden...

Entonces esta estructura daria 3 x 3 x 3 = 27 vueltas. (Ahora imaginen lo que tarda en entre tablas de 10000 registros...)

Bueno, siguiendo esta idea, entonces lo que necesitamos, es interceptar cada vuelta en el punto donde no queremos que se ingrese al queue y hacer un break.

Conociendo esto buscamos en nuestros embeds, embedido llamado:

RelacionTree After Next Primary File y RelationTree After Next Secondary File...

Aqui buscamos el archivo que requerimos excluir en algunos casos, que es Padres e Hijos, le escribimos en el caso de Padres:

PAD:AbueloId = ABU:AbueloId
If Access:Padres.Fetch(FK AbueloId) ! Si no existen padres que sean dependientes de este abuelo
Break ! hacer el break al Loop del armado del tree...
End

Y el caso de los hijos repetimos la condicion:

HIJ:PadreId = PAD:PadreId
If Access:Hijos.Fetch(FK PadreId) ! Si no existen hijos que sean dependientes de este abuelo
Break ! hacer el break al Loop del armado del tree...
End

El efecto sera que no nos mostrara aquellos padres y abuelos que no tengan hijos.

Si requerimos algo mas complejo podemos usar una vista, en vez de una Fetch a una tabla, pero obviamente se alentara esto cada vez mas y mas al llenar el Arbol.

Nota
Si usamos un motor de SQL, una alternativa mucho mas eficiente es declarar un Vista en nuestro motor y diccionario que sirva de base para llenar el Arbol, con esto aumentaria considerablemente la velocidad.

== Reemplazar caracteres en un string ==
Una rutina generica para reemplazar todas las instancias de un string dentro de otro

Replace PROCEDURE(string find,string replace,*cstring into)
Locate LONG,AUTO
CODE
IF UPPER(find)<>UPPER(replace)
LOOP
Locate = INSTRING(UPPER(find),UPPER(into),1,1)
IF ~Locate THEN RETURN .
into = SUB(into,1,Locate-1) & replace &SUB(into,Locate+LEN(find),LEN(into))
END
END

Para llamarlo:

Replace('Busacr','Reemplazar',Loc:miString)

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Contar los threads abiertos ==
Este código fue posteado por Jeff Slarve
ChildThreadCount Procedure!,Long
Ndx Long
Count Long
T &Window
W &Window
Code

Count = 0
SetTarget
T &= System{PROP:Target}
Loop Ndx = 1 to MaxThreads
SetTarget(,Ndx)
W &= System{PROP:Target}
If NOT W &= T
Count += 1
end
end
SetTarget
Return Count

== Permitir solo una instancia del EXE en ejecucion ==
En Inside the global map:

INCLUDE('CWUTIL.INC'),ONCE

En Global Program Setup:

IF NOT BeginUnique('MiAPP.exe')
BEEP(BEEP:SystemExclamation)
YIELD()
CASE MESSAGE('El programa ya esta ejecutando..','Ho, ho...',ICON:Asterisk,BUTTON:OK,BUTTON:OK,0)
OF BUTTON:OK
HALT()
END
END

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Cambiar los atributos de un archivo ==
(Del FAQ de SoftVelocity)
1. En Global Embeds

A. Before Global Includes:

LPCSTR EQUATE(CSTRING)
DWORD EQUATE(ULONG)

B. Global Data: Equates de los artributos

FILE_ATTRIBUTE_READONLY EQUATE(00000001h)
FILE_ATTRIBUTE_HIDDEN EQUATE(00000002h)
FILE_ATTRIBUTE_SYSTEM EQUATE(00000004h)
FILE_ATTRIBUTE_ARCHIVE EQUATE(00000020h)
FILE_ATTRIBUTE_NORMAL EQUATE(00000080h)
FILE_ATTRIBUTE_TEMPORARY EQUATE(00000100h)

C. Inside Global Map:

Module('Win32.lib')
SetFileAttributes(*CSTRING, ULONG), BOOL, RAW, PASCAL, NAME('SetFileAttributesA')
GetFileAttributes(*CSTRING), ULONG, RAW, PASCAL, NAME('GetFileAttributesA')
END

2. En el codigo:

filename CSTRING(50)

filename = 'test.txt'
y# = GetFileAttributes(filename) ! Leer atributos
y# = SetFileAttributes(filename, FILE_ATTRIBUTE_READONLY)

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Crear directorios ==
Hay 2 opciones:

1- Con Clarion (no sé si estarán estas funciones en versiones anteriores de Clarion)

En "Inside the Global map"
Include('clib.clw')

En Local Data
MiDir Cstring(256)
Ret Long

En tu embed
MiDir = 'Dirtest'
Ret = MkDir(MiDir)

2- Con API
En Global Embeds - inside global map:

MODULE('')
DirAccess(*CSTRING,SHORT=0),SHORT,RAW,NAME('_access'),PROC
MkDir(*CSTRING),SHORT,RAW,NAME('_mkdir'),PROC
DirRename(*CSTRING, *CSTRING), SHORT, RAW, NAME('_rename'),PROC
RmDir(*CSTRING),SHORT,RAW,NAME('_rmdir'),PROC
END

Y en tu embebido podés poner lo siguiente:

Var='O:\test' ! Ojo tiene que ser Cstring
IF DirAccess(Var)<>0 !Si no existe
MkDir(Var) !Crearlo
END

También se puede usar DirRename y RmDir para renombrar o borrar

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Modificar la posicion de un informe ==

Este código permite modificar la posición inicial vertical y horizontal de un informe. Es útil cuando trabajamos con un formulario preimpreso o una hoja membretada y necesitamos desplazar la impresión sin necesidad de reconfigurar el programa.

El punto embebido donde se ubica es After Open the Report.

!=====================================================
! MODIFICAR LA POSICION DEL INFORME
! El pie de página modificarlo sólo si se usa:
! Por ejemplo se pone ahí el Nro de página o algo así.
! No es necesario cambiar los atributos de las bandas
! de detalle adicionales que se usan en el informe.
!-----------------------------------------------------
DesplazamientoX = getini('Parametros',|
'DesplazamientoX','','.\prog.ini')
DesplazamientoY = getini('Parametros',|
'DesplazamientoY','','.\prog.ini')

if DesplazamientoX or DesplazamientoY then
SETTARGET(Report)
x# = report{prop:Xpos}
y# = report{prop:Ypos}
x# += DesplazamientoX
y# += DesplazamientoY
target{prop:Xpos} = x#
target{prop:Ypos} = y#
settarget

SETTARGET(Report,?Encabezado)
x# = ?Encabezado{prop:Xpos}
y# = ?Encabezado{prop:Ypos}
x# += DesplazamientoX
y# += DesplazamientoY
?Encabezado{prop:Xpos} = x#
?Encabezado{prop:Ypos} = y#
settarget

SETTARGET(Report,?PiePagina)
x# = ?PiePagina{prop:Xpos}
y# = ?PiePagina{prop:Ypos}
x# += DesplazamientoX
y# += DesplazamientoY
?PiePagina{prop:Xpos} = x#
?PiePagina{prop:Ypos} = y#
SETTARGET
end

== Generar un informe a partir de una cola en memoria ==

(Sin pasar por el template)

Se puede definir en el módulo en la parte de DATA el reporte necesario y mandarlo a imprimir.

En DATA SECTION

WMFQue QUEUE
PageImage STRING(64)
END
ReportRunDate LONG
ReportRunTime LONG
!!> Report (portrait)
Report REPORT,AT(1000,2000,6000,7000),THOUS,PRE(RPT),FONT('Arial',10)
HEADER,AT(1000,1000,6000,1000)
END
Detail DETAIL
END
FOOTER,AT(1000,9000,6000,1000)
END
FORM,AT(1000,1000,6000,9000)
END
END

Luego, en el botón que imprime, poner el siguiente código:

ReportRunDate = today()
ReportRunDate = today()
ReportRunTime = clock()
OPEN(Report)
LOOP x# = 1 to records(ColaError)
get(ColaError,x#)
PRINT(rpt:DetalleUno)
END
ENDPAGE(Report)
ReportPreview(WMFQue)
IF GlobalResponse = RequestCompleted
Report{PROP:FlushPreview} = True
END
CLOSE(Report)
FREE(WMFQue)

Este proceso usa el Print Preview de Clarion para visualizar el informe, por consiguiente, la apariencia es totalmente normal para el usuario

== Proceso BATCH que funcione sincronizado con el TIMER de la ventana. ==

En un proceso BATCH hecho a mano se puede operar en forma similar al report o al proccess, para eso hay que definir una pantalla que tenga el atributo TIMER (un valor de 1 es suficiente). El código fuente quedaría de la siguiente manera:

open(PantaTrabaja)
Accept
case event()
of event:openwindow
Display()
! Abrir pantalla, Abrir archivos, hacer el set
! Inicial
of event:timer
?Mensaje{prop:text} = 'Procesando...'
display(?Mensaje)
loop 2 times
next(archivo)
if errorcode() then
FinArchivo = true
Break
end
! HACER AQUÍ ALGÚN PROCESO..
end
of event:closewindow
Setcursor()
Close(PantaTrabaja)
Break
End!case

case field()
of ?BotonCancelar
if event() = event:accepted then
message('Proceso cancelado por el usuario.')
post(event:closewindow)
end
End
end!accept

== Drop Combo a mano, con opción a todos y recuerdo de último elegido ==

En muchos de mis informes, cuando pido parámetros asumo lo siguiente, por ejemplo: Si el código de cliente es igual a 0 (cero) se imprimen todos los clientes, sino, se imprime uno solo. Este código permite armar lo mismo con un DropCombo, agregando la opción TODOS LOS XXXX (código Cero).

1. Definir una cola con la siguiente estructura ( por ejemplo ):

Cola QUEUE,PRE(col)
descri STRING(20)
codigo SHORT
END

2. Definir una variable local llamada por ejemplo

Combo1 STRING(20)

3. En la pantalla definir una drop combo a mano, en el campo FROM poner el nombre de la COLA, y en el USE poner Combo1 ( no poner ?Combo1 )

4. Cargar la cola según corresponda después de abrir archivos, poniendo como último dato el código 0 y el texto 'TODOS LOS REGISTROS' y hacer un ADD(Cola,1) para que quede al principio.

5. Definir una variable global ( o local estática) que va a guardar el resultado elegido:

Glo:codigo short

6. En el evento open window, ANTES de abrir la ventana va el siguiente código

loop x# = 1 to records(Cola)
get(Cola,x#)
if col:codigo = glo:codigo then break.
end
Combo1 = col:descri
?Combo1{prop:selected} = x#

7. Al hacer esto, el combo se abre posicionado en el último elemento elegido o en TODOS LOS REGISTROS si es la primera vez.

== En un report, poner los totales en otra página ==

En algún informe, se puede solicitar como parámetro la opción de imprimir los totales correspondientes en una página nueva. Para ello, después de abrir el report:

if glo:totpag then
settarget(report)
?TituloTotalCategoria{prop:pagebefore} = 1
end

== En un report, cambiar el color de un campo según alguna condición ==

Si durante la impresión de un informe se desea cambiar algún atributo (tal como el color) de un campo puede hacer lo siguiente (antes de imprimir el detalle):

if cl:impotota <> cl:totacalc
settarget(report)
?ARC:importe{PROP:FONTCOLOR} = COLOR:RED
settarget(ProgressWindow)
else
settarget(report)
?ARC:importe{PROP:FONTCOLOR} = COLOR:NONE
settarget(ProgressWindow)
end
print(rpt:Detalle) ! Imprimir la línea de detalle

== Cerrar todas las ventanas abiertas ==
LOOP Thrd# = 2 TO 64 !1 es el Frame
POST(Event:CloseWindow,,Thrd#)
END

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Abrir cualquier archivo con ShellExecute ==
Hay varios templates gratis que implementan Shellexecute, por ejemplo:
http://www.sterlingdata.com/shellex.htm

Para hacerlo con codigo:

En Global-embed 'Inside the Global Map':
Module('Win32.lib')
ShellExecute(Long,*CString,*CString,*CString,*CString,Short),UShort,PASCAL,RAW,NAME('ShellExecuteA')
END

En Local Data
LOC:Handle LONG
LOC:Op CSTRING (255)
LOC:File CSTRING (255)
LOC:Path CSTRING (255)
LOC:Param CSTRING (255)
LOC:Show LONG
LOC:RetHandle LONG

En el embed
LOC:Handle = 0{PROP:Handle}
LOC:Op = 'Open'
LOC:File = 'C:\TEST.TXT'
LOC:Path = PATH()
LOC:Param = ' '
LOC:Show = 1
LOC:RetHandle = ShellExecute(LOC:Handle,LOC:Op,LOC:File,LOC:Param,LOC:Path,LOC:Show)
If LOC:Rethandle <> 0 Then
Message('Error','Error',Icon:Exclamation)
End

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Abrir una pagina WEB con ShellExecute ==
(Ver declaraciones del API y variables en el ejemplo anterior)

En el embed
LOC:Handle = 0{PROP:Handle}
LOC:Op = 'Open'
LOC:File = 'http://www.templatesclarion.com.ar'
LOC:Path = ' '
LOC:Param = ' '
LOC:Show = 1
LOC:RetHandle = ShellExecute(LOC:Handle,LOC:Op,LOC:File,LOC:Param,LOC:Path,LOC:Show)

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Convertir un LONG a un String Binario ==
binario='' !binario es CSTRING
LOOP F# = 1 TO 32
IF BAND(abinario, 1) !abinario es LONG
binario = '1' & binario
ELSE
binario = '0' & binario
END
abinario = abinario / 2
if abinario = 0 then break.
END

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Convertir un string binario a LONG ==
Para volver del CSTRING al LONG seria simplemente
X# = EVALUATE (binario & 'b')

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Copiar la QUEUE (solo lo que se esta viendo) de un browse a Excel ==
Copiar='' !Cstring de 4.000.000
LOOP C#= 1 TO BRW1.View{Prop:Fields}
!Primero una fila con los titulos
Copiar= Copiar & ?Browse:1{PropList:Header,C#} & '<9>'
END
Copiar= Copiar &'<13,10>'

LOOP F# = 1 TO RECORDS(BRW1.Q)
LOOP C#= 1 TO BRW1.View{Prop:Fields}
GET(BRW1.Q, F#)
Copiar= Copiar & FORMAT(WHAT(BRW1.Q, C#), ?Browse:1{PropList:Picture,C#}) & '<9>'
END
Copiar= Copiar &'<13,10>'
END
SETCLIPBOARD(Copiar)

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Copiar el VIEW (cuidado: se lee todo) de un browse a Excel ==
Copiar='' !CSTRNG de 4.000.000
LOOP C#= 1 TO BRW1.View{Prop:Fields}
Copiar= Copiar & ?Browse:1{PropList:Header,C#} & '<9>'
END
Copiar= Copiar &'<13,10>'

SET (BRW1.View)
LOOP
NEXT(BRW1.View)
IF ERRORCODE() THEN BREAK.
BRW1.SetQueueRecord
LOOP C#= 1 TO BRW1.View{Prop:Fields}
Copiar= Copiar & FORMAT(WHAT(BRW1.Q, C#), ?Browse:1{PropList:Picture,C#}) & '<9>'
END
Copiar= Copiar &'<13,10>'
END
SETCLIPBOARD(Copiar)

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

Para que no lea todo el contenido del archivo, sino que procese estrictamente lo mismo que muestra el browse, basta con agregar la antes del BRW1.SetQueueRecord el llamado a BRW1.ValidateRecord().
...
LOOP
NEXT(BRW1.View)
IF ERRORCODE() THEN BREAK.
IF BRW1.ValidateRecord() THEN CYCLE.
BRW1.SetQueueRecrod
...

Daniel Ruzo

== Mostrar iconos en un listbox desde una queue ==
Ejemplo: marcar en una cola de memoria si un empleado tiene entrada y/o salida

Primero agregar los iconos al Project

En el Codigo:

cola_empleados queue, pre(que)
nombre string(30)
entro long
entro_ico long
salio long
salio_ico long
end

En el list:

primer campo: nombre

segundo campo: entro, picture @p p, iconized, transparente

tercer campo: salio, picture @p p, iconized, transparente

En el init de la pantalla:

?list{prop:iconlist,1} = '~no.ico'
?list{prop:iconlist,2} = '~si.ico'

Donde cargo la cola y la muestro:

if condicion (si NO hay entrada)
que:entro_ico = 1 ! icono de no
else
que:entro_ico = 2 !icono de si
end
if condicion (si NO hay salida)
que:salio_ico = 1 ! icono de no
else
que:salio_ico = 2 !icono de si
end
! otras asignaciones
add(cola_empleados)
!
display(?list)

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Calcular Días Hábiles ==

Ante todo necesitas una tabla de feriados, con al menos un campo llamado,
por ej., diaferiado y una clave por dicho campo.

Luego podés hacer lo siguiente

habiles# = 0
loop dia# = FechaInicial to FechaFinal
if (Dia# % 7) = 0 then cycle. ! porque es domingo
if (Dia# % 7) = 6 then cycle. ! porque es sabado
!
! busco si es feriado
!
clear(feriado:record)
feriado:diaferiado = dia#
if access:feriado.fetch(Feriado:PorDia) = level:benign then cycle. !porque es feriado
!
habiles# += 1
end!loop
corridos# = fechafinal - fechainicial

Si los cálculos que vas a realizar son muchos y continuos, sería conveniente
que la tabla de feriados la cargues en una queue y realices las búsquedas
sobre ella.

Adrian Gallegos - Mega Sistemas S.R.L.

Otra opción: Días Hábiles del mes - Rutina que quita los días sábados y domingos del mes

CONTAR_DIAS ROUTINE
LOC:DIAS = 0
tope# = 1
LOOP UNTIL DAY(LOC:FECHA) = tope#
CASE LOC:FECHA % 7
of 0 ! Domingo
LOC:FECHA = LOC:FECHA - 1
CYCLE
of 6 ! sabado
LOC:FECHA = LOC:FECHA - 1
CYCLE
ELSE
LOC:DIAS += 1
LOC:FECHA = LOC:FECHA - 1
END !CASE
END !LOOP
IF LOC:FECHA % 7 = 0 or LOC:FECHA % 7 = 6 THEN !si el primero es feriado
! nada
else
LOC:DIAS += 1
END !IF

Julio César Britez

== Último día del mes y cantidad de días (Lunes, Martes, etc) entre 2 Fechas ==
Incluye el truco de saber el último día del mes: en la parte " Date(4,1,2005)-1 " significa que le resto 1 al primer día del mes siguiente, lo cual es una forma de obtener el último día del mes actual...

Loop Fecha# = Date(3,1,2005) TO (Date(4,1,2005)-1)
EXECUTE (Fecha# % 7) + 1
Domingo# +=1
Lunes# +=1
Martes# +=1
Miercoles# +=1
Jueves# +=1
Viernes# +=1
Sabado# +=1
END
END

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Fecha en Español (por ejemplo en el Frame)==
Si quieres que funcione independientemente de como este configurado windows,
lo mejor es poner este embed, al final de WindowManager.Init

EXECUTE (TODAY() % 7) + 1
Dia"= 'Domingo'
Dia"= 'Lunes'
Dia"= 'Martes'
Dia"= 'Miercoles'
Dia"= 'Jueves'
Dia"= 'Viernes'
Dia"= 'Sabado'
END

EXECUTE (MONTH(TODAY()))
Mes" = 'Enero'
Mes" = 'Febrero'
Mes" = 'Marzo'
Mes" = 'Abril'
Mes" = 'Mayo'
Mes" = 'Junio'
Mes" = 'Julio'
Mes" = 'Agosto'
Mes" = 'Septiembre'
Mes" = 'Octubre'
Mes" = 'Noviembre'
Mes" = 'Diciembre'
END
AppFrame{Prop:StatusText,1} = CLIP(Dia") & ' ' & DAY(TODAY()) & ' de ' &
CLIP(Mes")

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

Dia" = Choose(((TODAY() % 7) + 1),'Domingo','Lunes','Martes','Miercoles','Jueves','Viernes','Sabado')

Javier A. Junca Barreto [http://www.sicya.com (SICyA Software - Colombia)]

== Obtener la fecha del server ==
Este código lee la fecha del servidor, usando el truco de crear un archivo en el servidor y leer la fecha y hora de los atributos:

!Data
LOC:TMP STRING(254),STATIC
TMP FILE,DRIVER('Ascii'),CREATE,NAME(LOC:TMP)
RECORD RECORD
LIN STRING(1)
.
.
FILS QUEUE(File:queue),PRE(FIL)
END

CODE
LOC:TMP = PATH()&'\TMP'&RANDOM(10000,99999)&'.TMP'
CREATE(TMP)
IF NOT ERRORCODE()
DIRECTORY(FILS,LOC:TMP,0)
REMOVE(TMP)
GET(FILS,1)
IF TODAY() <> FIL:DATE OR ABS(CLOCK()-FIL:TIME) > 100
!FECHA DIFERENTE O 1 SEGUNDO DE DESFASE
SETTODAY(FIL:DATE)
SETCLOCK(FIL:TIME)
END
ELSE
REMOVE(TMP)
END

Carlos Gutierrez

''Con SQL''

La sugerencia de Carlos es muy buena. Si estás usando SQL o drivers ODBC, la otra opción es preguntarle la fecha al motor de base de datos.

La forma genérica de hacerlo es:
temp{prop:sql}='SELECT {fn curdate() }'

''Con NET TIME''

Posteado por Diego Sánchez al foro.
Run('NET TIME \\Server_Name /SET /Y')
Reemplazar "Server_Name" por el nombre del servidor o equipo del cual se desea obtener la hora
Fue posteado originalmente por un NICOLAS VEILLEUX nveilleux@nbautomation.com, en el foro comp.lang.clarion

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Llamar a un Stored Procedure ==
El código sería mas o menos asi:
L:Query = 'CALL NombreDelStored (''' & FORMAT(ParamFecha,@D12) & ''', ''' &
FORMAT(OtraFecha,@D12) & ''', ' & OtroParam1 &', ' & OtroParam2 &', ' &
OtroParam3 &' )'

ResSQL{prop:sql} = L:Query
Loop Until Access:ResSql.Next()
MiVariable = R:Campo1
etc = R:Campo2
....
END

En la tabla auxiliar ResSQL obtienes el resultado del último SELECT que
tenga el Stored Procedure.

Para mas detalles ver el documento sobre SQL Embebido [http://templatesclarion.com.ar/downloads/ (Templates Clarion)]

También recomiendo leer el help "MSSQL Accelerator Calling a Stored
Procedure". Ahi está explicado además el uso de valores de retorno y parámetros de salida.

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Encriptación básica ==
Encriptación / desencriptación básica de un campo usando el metodo XOR.
!la primera vez encripta
!al volver a aplicar el algoritmo con la misma
!Clave de encriptado: desencripta
X# = 1
loop Y# = 1 to Len(Campo)
Campo [Y#] = chr(bxor(val(Campo[Y#]), val(ClaveEncriptado[X#])))
X# += 1
if X# > len (ClaveEncriptado) then X# = 1.
end
display

!Campo y ClaveEncriptado son campos CString

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Generar un archivo de Texto a máxima velocidad==
Estas son las APIs para generar un archivo de texto sin necesidad de declararlo en el Diccionario.

Además es muy rápido, ideal para exportaciones.

En Global - Inside Global map:

MODULE('Windows API')
_lcreat(*CSTRING,SIGNED),SIGNED,PASCAL,RAW
_hwrite(SIGNED,*CSTRING,LONG),LONG,PASCAL,RAW
_lclose(SIGNED),SIGNED,PASCAL
END

Por ejemplo para guardar el contenido de un control Text

IF NOT FILEDIALOG('Guardar como',FileName,'Text|*.TXT|Source|*.CLW',FILE:Save + FILE:LongName)
CYCLE
END
F# = _lcreat(FileName,0)
X# = _hwrite(F#,Texto,LEN(Texto))
X# = _lclose(F#)

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Efecto BLINK en un campo ==
Tienes que crear un timer en la ventana, para eso ponle cada cuanto se va a
ejecutar en la propiedad timer de la ventana. Son centesimas de seg, asi que
si le pones 50 por ejemplo tu campo va a titilar 2 veces por segundo.

Luego cierra la ventana, vuelve a entrar y vas a encontrar un evento timer
de la ventana en los embeds.

Window Events --> Timer
if ?campo{prop:background} = COLOR:WHITE
?campo{prop:background} = COLOR:SILVER
else
?campo{prop:background} = COLOR:WHITE
end

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Función para calcular dígito verificador en CUIT ==
- La siguiente función devuelve el numero de CUIT con el dígito verificador
correcto.
- El parámetro que recibe es el numero de CUIT a revisar incluyendo el
dígito verificador.

...
CuitCliente='20-15433984-6'
IF Cuit(CuitCliente)=CuitCliente THEN
MESSAGE('Digito verificador correcto')
ELSE
MESSAGE('Digito verificador incorrecto')
END
...

Cuit PROCEDURE(cuit1)
cuit2 STRING(255)
digver LONG
lon LONG
fac LONG
car STRING(1)

CODE
cuit2=cuit1
digver=0
fac=2
lon=LEN(CLIP(cuit2))
LOOP i#=lon-1 TO 1 BY -1
car=SUB(cuit2,i#,1)
IF car<'0' OR car>'9' THEN
CYCLE
.
digver=digver+(car*fac)
fac+=1
IF fac>7 THEN
fac=2
.
.
digver=11-(digver%11)
IF digver>9 THEN
digver=0
.
cuit2=SUB(cuit2,1,lon-1) & FORMAT(digver,@n01)
RETURN(cuit2)

Este codigo esta en la documentacion del template de Impresoras Fiscales
(BIGSYS TEMPLATES) del amigo Juan Carlos Rodríguez

== Validar Email ==
Puedes hacerlo con MATCH, el cual devuelve 1 o 0 si el mail no es valido.
Ejemplo:

X# = MATCH(UPPER(CLIP(locemail)),|
'^[-A-Z0-9._]+@{{[-A-Z0-9._]+.}+[A-Z][A-Z][A-Z]?[A-Z]?$', Match:Regular)

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Restar Horas==
Para sacar la diferencia entre horas es simplemente:
resultado = hora2 - hora + 1

El +1 es porque sino que faltaria un segundo cuando muestres el resultado (en formato @T6, por ej)

Si Hora2 es del dia siguiente, la cuenta seria:
resultado = (hora2 +(100*60*60*24)) - hora + 1

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

== Digito Verificador para 5 digitos ==

Si tenes un numero de 5 digitos y deses verificar que el mismo es ingresado correctamente podes usar este codigo que genera un digito verificador

Crea una funcion que tenga un parametro (numero a verificar) y retorne el digito verificador correspondiente ejem: DigitoV5(LONG xNumero),BYTE

loc:Numero = xNumero

loc:Valor = (loc:Numero[1]*5) + |
(loc:Numero[2]*4) + |
(loc:Numero[3]*3) + |
(loc:Numero[4]*2) + |
(loc:Numero[5]*7)

IF (loc:Valor%5) + 1 = 0 OR (loc:Valor%5) + 1 = 1
loc:Digito = 0
ELSE
loc:Digito = 6 - ((loc:Valor%5) + 1)
END

RETURN loc:Digito

Ruben Garcia [http://www.dipsarg.com (DiPS)]

== Digito Verificador para Cualquier Longitud ==

Si no sabes que longitud puede tener el numero a verificar podes probar verificarla con este codigo

Crea una funcion cuyo parametro es el numero a verificar y retorne el digito verificador. Ej. DigitoV(STRING xNumero),BYTE

!Inicializa
loc:Numero = xNumero
loc:Valor = 0
loc:Multiplo = 1

!Barrido y calculo
LOOP loc:Posicion = LEN(CLIP(loc:Numero)) TO 1 BY -1
loc:Multiplo += 1
IF loc:Multiplo > 7
loc:Multiplo = 2
END
loc:Valor += loc:Numero[loc:Posicion] * loc:Multiplo
END

loc:Digito = loc:Valor % 11

IF loc:Digito = 10
loc:Digito = 0
END

RETURN loc:Digito

Ruben Garcia [http://www.dipsarg.com (DiPS)]

== Autoincremento Manual ==

Esto se utiliza cuando tenemos una tabla en la cual queremos manejar la clave de auto incremento

CLEAR(MASTER)
SET(MAS:ClavePorID, MAS:ClavePorID)
ACCES:MASTER.Previous()
IF MAS:Id = 0 THEN
MAS:Id = 1
ELSE
MAS:Id = MAS:Id +1
END

!!!MAS:Id TENDRÍA EL VALOR DEL PROXIMO NUMERO.-

Gracias [mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

Nota: El mecanismo descrito es "confiable" sólo para aplicaciones que usan TPS y en modo single-user. Para Multiusuario y SQL hay que tener cuidado con las lecturas simultáneas del último valor.
También puede simplificarse el "if ... then ... else ..." como "MAS:Id = MAS:Id +1" (si es cero, será 1, no hace falta chequearlo)

== Desabilitar menu desde cualquier procedimiento ==
Una opcion seria usando NOTIFY.
En el Frame
Window Events
Notify
DISABLE = VariableGlobal

En cualquier procedimiento que se necesite deshabilitar un menu

VariableGlobal = Nro de Use del Menu
NOTIFY (999, 1)

Puede ser 999 o cualquier cosa ya que no estoy usando ese parametro.
(bueno, en realidad podria usar ese parametro en lugar de la global...)
1 es el Tread del Frame

Como desde los otros procedimientos no existen los use del los items de menu
(o sea ?menuitem) lo que hay que hacer es ponerles un numero a cada uno.
Esto se logra poniendolos de esta manera ?use, numero en la definicion del
menu.

[mailto:Fernando_Cerini@hotmail.com Fernando Cerini]

==Formatear fechas en SQL ==
Les paso una función que utilizo para trabajar con las fechas en el SQL parecido al format de clarion. Es muy útil.

CREATE FUNCTION dbo.FormatDateTime
(
@dt DATETIME,
@format VARCHAR(16)
)
RETURNS VARCHAR(64)
AS
BEGIN
DECLARE @dtVC VARCHAR(64)
SELECT @dtVC = CASE @format

WHEN 'LONGDATE' THEN

DATENAME(dw, @dt)
+ ',' + SPACE(1) + DATENAME(m, @dt)
+ SPACE(1) + CAST(DAY(@dt) AS VARCHAR(2))
+ ',' + SPACE(1) + CAST(YEAR(@dt) AS CHAR(4))

WHEN 'LONGDATEANDTIME' THEN

DATENAME(dw, @dt)
+ ',' + SPACE(1) + DATENAME(m, @dt)
+ SPACE(1) + CAST(DAY(@dt) AS VARCHAR(2))
+ ',' + SPACE(1) + CAST(YEAR(@dt) AS CHAR(4))
+ SPACE(1) + RIGHT(CONVERT(CHAR(20),
@dt - CONVERT(DATETIME, CONVERT(CHAR(8),
@dt, 112)), 22), 11)

WHEN 'SHORTDATE' THEN

LEFT(CONVERT(CHAR(19), @dt, 0), 11)

WHEN 'SHORTDATEANDTIME' THEN

REPLACE(REPLACE(CONVERT(CHAR(19), @dt, 0),
'AM', ' AM'), 'PM', ' PM')

WHEN 'UNIXTIMESTAMP' THEN

CAST(DATEDIFF(SECOND, '19700101', @dt)
AS VARCHAR(64))

WHEN 'YYYYMMDD' THEN

CONVERT(CHAR(8), @dt, 112)

WHEN 'YYYY-MM-DD' THEN

CONVERT(CHAR(10), @dt, 23)

WHEN 'YYMMDD' THEN

CONVERT(VARCHAR(8), @dt, 12)

WHEN 'YY-MM-DD' THEN

STUFF(STUFF(CONVERT(VARCHAR(8), @dt, 12),
5, 0, '-'), 3, 0, '-')

WHEN 'MMDDYY' THEN

REPLACE(CONVERT(CHAR(8), @dt, 10), '-', SPACE(0))

WHEN 'MM-DD-YY' THEN

CONVERT(CHAR(8), @dt, 10)

WHEN 'MM/DD/YY' THEN

CONVERT(CHAR(8), @dt, 1)

WHEN 'MM/DD/YYYY' THEN

CONVERT(CHAR(10), @dt, 101)

WHEN 'DDMMYY' THEN

REPLACE(CONVERT(CHAR(8), @dt, 3), '/', SPACE(0))

WHEN 'DD-MM-YY' THEN

REPLACE(CONVERT(CHAR(8), @dt, 3), '/', '-')

WHEN 'DD/MM/YY' THEN

CONVERT(CHAR(8), @dt, 3)

WHEN 'DD/MM/YYYY' THEN

CONVERT(CHAR(10), @dt, 103)

WHEN 'HH:MM:SS 24' THEN

CONVERT(CHAR(8), @dt, 8)

WHEN 'HH:MM 24' THEN

LEFT(CONVERT(VARCHAR(8), @dt, 8), 5)

WHEN 'HH:MM:SS 12' THEN

LTRIM(RIGHT(CONVERT(VARCHAR(20), @dt, 22), 11))

WHEN 'HH:MM 12' THEN

LTRIM(SUBSTRING(CONVERT(
VARCHAR(20), @dt, 22), 10, 5)
+ RIGHT(CONVERT(VARCHAR(20), @dt, 22), 3))

ELSE

'Invalid format specified'

END
RETURN @dtVC
END
GO

Ejemplos:

DECLARE @now DATETIME
SET @now = GETDATE()

PRINT dbo.FormatDateTime(@now, 'LONGDATE')
PRINT dbo.FormatDateTime(@now, 'LONGDATEANDTIME')
PRINT dbo.FormatDateTime(@now, 'SHORTDATE')
PRINT dbo.FormatDateTime(@now, 'SHORTDATEANDTIME')
PRINT dbo.FormatDateTime(@now, 'UNIXTIMESTAMP')
PRINT dbo.FormatDateTime(@now, 'YYYYMMDD')
PRINT dbo.FormatDateTime(@now, 'YYYY-MM-DD')
PRINT dbo.FormatDateTime(@now, 'YYMMDD')
PRINT dbo.FormatDateTime(@now, 'YY-MM-DD')
PRINT dbo.FormatDateTime(@now, 'MMDDYY')
PRINT dbo.FormatDateTime(@now, 'MM-DD-YY')
PRINT dbo.FormatDateTime(@now, 'MM/DD/YY')
PRINT dbo.FormatDateTime(@now, 'MM/DD/YYYY')
PRINT dbo.FormatDateTime(@now, 'DDMMYY')
PRINT dbo.FormatDateTime(@now, 'DD-MM-YY')
PRINT dbo.FormatDateTime(@now, 'DD/MM/YY')
PRINT dbo.FormatDateTime(@now, 'DD/MM/YYYY')
PRINT dbo.FormatDateTime(@now, 'HH:MM:SS 24')
PRINT dbo.FormatDateTime(@now, 'HH:MM 24')
PRINT dbo.FormatDateTime(@now, 'HH:MM:SS 12')
PRINT dbo.FormatDateTime(@now, 'HH:MM 12')
PRINT dbo.FormatDateTime(@now, 'goofy')

Posteado al foro por Omar Squiabro

== Anular Tecla Escape ==

Hay veces que se necesita que el usuario salga de una FORM o de una ventana solo cuando pulse un determinado boton o se halla completado alguna condicion. Y en estos casos puede suceder que si el usuario pulsa la tecla ESC cause algun problema

Primero hay que activar la alerta de la tecla esc en el INIT de la ventana

ALERT(EscKey)

Despues en el evento alertkey

IF KEYCODE() = EscKey
SELECT(?UnDeterminadoCampo) !1= al primero
RETURN Level:Notify
END

Si el codigo embebido es puesto despues del codigo generado por clarion reemplazar el RETURN por CYCLE

Ruben Garcia [http://www.programaya.com (DiPS)]

== Convertir Número Hexadecimal a Binario ==
A veces, y sobre todo al trabajar con estados de puertos de comunicaciones, necesitamos convertir numeros hexadecimales a binario para establecer errores o tratar envios y recepciones.
Esta función hace justamente esto de forma sencilla.

HexaABinario PROCEDURE(PAR:Nhexa) ! (String),String
HBinario String(4),dim(16) !Equivalencias
RetuBina String(100) !Variable Retorno

CODE
HBinario[01] = '0000' ! 0h
HBinario[02] = '0001' ! 1h
HBinario[03] = '0010' ! 2h
HBinario[04] = '0011' ! 3h
HBinario[05] = '0100' ! 4h
HBinario[06] = '0101' ! 5h
HBinario[07] = '0110' ! 6h
HBinario[08] = '0111' ! 7h
HBinario[09] = '1000' ! 8h
HBinario[10] = '1001' ! 9h
HBinario[11] = '1010' ! Ah 65
HBinario[12] = '1011' ! Bh 66
HBinario[13] = '1100' ! Ch 67
HBinario[14] = '1101' ! Dh 68
HBinario[15] = '1110' ! Eh 69
HBinario[16] = '1111' ! Fh 70
CLEAR(RetuBina)
PAR:NHexa = UPPER(PAR:NHexa) !Aseguro letras en mayusculas
LOOP I# = 1 to LEN(CLIP(PAR:NHexa))
IF NUMERIC(PAR:NHexa[I#]) THEN !Si es numero es <= 9
!Asigno equivalente
RetuBina = CLIP(RetuBina) & HBinario[PAR:NHexa[I#]+1]
ELSE
!Asigno equivalente tomando,por ejemplo, 65 - 54 = 11 para "A"
RetuBina = CLIP(RetuBina) & HBinario[VAL(PAR:NHexa[I#])-54]
END
END
!Retorno la cadena binaria sin ceros a la izquierda
RETURN(SUB(RetuBina, INSTRING('1',RetuBina), LEN(CLIP(RetuBina))))

Bueno, espero les sea de utilidad!

Mario A. Wojcik

== Transacciones, TCF, Logout, Commit, Rollback ==

Solucion al tema del TCF, crearlo, verlo, etc.

Paso 1
En el punto embebido del FRAME (windowsManager init (priority 6100) o sea antes que se abra ningun archivo,
Insertar el siguiente codigo:
<pre>
GLO:Datos:TCF = 'TCF=' & CLIP(GLO:WorkDir) & '\' & 'AR.TCF'
Send(CLIENTES,GLO:Datos:TCF)
</pre>
Nota 1:
No es necesario definir en ningun lado el archivo .TCF ni su estructura porque de todo se encarga el driver.
Nota 2:
no enviar (SEND) los datos para el .TCF desde el diccionario, según los autores, esto no funciona.
Nota 3: Solo es necesario un archivo .TCF para toda la aplicación.

Listo, el archivo de control de transacciones ya esta creado y sin dudas funcionara.
Para que todo quede completo deberiamos hacer:
<pre>
LOGOUT(1,CabeceraFactura,DetalleFactura) !Comienza la transaccion
DO ErrHandler !Chequear errores
ADD(CabeceraFactura) !Agregar registro al padre
DO ErrHandler !
LOOP X# = 1 TO RECORDS(DetailQue) !Procesar los registros almacenados
GET(DetailQue,X#) !traer uno de la Cola
DO ErrHandler !
Det:Record = DetailQue !Asignar al record buffer
ADD(DetalleFactura) !Hacer el Add al archivo
DO ErrHandler !
END
COMMIT !Terminar la transaccion, todo OK
ASSERT(~ERRORCODE())

ErrHandler ROUTINE !Runina de manejo de errores
IF NOT ERRORCODE() THEN EXIT. !Sale si no hay errores
Err" = ERROR() !Guarda el mensaje de error
ROLLBACK !Anula la transaccion
ASSERT(~ERRORCODE())
BEEP !Avisa al usuario
MESSAGE('Transaction Error - ' & Err")
RETURN
</pre>
Lo anterior es copia de la ayuda del manual de Clarion 6.3

Para verificar que exista realmente el archivo .TCF podemos usar en cualquer punto de la aplicación lo siguiente:

Poner un string variable en pantalla y en un boton:

Loc:Tcf = SEND(CLIENTES, 'TCF')
DISPLAY()

Eso deberia ser todo. Por lo menos para mi funciona.