Codigo Util
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)
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
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)
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
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
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
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)
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
Convertir un string binario a LONG
Para volver del CSTRING al LONG seria simplemente
X# = EVALUATE (binario & 'b')
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)
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)
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)
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
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")
Dia" = Choose(((TODAY() % 7) + 1),'Domingo','Lunes','Martes','Miercoles','Jueves','Viernes','Sabado')
Javier A. Junca Barreto (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
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 (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.
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
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#)
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
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)
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
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 (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 (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 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)
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.
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 (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:
GLO:Datos:TCF = 'TCF=' & CLIP(GLO:WorkDir) & '\' & 'AR.TCF' Send(CLIENTES,GLO:Datos:TCF)
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:
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
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()
Eso deberia ser todo. Por lo menos para mi funciona. Carlos Barroso DBA Oracle Programador Clarion