yo tengo parecido pero es para seleccionar permisos para usaurios, seria cambiarlos por los dias de la semana
almacena los datos en un arreglo en un ca<mpo numerico o de caracter.
STATIC PROCEDURE Usuarios_Permisos()
LOCAL lGrabar := FALSE
LOCAL oError
LOCAL cModulo, x
PRIVATE oDlgMod, oBrwM
PRIVATE aModulos1 := {}
PRIVATE aModulos2 := {}
AAdd( aModulos1, { FALSE, "C_CLIENTES", "Catalogo de clientes" } )
AAdd( aModulos1, { FALSE, "D_PRESTAMO", "Detalle de prestamo" } )
AAdd( aModulos1, { FALSE, "P_PRESTAMOS", "Programación de prestamos" } )
AAdd( aModulos1, { FALSE, "R_DESEMBOLSO", "Registro de desembolsos" } )
AAdd( aModulos1, { FALSE, "C_APERTURA", "CAJA->Apertura de caja" } )
AAdd( aModulos1, { FALSE, "C_DESEMBOLSO", "CAJA->Desembolso de prestamo" } )
AAdd( aModulos1, { FALSE, "C_DIFERIDO", "CAJA->Abono en oficina" } )
AAdd( aModulos1, { FALSE, "C_FLUJO", "CAJA->flujo de efectivo por ruta" } )
AAdd( aModulos1, { FALSE, "C_OTROS", "CAJA->Otros movimientos" } )
AAdd( aModulos1, { FALSE, "C_COMPRA", "CAJA->Comprar dolares" } )
AAdd( aModulos1, { FALSE, "C_VENTA", "CAJA->Venta dolares" } )
AAdd( aModulos1, { FALSE, "C_TASA", "CAJA->Tasa de cambio" } )
AAdd( aModulos1, { FALSE, "R_COBRO", "Registro de cobro por ruta" } )
AAdd( aModulos1, { FALSE, "R_FINANCIEROS", "Reportes financieros" } )
AAdd( aModulos1, { FALSE, "T_USUARIOS", "TABLAS->Usuarios y permisos" } )
AAdd( aModulos1, { FALSE, "T_PLAZOS", "TABLAS->Plazos de pagos" } )
AAdd( aModulos1, { FALSE, "T_FERIADOS", "TABLAS->Feriados" } )
AAdd( aModulos1, { FALSE, "T_ZONAS", "TABLAS->Zonas" } )
AAdd( aModulos1, { FALSE, "T_CIUDADES", "TABLAS->Ciudades" } )
AAdd( aModulos1, { FALSE, "T_COBRADORES", "TABLAS->Cobradores" } )
AAdd( aModulos1, { FALSE, "T_GESTORES", "TABLAS->Gestores" } )
AAdd( aModulos1, { FALSE, "T_RUTAS", "TABLAS->Rutas de cobro" } )
AAdd( aModulos1, { FALSE, "T_REORGANIZAR", "TABLAS->Reorganizar datos" } )
aModulos2 := StringToArray( USUA->MODULOS )
FOR EACH cModulo IN aModulos2
nPos := AScan( aModulos1, {|aItem| aItem[ 2 ] == cModulo } )
IF nPos > 0
aModulos1[ nPos, 1] := TRUE
ENDIF
NEXT
DEFINE DIALOG oDlgMod NAME "DLG_USUARIOP" OF oDlg ICON GetIcon() FONT oFontD
REDEFINE SAY PROMPT ( "Accesos de " + RTrim( USUA->NOMBRE ) ) ID 101 OF oDlgMod COLOR CLR_WHITE, CLR_BLUE
REDEFINE XBROWSE oBrwM ID 102 OF oDlgMod ;
COLUMNS 1, 3 ;
HEADERS "Permitir", "Descripción de modulo" ;
SIZE 100, 150 ;
ARRAY aModulos1 ON DBLCLICK Usuarios_CambiaAcceso() FONT oFontD
oBrwM:MyConfig()
oBrwM:aCols[ 1 ]:SetCheck( { "BMS_CHECKON", "BMS_CHECKOFF" } )
oBrwM:bKeyDown := {|nKey| IIf( nKey==VK_RETURN .or. nKey==VK_SPACE, Usuarios_CambiaAcceso(), NIL ) }
REDEFINE BUTTON ;
ID 201 OF oDlgMod ;
ACTION ( lGrabar := TRUE, oDlgMod:end() )
REDEFINE BUTTON ;
ID 202 OF oDlgMod ;
ACTION ( lGrabar := FALSE, oDlgMod:end() )
ACTIVATE DIALOG oDlgMod
IF lGrabar
aModulos2 := {}
FOR x := 1 TO Len( aModulos1 )
IF aModulos1[ x, 1 ] == TRUE
AAdd( aModulos2, aModulos1[ x, 2 ] )
ENDIF
NEXT
TRY
AdsBeginTransaction()
IF USUA->( DBLockRec() )
USUA->MODULOS := Val2PrgExp( aModulos2 )
ENDIF
AdsCommitTransaction()
CATCH oError
AdsRollBack()
ShowError( oError )
END
RecordsUnLock( "USUA" )
MsgInfo( "Permisos actualizados!" )
ENDIF
oBrw:SetFocus()
RETURN
FUNCTION Val2PrgExp( xVal )
LOCAL cType := ValType( xVal )
LOCAL aVar, cRet
SWITCH cType
CASE 'C'
IF !( '"' IN xVal )
RETURN '"' + xVal + '"'
ELSEIF !( "'" IN xVal )
RETURN "'" + xVal + "'"
ELSEIF ( ! "[" IN xVal ) .AND. ( ! "]" IN xVal )
RETURN "[" + xVal + "]"
ELSE
Throw( ErrorNew( "VAL2PRGEXP", 0, 3102, ProcName(), "No se puede convertir a cadena", { xVal } ) )
EXIT
ENDIF
CASE 'D'
RETURN "STOD( '" + dToS( xVal ) + "' )"
CASE 'L'
RETURN IIF( xVal, ".T.", ".F." )
CASE 'N'
RETURN Ltrim( Str( xVal ) )
CASE 'A'
cRet := "{"
FOR EACH aVar IN xVal
cRet += ( Val2PrgExp( aVar ) + "," )
NEXT
IF cRet[ -2 ] == ','
cRet[ -2 ] := ''
ENDIF
cRet[ -1 ] := '}'
RETURN cRet
DEFAULT
IF xVal == NIL
cRet := "NIL"
ELSE
Throw( ErrorNew( "VAL2PRGEXP", 0, 3103, ProcName(), "Tipo no soportado", { xVal } ) )
ENDIF
END
RETURN cRet
/*-------------------------------------------------------------------------------------------------*/
FUNCTION StringToArray( cString )
LOCAL aArray := {}
LOCAL oError := NIL
IF !Empty( cString )
cString := AllTrim( cString )
TRY
IF Left( cString, 1 ) == "{" .and. Right( cString, 1 ) == "}"
aArray := &( cString )
IF !HB_IsArray( aArray )
aArray := {}
ENDIF
ENDIF
CATCH oError
aArray := {}
END
ENDIF
RETURN aArray
/*-------------------------------------------------------------------------------------------------*/
PROCEDURE Usuarios_CambiaAcceso()
LOCAL nPos := Eval( oBrwM:bKeyNo )
IF nPos > 0
aModulos1[ nPos, 1 ] := !aModulos1[ nPos, 1 ]
ENDIF
oBrwM:RefreshCurrent()
RETURN