TEMARIO:
- NOMBRE DE LA TIENDA
- LOGOTIPO O IMAGEN REPRESETATIVA
- NIVELES DE USUARIO
- PANTALLA PRINCIPAL DEL PROYECTO “SUPER SOBRAS”
- PANTALLA QUE VALIDA LA CONTRASEÑA DEL ADMINISTRADOR
- CONTRASEÑA ERRRONEA
- CONTRASEÑA VALIDA
- PATALLA DE TRABAJO DEL ADMINISTRADOR
- OPCION AGREGAR TRBAJADOR
- AGREGAR PRODUCTOS
- BORRAR ELEMENTOS DEL ALMACEN O DB.
- SEGURO DE HACER LOS CAMBIOS:
- VALIDACION DE CONTRASEÑA DE CAJEROS
- NOMBRE DE CAJERO NO RECONOCIDO
- CONTRASEÑA ADMITIDA
- EXTRAS DEL PROYECTO
- VISUALIZA PRODUCTOS
- USUARIO SOLO VISUALIZA PRODUCTOS Y CARACTERISTICA PRECIO.
- RESPALDO DE BASE DE DATOS
- INVENTARIO:
NOMBRE DE LA TIENDA:
NIVELES DE USUARIO:
LOGOTIPO O IMAGEN REPRESETATIVA:
PANTALLA PRINCIPAL DEL PROYECTO “SUPER SOBRAS”
AL DAR CLICK EN ADMINISTRADOR: llama el formulario 1
|
Private Sub Command1_Click()
Form1.Show
End Sub
AL DAR CLICK EN CAJERO: llama el formulario 2
|
Private Sub Command2_Click()
Form2.Show
End Sub
AL DAR CLICK EN USUARIO: llama el formulario 3
|
Private Sub Command3_Click()
frmTes.Show
End Sub
AL DAR CLICK EN SALIR : Termina
|
Private Sub Command4_Click()
End
End Sub
Private Sub Form_Load()
End Sub
PANTALLA QUE VALIDA LA CONTRASEÑA DEL ADMINISTRADOR
La clave universal es: valor de Pi: aproximado y se tiene que dar para ingresar al sistema. Si no manda un mensaje para volver intentarlo
|
Private Sub Command1_Click()
If Text2.Text = "3.141592" Then
MsgBox ("BIENVENIDO")
frmad.Show
Else
MsgBox ("No eres administrador, Intenta de nuevo")
End If
End Sub
Private Sub Command2_Click()
Supersobras.Show
End Sub
Private Sub Label2_Click()
End Sub
CONTRASEÑA ERRRONEA
CONTRASEÑA VALIDA
PATALLA DE TRABAJO DEL ADMINISTRADOR:
OPCION AGREGAR TRBAJADOR:
AGREGAR PRODUCTOS:
Option Explicit
Dim cnAP As ADODB.Connection
Dim rsUsers As ADODB.Recordset
Dim mDuplicate As Boolean
Dim mNew As Boolean
Dim mDirty As Boolean
Dim mMove As Boolean
Dim mBkMark As Variant
Dim bBookMarkable As Boolean
Public Sub DimControls(cString As String)
Dim i As Integer
Dim jcStr() As String
jcStr = Split(cString, ",")
For i = LBound(jcStr) To UBound(jcStr)
cmdControl(i).Enabled = Val(jcStr(i))
Next
End Sub
Private Sub cmdControl_Click(Index As Integer)
If bBookMarkable And rsUsers.RecordCount > 0 Then
mBkMark = rsUsers.Bookmark
End If
Dim strSQL As String
Select Case Index
Case 0
ClearControls
mNew = True
DimControls "0,0,0,1,1"
DimNav "0,0,0,0"
Case 1
If rsUsers.RecordCount > 0 Then
If (MsgBox("¿ESTAS SEGURO DE BORRAR EL PRODUCTO? : " & rsUsers!UserName, vbYesNo, "DB Turor") = vbYes) Then
With rsUsers
.Delete
.Requery
If EmptyDB(rsUsers) Then
Call ClearControls
mDirty = False
End If
LoadControls
Call cmdNavigate_Click(2)
End With
End If
End If
Case 2 '
mDuplicate = True
DimControls "0,0,0,1,1"
DimNav "0,0,0,0"
Case 3
If mDuplicate Or mNew Then
strSQL = "INSERT INTO Users (UserName, Pwd,Cost,Units, Ventas) VALUES ('" _
& txtUserName.Text & "','" & txtPwd.Text & "','" & cost.Text & "','" & units.Text & "','" & Text1.Text & "');"
Else
If EmptyDB(rsUsers) Then
LoadControls
Exit Sub
End If
strSQL = "UPDATE Users SET UserName = '" & txtUserName.Text & "', Pwd = '" & txtPwd.Text & "', Cost = '" & cost.Text & "', Units = '" & units.Text & "', Ventas = '" & Text1.Text & "'" _
& "WHERE Users.ID = " & rsUsers!id & ";"
End If
cnAP.Execute strSQL
rsUsers.Requery
mDuplicate = False
mNew = False
mDirty = False
DimControls "1,1,1,0,0"
DimNavX '
Me.Caption = "DB Tester (" & rsUsers.AbsolutePosition & " of " & rsUsers.RecordCount & ")"
Case 4
If bBookMarkable And rsUsers.RecordCount > 0 Then
rsUsers.Bookmark = mBkMark
End If
LoadControls
mDuplicate = False
mNew = False
mDirty = False
End Select
mBkMark = -1
End Sub
Private Sub ClearControls()
txtUserName.Text = vbNullString
txtPwd.Text = vbNullString
cost.Text = vbNullString
units.Text = vbNullString
Text1.Text = vbNullString
End Sub
Private Sub cmdNavigate_Click(Index As Integer)
With rsUsers
If EmptyDB(rsUsers) Then
DimNavX
Exit Sub
End If
Select Case Index
Case 0
.MoveFirst
Case 1
.MovePrevious
If .BOF Then
.MoveFirst
End If
Case 2
.MoveNext
If .EOF Then
.MoveLast
End If
Case 3
.MoveLast
End Select
End With
mMove = True
LoadControls
End Sub
Public Sub DimNav(cString As String)
Dim jcStr() As String
Dim i As Integer
jcStr = Split(cString, ",")
For i = LBound(jcStr) To UBound(jcStr)
cmdNavigate(i).Enabled = Val(jcStr(i))
Next
End Sub
Private Sub Command1_Click()
RESPALDADOR.Show
End Sub
Private Sub cost_Change()
If Not mMove Then
DimControls "0,0,0,1,1"
DimNav "0,0,0,0"
mDirty = True
End If
End Sub
Private Sub Form_Load()
Set cnAP = New ADODB.Connection
Set rsUsers = New ADODB.Recordset
rsUsers.CursorLocation = adUseClient
cnAP.Open "Driver={Microsoft Access Driver (*.mdb)};" & _
"Dbq=" & App.Path & "mydb.mdb;" & _
"Uid=admin;" & _
"Pwd="
cnAP.CursorLocation = adUseClient
rsUsers.Open "SELECT * FROM Users;", cnAP, adOpenDynamic, adLockPessimistic
LoadControls
Me.Caption = "DB Tester (" & rsUsers.AbsolutePosition & " of " & rsUsers.RecordCount & ")"
bBookMarkable = IIf(rsUsers.Supports(adBookmark), True, False)
End Sub
Private Sub LoadControls()
With rsUsers
If .RecordCount <= 1 Then
DimNavX '"0,0,0,0"
End If
If EmptyDB(rsUsers) Then
DimControls "1,0,0,0,0"
Exit Sub
End If
If .BOF Then
.MoveFirst
End If
If .EOF Then
.MoveLast
End If
txtUserName.Text = !UserName & ""
txtPwd.Text = !pwd & ""
cost.Text = !cost & ""
units.Text = !units & ""
Text1.Text = !Ventas & ""
End With
DimNavX
DimControls "1,1,1,0,0"
mDirty = False
Me.Caption = "DB Tester (" & rsUsers.AbsolutePosition & " of " & rsUsers.RecordCount & ")"
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim jAnswer As Long
If mDirty Then
jAnswer = MsgBox("¿DESEAS GUARDAR LOS DATOS?", vbYesNoCancel + vbExclamation, "DB Tester")
Select Case jAnswer
Case vbYes
Call cmdControl_Click(3)
Cancel = False
Case vbNo
Cancel = False
Case vbCancel
Cancel = True
End Select
End If
End Sub
Private Sub txtPwd_Change()
If Not mMove Then
DimControls "0,0,0,1,1"
DimNav "0,0,0,0"
mDirty = True
End If
End Sub
Private Sub txtUserName_Change()
If Not mMove Then
DimControls "0,0,0,1,1"
DimNav "0,0,0,0"
mDirty = True
End If
End Sub
Private Function EmptyDB(objrs As ADODB.Recordset) As Boolean
If objrs.BOF And objrs.EOF Then
EmptyDB = True
Else
EmptyDB = False
End If
End Function
Private Sub DimNavX()
Dim jPos, jCount As Long
With rsUsers
jPos = .AbsolutePosition
jCount = .RecordCount
End With
If jCount > 0 Then
If jPos = 1 Then
DimNav "0,0,1,1"
Else
If jPos = jCount Then
DimNav "1,1,0,0"
Else
DimNav "1,1,1,1"
End If
End If
If jCount = 1 Then
DimNav "0,0,0,0"
End If
Else
DimNav "0,0,0,0"
End If
End Sub
Private Sub units_Change()
If Not mMove Then
DimControls "0,0,0,1,1"
DimNav "0,0,0,0"
mDirty = True
End If
End Sub
BORRAR ELEMENTOS DEL ALMACEN O DB.
SEGURO DE HACER LOS CAMBIOS:
VALIDACION DE CONTRASEÑA DE CAJEROS
MsgBox ("welcome")
frmCajero.Show
ElseIf Text1.Text = "Laura" And Text2.Text = "12345" Then
MsgBox ("welcome")
frmCajero.Show
Else
MsgBox ("no eres usuario admitido, try again")
End If
End Sub
Private Sub Command2_Click()
Supersobras.Show
End Sub
Private Sub Option3_Click()
End Sub
Private Sub Text1_Change()
End Sub
NOMBRE DE CAJERO NO RECONOCIDO
CONTRASEÑA ADMITIDA
Private Sub Command1_Click()
If Text1.Text = "Salvador" And Text2.Text = "123" Then
MsgBox ("welcome")
frmCajero.Show
ElseIf Text1.Text = "Eduardo" And Text2.Text = "1234" Then
MsgBox ("welcome")
frmCajero.Show
ElseIf Text1.Text = "Ivonne" And Text2.Text = "12345" Then
MsgBox ("welcome")
frmCajero.Show
ElseIf Text1.Text = "Laura" And Text2.Text = "12345" Then
MsgBox ("welcome")
frmCajero.Show
Else
MsgBox ("no eres usuario admitido, try again")
End If
End Sub
Private Sub Command2_Click()
Supersobras.Show
End Sub
Private Sub Option3_Click()
End Sub
EXTRAS DEL PROYECTO:
Private Sub Text2_Change()
If Not mMove Then
DimControls "0,0,0,1,1"
DimNav "0,0,0,0"
mDirty = True
End If
End Sub
Private Sub Text3_Change()
If Not mMove Then
DimControls "0,0,0,1,1"
DimNav "0,0,0,0"
mDirty = True
End If
End Sub
Private Sub txtPwd_Change()
If Not mMove Then
DimControls "0,0,0,1,1"
DimNav "0,0,0,0"
mDirty = True
End If
End Sub
Private Sub txtUserName_Change()
If Not mMove Then
DimControls "0,0,0,1,1"
DimNav "0,0,0,0"
mDirty = True
End If
End Sub
Private Function EmptyDB(objrs As ADODB.Recordset) As Boolean
If objrs.BOF And objrs.EOF Then
EmptyDB = True
Else
EmptyDB = False
End If
End Function
Private Sub DimNavX()
Dim jPos, jCount As Long
With rsUsers
jPos = .AbsolutePosition
jCount = .RecordCount
End With
If jCount > 0 Then
If jPos = 1 Then
DimNav "0,0,1,1"
Else
If jPos = jCount Then
DimNav "1,1,0,0"
Else
DimNav "1,1,1,1"
End If
End If
If jCount = 1 Then
DimNav "0,0,0,0"
End If
Else
DimNav "0,0,0,0"
End If
End Sub
Private Sub units_Change()
If Not mMove Then
DimControls "0,0,0,1,1"
DimNav "0,0,0,0"
mDirty = True
End If
End Sub
VISUALIZA PRODUCTOS:
USUARIO SOLO VISUALIZA PRODUCTOS Y CARACTERISTICA PRECIO.
Private Sub cmdNavigate_Click(Index As Integer)
With rsUsers
If EmptyDB(rsUsers) Then
DimNavX
Exit Sub
End If
Select Case Index
Case 0
.MoveFirst
Case 1
.MovePrevious
If .BOF Then
.MoveFirst
End If
Case 2
.MoveNext
If .EOF Then
.MoveLast
End If
Case 3
.MoveLast
End Select
End With
mMove = True
LoadControls
End Sub
Private Sub cmdNavigate_Click2(Index As Integer)
With rsUsers
If EmptyDB(rsUsers) Then
DimNavX
Exit Sub
End If
Select Case Index
Case 0
.MoveFirst
Case 1
.MovePrevious
If .BOF Then
.MoveFirst
End If
Case 2
.MoveNext
If .EOF Then
.MoveLast
End If
Case 3
.MoveLast
End Select
End With
mMove = True
LoadControls
End Sub
Private Sub txtUserName_Change()
If Not mMove Then
DimControls "0,0,0,1,1"
DimNav "0,0,0,0"
mDirty = True
End If
End Sub
Private Sub txtPwd_Change()
If Not mMove Then
DimControls "0,0,0,1,1"
DimNav "0,0,0,0"
mDirty = True
End If
End Sub
Private Sub Text2_Change()
End Sub
RESPALDO DE BASE DE DATOS:
If BTest < BUFSIZE Then
Chunk = BTest
Else
Chunk = BUFSIZE
End If
Buf = String(Chunk, " ")
Get F1, , Buf
Put F2, , Buf
BTest = FSize - LOF(F2)
ProgressBar.Value = (100 - Int(100 * BTest / FSize))
Loop Until BTest = 0
Close F1
Close F2
CopyFile = FSize
ProgressBar.Value = 0
Exit Function
FileCopyError:
MsgBox "ERROR DE COPIADO , INTENTA OTRA VEZ"
Close F1
Close F2
Exit Function
End Function
Public Function ExtractName(SpecIn As String) As String
Dim i As Integer
Dim SpecOut As String
On Error Resume Next
For i = Len(SpecIn) To 1 Step -1
If Mid(SpecIn, i, 1) = "" Then
SpecOut = Mid(SpecIn, i + 1)
Exit For
End If
Next i
ExtractName = SpecOut
End Function
Private Sub Browsedestination_Click()
Dim bi As BROWSEINFO
Dim rtn&, pidl&, path$, pos%
bi.hOwner = Me.hWnd
bi.lpszTitle = "BUSCAR EL DESTINO..."
bi.ulFlags = BIF_RETURNONLYFSDIRS
pidl& = SHBrowseForFolder(bi)
path = Space(512)
T = SHGetPathFromIDList(ByVal pidl&, ByVal path)
pos% = InStr(path$, Chr$(0))
SpecIn = Left(path$, pos - 1)
If Right$(SpecIn, 1) = "" Then
SpecOut = SpecIn
Else
SpecOut = SpecIn + ""
End If
Destinationpath.Text = SpecOut + ExtractName(Filepath.Text)
End Sub
Private Sub Browsefile_Click()
Dialog.DialogTitle = "BUSCAR EL ORIGEN..."
Dialog.ShowOpen
Filepath.Text = Dialog.FileName
End Sub
Private Sub Cancel_Click()
Unload Me
End Sub
Private Sub Copy_Click()
On Error Resume Next
If Filepath.Text = "" Then
MsgBox "ESPECIFICA EL ORIGEN", vbCritical
Exit Sub
End If
If Destinationpath.Text = "" Then
MsgBox "ESPECIFICA EL DESTINO POR FAVOR", vbCritical
Exit Sub
End If
ProgressBar.Value = CopyFile(Filepath.Text, Destinationpath.Text)
End Sub
Private Sub filepath_Change()
Destinationpath.Enabled = True
Browsedestination.Enabled = True
Destinationpath.SetFocus
End Sub
Private Sub Form_Load()
Move (Screen.Width - Width) 2, (Screen.Height - Height) 2
End Sub
INVENTARIO: