Descargar

Sistema para control de tiempo y asistencia de personal (página 3)


Partes: 1, 2, 3, 4

If va = False Then

LstTAsig.AddItem LstTurnos.Text

LstTAsig.ItemData(LstTAsig.NewIndex) = LstTurnos.ItemData(LstTurnos.ListIndex)

End If

End If

Case 2

If LstTAsig.ListIndex <> -1 Then

LstTAsig.RemoveItem (LstTAsig.ListIndex)

End If

Case 3

LstTAsig.Clear

End Select

End Sub

Private Sub Form_Load()

Set Personal = New BD_Personal

Set Turnos = New BD_Turnos

Set Asignar = New Bb_Asignaciones

Me.Top = 0

Me.Left = 0

Personal.Busqueda LstNombres, "", "", "", "", "", -1, True

End Sub

Private Sub Form_Unload(Cancel As Integer)

Retornar

End Sub

Private Sub LstNombres_DblClick()

Call CmdAceptar_Click

End Sub

Private Sub LstNombres_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

Call CmdAceptar_Click

End If

End Sub

Private Sub LstTurnos_DblClick()

Call CmdControles_Click(1)

End Sub

Private Sub TxtNombre_Change(Index As Integer)

Personal.Busqueda LstNombres, TxtNombre(2).Text, TxtNombre(3).Text, TxtNombre(0).Text, TxtNombre(1).Text, "", -1, True

End Sub

Private Sub TxtNombre_KeyPress(Index As Integer, KeyAscii As Integer)

KeyAscii = Asc(UCase(Chr(KeyAscii)))

If KeyAscii = 13 Then

If Index < 3 Then

TxtNombre(Index + 1).SetFocus

Else

If LstNombres.Enabled = True Then

LstNombres.ListIndex = 0

LstNombres.SetFocus

Else

CmdCancelar.SetFocus

End If

End If

End If

End Sub

FrmCamara:

Private Sub Form_Load()

Me.Top = 200

Me.Left = 200

End Sub

FrmConsulta:

Option Explicit

Private Marcaciones As BD_Marcacion

Private Sub CmdSalir_Click()

Unload Me

End Sub

Private Sub DTPFecha_Change()

Marcaciones.LlenarListado DTPFecha.Value, LstPersonal, QueEstado

VaciarDatos

End Sub

Private Sub Form_Load()

Set Marcaciones = New BD_Marcacion

Me.Top = 0

Me.Left = 0

DTPFecha.Value = Date

DTPFecha.MaxDate = Date

Marcaciones.LlenarListado DTPFecha.Value, LstPersonal, 0

End Sub

Private Sub Form_Unload(Cancel As Integer)

Retornar

End Sub

Private Sub LstPersonal_Click()

Dim Datos(15) As String

Dim k As Integer

VaciarDatos

Marcaciones.LLenaDatos LstPersonal.ItemData(LstPersonal.ListIndex), Datos

For k = 0 To 14

LblDatos(k).Caption = Datos(k)

Next k

End Sub

Public Sub VaciarDatos()

Dim k As Integer

For k = 0 To 14

LblDatos(k).Caption = ""

Next k

ImgIngreso.Picture = LoadPicture("")

ImgSalida.Picture = LoadPicture("")

End Sub

Private Sub Opciones_Click(Index As Integer)

Marcaciones.LlenarListado DTPFecha.Value, LstPersonal, QueEstado

VaciarDatos

End Sub

Public Function QueEstado() As Integer

If Opciones(0).Value = True Then QueEstado = 1

If Opciones(1).Value = True Then QueEstado = 2

If Opciones(2).Value = True Then QueEstado = 0

End Function

FrmFestivos:

Option Explicit

Private AuxMes As Integer

Private DiasFestivos As BD_DiasF

Private Sub C_Mes_CambiaAnyo(Index As Integer, NuevoAnyo As Integer, Cancel As Boolean)

If Index = 1 Then

If C_Mes(1).Mes = 1 Then

C_Mes(0).Anyo = NuevoAnyo – 1

C_Mes(2).Anyo = NuevoAnyo

Else

If C_Mes(1).Mes = 12 Then

C_Mes(0).Anyo = NuevoAnyo

C_Mes(2).Anyo = NuevoAnyo + 1

Else

C_Mes(0).Anyo = NuevoAnyo

C_Mes(2).Anyo = NuevoAnyo

End If

End If

If NuevoAnyo < Year(Date) Then

C_Mes(1).ColorearSel = False

Else

If NuevoAnyo = Year(Date) Then

If C_Mes(1).Mes >= Month(Date) Then

C_Mes(1).ColorearSel = True

Else

C_Mes(1).ColorearSel = False

End If

Else

C_Mes(1).ColorearSel = True

End If

End If

T_Cambio.Enabled = True

End If

End Sub

Private Sub C_Mes_CambiaMes(Index As Integer, ByVal NuevoMes As Integer, Cancel As Boolean)

Dim MM As Integer

If Index = 1 Then

If NuevoMes = 1 Then

If C_Mes(1).Mes <> 12 Then

C_Mes(0).Anyo = C_Mes(1).Anyo – 1

End If

C_Mes(0).Mes = 12

Else

C_Mes(0).Mes = NuevoMes – 1

End If

If NuevoMes = 12 Then

If C_Mes(1).Mes = 11 Then

C_Mes(2).Anyo = C_Mes(1).Anyo + 1

End If

C_Mes(2).Mes = 1

Else

C_Mes(2).Mes = NuevoMes + 1

End If

If NuevoMes = 11 Then

C_Mes(2).Anyo = C_Mes(1).Anyo

End If

If NuevoMes = 2 Then

C_Mes(0).Anyo = C_Mes(1).Anyo

End If

If NuevoMes < Month(Date) And C_Mes(1).Anyo <= Year(Date) Then

C_Mes(1).ColorearSel = False

Else

If C_Mes(1).Anyo >= Year(Date) Then

C_Mes(1).ColorearSel = True

End If

End If

T_Cambio.Enabled = True

End If

End Sub

Private Sub C_Mes_DblClick(Index As Integer, DiaClicado As Integer)

Dim NombreFecha As String

If C_Mes(1).ColorearSel = True Then

NombreFecha = InputBox("INGRESE UN NOMBRE PARA LA FECHA:" + Str(C_Mes(1).fecha), "AVISO")

If NombreFecha <> "" Then

LstDiasFestivos.AddItem Str(C_Mes(1).fecha) + " " + NombreFecha

DiasFestivos.Nuevo NombreFecha, C_Mes(1).Dia, C_Mes(1).Mes, C_Mes(1).Anyo

LstDiasFestivos.ItemData(LstDiasFestivos.NewIndex) = DiasFestivos.codigo

C_Mes(1).ColorCelda(DiasFestivos.Dia) = vbRed

End If

End If

End Sub

Private Sub C_Mes_SelChange(Index As Integer, NuevoValor As String)

Dim ii As Integer

If Index = 1 Then

If NuevoValor <> "" Then

If C_Mes(1).Mes = Month(Date) And C_Mes(1).Anyo = Year(Date) Then

If Val(NuevoValor) < Day(Date) Then

C_Mes(1).ColorearSel = False

Else

C_Mes(1).ColorearSel = True

End If

End If

If C_Mes(1).ColorCelda(Val(NuevoValor)) = vbRed Then

If DiasFestivos.BuscaFecha(Val(NuevoValor), C_Mes(1).Mes, C_Mes(2).Anyo) = True Then

For ii = 0 To LstDiasFestivos.ListCount – 1

If LstDiasFestivos.ItemData(ii) = DiasFestivos.codigo Then

LstDiasFestivos.ListIndex = ii

Exit For

End If

Next ii

Else

LstDiasFestivos.ListIndex = -1

End If

End If

End If

End If

End Sub

Private Sub CmdAceptar_Click()

Unload Me

End Sub

Private Sub CmdColoca_Click()

Call C_Mes_DblClick(1, C_Mes(1).Dia)

End Sub

Private Sub CmdQuita_Click()

Dim cc As Integer

If LstDiasFestivos.ListIndex <> -1 Then

cc = LstDiasFestivos.ItemData(LstDiasFestivos.ListIndex)

DiasFestivos.BuscaCodigo (cc)

C_Mes(1).ColorCelda(DiasFestivos.Dia) = vbWhite

DiasFestivos.Borrar cc

LstDiasFestivos.RemoveItem (LstDiasFestivos.ListIndex)

End If

End Sub

Private Sub Form_Load()

Set DiasFestivos = New BD_DiasF

Me.Top = 0

Me.Left = 0

AuxMes = Month(Date)

If AuxMes = 1 Then

C_Mes(0).Anyo = Year(Date) – 1

C_Mes(0).Mes = 12

Else

C_Mes(0).Mes = AuxMes – 1

End If

C_Mes(1).Mes = Month(Date)

If AuxMes = 12 Then

C_Mes(2).Anyo = Year(Date) + 1

C_Mes(2).Mes = 1

Else

C_Mes(2).Mes = AuxMes + 1

End If

LlenarMeses

C_Mes(1).Dia = Day(Date)

End Sub

Private Sub Form_Unload(Cancel As Integer)

Retornar

End Sub

Private Sub T_Cambio_Timer()

T_Cambio.Enabled = False

LlenarMeses

If C_Mes(1).Mes = Month(Date) And C_Mes(1).Anyo = Year(Date) Then

C_Mes(1).Dia = Day(Date)

End If

End Sub

Private Sub LlenarMeses()

Dim ii As Integer

For ii = 0 To 2

DiasFestivos.LLenarMes C_Mes(ii)

Next

DiasFestivos.LLenarLista LstDiasFestivos, C_Mes(1).Mes, C_Mes(1).Anyo

End Sub

FrmIngreso:

Option Explicit

Private Usuario As BD_Personal

Private Sub CmdSalir_Click()

Unload Me

End Sub

Private Sub Form_Load()

Set Usuario = New BD_Personal

End Sub

Private Sub CmdAceptar_Click()

If Usuario.ClaveRepetido(TxtClave.Text) Then

UserActivo = Usuario.codigo

TipoUser = Usuario.tipo

IniciarMenu

MDIPrincipal.Show

Unload Me

Else

MsgBox "CLAVE INCORRECTA", , "AVISO"

TxtClave.Text = ""

TxtClave.SetFocus

End If

End Sub

Private Sub TxtClave_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

Call CmdAceptar_Click

End If

End Sub

FrmInicio:

Private Sub Form_Load()

If App.PrevInstance = True Then

End

End If

End Sub

Private Sub T_inicio_Timer()

T_inicio.Enabled = False

MDIPrincipal.Show

MDIPrincipal.SysTray1.PonerSystray

MDIPrincipal.Hide

Unload Me

End Sub

FrmPersonal:

Private Personal As BD_Personal

Private EsNuevo As Boolean

Private EsBusqueda As Boolean

Private Sub CmbTipo_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

CmdAceptar.SetFocus

End If

End Sub

Private Sub CmdAceptar_Click()

Dim CAct As Integer

If EsBusqueda = False Then

CAct = Personal.BuscaRepetido(TxtDatos(0), TxtDatos(1), TxtDatos(2), TxtDatos(3))

If (CAct <> 0 And EsNuevo = True) Or (CAct <> Personal.codigo And EsNuevo = False) Then

MsgBox "USUARIO REPETIDO POR FAVOR VERIFIQUE", , "AVISO"

TxtDatos(0).SetFocus

Exit Sub

Else

CAct = Personal.ClaveRepetido(TxtDatos(5))

If (CAct <> 0 And EsNuevo = True) Or (CAct <> 0 And CAct <> Personal.codigo And EsNuevo = False) Then

MsgBox "CONTRASEÑA REPETIDA POR FAVOR CAMBIELA", , "AVISO"

TxtDatos(5).SetFocus

Exit Sub

Else

If EsNuevo = True Then

Personal.Nuevo CmbTipo.ListIndex, TxtDatos(0), TxtDatos(1), TxtDatos(2), TxtDatos(3), TxtDatos(5), TxtDatos(4)

Else

Personal.Actualiza Personal.codigo, CmbTipo.ListIndex, TxtDatos(0), TxtDatos(1), TxtDatos(2), TxtDatos(3), TxtDatos(5), TxtDatos(4)

End If

End If

End If

Else

If LstResultado.ListIndex <> -1 Then

Personal.CRBusqueda LstResultado.ItemData(LstResultado.ListIndex)

Else

MsgBox "Escoga un resultado de busqueda", , "AVISO"

End If

End If

CargaDatos

Call CmdCancelar_Click

End Sub

Private Sub CmdCancelar_Click()

Controles True

CargaDatos

Datos False

CmdAceptar.Enabled = False

CmdCancelar.Visible = False

Navegadores True

EsNuevo = False

EsBusqueda = False

LstResultado.Visible = False

LblBusqueda.Visible = False

LstResultado.Clear

End Sub

Private Sub CmdControles_Click(Index As Integer)

Select Case Index

Case 0

Personal.Primero

Case 1

Personal.Anterior

Case 2

Personal.Siguiente

Case 3

Personal.Ultimo

End Select

CargaDatos

End Sub

Private Sub CmdSalir_Click()

Unload Me

End Sub

Private Sub CmdComandos_Click(Index As Integer)

Controles False

CmdAceptar.Enabled = True

CmdCancelar.Visible = True

Navegadores False

Select Case Index

Case 0

BorrarDatos

Datos True

TxtDatos(0).SetFocus

EsNuevo = True

Case 1

Datos True

TxtDatos(0).SetFocus

Case 2

If MsgBox("ESTA SEGURO DE ELIMINAR A: " & Personal.nombre1 & " " & Personal.apellido1, vbYesNo, "CONFIRME") = vbYes Then

Personal.Borrar Personal.codigo

Personal.Primero

CargaDatos

End If

Call CmdCancelar_Click

Case 3

LstResultado.Visible = True

LblBusqueda.Visible = True

BorrarDatos

Datos True

TxtDatos(0).SetFocus

EsBusqueda = True

End Select

End Sub

Private Sub Form_Load()

Set Personal = New BD_Personal

Me.Top = 0

Me.Left = 0

CargaDatos

Datos False

EsNuevo = False

EsBusqueda = False

End Sub

Private Sub Datos(Estado As Boolean)

Dim x As Integer

For x = 0 To 5

TxtDatos(x).Enabled = Estado

Next x

CmbTipo.Enabled = Estado

End Sub

Private Sub Navegadores(Estado As Boolean)

Dim x As Integer

For x = 0 To 3

CmdControles(x).Enabled = Estado

Next x

End Sub

Private Sub Controles(Estado As Boolean)

Dim x As Integer

For x = 0 To 3

CmdComandos(x).Enabled = Estado

Next x

End Sub

Private Sub CargaDatos()

TxtDatos(0).Text = Personal.nombre1

TxtDatos(1).Text = Personal.nombre2

TxtDatos(2).Text = Personal.apellido1

TxtDatos(3).Text = Personal.apellido2

TxtDatos(4).Text = Personal.direccion

TxtDatos(5).Text = Personal.contrasena

CmbTipo.ListIndex = Personal.tipo

End Sub

Private Sub BorrarDatos()

Dim x As Integer

For x = 0 To 5

TxtDatos(x).Text = ""

Next x

CmbTipo.ListIndex = -1

End Sub

Private Sub Form_Unload(Cancel As Integer)

Retornar

End Sub

Private Sub TxtDatos_Change(Index As Integer)

If EsBusqueda = True Then

Personal.Busqueda LstResultado, TxtDatos(0), TxtDatos(1), TxtDatos(2), TxtDatos(3), TxtDatos(4), CmbTipo.ListIndex

End If

End Sub

Private Sub TxtDatos_KeyPress(Index As Integer, KeyAscii As Integer)

KeyAscii = Asc(UCase(Chr(KeyAscii)))

If KeyAscii = 13 Then

If Index < 5 Then

TxtDatos(Index + 1).SetFocus

End If

If Index = 5 Then

CmbTipo.SetFocus

End If

Else

Select Case Index

Case 0, 1, 2, 3

If Not (EsLetra(KeyAscii) Or KeyAscii = 8) Then

KeyAscii = 0

End If

Case 5

If Not (IsNumeric(Chr(KeyAscii))) And KeyAscii <> 8 Then

KeyAscii = 0

End If

End Select

End If

End Sub

FrmReloj:

Option Explicit

Private Sub Form_Load()

Me.Top = 0

Me.Left = 0

EnvioReloj = False

End Sub

Private Sub ChReloj_Click()

Dim i As Integer

If ChReloj.Value = 1 Then

T_Reloj.Enabled = True

CargaReloj

For i = 0 To 5

TxtReloj(i).Enabled = False

Next i

Else

T_Reloj.Enabled = False

For i = 0 To 5

TxtReloj(i).Enabled = True

Next i

TxtReloj(2).SetFocus

End If

End Sub

Private Sub CmdAceptar_Click()

Dim dat As Boolean

Dim i As Integer

dat = False

For i = 0 To 5

If TxtReloj(i).Text <> "00" Then

dat = True

Exit For

End If

Next i

If dat = True Then

For i = 0 To 5

TxtReloj(i).Enabled = False

Next i

S_Espera.Visible = True

LblEspera.Visible = True

CmdSalir.Enabled = False

CmdAceptar.Enabled = False

EnvioReloj = True

T_Espera.Enabled = True

Else

MsgBox "NO HAY UN CAMBIO REGISTRADO", , "AVISO"

End If

End Sub

Private Sub Form_Unload(Cancel As Integer)

Retornar

End Sub

Private Sub T_Espera_Timer()

Dim i As Integer

T_Espera.Enabled = False

For i = 0 To 5

TxtReloj(i).Enabled = True

Next i

S_Espera.Visible = False

LblEspera.Visible = False

CmdSalir.Enabled = True

CmdAceptar.Enabled = True

EnvioReloj = False

MsgBox "NO HAY CONEXION CON EL MARCADOR", , "AVISO"

End Sub

Private Sub T_Reloj_Timer()

CargaReloj

End Sub

Private Sub CmdSalir_Click()

Unload Me

End Sub

Private Sub CargaReloj()

TxtReloj(0).Text = Second(Now)

TxtReloj(1).Text = Minute(Now)

TxtReloj(2).Text = Hour(Now)

TxtReloj(3).Text = Day(Now)

TxtReloj(4).Text = Month(Now)

TxtReloj(5).Text = Mid(Str(Year(Now)), 4, 2)

End Sub

Private Sub TxtReloj_GotFocus(Index As Integer)

TxtReloj(Index).SelStart = 0

TxtReloj(Index).SelLength = 2

End Sub

Private Sub TxtReloj_KeyPress(Index As Integer, KeyAscii As Integer)

KeyAscii = Asc(UCase(Chr(KeyAscii)))

If KeyAscii = 13 Then

If Index = 1 Or Index = 2 Then TxtReloj(Index – 1).SetFocus

If Index = 0 Then TxtReloj(3).SetFocus

If Index = 4 Or Index = 3 Then TxtReloj(Index + 1).SetFocus

If Index = 5 Then CmdAceptar.SetFocus

Else

If TxtReloj(Index).SelLength = 2 Then

TxtReloj(Index).Text = ""

End If

If Not (IsNumeric(Chr(KeyAscii))) And KeyAscii <> 8 Then

KeyAscii = 0

Else

If Index = 2 Then _

If Val(TxtReloj(Index).Text + Chr(KeyAscii)) > 23 Then KeyAscii = 0

If Index = 0 Or Index = 1 Then _

If Val(TxtReloj(Index).Text + Chr(KeyAscii)) > 59 Then KeyAscii = 0

If Index = 3 Then _

If Val(TxtReloj(Index).Text + Chr(KeyAscii)) > 31 Then KeyAscii = 0

If Index = 4 Then _

If Val(TxtReloj(Index).Text + Chr(KeyAscii)) > 12 Then KeyAscii = 0

End If

End If

End Sub

Private Sub TxtReloj_LostFocus(Index As Integer)

If TxtReloj(Index).Text = "" Then

TxtReloj(Index).Text = "00"

End If

If Val(TxtReloj(Index).Text) < 10 Then

TxtReloj(Index).Text = "0" + CStr(Val(TxtReloj(Index).Text))

End If

End Sub

FrmReportes:

Option Explicit

Private Marcacion As BD_Marcacion

Private x As Integer

Private np As Integer

Private Largo As Variant

Private Ancho As Variant

Private y As Double

Private i As Integer

Private Sub CmdAceptar_Click()

Marcacion.LLenarReporte DtpDesde.Value, DtpHasta.Value, 1, MSFTabla

End Sub

Private Sub CmdSalir_Click()

Unload Me

End Sub

Private Sub Command1_Click()

End Sub

Private Sub Form_Load()

Dim dd As Integer

Dim i As Integer

Set Marcacion = New BD_Marcacion

Me.Top = 0

Me.Left = 0

DtpDesde.Value = "1/" + CStr(Month(Date)) + "/" + CStr(Year(Date))

DtpHasta.Value = CStr(FinDeMes(Month(Date), Year(Date))) + "/" + CStr(Month(Date)) + "/" + CStr(Year(Date))

MSFTabla.RowHeight(0) = 250

MSFTabla.ColWidth(0) = 4000

MSFTabla.ColWidth(1) = 1200

MSFTabla.ColWidth(2) = 1200

MSFTabla.ColWidth(3) = 1200

MSFTabla.ColWidth(4) = 1200

MSFTabla.TextMatrix(0, 0) = "NOMBRES"

MSFTabla.TextMatrix(0, 1) = "T.NORMAL"

MSFTabla.TextMatrix(0, 2) = "T.NOCTUR."

MSFTabla.TextMatrix(0, 3) = "T.EX. 50%"

MSFTabla.TextMatrix(0, 4) = "T.EX. 100%"

For i = 0 To 4

MSFTabla.Col = i

MSFTabla.CellAlignment = 4

MSFTabla.CellFontBold = True

MSFTabla.ColAlignment(i) = 4

Next i

End Sub

Private Sub Form_Unload(Cancel As Integer)

Retornar

End Sub

Private Sub CmdImprimir_Click()

If MSFTabla.Rows > 0 Then

x = (MSFTabla.Rows – 1) / 44

Else

x = 0

End If

If (MSFTabla.Rows – 1) – (x * 44) > 0 Then

x = x + 1

End If

If x = 0 Then

MsgBox "NO HAY REGISTROS PARA IMPRIMIR"

Else

If MsgBox("DESEA IMPRIMIR " + CStr(x) + " HOJA(S) DE REPORTE", vbYesNo, "CONFIRMACION") = vbYes Then

Largo = Printer.Height

Ancho = Printer.Width

Printer.PaperSize = vbPRPSA4

'Titulo del reporte

Printer.ScaleMode = vbCentimeters

Printer.CurrentX = 6

Printer.CurrentY = 2

Printer.Font = "Arial"

Printer.Font.Size = 20

Printer.Print "REPORTE DESDE EL" + DtpDesde.Value + " HASTA EL " + DtpHasta.Value

'Fechas del reporte

For np = 1 To x

Encabezado

Detalles

PieDePagina

Next n

Printer.EndDoc

Printer.Height = Largo

Printer.Width = Ancho

End If

End If

End Sub

Private Sub Encabezado()

'Titulos de las columnas

Printer.CurrentX = 2

Printer.CurrentY = 4

Printer.Font = "Arial"

Printer.Font.Size = 11

Printer.Print "NOMBRES NORMAL NOCTURNA EXTRA 50% EXTRA 100%"

End Sub

Private Sub Detalles()

Dim Contador As Integer

Contador = 1

'Detalles del reporte

y = 4.7

Printer.Font = "Arial"

Printer.Font.Size = 10

i = ((np – 1) * 44) + 1

While Contador < 45

Printer.CurrentX = 2.5

Printer.CurrentY = y

Printer.Print MSFTabla.TextMatrix(i, 0)

Printer.CurrentX = 4

Printer.CurrentY = y

Printer.Print MSFTabla.TextMatrix(i, 1)

Printer.CurrentX = 10

Printer.CurrentY = y

Printer.Print MSFTabla.TextMatrix(i, 2)

Printer.CurrentX = 13.5

Printer.CurrentY = y

Printer.Print MSFTabla.TextMatrix(i, 3)

Printer.CurrentX = 18

Printer.CurrentY = y

Printer.Print MSFTabla.TextMatrix(i, 4)

y = y + 0.5

Contador = Contador + 1

i = i + 1

If i = MSFTabla.Rows Then

Exit Sub

End If

Wend

End Sub

Private Sub PieDePagina()

'Pie de pagina

Printer.CurrentX = 3

Printer.CurrentY = 27

Printer.Font = "Arial"

Printer.Font.Size = 10

Printer.Print Format(Date, "Short Date")

Printer.CurrentX = 10

Printer.CurrentY = 27

Printer.Print "Pag. " + CStr(np) + " de " + CStr(x)

Printer.CurrentX = 15

Printer.CurrentY = 27

Printer.Print "Revisado por"

Printer.EndDoc

End Sub

FrmTurnos:

Option Explicit

Private Turnos As BD_Turnos

Private turno As String

Private Sub CmdCancelar_Click()

BorraDatos

CuadroControles True

CuadroHorario False

CmdSalir.Enabled = True

If Turnos.codigo <> 0 Then

LD

CuadroNavegadores True

CmdComandos(1).Enabled = True

CmdComandos(2).Enabled = True

LstTurnos.Enabled = True

End If

End Sub

Private Sub CmdComandos_Click(Index As Integer)

Dim i As Integer

Select Case Index

Case 0

CuadroControles False

CuadroNavegadores False

CuadroHorario True

CmdSalir.Enabled = False

LstTurnos.Enabled = False

BorraDatos

TxtNombre.SetFocus

Case 1

CuadroControles False

CuadroNavegadores False

CmdSalir.Enabled = False

CuadroHorario True

TxtNombre.Enabled = False

TxtDesde(0).SetFocus

Case 2

If MsgBox("VA A BORRAR EL TURNO: " + TxtNombre.Text + " ESTA SEGURO?", vbYesNo, "ATENCION") = vbYes Then

Turnos.Borrar Turnos.codigo

If Turnos.LLenarLista(LstTurnos) = False Then

BorraDatos

CuadroNavegadores False

CmdComandos(1).Enabled = False

CmdComandos(2).Enabled = False

Else

LD

End If

End If

End Select

End Sub

Private Sub CmdControles_Click(Index As Integer)

Select Case Index

Case 0

Turnos.Primero

Case 1

Turnos.Anterior

Case 2

Turnos.Siguiente

Case 3

Turnos.Ultimo

End Select

LD

End Sub

Private Sub CmdAceptar_Click()

Dim ind As Integer

Dim Listo As Boolean

Listo = False

If TxtDesde(0).Text <> "" Or TxtDesde(1).Text <> "" Then

If TxtHasta(0).Text <> "" Or TxtHasta(1).Text <> "" Then

If TxtDesde(0).Text <> TxtHasta(0) Or TxtDesde(1).Text <> TxtHasta(1) Then

If VeriHora(TxtDesde(0), TxtDesde(1), TxtHasta(0), TxtHasta(1)) = True Then

Listo = True

Else

If MsgBox("LA HORA FINAL ES MENOR QUE LA INICIAL ESTA SEGURO DE SEQUIR", vbYesNo, "AVISO") = vbYes Then

Listo = True

Else

TxtHasta(0).SetFocus

End If

End If

Else

MsgBox "LA HORA INICIAL ES IGUAL QUE LA FINAL", vbExclamation, "ATENCION"

TxtHasta(0).SetFocus

End If

Else

MsgBox "COLOQUE UNA HORA FINAL", vbExclamation, "ATENCION"

TxtHasta(0).SetFocus

End If

Else

MsgBox "COLOQUE UNA HORA INICIAL", vbExclamation, "ATENCION"

TxtDesde(0).SetFocus

End If

If Listo = True Then

turno = TxtDesde(0).Text + ":" + TxtDesde(1).Text + " +/- " + TxtDesde(2).Text _

+ " a " + TxtHasta(0).Text + ":" + TxtHasta(1).Text + " +/- " + TxtHasta(2).Text

If TxtNombre.Enabled = True Then

Turnos.Nuevo TxtNombre.Text, turno

MsgBox "INGRESADO", , "AVISO"

Else

Turnos.Actualiza Turnos.codigo, TxtNombre.Text, turno

MsgBox "ACTUALIZADO", , "AVISO"

End If

Turnos.LLenarLista LstTurnos

Call CmdCancelar_Click

End If

End Sub

Private Sub CmdSalir_Click()

Unload Me

End Sub

Private Sub Form_Load()

Set Turnos = New BD_Turnos

Me.Top = 0

Me.Left = 0

If Turnos.LLenarLista(LstTurnos) = False Then

CuadroNavegadores False

CmdComandos(1).Enabled = False

CmdComandos(2).Enabled = False

Else

LD

End If

CuadroHorario False

End Sub

Private Sub LD()

Dim j As Integer

TxtNombre.Text = Turnos.nombre

TxtDesde(0).Text = Mid(Turnos.Turno1, 1, 2)

TxtDesde(1).Text = Mid(Turnos.Turno1, 4, 2)

TxtDesde(2).Text = Mid(Turnos.Turno1, 11, 2)

TxtHasta(0).Text = Mid(Turnos.Turno1, 16, 2)

TxtHasta(1).Text = Mid(Turnos.Turno1, 19, 2)

TxtHasta(2).Text = Mid(Turnos.Turno1, 26, 2)

For j = 0 To LstTurnos.ListCount – 1

If LstTurnos.ItemData(j) = Turnos.codigo Then Exit For

Next j

LstTurnos.ListIndex = j

End Sub

Private Sub Form_Unload(Cancel As Integer)

Retornar

End Sub

Private Sub CuadroHorario(Estado As Boolean)

Dim ii As Integer

TxtNombre.Enabled = Estado

For ii = 0 To 2

TxtDesde(ii).Enabled = Estado

TxtHasta(ii).Enabled = Estado

Next ii

CmdAceptar.Enabled = Estado

CmdCancelar.Enabled = Estado

End Sub

Private Sub CuadroNavegadores(Estado As Boolean)

Dim ii As Integer

For ii = 0 To 3

CmdControles(ii).Enabled = Estado

Next ii

End Sub

Private Sub CuadroControles(Estado As Boolean)

Dim ii As Integer

For ii = 0 To 2

CmdComandos(ii).Enabled = Estado

Next ii

End Sub

Private Sub LstTurnos_Click()

If LstTurnos.ListIndex <> -1 Then

Turnos.BuscaCodigo LstTurnos.ItemData(LstTurnos.ListIndex)

LD

End If

End Sub

Private Sub TxtDesde_GotFocus(Index As Integer)

TxtDesde(Index).SelStart = 0

TxtDesde(Index).SelLength = 2

End Sub

Private Sub TxtDesde_KeyPress(Index As Integer, KeyAscii As Integer)

KeyAscii = Asc(UCase(Chr(KeyAscii)))

If KeyAscii = 13 Then

If Index < 2 Then

TxtDesde(Index + 1).SetFocus

Else

TxtHasta(0).SetFocus

End If

Else

If TxtDesde(Index).SelLength = 2 Then

TxtDesde(Index).Text = ""

End If

If Not (IsNumeric(Chr(KeyAscii))) And KeyAscii <> 8 Then

KeyAscii = 0

Else

If Index = 0 Then

If Val(TxtDesde(0).Text + Chr(KeyAscii)) > 23 Then

KeyAscii = 0

End If

Else

If Val(TxtDesde(Index).Text + Chr(KeyAscii)) > 59 Then

KeyAscii = 0

End If

End If

End If

End If

End Sub

Private Sub TxtDesde_LostFocus(Index As Integer)

If TxtDesde(Index).Text = "" Then

TxtDesde(Index).Text = "00"

End If

If Val(TxtDesde(Index).Text) < 10 Then

TxtDesde(Index).Text = "0" + CStr(Val(TxtDesde(Index).Text))

End If

End Sub

Private Sub TxtHasta_GotFocus(Index As Integer)

TxtHasta(Index).SelStart = 0

TxtHasta(Index).SelLength = 2

End Sub

Private Sub TxtHasta_KeyPress(Index As Integer, KeyAscii As Integer)

KeyAscii = Asc(UCase(Chr(KeyAscii)))

If KeyAscii = 13 Then

If Index < 2 Then

TxtHasta(Index + 1).SetFocus

Else

CmdAceptar.SetFocus

End If

Else

If TxtHasta(Index).SelLength = 2 Then

TxtHasta(Index).Text = ""

End If

If Not (IsNumeric(Chr(KeyAscii))) And KeyAscii <> 8 Then

KeyAscii = 0

Else

If Index = 0 Then

If Val(TxtHasta(0).Text + Chr(KeyAscii)) > 23 Then

KeyAscii = 0

End If

Else

If Val(TxtHasta(Index).Text + Chr(KeyAscii)) > 59 Then

KeyAscii = 0

End If

End If

End If

End If

End Sub

Private Sub TxtHasta_LostFocus(Index As Integer)

If TxtHasta(Index).Text = "" Then

TxtHasta(Index).Text = "00"

End If

If Val(TxtHasta(Index).Text) < 10 Then

TxtHasta(Index).Text = "0" + CStr(Val(TxtHasta(Index).Text))

End If

End Sub

Private Sub TxtNombre_KeyPress(KeyAscii As Integer)

KeyAscii = Asc(UCase(Chr(KeyAscii)))

If KeyAscii = 13 Then

TxtDesde(0).SetFocus

End If

End Sub

Private Sub TxtNombre_Validate(Cancel As Boolean)

If TxtNombre.Text = "" Then

MsgBox "POR FAVOR INGRESE UN NOMBRE", vbExclamation, "ATENCION"

Cancel = True

End If

End Sub

Private Sub BorraDatos()

Dim j As Integer

TxtNombre.Text = ""

For j = 0 To 2

TxtDesde(j).Text = "00"

TxtHasta(j).Text = "00"

Next j

End Sub

MDIPrincipal:

Option Explicit

Public Marcaciones As BD_Marcacion

Private ConteoB As Integer

Private Sub M_H_Asignar_Click()

Menus False

Ancho = 9200

Largo = 8350

Me.Height = Largo

Me.Width = Ancho

FrmAsignaciones.Show

End Sub

Private Sub M_H_G_DiasF_Click()

Menus False

Ancho = 9250

Largo = 8400

Me.Height = Largo

Me.Width = Ancho

FrmFestivos.Show

End Sub

Private Sub M_H_G_Turnos_Click()

Menus False

Ancho = 9400

Largo = 8450

Me.Height = Largo

Me.Width = Ancho

FrmTurnos.Show

End Sub

Private Sub M_P_cambio_Click()

FrmIngreso.Show

Me.Hide

End Sub

Private Sub M_P_consulta_Click()

Menus False

Ancho = 8550

Largo = 7600

Me.Height = Largo

Me.Width = Ancho

FrmConsulta.Show

End Sub

Private Sub M_P_ingreso_Click()

Menus False

Ancho = 8490

Largo = 7590

Me.Height = Largo

Me.Width = Ancho

FrmPersonal.Show

End Sub

Private Sub M_P_Terminar_Click()

On Error Resume Next

MSmarcador.PortOpen = False

SysTray1.RemoverSystray

End

End Sub

Private Sub M_R_mensual_Click()

Menus False

Ancho = 9400

Largo = 8450

Me.Height = Largo

Me.Width = Ancho

FrmReportes.Show

End Sub

Private Sub M_reloj_Click()

Menus False

Ancho = 8170

Largo = 4300

Me.Height = Largo

Me.Width = Ancho

FrmReloj.Show

End Sub

Private Sub MDIForm_Load()

Set Marcaciones = New BD_Marcacion

Ancho = 5280

Largo = 3465

IniciarMenu

EnvioDatos = True

FrmCamara.Show

ConteoB = 1

MSmarcador.CommPort = Puerto

On Error Resume Next

MSmarcador.PortOpen = True

If Err.Number = 8002 Then MsgBox "NO ESTA CONFIGURADO UN PUERTO EL PROGRAMA NO FUNCIONARA"

End Sub

Private Sub MDIForm_Resize()

'COLOCAR AQUI EL TAMAÑO DE LA VENTANA

If Me.WindowState = 0 Then

Me.Height = Largo

Me.Width = Ancho

Me.Top = (Screen.Height – Me.Height) / 2

Me.Left = (Screen.Width – Me.Width) / 2

Else

If Me.WindowState = 2 Then Me.WindowState = 0

End If

End Sub

Private Sub MDIForm_Unload(Cancel As Integer)

MDIPrincipal.Hide

Cancel = 1

End Sub

Private Sub MSmarcador_OnComm()

If MSmarcador.CommEvent = comEvReceive Then

If Usb = False Then

Lectura = MSmarcador.Input

Else

If Mid(Lectura, 1, 1) = "C" Then

Lectura = Lectura + MSmarcador.Input

ConteoB = ConteoB + 1

If ConteoB = 8 Then

ConteoB = 1

Nc = Asc(Mid(Lectura, 2, 1))

clave = Mid(Lectura, 3, Nc + 1)

Cual = Resultado

Lectura = "0"

T_Retrazo.Enabled = True

End If

Else

If Mid(Lectura, 1, 1) = "R" Then

Lectura = Lectura + MSmarcador.Input

ConteoB = ConteoB + 1

If ConteoB = 7 Then

ConteoB = 1

IngresarDatos Mid(Lectura, 2, 6)

Lectura = "0"

End If

Else

Lectura = MSmarcador.Input

End If

End If

End If

If Lectura = "P" Then

FrmReloj.T_Espera.Enabled = False

Proc_Reloj

Proc_Datos

End If

If Lectura = "V" Then

MSmarcador.Output = "C"

End If

If Usb = False Then

If Mid(Lectura, 1, 1) = "C" Then

Nc = Asc(Mid(Lectura, 2, 1))

clave = Mid(Lectura, 3, Nc + 1)

Cual = Resultado

T_Retrazo.Enabled = True

Lectura = "0"

End If

If Mid(Lectura, 1, 1) = "R" Then

IngresarDatos Mid(Lectura, 2, 6)

End If

End If

If Lectura = "E" Then

MSmarcador.Output = "L"

End If

If Lectura = "F" Then

MSmarcador.Output = "X"

End If

If Mid(Lectura, 1, 1) = "S" Then

Cual = Consultando

T_Retrazo.Enabled = True

End If

End If

End Sub

Private Sub SysTray1_DblClick(Button As Integer)

If MDIPrincipal.Visible = False Then FrmIngreso.Show Else MDIPrincipal.SetFocus

End Sub

Private Sub T_Retrazo_Timer()

Select Case Cual

Case 0

Proc_Envio_Reloj

Case 1

Proc_Ver_Clave

Case 2

T_Retrazo.Enabled = False

MSmarcador.Output = "K"

TomaFoto

If FrmConsulta.Visible = True Then

Marcaciones.LlenarListado FrmConsulta.DTPFecha.Value, FrmConsulta.LstPersonal, FrmConsulta.QueEstado

FrmConsulta.VaciarDatos

MsgBox "SE ACTUALIZO UNA MARCACION", vbDefaultButton2, "AVISO"

End If

Case 3

Proc_Ver_Consulta

End Select

End Sub

MODULOS:

Procedimientos:

Option Explicit

Public Sub Proc_Reloj()

If EnvioReloj = True Then

r = 0

EnvioReloj = False

MDIPrincipal.MSmarcador.Output = "R"

Cual = Reloj

MDIPrincipal.T_Retrazo.Enabled = True

End If

End Sub

Public Sub Proc_Datos()

If EnvioDatos = True Then

EnvioDatos = False

MDIPrincipal.MSmarcador.Output = "D"

End If

End Sub

Public Sub Proc_Envio_Reloj()

MDIPrincipal.MSmarcador.Output = Chr(Val("&H" + FrmReloj.TxtReloj(r).Text))

r = r + 1

If r = 6 Then

MDIPrincipal.T_Retrazo.Enabled = False

FrmReloj.S_Espera.Visible = False

FrmReloj.LblEspera.Visible = False

FrmReloj.CmdSalir.Enabled = True

FrmReloj.CmdAceptar.Enabled = True

For r = 0 To 5

FrmReloj.TxtReloj(r).Enabled = True

Next r

r = 0

End If

End Sub

Public Function EsLetra(dato As Integer) As Boolean

If ((dato > 64) And (dato < 91)) Or ((dato > 96) And (dato < 123)) Or Chr(dato) = "ñ" Or Chr(dato) = "Ñ" Or dato = 95 Then

EsLetra = True

Else

EsLetra = False

End If

End Function

Public Sub Menus(Estado As Boolean)

Dim k As Integer

For k = 0 To 3

MDIPrincipal.Menu(k).Enabled = Estado

Next k

End Sub

Public Sub Retornar()

Ancho = 5280

Largo = 3465

Menus True

MDIPrincipal.Height = Largo

MDIPrincipal.Width = Ancho

End Sub

Public Sub Proc_Ver_Clave()

Dim Personal As BD_Personal

Set Personal = New BD_Personal

Dim cl As Integer

MDIPrincipal.T_Retrazo.Enabled = False

If Personal.ClaveRepetido(clave) = True Then

MDIPrincipal.MSmarcador.Output = "Y"

Else

MDIPrincipal.MSmarcador.Output = "N"

End If

clave = CStr(Personal.codigo)

End Sub

Public Sub IngresarDatos(Datos As String)

Dim ff As Integer

For ff = 0 To 5

DatoFecha(ff) = DecHexRej(Asc(Mid(Datos, ff + 1, 1)))

Next ff

MDIPrincipal.Marcaciones.IngresoMarcado Val(clave), DatoFecha

Cual = Confirmado

MDIPrincipal.T_Retrazo.Enabled = True

End Sub

Public Function DecHexRej(numero As Integer) As Integer

Dim n1 As Integer

Dim r1 As Integer

If numero > 9 Then

n1 = Int(numero / 16)

r1 = numero – (n1 * 16)

DecHexRej = (n1 * 10) + r1

Else

DecHexRej = numero

End If

End Function

Public Sub Proc_Ver_Consulta()

Dim Marca As BD_Marcacion

Set Marca = New BD_Marcacion

MDIPrincipal.T_Retrazo.Enabled = False

If Marca.Consultando(Val(clave)) = True Then

MDIPrincipal.MSmarcador.Output = "Y"

Else

MDIPrincipal.MSmarcador.Output = "N"

End If

End Sub

Public Function VeriHora(d1 As String, d2 As String, h1 As String, h2 As String) As Boolean

VeriHora = False

If Val(h1) > Val(d1) Then

VeriHora = True

End If

If Val(h1) = Val(d1) Then

If Val(h2) > Val(d2) Then

VeriHora = True

End If

End If

End Function

Public Sub TomaFoto()

Dim RutaPrograma As String

Dim RutaFotoOriginal As String

Dim RutaFotoDestino As String

Dim FotoLista As Boolean

On Error Resume Next

Kill App.Path + "fotosm" + "*.bmp"

On Error Resume Next

FotoLista = FrmCamara.ezVidCap1.CapSingleFrame

RutaFotoOriginal = App.Path + "fotosm" + CStr(NumeroMarcacion) + "_" + CStr(IngSal) + ".bmp"

Call FrmCamara.ezVidCap1.SaveDIB(RutaFotoOriginal)

If Err Then

MsgBox Err.Description, vbInformation, App.Title

End If

RutaPrograma = App.Path + "PVW32Con.exe "

RutaFotoDestino = App.Path + "fotosm "

Shell RutaPrograma + " " + RutaFotoOriginal + " -j –jq020 –o " + RutaFotoDestino, vbHide

End Sub

Public Function FinDeMes(MM As Integer, aa As Integer) As Integer

Select Case MM

Case 1, 3, 5, 7, 8, 10, 12

FinDeMes = 31

Case 2

If aa = aa – (Int(aa / 4) * 4) = 0 Then

FinDeMes = 29

Else

FinDeMes = 28

End If

Case 4, 6, 9, 11

FinDeMes = 30

End Select

End Function

Public Sub IniciarMenu()

MDIPrincipal.Menu(0).Visible = True

MDIPrincipal.Menu(1).Visible = True

MDIPrincipal.Menu(2).Visible = True

MDIPrincipal.M_R_mensual.Visible = True

MDIPrincipal.M_R_personalizado.Visible = True

Select Case TipoUser

Case 1

MDIPrincipal.Menu(0).Visible = False

MDIPrincipal.M_P_ingreso.Visible = False

MDIPrincipal.M_H_generar.Visible = False

Case 2

MDIPrincipal.Menu(0).Visible = False

MDIPrincipal.Menu(1).Visible = False

MDIPrincipal.Menu(2).Visible = False

MDIPrincipal.M_R_mensual.Visible = False

MDIPrincipal.M_R_personalizado.Visible = False

End Select

End Sub

VARIABLES:

Option Explicit

Public Const RutaConexion As String = "DSN=Personal;Password=pcv06;Persist Security Info=False"

Public EnvioReloj As Boolean

Public EnvioDatos As Boolean

Public Lectura As String

Public Enum Tipos

Reloj = 0

Resultado = 1

Confirmado = 2

Consultando = 3

End Enum

Public Cual As Tipos

Public r As Integer

Public UserActivo As Integer

Public TipoUser As Integer

Public Largo As Integer

Public Ancho As Integer

Public Nc As Integer

Public clave As String

Public DatoFecha(5) As Integer

Public Puerto As Integer

Public Usb As Boolean

Public HoraNocD As Integer

Public MinutoNocD As Integer

Public HoraNocH As Integer

Public MinutoNocH As Integer

Public SD100 As Boolean

Public NumeroMarcacion As Integer

Public IngSal As Integer

MODULOS DE CLASE

BD_Asignaciones:

Option Explicit

Private MisDatosAux As ADODB.Recordset

Private MiConexion As ADODB.Connection

Private sql As String

Private mcod_empleado As Integer

Private mcod_turno As Integer

Property Get Codigo_Empleado() As Integer

Codigo_Empleado = mcod_empleado

End Property

Property Get Codigo_Turno() As Integer

Codigo_Turno = mcod_turno

End Property

Private Sub Class_Initialize()

Set MiConexion = New ADODB.Connection

Set MisDatosAux = New ADODB.Recordset

MiConexion.ConnectionString = RutaConexion

MiConexion.Open RutaConexion

End Sub

Private Sub Class_Terminate()

MiConexion.Close

End Sub

Public Sub Nuevo(cod_empleado As Integer, cod_turno As Integer)

MiConexion.Execute "Insert into Asignaciones (cod_empleado,cod_turno) " _

& "values (" & cod_empleado & "," & cod_turno & ")"

End Sub

Public Sub Borrar(codigo As Integer)

On Error Resume Next

MiConexion.Execute "Delete from asignaciones where cod_empleado = " & codigo & ""

End Sub

Public Sub LlenarAsignaciones(codigo As Integer, lista As ListBox)

sql = "SELECT Asignaciones.cod_empleado, Asignaciones.cod_turno, Turnos.nombre " _

& "FROM Turnos INNER JOIN Asignaciones ON " _

& "Turnos.codigo = Asignaciones.cod_turno " _

& "WHERE (((Asignaciones.cod_empleado)=" & codigo & "))"

MisDatosAux.CursorType = adOpenDynamic

MisDatosAux.Open sql, MiConexion, , , adCmdText

lista.Clear

lista.Enabled = True

If Not (MisDatosAux.EOF = True And MisDatosAux.BOF = True) = True Then

MisDatosAux.MoveFirst

While MisDatosAux.EOF = False

lista.AddItem MisDatosAux!nombre

lista.ItemData(lista.NewIndex) = MisDatosAux!cod_turno

MisDatosAux.MoveNext

Wend

End If

MisDatosAux.Close

End Sub

BD_Config:

Option Explicit

Private MisDatosAux As ADODB.Recordset

Private MiConexion As ADODB.Connection

Private sql As String

Private mpuerto As Integer

Private musb As Integer

Property Get Puerto() As Integer

Puerto = mpuerto

End Property

Property Get EsUsb() As Boolean

If musb = 0 Then

EsUsb = False

Else

EsUsb = True

End If

End Property

Private Sub Class_Initialize()

Set MiConexion = New ADODB.Connection

Set MisDatosAux = New ADODB.Recordset

MiConexion.ConnectionString = RutaConexion

MiConexion.Open RutaConexion

sql = "select * from configuracion"

MisDatosAux.CursorType = adOpenDynamic

MisDatosAux.Open sql, MiConexion, , , adCmdText

MisDatosAux.MoveFirst

mpuerto = MisDatosAux!Puerto

musb = MisDatosAux!Usb

MisDatosAux.Close

End Sub

Private Sub Class_Terminate()

MiConexion.Close

End Sub

Public Sub CambioPuerto(P As Integer)

MiConexion.Execute "Update configuracion set puerto=" & P & " where usb = " & musb & ""

mpuerto = P

End Sub

Public Sub CambioUsb(SiUsb As Boolean)

Dim indicador As Integer

If SiUsb = False Then

indicador = 0

Else

indicador = 1

End If

MiConexion.Execute "Update configuracion set usb=" & indicador & " where puerto = " & mpuerto & ""

musb = indicador

End Sub

BD_DiasF:

Option Explicit

Private MisDatos As ADODB.Recordset

Private MiConexion As ADODB.Connection

Private sql As String

Private mcodigo As Integer

Private mnombre As String

Private mdia As Integer

Private mmes As Integer

Private manio As Integer

Property Get codigo() As Integer

codigo = mcodigo

End Property

Property Get nombre() As String

nombre = mnombre

End Property

Property Get Dia() As Integer

Dia = mdia

End Property

Property Get Mes() As Integer

Mes = mmes

End Property

Property Get Anio() As Integer

Anio = manio

End Property

Private Sub Class_Initialize()

Set MiConexion = New ADODB.Connection

Set MisDatos = New ADODB.Recordset

MiConexion.ConnectionString = RutaConexion

MiConexion.Open RutaConexion

End Sub

Private Sub Class_Terminate()

MiConexion.Close

End Sub

Private Sub LlenarDatos()

With MisDatos

mcodigo = !codigo

mnombre = !nombre

mdia = !Dia

mmes = !Mes

manio = !Anio

End With

End Sub

Public Sub Nuevo(nombre As String, Dia As Integer, Mes As Integer, Anio As Integer)

Dim c As Integer

MisDatos.CursorType = adOpenDynamic

MisDatos.Open "select Codigo from DiasF order by Codigo", MiConexion, , , adCmdText

If MisDatos.EOF = True And MisDatos.BOF = True Then

c = 1

Else

MisDatos.MoveLast

c = MisDatos!codigo + 1

End If

MisDatos.Close

MiConexion.Execute "Insert into DiasF (codigo,nombre,dia,mes,anio) " _

& "values (" & c & ",'" & nombre & "'," & Dia & "," & Mes & "," & Anio & ")"

mcodigo = c

mnombre = nombre

mdia = Dia

mmes = Mes

manio = Anio

End Sub

Public Function BuscaNombre(nombre As String) As Boolean

sql = "select * from DiasF where nombre = '" & nombre & "'"

MisDatos.CursorType = adOpenDynamic

MisDatos.Open sql, MiConexion, , , adCmdText

If MisDatos.EOF = True And MisDatos.BOF = True Then

BuscaNombre = False

Else

With MisDatos

mcodigo = !codigo

mnombre = !nombre

mdia = !Dia

mmes = !Mes

manio = !Anio

End With

BuscaNombre = True

End If

MisDatos.Close

End Function

Public Function BuscaCodigo(codigo As Integer) As Boolean

sql = "select * from DiasF where codigo = " & codigo & ""

MisDatos.CursorType = adOpenDynamic

MisDatos.Open sql, MiConexion, , , adCmdText

If MisDatos.EOF = True And MisDatos.BOF = True Then

BuscaCodigo = False

Else

With MisDatos

mcodigo = !codigo

mnombre = !nombre

mdia = !Dia

mmes = !Mes

manio = !Anio

End With

BuscaCodigo = True

End If

MisDatos.Close

End Function

Public Function BuscaFecha(Dia As Integer, Mes As Integer, Anio As Integer) As Boolean

sql = "select * from DiasF where dia = " & Dia & " and mes = " & Mes & " and anio = " & Anio + 2000 & ""

MisDatos.CursorType = adOpenDynamic

MisDatos.Open sql, MiConexion, , , adCmdText

If MisDatos.EOF = True And MisDatos.BOF = True Then

BuscaFecha = False

Else

With MisDatos

mcodigo = !codigo

mnombre = !nombre

mdia = !Dia

mmes = !Mes

manio = !Anio

End With

BuscaFecha = True

End If

MisDatos.Close

End Function

Public Sub LLenarMes(Mes As CalendarioMes)

Dim m As Integer

Dim a As Integer

m = Mes.Mes

a = Mes.Anyo

sql = "select * from DiasF where mes = " & m & " and anio = " & a & " order by dia"

MisDatos.CursorType = adOpenDynamic

MisDatos.Open sql, MiConexion, , , adCmdText

If Not (MisDatos.EOF = True And MisDatos.BOF = True) = True Then

MisDatos.MoveFirst

While MisDatos.EOF = False

Mes.ColorCelda(MisDatos!Dia) = vbRed

MisDatos.MoveNext

Wend

End If

MisDatos.Close

End Sub

Public Sub LLenarLista(lista As ListBox, Mes As Integer, Anio As Integer)

Dim m As Integer

Dim a As Integer

sql = "select * from DiasF where mes = " & Mes & " and anio = " & Anio & " order by dia"

MisDatos.CursorType = adOpenDynamic

MisDatos.Open sql, MiConexion, , , adCmdText

lista.Clear

If Not (MisDatos.EOF = True And MisDatos.BOF = True) = True Then

MisDatos.MoveFirst

While MisDatos.EOF = False

lista.AddItem CStr(MisDatos!Dia) + "/" + CStr(MisDatos!Mes) + "/" + CStr(MisDatos!Anio) + " " + MisDatos!nombre

lista.ItemData(lista.NewIndex) = MisDatos!codigo

MisDatos.MoveNext

Wend

End If

MisDatos.Close

End Sub

Public Sub Borrar(codigo As Integer)

On Error Resume Next

MiConexion.Execute "Delete from DiasF where Codigo = " & codigo & ""

End Sub

BD_Marcacion:

Option Explicit

Private MisDatos As ADODB.Recordset

Private MisDatosAux As ADODB.Recordset

Private MiConexion As ADODB.Connection

Private sql As String

Private mcodigo As Integer

Private mcod_turno As Integer

Private mestado As Integer

Private mh_ex_t As Integer

Private mm_ex_t As Integer

Private mh_ex_m As Integer

Private mm_ex_m As Integer

Private mhoras_trab As Integer

Private mminutos_trab As Integer

Private mhoras_nocturnas As Integer

Private mminutos_nocturnas As Integer

Private mhora_ing As Integer

Private mminuto_ing As Integer

Private msegundo_ing As Integer

Private mdia_ing As Integer

Private mmes_ing As Integer

Private manio_ing As Integer

Private mhora_sal As Integer

Private mminuto_sal As Integer

Private msegundo_sal As Integer

Private mdia_sal As Integer

Private mmes_sal As Integer

Private manio_sal As Integer

Private mobservacion As Integer

Property Get codigo() As Integer

codigo = mcodigo

End Property

Property Get turno() As Integer

turno = mcod_turno

End Property

Property Get Estado() As Integer

Estado = mestado

End Property

Property Get Extras100() As String

Extras100 = ""

If mh_ex_t < 10 Then Extras100 = "0"

Extras100 = Extras100 + CStr(mh_ex_t) + ":"

If mm_ex_t < 10 Then Extras100 = Extras100 + "0"

Extras100 = Extras100 + CStr(mm_ex_t)

End Property

Property Get Extras50() As String

Extras50 = ""

If mh_ex_m < 10 Then Extras50 = "0"

Extras50 = Extras50 + CStr(mh_ex_m) + ":"

If mm_ex_m < 10 Then Extras50 = Extras50 + "0"

Extras50 = Extras50 + CStr(mm_ex_m)

End Property

Property Get Normal() As String

Normal = ""

If mhoras_trab < 10 Then Normal = "0"

Normal = Normal + CStr(mhoras_trab) + ":"

If mminutos_trab < 10 Then Normal = Normal + "0"

Normal = Normal + CStr(mminutos_trab)

End Property

Property Get Nocturnas() As String

Nocturnas = ""

If mhoras_nocturnas < 10 Then Nocturnas = "0"

Nocturnas = Nocturnas + CStr(mhoras_nocturnas) + ":"

If mminutos_nocturnas < 10 Then Nocturnas = Nocturnas + "0"

Nocturnas = Nocturnas + CStr(mminutos_nocturnas)

End Property

Property Get Ingreso() As String

Ingreso = ""

If mhora_ing < 10 Then Ingreso = "0"

Ingreso = Ingreso + CStr(mhora_ing) + ":"

If mminuto_ing < 10 Then Ingreso = Ingreso + "0"

Ingreso = Ingreso + CStr(mminuto_ing) + ":"

If msegundo_ing < 10 Then Ingreso = Ingreso + "0"

Ingreso = Ingreso + CStr(msegundo_ing) + " "

If mdia_ing < 10 Then Ingreso = Ingreso + "0"

Ingreso = Ingreso + CStr(mdia_ing) + "/"

If mmes_ing < 10 Then Ingreso = Ingreso + "0"

Ingreso = Ingreso + CStr(mmes_ing) + "/"

If manio_ing < 10 Then Ingreso = Ingreso + "0"

Ingreso = Ingreso + CStr(manio_ing)

End Property

Property Get Salida() As String

Salida = ""

If mhora_sal < 10 Then Salida = "0"

Salida = Salida + CStr(mhora_sal) + ":"

If mminuto_sal < 10 Then Salida = Salida + "0"

Salida = Salida + CStr(mminuto_sal) + ":"

If msegundo_sal < 10 Then Salida = Salida + "0"

Salida = Salida + CStr(msegundo_sal) + " "

If mdia_sal < 10 Then Salida = Salida + "0"

Salida = Salida + CStr(mdia_sal) + "/"

If mmes_sal < 10 Then Salida = Salida + "0"

Salida = Salida + CStr(mmes_sal) + "/"

If manio_sal < 10 Then Salida = Salida + "0"

Salida = Salida + CStr(manio_sal)

End Property

Property Get observacion() As Integer

observacion = mobservacion

End Property

Private Sub Class_Initialize()

Set MiConexion = New ADODB.Connection

Set MisDatos = New ADODB.Recordset

Set MisDatosAux = New ADODB.Recordset

MiConexion.ConnectionString = RutaConexion

MiConexion.Open RutaConexion

End Sub

Private Sub Class_Terminate()

MiConexion.Close

End Sub

Private Sub LlenarDatos()

With MisDatos

mcodigo = !codigo

mcod_turno = !cod_turno

mestado = !Estado

mh_ex_t = !h_ex_t

mm_ex_t = !m_ex_t

mh_ex_m = !h_ex_m

mm_ex_m = !m_ex_m

mhoras_trab = !horas_trab

mminutos_trab = !minutos_trab

mhora_ing = !hora_ing

mminuto_ing = !minuto_ing

msegundo_ing = !segundo_ing

mdia_ing = !dia_ing

mmes_ing = !men_ing

manio_ing = !anio_ing

mhora_sal = !hara_sal

mminuto_sal = !minuto_sal

msegundo_sal = !segundo_sal

mdia_sal = !dia_sal

mmes_sal = !mes_sal

manio_sal = !anio_sal

mobservacion = !observacion

End With

End Sub

Public Sub IngresoMarcado(clave As Integer, DatosFecha() As Integer)

'PROGRAMA PARA ANALIZAR DATOS Y GUARDARLOS

Dim turno As Integer

Dim numero As Integer

sql = "select * from marcacion where codigo = " & clave & " and estado = 1"

MisDatos.Open sql, MiConexion, , , adCmdText

If MisDatos.BOF = True And MisDatos.EOF = True Then

mobservacion = 0

MisDatos.Close

turno = VerTurno(clave, DatosFecha)

MisDatos.CursorType = adOpenDynamic

MisDatos.Open "select Num_Marcacion from marcacion order by Num_Marcacion", , , adCmdText

If MisDatos.BOF = True And MisDatos.EOF = True Then

NumeroMarcacion = 1

Else

MisDatos.MoveLast

NumeroMarcacion = MisDatos!Num_marcacion + 1

End If

IngSal = 1

MisDatos.Close

MiConexion.Execute "Insert into marcacion (Num_Marcacion,codigo,cod_turno,estado,hora_ing,minuto_ing," _

& "segundo_ing,dia_ing,mes_ing,anio_ing,observacion) " _

& "values (" & NumeroMarcacion & "," & clave & "," & turno & ",1," & DatosFecha(0) & "," & DatosFecha(1) & "," _

& "" & DatosFecha(2) & "," & DatosFecha(3) & "," & DatosFecha(4) & "," _

& "" & DatosFecha(5) & "," & mobservacion & ")"

Else

If VerificarCierre(clave, DatosFecha) = True Then

NumeroMarcacion = MisDatos!Num_marcacion

IngSal = 2

CerrarTurno clave, DatosFecha

MisDatos.Close

MiConexion.Execute "Update marcacion set" _

& " estado = 2, h_ex_t = " & mh_ex_t & ", " _

& " m_ex_t = " & mm_ex_t & ", h_ex_m = " & mh_ex_m & ", " _

& " m_ex_m = " & mm_ex_m & ", horas_trab = " & mhoras_trab & ", " _

& " minutos_trab = " & mminutos_trab & ", horas_nocturnas = " & mhoras_nocturnas & ", " _

& " minutos_nocturnas = " & mminutos_nocturnas & ", " _

& " hora_sal = " & DatosFecha(0) & ", minuto_sal = " & DatosFecha(1) & ", " _

& " segundo_sal = " & DatosFecha(2) & ", dia_sal = " & DatosFecha(3) & ", " _

& " mes_sal = " & DatosFecha(4) & ", anio_sal = " & DatosFecha(5) & ", " _

& " observacion = " & mobservacion & " " _

& "where codigo = " & clave & " and estado = 1"

Else

turno = MisDatos!cod_turno

MisDatos.Close

MiConexion.Execute "Update marcacion set" _

& " estado = 2, " _

& " observacion = 7 " _

& "where codigo = " & clave & " and estado = 1"

mobservacion = 0

MisDatos.CursorType = adOpenDynamic

MisDatos.Open "select Num_Marcacion from marcacion order by Num_Marcacion", , , adCmdText

If MisDatos.BOF = True And MisDatos.EOF = True Then

NumeroMarcacion = 1

Else

MisDatos.MoveLast

NumeroMarcacion = MisDatos!Num_marcacion + 1

End If

IngSal = 1

MisDatos.Close

MiConexion.Execute "Insert into marcacion (Num_Marcacion,codigo,cod_turno,estado,hora_ing,minuto_ing," _

& "segundo_ing,dia_ing,mes_ing,anio_ing,observacion) " _

& "values (" & NumeroMarcacion & "," & clave & "," & turno & ",1," & DatosFecha(0) & "," & DatosFecha(1) & "," _

& "" & DatosFecha(2) & "," & DatosFecha(3) & "," & DatosFecha(4) & "," _

& "" & DatosFecha(5) & "," & mobservacion & ")"

End If

End If

End Sub

Public Function VerTurno(cl As Integer, Hora() As Integer) As Integer

Dim HT As Double

Dim HM As Double

Dim Tol As Double

Dim Difer As Double

Dim EsAtrazo As Boolean

HM = Hora(0) + (Hora(1) / 60)

sql = "SELECT * FROM Turnos " _

& "INNER JOIN Asignaciones ON Turnos.codigo = Asignaciones.cod_turno " _

& "WHERE (((Asignaciones.cod_empleado)=" & cl & "))"

MisDatos.CursorType = adOpenDynamic

MisDatos.Open sql, MiConexion, , , adCmdText

If MisDatos.BOF = True And MisDatos.EOF = True Then

mobservacion = 1

VerTurno = -1

MisDatos.Close

Else

MisDatos.MoveFirst

Difer = 1000

While MisDatos.EOF = False

HT = MisDatos!horad1 + (MisDatos!minutod1 / 60)

Tol = MisDatos!toled1 / 60

If HM >= HT – Tol And HM <= HT + Tol Then

VerTurno = MisDatos!codigo

MisDatos.Close

Exit Function

Else

If Difer > Abs(HT – HM) Then

VerTurno = MisDatos!codigo

Difer = Abs(HT – HM)

If HT – HM > 0 Then

EsAtrazo = False

Else

EsAtrazo = True

End If

End If

End If

MisDatos.MoveNext

Wend

MisDatos.Close

If EsAtrazo = True Then

mobservacion = 2

Else

mobservacion = 4

End If

End If

End Function

Private Sub CerrarTurno(cl As Integer, Hora() As Integer)

Dim HT As Double

Dim HM As Double

Dim Tol As Double

If MisDatos!cod_turno <> -1 Then

sql = "select * from Turnos where codigo = " & MisDatos!cod_turno & ""

MisDatosAux.Open sql, MiConexion, , , adCmdText

mobservacion = MisDatos!observacion

HM = (Hora(0) + Hora(1) / 60)

HT = MisDatosAux!horah1 + (MisDatosAux!minutoh1 / 60)

Tol = MisDatosAux!toleh1 / 60

If HM >= HT – Tol And HM <= HT + Tol Then

If MisDatos!observacion = 0 Then

CalculoHoras MisDatosAux!horad1, MisDatosAux!minutod1, MisDatosAux!horah1, MisDatosAux!minutoh1, Hora

Else

CalculoHoras MisDatos!hora_ing, MisDatos!minuto_ing, Hora(0), Hora(1), Hora

End If

Else

If HM < HT Then

Select Case MisDatos!observacion

Case 0

mobservacion = 3

Case 2

mobservacion = 5

Case 4

mobservacion = 6

End Select

End If

CalculoHoras MisDatos!hora_ing, MisDatos!minuto_ing, Hora(0), Hora(1), Hora

End If

MisDatosAux.Close

Else

CalculoHoras MisDatos!hora_ing, MisDatos!minuto_ing, Hora(0), Hora(1), Hora

End If

End Sub

Private Sub CalculoHoras(HD As Integer, MD As Integer, HH As Integer, MH As Integer, fecha() As Integer)

Dim Ndias As Integer

Dim FD As String

Dim FH As String

Dim H_Desde As String

Dim H_Hasta As String

Dim HoraHasta As Integer

Dim HoraDesde As Integer

Dim Tminutos As Integer

Dim MinutosNoche As Integer

Dim k As Integer

Dim T_Aux As Integer

Dim DiasFeriados As BD_DiasF

Set DiasFeriados = New BD_DiasF

FD = CStr(MisDatos!dia_ing) + "/" + CStr(MisDatos!mes_ing) + "/" + CStr(MisDatos!anio_ing)

FH = CStr(fecha(3)) + "/" + CStr(fecha(4)) + "/" + CStr(fecha(5))

Ndias = DateDiff("d", FD, FH)

FD = CStr(HD) + ":" + CStr(MD) + ":00 " + _

CStr(MisDatos!dia_ing) + "/" + CStr(MisDatos!mes_ing) + "/" + CStr(MisDatos!anio_ing)

FH = CStr(HH) + ":" + CStr(MH) + ":00 " + _

CStr(fecha(3)) + "/" + CStr(fecha(4)) + "/" + CStr(fecha(5))

Tminutos = DateDiff("n", FD, FH)

mhoras_trab = Int(Tminutos / 60)

mminutos_trab = Tminutos – (Int(Tminutos / 60) * 60)

If Ndias = 0 Then

If ((Val(Format(FD, "w")) = 1 Or Val(Format(FD, "w")) = 7) And SD100 = True) Or DiasFeriados.BuscaFecha(fecha(3), fecha(4), fecha(5)) = True Then

mh_ex_t = mhoras_trab

mm_ex_t = mminutos_trab

mhoras_trab = 0

mminutos_trab = 0

Else

H_Desde = CStr(HoraNocD) + ":" + CStr(MinutoNocD) + ":00"

H_Hasta = CStr(MisDatos!hora_ing) + ":" + CStr(MisDatos!minuto_ing) + ":00"

If Val(DateDiff("n", H_Desde, H_Hasta)) > 0 Then

mhoras_nocturnas = mhoras_trab

mminutos_nocturnas = mminutos_trab

Else

H_Desde = CStr(fecha(0)) + ":" + CStr(fecha(1)) + ":00"

H_Hasta = CStr(HoraNocD) + ":" + CStr(MinutoNocD) + ":00"

MinutosNoche = Val(DateDiff("n", H_Hasta, H_Desde))

If MinutosNoche > 0 Then

mhoras_nocturnas = Int(MinutosNoche / 60)

mminutos_nocturnas = MinutosNoche – (mhoras_nocturnas * 60)

End If

End If

End If

Else

For k = 0 To Ndias

If k = 0 Then

H_Desde = CStr(MisDatos!hora_ing) + ":" + CStr(MisDatos!minuto_ing) + ":00"

H_Hasta = "23:59:00"

Tminutos = Val(DateDiff("n", H_Desde, H_Hasta)) + 1

If ((Val(Format(FD, "w")) = 1 Or Val(Format(FD, "w")) = 7) And SD100 = True) Or DiasFeriados.BuscaFecha(fecha(3), fecha(4), fecha(5)) = True Then

mh_ex_t = Int(Tminutos / 60)

mm_ex_t = Tminutos – (mhoras_trab * 60)

mhoras_trab = 0

mminutos_trab = 0

Else

mhoras_trab = Int(Tminutos / 60)

mminutos_trab = Tminutos – (mhoras_trab * 60)

If mhoras_trab > 8 Then

mh_ex_m = mhoras_trab – 8

mm_ex_m = mminutos_trab

mhoras_trab = 8

mminutos_trab = 0

H_Hasta = CStr(MisDatos!hora_ing + 8) + ":" + CStr(MisDatos!minuto_ing) + ":00"

Else

H_Hasta = "23:59:00"

End If

If Val(DateDiff("n", CStr(HoraNocD) + ":" + CStr(MinutoNocD), CStr(MisDatos!hora_ing) + ":" + CStr(MisDatos!minuto_ing))) > 0 Then

H_Desde = CStr(MisDatos!hora_ing) + ":" + CStr(MisDatos!minuto_ing)

Else

H_Desde = CStr(HoraNocD) + ":" + CStr(MinutoNocD)

End If

MinutosNoche = Val(DateDiff("n", H_Desde, H_Hasta)) + 1

If H_Hasta = "23:59:00" Then MinutosNoche = MinutosNoche + 1

If MinutosNoche > 0 Then

mhoras_nocturnas = Int(MinutosNoche / 60)

mminutos_nocturnas = MinutosNoche – (mhoras_nocturnas * 60)

End If

End If

Else

If k = Ndias Then

H_Desde = "00:00:00"

H_Hasta = CStr(fecha(0)) + ":" + CStr(fecha(1)) + ":00"

Tminutos = Val(DateDiff("n", H_Desde, H_Hasta))

FD = CStr(fecha(3)) + "/" + CStr(fecha(4)) + "/" + CStr(fecha(5))

If mhoras_trab = 8 Then

If ((Val(Format(FD, "w")) = 1 Or Val(Format(FD, "w")) = 7) And SD100 = True) Or DiasFeriados.BuscaFecha(fecha(3), fecha(4), fecha(5)) = True Then

mh_ex_t = mh_ex_t + Int(Tminutos / 60)

mm_ex_t = mm_ex_t + Tminutos – (mh_ex_t * 60)

If mm_ex_t >= 60 Then

mh_ex_t = mh_ex_t + Int(mm_ex_t / 60)

mm_ex_t = mm_ex_t – (Int(mm_ex_t / 60) * 60)

End If

Else

mh_ex_m = mh_ex_m + Int(Tminutos / 60)

mm_ex_m = mm_ex_m + Tminutos – (Int(Tminutos / 60) * 60)

If mm_ex_m >= 60 Then

mh_ex_m = mh_ex_m + Int(mm_ex_m / 60)

mm_ex_m = mm_ex_m – (Int(mm_ex_m / 60) * 60)

End If

End If

Else

T_Aux = (mhoras_trab * 60) + mminutos_trab

mhoras_trab = mhoras_trab + Int(Tminutos / 60)

mminutos_trab = mminutos_trab + Tminutos – (Int(Tminutos / 60) * 60)

If mminutos_trab >= 60 Then

mhoras_trab = mhoras_trab + Int(mminutos_trab / 60)

mminutos_trab = mminutos_trab – (Int(mminutos_trab / 60) * 60)

End If

If mhoras_trab > 8 Then

If ((Val(Format(FD, "w")) = 1 Or Val(Format(FD, "w")) = 7) And SD100 = True) Or DiasFeriados.BuscaFecha(fecha(3), fecha(4), fecha(5)) = True Then

mh_ex_t = mhoras_trab – 8

mm_ex_t = mminutos_trab

Else

mh_ex_m = mh_ex_m + mhoras_trab – 8

mm_ex_m = mminutos_trab

End If

mhoras_trab = 8

mminutos_trab = 0

Tminutos = 480 – T_Aux

H_Hasta = CStr(Int(Tminutos / 60)) + ":" + CStr(Tminutos – (Int(Tminutos / 60) * 60)) + ":00"

Else

H_Hasta = CStr(fecha(0)) + ":" + CStr(fecha(1)) + ":00"

End If

H_Desde = CStr(HoraNocH) + ":" + CStr(MinutoNocH) + ":00"

MinutosNoche = Val(DateDiff("n", H_Desde, H_Hasta))

If MinutosNoche > 0 Then

mhoras_nocturnas = mhoras_nocturnas + HoraNocH

mminutos_nocturnas = mminutos_nocturnas + MinutoNocH

Else

If H_Hasta = CStr(fecha(0)) + ":" + CStr(fecha(1)) + ":00" Then

mhoras_nocturnas = mhoras_nocturnas + fecha(0)

mminutos_nocturnas = mminutos_nocturnas + fecha(1)

Else

mhoras_nocturnas = mhoras_nocturnas + Int(Tminutos / 60)

mminutos_nocturnas = mminutos_nocturnas + (Tminutos – (Int(Tminutos / 60) * 60))

End If

End If

If mminutos_nocturnas >= 60 Then

mhoras_nocturnas = mhoras_nocturnas + Int(mminutos_nocturnas / 60)

mminutos_nocturnas = mminutos_nocturnas – (Int(mminutos_nocturnas / 60) * 60)

End If

End If

Else

FD = DateAdd("d", 1, FD)

If mhoras_trab = 8 Then

If ((Val(Format(FD, "w")) = 1 Or Val(Format(FD, "w")) = 7) And SD100 = True) Or DiasFeriados.BuscaFecha(Day(FD), Month(FD), Year(FD)) = True Then

mh_ex_t = mh_ex_t + 24

Else

mh_ex_m = mh_ex_m + 24

End If

Else

mhoras_trab = mhoras_trab + 24

If ((Val(Format(FD, "w")) = 1 Or Val(Format(FD, "w")) = 7) And SD100 = True) Or DiasFeriados.BuscaFecha(Day(FD), Month(FD), Year(FD)) = True Then

mh_ex_t = mhoras_trab – 8

mm_ex_t = mminutos_trab

Else

mh_ex_m = mhoras_trab – 8

mm_ex_m = mminutos_trab

End If

mhoras_trab = 8

mminutos_trab = 0

mhoras_nocturnas = mhoras_nocturnas + HoraNocH

mminutos_nocturnas = mminutos_nocturnas + MinutoNocH

End If

End If

End If

Next k

End If

End Sub

Private Function VerificarCierre(cl As Integer, Hora() As Integer) As Boolean

Dim HT As Double

Dim HM As Double

Dim Tol As Double

HM = Hora(0) + (Hora(1) / 60)

sql = "SELECT * FROM Turnos " _

& "WHERE codigo=" & MisDatos!cod_turno & ""

MisDatosAux.Open sql, MiConexion, , , adCmdText

HT = MisDatosAux!horad1 + (MisDatosAux!minutod1 / 60)

Tol = MisDatosAux!toled1 / 60

If HM >= HT – Tol And HM <= HT + Tol Then

VerificarCierre = False

Else

VerificarCierre = True

End If

MisDatosAux.Close

End Function

Public Sub LlenarListado(fecha As Date, lista As ListBox, Esta As Integer)

Dim Dia As Integer

Dim Mes As Integer

Dim Anio As Integer

Dia = Day(fecha)

Mes = Month(fecha)

Anio = Year(fecha) – 2000

lista.Clear

sql = "select marcacion.num_marcacion,marcacion.codigo," _

& "personal.nombre1,personal.nombre2,personal.apellido1,personal.apellido2 " _

& "from personal inner join marcacion on Personal.codigo = marcacion.codigo " _

& "where marcacion.dia_ing=" & Dia & " and marcacion.mes_ing=" & Mes & " and marcacion.anio_ing=" & Anio & ""

If Esta <> 0 Then sql = sql + " and estado=" & Esta & ""

sql = sql + " order by hora_ing,minuto_ing"

MisDatos.CursorType = adOpenDynamic

MisDatos.Open sql, MiConexion, , , adCmdText

If MisDatos.BOF = True And MisDatos.EOF = True Then

lista.AddItem "NO HAY REGISTROS"

lista.Enabled = False

Else

lista.Enabled = True

MisDatos.MoveFirst

While MisDatos.EOF = False

lista.AddItem MisDatos!nombre1 + " " + MisDatos!nombre2 + " " + MisDatos!apellido1 + " " + MisDatos!apellido2

lista.ItemData(lista.NewIndex) = MisDatos!Num_marcacion

MisDatos.MoveNext

Wend

End If

Partes: 1, 2, 3, 4
 Página anterior Volver al principio del trabajoPágina siguiente