Universidad Interamericana de Puerto Rico

Recinto Metropolitano

Facultad de Ciencias y Tecnología

Departamento de Ciencias de Computadoras

Programa Graduado en Computación Educativa

Proyecto 2

Inventario de compañías

Gladys M. Ortiz Castillo

596-16-0280

CEDU 5120 Programación de Computadoras

Sección 14007

Profesor Carlos A. Díaz Aponte

Descripción del programa

            El te permite trabajar con el inventario de tres compañías. Escoges la compañía con la que quieres trabajar, entrar la contraseña (“password”) y trabajas contra los datos que se obtienen de y almacenan a una base de datos.

Listado del programa y ejemplo de pantallas

Option Explicit

'Gladys M. Ortiz Castillo

'Archivo: frmSplash

'Descripción: Pantalla de inicio y que presenta la información relacionada a la aplicación.

'Entradas: N/A

'Salidas: N/A

Private Sub Form_KeyPress(KeyAscii As Integer)

    frmMenu.Show

    Unload Me

End Sub

Private Sub Form_Load()

    lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision

    lblProductName.Caption = App.Title

End Sub

Private Sub Frame1_Click()

    frmMenu.Show

    Unload Me

End Sub

Private Sub Timer1_Timer()

    frmMenu.Show

Unload Me

End Sub

Option Explicit

'Gladys M. Ortiz Castillo

'Archivo: frmMenu

'Descripción: Pantalla que presenta la opción de escoger la compañía con la que uno desea trabajar.

'Entradas: cmbList

'Salidas: N/A

'Terminar aplicación

Private Sub cmdSalir_Click()

    End

End Sub

'Llenar combo box

Private Sub Form_Load()

    cmbLista.AddItem "COMPUTER_LAB"

    cmbLista.AddItem "MUEBLETON"

    cmbLista.AddItem "MUSIC_SHOP"

End Sub

'Comenzar con aplicación

Private Sub cmdAcceder_Click()

    If cmbLista.Text = "" Then

        MsgBox "Favor de escoger una compañía"

cmbLista.SetFocus

    Else

        frmLogin.Show

    End If

End Sub

'Ver forma de About

Private Sub mnuAcerca_Click()

    frmAbout.Show

End Sub

'Terminar aplicación

Private Sub mnuSalir_Click()

    End

End Sub

Option Explicit

'Gladys M. Ortiz Castillo

'Archivo: frmAbout

'Descripción: Pantalla que presenta la información relacionada a la aplicación.

'Entradas: N/A

'Salidas: N/A

' Reg Key Security Options...

Const READ_CONTROL = &H20000

Const KEY_QUERY_VALUE = &H1

Const KEY_SET_VALUE = &H2

Const KEY_CREATE_SUB_KEY = &H4

Const KEY_ENUMERATE_SUB_KEYS = &H8

Const KEY_NOTIFY = &H10

Const KEY_CREATE_LINK = &H20

Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _

                       KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _

                       KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL

' Reg Key ROOT Types...

Const HKEY_LOCAL_MACHINE = &H80000002

Const ERROR_SUCCESS = 0

Const REG_SZ = 1                         ' Unicode nul terminated string

Const REG_DWORD = 4                      ' 32-bit number

Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"

Const gREGVALSYSINFOLOC = "MSINFO"

Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"

Const gREGVALSYSINFO = "PATH"

Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long

Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long

Private Sub cmdSysInfo_Click()

  Call StartSysInfo

End Sub

Private Sub cmdOK_Click()

  Unload Me

End Sub

Private Sub Form_Load()

    Me.Caption = "About " & App.Title

    lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision

    lblTitle.Caption = App.Title

End Sub

Public Sub StartSysInfo()

    On Error GoTo SysInfoErr

    Dim rc As Long

    Dim SysInfoPath As String

    ' Try To Get System Info Program Path\Name From Registry...

    If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then

    ' Try To Get System Info Program Path Only From Registry...

    ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then

        ' Validate Existance Of Known 32 Bit File Version

        If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then

            SysInfoPath = SysInfoPath & "\MSINFO32.EXE"

        ' Error - File Can Not Be Found...

        Else

            GoTo SysInfoErr

        End If

    ' Error - Registry Entry Can Not Be Found...

    Else

        GoTo SysInfoErr

    End If

    Call Shell(SysInfoPath, vbNormalFocus)

    Exit Sub

SysInfoErr:

    MsgBox "System Information Is Unavailable At This Time", vbOKOnly

End Sub

Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean

    Dim i As Long                                           ' Loop Counter

    Dim rc As Long                                          ' Return Code

    Dim hKey As Long                                        ' Handle To An Open Registry Key

    Dim hDepth As Long                                      '

    Dim KeyValType As Long                                  ' Data Type Of A Registry Key

    Dim tmpVal As String                                    ' Tempory Storage For A Registry Key Value

    Dim KeyValSize As Long                                  ' Size Of Registry Key Variable

    '------------------------------------------------------------

    ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}

    '------------------------------------------------------------

    rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key

    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...

    tmpVal = String$(1024, 0)                             ' Allocate Variable Space

    KeyValSize = 1024                                       ' Mark Variable Size

    '------------------------------------------------------------

    ' Retrieve Registry Key Value...

    '------------------------------------------------------------

    rc = RegQueryValueEx(hKey, SubKeyRef, 0, _

                         KeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value

    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Errors

    If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then           ' Win95 Adds Null Terminated String...

        tmpVal = Left(tmpVal, KeyValSize - 1)               ' Null Found, Extract From String

    Else                                                    ' WinNT Does NOT Null Terminate String...

        tmpVal = Left(tmpVal, KeyValSize)                   ' Null Not Found, Extract String Only

    End If

    '------------------------------------------------------------

    ' Determine Key Value Type For Conversion...

    '------------------------------------------------------------

    Select Case KeyValType                                  ' Search Data Types...

    Case REG_SZ                                             ' String Registry Key Data Type

        KeyVal = tmpVal                                     ' Copy String Value

    Case REG_DWORD                                          ' Double Word Registry Key Data Type

        For i = Len(tmpVal) To 1 Step -1                    ' Convert Each Bit

            KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' Build Value Char. By Char.

        Next

        KeyVal = Format$("&h" + KeyVal)                     ' Convert Double Word To String

    End Select

    GetKeyValue = True                                      ' Return Success

    rc = RegCloseKey(hKey)                                  ' Close Registry Key

    Exit Function                                           ' Exit

GetKeyError:      ' Cleanup After An Error Has Occured...

    KeyVal = ""                                             ' Set Return Val To Empty String

GetKeyValue = False                                     ' Return Failure

    rc = RegCloseKey(hKey)                                  ' Close Registry Key

End Function

Option Explicit

'Gladys M. Ortiz Castillo

'Archivo: frmLogin

'Descripción: Pantalla que certifica que puedes acceder los archivo.

'Entradas: txtPassword

'Salidas: N/A

Public LoginSucceeded As Boolean

Private Sub cmdCancel_Click()

    'set the global var to false

    'to denote a failed login

    LoginSucceeded = False

    Me.Hide

End Sub

Private Sub cmdOK_Click()

    'check for correct password

    If txtPassword = "password" Then

        'place code to here to pass the

        'success to the calling sub

        'setting a global var is the easiest

        LoginSucceeded = True

        If frmMenu.cmbLista.Text = "COMPUTER_LAB" Then

            frmVerComp.Show

        Else

            If frmMenu.cmbLista.Text = "MUEBLETON" Then

                frmVerMueble.Show

            Else

                If frmMenu.cmbLista.Text = "MUSIC_SHOP" Then

                    frmVerMusic.Show

                End If

            End If

End If

        Unload Me

        frmMenu.Hide

    Else

        MsgBox "Invalid Password, try again!", , "Login"

        txtPassword.SetFocus

        SendKeys "{Home}+{End}"

    End If

End Sub

Private Sub Form_Load()

txtPassword.Text = ""

End Sub

Option Explicit

'Gladys M. Ortiz Castillo

'Archivo: frmvercomp

'Descripción: Pantalla que presenta el inventario de la compañía "Computer Lab", y permite manejar los archivos.

'Entradas: DataG, txtabuscar, botones de opcion (optCodigo, optPrecio, optUnidad)

'Salidas: DataG, cmdImprimir, mnuImprimir

Dim compania As String

'Botones

'Botón añadir record

Private Sub cmdAnadir_Click()

    AdoC.Recordset.AddNew

End Sub

'Botón borrar record

Private Sub cmdBorrar_Click()

AdoC.Recordset.Delete

End Sub

'Botón actualizar record

Private Sub cmdActualizar_Click()

    AdoC.Recordset.Update

End Sub

'Botón de buscar

Private Sub cmdBuscarV_Click()

frmMetodo.Visible = True

    optPrecio.Value = False

    optCodigo.Value = False

    optUnidad.Value = False

End Sub

'Presentar el texto para la búsqueda

Private Sub optCodigo_Click()

    txtAbuscar.Visible = True

    txtAbuscar.Text = ""

End Sub

'Presentar el texto para la búsqueda

Private Sub optPrecio_Click()

    txtAbuscar.Visible = True

    txtAbuscar.Text = ""

End Sub

'Presentar el texto para la búsqueda

Private Sub optUnidad_Click()

    txtAbuscar.Visible = True

    txtAbuscar.Text = ""

End Sub

'Proceso de buscar

Private Sub cmdBuscar_Click()

Dim buscar As String  'record buscado

Dim original As Integer   'posicion del record actual

    'record original

    original = AdoC.Recordset.Bookmark

    'filtro de búsqueda

    'Ir al primer record

AdoC.Recordset.MoveFirst

    If optCodigo.Value = True Then

        buscar = "codigo =" + txtAbuscar.Text

    Else

        If optPrecio.Value = True Then

            buscar = "precio =" + txtAbuscar.Text

        Else

            If optUnidad.Value = True Then

                buscar = "unidad = " + txtAbuscar.Text

            End If

        End If

End If

    'Buscar el record según el filtro de búsqueda

    AdoC.Recordset.Find buscar, 0

    cmdBuscar.Visible = False

    txtAbuscar.Visible = False

    frmMetodo.Visible = False

If AdoC.Recordset.EOF Then

        MsgBox "No se encontró"

        AdoC.Recordset.MoveFirst

        cmdBuscar.Visible = False

    End If

End Sub

'Imprimir

Private Sub cmdImprimir_Click()

    frmVerComp.Print

End Sub

Private Sub cmdMenu_Click()

    frmMenu.Show

    Unload Me

End Sub

'Ver listado

Private Sub cmdVer_Click()

    DataG.Refresh

    AdoC.Recordset.MoveFirst

End Sub

'Al abrir forma

Private Sub Form_Load()

txtAbuscar.Visible = False

    frmMetodo.Visible = False

    cmdBuscar.Visible = False

End Sub

'Menú control

'Menú para ir a forma de menu

Private Sub mnuMenu_Click()

    frmMenu.Show

    Unload Me

End Sub

'Añadir record menu

Private Sub mnuAnadir_Click()

    AdoC.Recordset.AddNew

End Sub

'Borrar record menu

Private Sub mnuBorrar_Click()

    AdoC.Recordset.Delete

End Sub

'Actualizar record menu

Private Sub mnuActualizar_Click()

    AdoC.Recordset.Update

End Sub

'Menú de buscar

Private Sub mnuBuscar_Click()

txtAbuscar.Visible = True

    frmMetodo.Visible = True

    cmdBuscar.Visible = True

End Sub

'Menú imprimir

Private Sub mnuImprimir_Click()

    frmVerComp.Print

End Sub

'Menú ver lista

Private Sub mnuLista_Click()

    DataG.Refresh

    AdoC.Recordset.MoveFirst

End Sub

'Menu ver about

Private Sub mnuAbout_Click()

frmAbout.Show

End Sub

'Presentar el botón para buscar

Private Sub txtAbuscar_KeyPress(KeyAscii As Integer)

cmdBuscar.Visible = True

End Sub

Option Explicit

'Gladys M. Ortiz Castillo

'Archivo: frmVerMueble

'Descripción: Pantalla que presenta el inventario de la compañía "MUEBLETON", y permite manejar los archivos.

'Entradas: DataG, txtabuscar, botones de opcion (optCodigo, optPrecio, optUnidad)

'Salidas: DataG, cmdImprimir, mnuImprimir

Dim compania As String

'Botones

'Botón añadir record

Private Sub cmdAnadir_Click()

    AdoC.Recordset.AddNew

End Sub

'Botón borrar record

Private Sub cmdBorrar_Click()

AdoC.Recordset.Delete

End Sub

'Botón actualizar record

Private Sub cmdActualizar_Click()

    AdoC.Recordset.Update

End Sub

'Botón de buscar

Private Sub cmdBuscarV_Click()

frmMetodo.Visible = True

    optPrecio.Value = False

    optCodigo.Value = False

    optUnidad.Value = False

End Sub

'Presentar el texto para la búsqueda

Private Sub optCodigo_Click()

    txtAbuscar.Visible = True

    txtAbuscar.Text = ""

End Sub

'Presentar el texto para la búsqueda

Private Sub optPrecio_Click()

    txtAbuscar.Visible = True

    txtAbuscar.Text = ""

End Sub

'Presentar el texto para la búsqueda

Private Sub optUnidad_Click()

    txtAbuscar.Visible = True

    txtAbuscar.Text = ""

End Sub

'Proceso de buscar

Private Sub cmdBuscar_Click()

Dim buscar As String  'record buscado

Dim original As Integer   'posicion del record actual

    'record original

    original = AdoC.Recordset.Bookmark

    'filtro de búsqueda

    'Ir al primer record

AdoC.Recordset.MoveFirst

    If optCodigo.Value = True Then

        buscar = "codigo =" + txtAbuscar.Text

    Else

        If optPrecio.Value = True Then

            buscar = "precio =" + txtAbuscar.Text

        Else

            If optUnidad.Value = True Then

                buscar = "unidad = " + txtAbuscar.Text

            End If

        End If

End If

    'Buscar el record según el filtro de búsqueda

    AdoC.Recordset.Find buscar, 0

    cmdBuscar.Visible = False

    txtAbuscar.Visible = False

    frmMetodo.Visible = False

If AdoC.Recordset.EOF Then

        MsgBox "No se encontró"

        AdoC.Recordset.MoveFirst

        cmdBuscar.Visible = False

    End If

End Sub

'Imprimir

Private Sub cmdImprimir_Click()

    frmVerMueble.Print

End Sub

Private Sub cmdMenu_Click()

    frmMenu.Show

    Unload Me

End Sub

'Ver listado

Private Sub cmdVer_Click()

    DataG.Refresh

    AdoC.Recordset.MoveFirst

End Sub

'Al abrir forma

Private Sub Form_Load()

txtAbuscar.Visible = False

    frmMetodo.Visible = False

    cmdBuscar.Visible = False

End Sub

'Menú control

'Menú para ir a forma de menu

Private Sub mnuMenu_Click()

    frmMenu.Show

    Unload Me

End Sub

'Añadir record menu

Private Sub mnuAnadir_Click()

    AdoC.Recordset.AddNew

End Sub

'Borrar record menu

Private Sub mnuBorrar_Click()

    AdoC.Recordset.Delete

End Sub

'Actualizar record menu

Private Sub mnuActualizar_Click()

    AdoC.Recordset.Update

End Sub

'Menú de buscar

Private Sub mnuBuscar_Click()

    txtAbuscar.Visible = True

    frmMetodo.Visible = True

    cmdBuscar.Visible = True

End Sub

'Menú imprimir

Private Sub mnuImprimir_Click()

    frmVerMueble.Print

End Sub

'Menú ver lista

Private Sub mnuLista_Click()

    DataG.Refresh

    AdoC.Recordset.MoveFirst

End Sub

'Presentar el botón para buscar

Private Sub txtAbuscar_KeyPress(KeyAscii As Integer)

cmdBuscar.Visible = True

End Sub

Option Explicit

'Gladys M. Ortiz Castillo

'Archivo: frmVerMusic

'Descripción: Pantalla que presenta el inventario de la compañía "MUSIC SHOP", y permite manejar los archivos.

'Entradas: DataG, txtabuscar, botones de opcion (optCodigo, optPrecio, optUnidad)

'Salidas: DataG, cmdImprimir, mnuImprimir

Dim compania As String

'Botones

'Botón añadir record

Private Sub cmdAnadir_Click()

    AdoC.Recordset.AddNew

End Sub

'Botón borrar record

Private Sub cmdBorrar_Click()

AdoC.Recordset.Delete

End Sub

'Botón actualizar record

Private Sub cmdActualizar_Click()

    AdoC.Recordset.Update

End Sub

'Botón de buscar

Private Sub cmdBuscarV_Click()

frmMetodo.Visible = True

    optPrecio.Value = False

    optCodigo.Value = False

    optUnidad.Value = False

End Sub

'Presentar el texto para la búsqueda

Private Sub optCodigo_Click()

    txtAbuscar.Visible = True

    txtAbuscar.Text = ""

End Sub

'Presentar el texto para la búsqueda

Private Sub optPrecio_Click()

    txtAbuscar.Visible = True

    txtAbuscar.Text = ""

End Sub

'Presentar el texto para la búsqueda

Private Sub optUnidad_Click()

    txtAbuscar.Visible = True

    txtAbuscar.Text = ""

End Sub

'Proceso de buscar

Private Sub cmdBuscar_Click()

Dim buscar As String  'record buscado

Dim original As Integer   'posicion del record actual

    'record original

    original = AdoC.Recordset.Bookmark

    'filtro de búsqueda

    'Ir al primer record

AdoC.Recordset.MoveFirst

    If optCodigo.Value = True Then

        buscar = "codigo =" + txtAbuscar.Text

    Else

        If optPrecio.Value = True Then

            buscar = "precio =" + txtAbuscar.Text

        Else

            If optUnidad.Value = True Then

                buscar = "unidad = " + txtAbuscar.Text

            End If

        End If

End If

    'Buscar el record según el filtro de búsqueda

    AdoC.Recordset.Find buscar, 0

    cmdBuscar.Visible = False

    txtAbuscar.Visible = False

    frmMetodo.Visible = False

If AdoC.Recordset.EOF Then

        MsgBox "No se encontró"

        AdoC.Recordset.MoveFirst

        cmdBuscar.Visible = False

    End If

End Sub

'Imprimir

Private Sub cmdImprimir_Click()

    frmVerMusic.Print

End Sub

Private Sub cmdMenu_Click()

    frmMenu.Show

    Unload Me

End Sub

'Ver listado

Private Sub cmdVer_Click()

    DataG.Refresh

    AdoC.Recordset.MoveFirst

End Sub

'Al abrir forma

Private Sub Form_Load()

txtAbuscar.Visible = False

    frmMetodo.Visible = False

    cmdBuscar.Visible = False

End Sub

'Menú control

'Menú para ir a forma de menu

Private Sub mnuMenu_Click()

    frmMenu.Show

    Unload Me

End Sub

'Añadir record menu

Private Sub mnuAnadir_Click()

    AdoC.Recordset.AddNew

End Sub

'Borrar record menu

Private Sub mnuBorrar_Click()

    AdoC.Recordset.Delete

End Sub

'Actualizar record menu

Private Sub mnuActualizar_Click()

    AdoC.Recordset.Update

End Sub

'Menú de buscar

Private Sub mnuBuscar_Click()

txtAbuscar.Visible = True

    frmMetodo.Visible = True

    cmdBuscar.Visible = True

End Sub

'Menú imprimir

Private Sub mnuImprimir_Click()

    frmVerMusic.Print

End Sub

'Menú ver lista

Private Sub mnuLista_Click()

DataG.Refresh

    AdoC.Recordset.MoveFirst

End Sub

'Menu ver about

Private Sub mnuAbout_Click()

frmAbout.Show

End Sub

'Presentar el botón para buscar

Private Sub txtAbuscar_KeyPress(KeyAscii As Integer)

cmdBuscar.Visible = True

End Sub

Prueba del programa

Se utilizó parte de la información aquí presentada para verificar la lectura y escritura a la base de datos y otras funciones (búsqueda, ver, imprimir)

Referencias

Díaz Aponte, Carlos A. (2004). CEDU 5120 Programacióñ de Computadoras. [online]. Available: http://coqui.lce.org/cadiaz/ (September 2004)