D57. Mòdul 5. Pràctica 4. Programació d'aplicacions educatives amb Visual Basic

Pràctica optativa

Executar el programa m5p4.exe per conèixer el seu comportament.

Veure el llistat del codi del programa, m5p4.

Executar Visual Basic per editar el projecte (acabat): m5p4.vbp.

Creació d'una base de dades d'alumnes amb un fitxer d'accés aleatori

En activitats anteriors heu tractat dos tipus de fitxers: els fitxers d'accés seqüencial i els fitxers d'accés aleatori. En aquesta pràctica es tracten amb més èmfasi aquests últims. Recordeu, a més, que hi ha altre tipus de fitxers: els fitxers binaris, que també emmagatzemen dades però que no tenen necessàriament la mateixa longitud.

L'activitat consisteix en crear un editor de fitxes de dades d'alumnes que permet crear, obrir o tancar un fitxer i que permet recórrer, editar i afegir registres a la base de dades.

La finestra principal, en mode edició, ha de tenir un aspecte semblant al següent:

El formulari principal serà semblant al mostrat anteriorment, amb un menú fitxer i amb les opcions de la figura petita:

Fase de disseny de la interfície d’usuari

Obrireu un nou projecte com en la última pràctica del mòdul 3, és a dir, Controles de VB Edición Profesional que permetà fer servir un el control, CommonDialog

, al directori C:\VBCurs\VBActivi\m5\p4 i amb el nom m5p4. Les propietats dels objectes que hi apareixen al formulari són:

Objecte	Propietat	Valor
Formulari	(Nombre)	frmAlumnes
	Caption	Dades alumnes
	ControlBox	False
	MaxButton	False
	BorderStyle	1-Fixed Single
Etiqueta Núm de registre	(Nombre)	lblNúmRegistreActual
	Caption
Caixes de text: totes elles tenen la propietat Text amb el valor "" (cadena buida)
Caixa Nom del fitxer	(Nombre)	txtNomFitxer
	Enabled	False
Caixa Nom	(Nombre)	txtNom
Caixa Adreça	(Nombre)	txtAdreça
Caixa Codi Postal	(Nombre)	txtCodiPostal
Caixa Població	(Nombre)	txtPoblació
Caixa Telèfon	(Nombre)	txtTelèfon
Botons de comandament
Botó Primer	(Nombre)	cmdPrimer
	Caption	Primer
Botó Últim	(Nombre)	cmdÚltim
	Caption	Últim
Botó Següent	(Nombre)	cmdSegüent
	Caption	Següent
Botó Anterior	(Nombre)	cmdAnterior
	Caption	Anterior
Botó Nou	(Nombre)	cmdNou
	Caption	Nou
Botó Gravar	(Nombre)	cmdGravar
	Caption	Gravar
Diàleg Comú	(Nombre)	CMDialog

Les opcions de menú, que creareu clicat amb el botó dret en el formulari i en el menú contextual que apareix escollireu la opció, Editor de menús... .

són les següents:

Objecte	Propietat	Valor
Opcions de menú	Caption	&Crear
	(Nombre)	mnuCrear
	Caption	&Obrir
	(Nombre)	mnuObrir
	Caption	&Tancar
	(Nombre)	mnuTancar
	Caption	&Sortir
	(Nombre)	mnuSortir

Els altres controls són etiquetes o quadres de dibuix que podeu incorporar de la forma que cregueu més oportuna.

Fase de programació de respostes a events

Declaracions d'àmbit global a tot el projecte

Creeu un nou mòdul que podeu anomenar m5p4mod.bas, quan el deseu, per tal d'afegir les declaracions de constants que seran utilitzades en el programa i que podeu consultar en el fitxer CONSTANTS.TXT del directori C:\VB.

Tema: Constant.txt Subtema: tots els subtemes

Recordeu que no cal que escriviu aquest codi, llegiu-vos-el per saber que i com ho fa i a continuació el podeu copiar a la carpeta i enganxar-lo en la finestra d'edició de Visual Basic.

Afegiu també la declaració d'un nou tipus de dades per tal d'emmagatzemar provisionalment les dades d'un alumne a la memòria de l'ordinador mitjançant un registre:

Global Const MODAL = 1
Global Const MB_OK = 0
Global Const MB_YESNO = 4
Global Const MB_ICONSTOP = 16
Global Const IDYES = 6
Global Const DLG_FILE_OPEN = 1

Global Const KEY_ESCAPE = &H1B
Global Const KEY_RETURN = &HD

Type AdrecesAlumnes
  Nom As String * 45
  Adreça As String * 30
  CodiPostal As String * 5
  Població As String * 15
  Telèfon As String * 12
End Type

Global NomFitxerActual As String
Global NomFitxerNou As String

Fixeu-vos que cada registre de la base de dades té una longitud fixa de 107 caràcters. Les dues darreres variables serveixen per emmagatzemar el nom del fitxer en ús o el nom del fitxer nou que es vol crear, en el qual el disc i el camí (path) formaran part d'aquest nom. A més, es fa servir per saber si hi ha una base de dades oberta.

Descripció del recorregut de dades de la pantalla al fitxer i del fitxer a la pantalla.

Com veieu a la figura el recorregut de dades entre la pantalla i el fitxer es fa mitjançant una variable Alumne del nou tipus definit AdrecesAlumnes.

És a dir, les dades que es visualitzen a la pantalla i que es llegeixen o es desen al fitxer fan servir un registre auxiliar, del tipus Alumne, que és l'encarregat de mantenir les dades de manera provisional a la memòria de l'ordinador.

Declaracions de les variables globals a nivell del formulari frmAlumnes

Les variables globals d'àmbit el formulari són:

NúmRegistreActual:	És el lloc que ocupa el registre mostrat en la pantalla dins del fitxer.
NúmRegistres:	Número de registres que hi ha al fitxer.
LongitudRegistre:	Número de caràcters dels registres i l'estructura de dades.
Alumne:	Variable per contenir les dades d'un alumne.

Aquestes variables es declaren a l'apartat general del formulari.

Dim NúmRegistreActual As Integer
Dim NúmRegistres As Integer
Dim LongitudRegistre As Integer
Dim Alumne As AdrecesAlumnes

Totes aquestes variables les inicialitzareu en el moment de carregar aquest formulari, excepte la variable Alumne, mitjançant l'event Load, tal com s'esmenta en el paràgraf que tracta els mètodes associats a l'event Load.

Funcions d'àmbit general al formulari per desar i llegir dades

La funció GravaDadesPantalla llegeix les dades de la pantalla i les desa en el fitxer en el lloc que indiqui la variable NúmRegistreActual. També retorna un valor cert si desa les dades, i fals si no pot fer-ho.

La funció LlegeixRegistre rep el número del registre que ha de llegir i assigna els seus valors a la variable Alumne. Finalment, les posa a la pantalla. També retorna un valor cert si té èxit en llegir les dades i fals si no té èxit.

Aquestes funcions s'escriuen a l'apartat General de formulari.

Function GravaDadesPantalla () As Integer
  Dim Contestació As Integer

  On Error GoTo ErrGrava

  Alumne.Nom = txtNom
  Alumne.Adreça = txtAdreça
  Alumne.CodiPostal = txtCodiPostal
  Alumne.Població = txtPoblació
  Alumne.Telèfon = txtTelèfon
  Put #1, NúmRegistreActual, Alumne
  GravaDadesPantalla = True
  Exit Function
ErrGrava:
  Contestació = MsgBox("No desat. Ho torno a intentar?", MB_YESNO)
  If Contestació = IDYES Then
    Resume 0
  Else
    GravaDadesPantalla = False
    Exit Function
  End If
End Function

Function LlegeixRegistre (NúmReg As Integer) As Integer
  Dim Contestació As Integer

  On Error GoTo ErrLlegeix
    
  Get #1, NúmReg, Alumne
  LlegeixRegistre = True
  txtNom = Alumne.Nom
  txtAdreça = Alumne.Adreça
  txtCodiPostal = Alumne.CodiPostal
  txtPoblació = Alumne.Població
  txtTelèfon = Alumne.Telèfon
  lblNúmRegistreActual.Caption = NúmReg
  Exit Function
ErrLlegeix:
  Contestació = MsgBox("No llegit. Ho torno a intentar?", MB_YESNO)
  If Contestació = IDYES Then
    Resume 0
  Else
    LlegeixRegistre = False
    Exit Function
  End If
End Function

El procediment EsborraDadesPantalla esborra el text que hi hagi a les caixes de text:

Sub EsborraDadesPantalla ()
  lblNúmRegistreActual.Caption = ""
  txtNom = ""
  txtAdreça = ""
  txtPoblació = ""
  txtCodiPostal = ""
  txtTelèfon = ""
End Sub

Mètodes associats a l'event Load

Per al formulari principal:

Sub Form_Load ()
  NúmRegistreActual = 0
  NúmRegistres = 0
  NomFitxerActual = ""
  LongitudRegistre = 107
End Sub

Aquest mètode inicialitza les variables esmentades als valors inicials.

Mètodes associats a l'event Click

Una característica comú a tots els botons és que han de desar les dades de la pantalla abans de fer la seva funció, excepte el botó Gravar pantalla que ha de desar i no ha de fer res més. Així, en tots els procediments següents primer es comprova si hi ha una base de dades en ús i, si és així, es desen les dades de la pantalla. En cas d'aconseguir-ho s'executa el codi específic de la funció associada a cada botó.

Per al botó Anterior:

Sub cmdAnterior_Click ()
  Dim BéGravat As Integer
  Dim BéLlegit As Integer

  If (NomFitxerActual <> "") And (NúmRegistreActual > 1) Then
    BéGravat = GravaDadesPantalla()
    If BéGravat Then
      BéLlegit = LlegeixRegistre(NúmRegistreActual - 1)
      If BéLlegit Then NúmRegistreActual = NúmRegistreActual - 1
    End If
  End If
End Sub

Per al botó Desar:

Sub cmdGravar_Click ()
  Dim BéGravat As Integer

  If NomFitxerActual <> "" Then
    BéGravat = GravaDadesPantalla()
    If (Not BéGravat) Then MsgBox "No gravat", MB_OK
  End If
End Sub

Per al botó Nou:

Sub cmdNou_Click ()
  Dim BéGravat As Integer
  Dim BéLlegit As Integer

  If NomFitxerActual <> "" Then
    BéGravat = GravaDadesPantalla()
    If BéGravat Then
      EsborraDadesPantalla
      NúmRegistres = NúmRegistres + 1
      NúmRegistreActual = NúmRegistres
      lblNúmRegistreActual.Caption = NúmRegistreActual
    End If
  End If
End Sub

Per al botó Primer:

Sub cmdPrimer_Click ()
  Dim BéGravat As Integer
  Dim BéLlegit As Integer

  If NomFitxerActual <> "" Then
    BéGravat = GravaDadesPantalla()
    If BéGravat Then
      BéLlegit = LlegeixRegistre(1)
      If BéLlegit Then NúmRegistreActual = 1
    End If
  End If
End Sub

Per al botó Següent:

Sub cmdSegüent_Click ()
  Dim BéGravat As Integer
  Dim BéLlegit As Integer

  If (NomFitxerActual <> "") And (NúmRegistreActual < NúmRegistres) Then
    BéGravat = GravaDadesPantalla()
    If BéGravat Then
      BéLlegit = LlegeixRegistre(NúmRegistreActual + 1)
      If BéLlegit Then NúmRegistreActual = NúmRegistreActual + 1
    End If
  End If
End Sub

Per al botó Últim:

Sub cmdÚltim_Click ()
  Dim BéGravat As Integer
  Dim BéLlegit As Integer

  If NomFitxerActual <> "" Then
    BéGravat = GravaDadesPantalla()
    If BéGravat Then
      BéLlegit = LlegeixRegistre(NúmRegistres)
      If BéLlegit Then NúmRegistreActual = NúmRegistres
    End If
  End If
End Sub

Mètodes associats a les opcions de menú

El menú Fitxer té les opcions Crear, Obrir, Tancar i Sortir. Per tal d'obrir un fitxer podeu fer ús de l'eina CMDialog, però per crear un nou fitxer heu de demanar el nom a l'usuari, així com la unitat de disc i el directori. També heu de validar si un nom de fitxer nou ja existeix o no. Totes aquestes operacions no les fa el CMDialog. Per tant, heu de fer una finestra de diàleg que permetrà conèixer algunes eines noves semblant al mostrat aquí a sota.

Aquest formulari nou, del qual s'especifiquen més avall les seves propietats, està lligat al menú Crear tal com s'esmenta a continuació en el procediment associat a l'opció de menú Crear:

Mètode associat a l'opció de menú Crear

Sub mnuCrear_Click ()
  On Error GoTo ErrmnuCrear

  If NomFitxerActual <> "" Then
    mnuTancar_Click
  End If
  frmFitxerCrear.Show Modal
  If NomFitxerNou <> "" Then
    Open NomFitxerNou For Random As #1 Len = LongitudRegistre
    NomFitxerActual = NomFitxerNou
    txtNomFitxer = NomFitxerNou
    txtNomFitxer.SelStart = Len(txtNomFitxer)
    NúmRegistreActual = 1
    lblNúmRegistreActual.Caption = NúmRegistreActual
  End If
  Exit Sub
ErrmnuCrear:
  MsgBox "Hi ha un error", MB_OK
  Exit Sub
End Sub

Aquesta opció comprova si teniu un fitxer obert i el tanca cas que ho estigui. Després crida al formulari mostrat en la figura adjunta amb la instrucció:

frmFitxerCrear.Show Modal

El formulari que apareix en clicar el menú Crear està dissenyat segons s'especifica en els apartats a i b següents:

Per crear un nou formulari cliqueu amb el botó dret en la finestra proyecto, cliqueu en la opció, agregar i després en la subopció, Formulario:

Deseu-lo amb el nom m5p4frm2.frm.

a) Fase de disseny de la interfície d'usuari del formulari que apareix en clicar el menú Crear

Les propietats dels objectes són:

Objecte	Propietat	Valor
Formulari	(Nombre)	frmFitxerCrear
	Caption	Crear Fitxer
	ControlBox	False
	MaxButton	False
	BorderStyle	1 - Fixed Single
Botons de comandament
Botó D'acord	(Nombre)	cmdDacord
	Caption	D'acord
Botó Cancel·lar	(Nombre)	cmdCancelar
	Caption	Cancel·lar
Llista d'unitats	(Nombre)	drvDiscDestí
Llista de directoris	(Nombre)	dirDirectoriDestí
Llista d'arxius	(Nombre)	filLlistaFitxers
	Enabled	False
Quadre de text	(Nombre)	txtNomFitxer

En aquest formulari són novetat els objectes: llista d'unitats, llista de directoris i llista d'arxius, que podeu crear utilitzant les eines corresponents:

Tema: Disk drive control

Tema: Directori List Box Control

Tema: File List Box Contro

b) Codi associat als controls del formulari frmFitxerCrear

Mètodes associats a l'event Click en el formulari frmFitxerCrear:

Per al botó Cancel·lar:

Sub cmdCancelar_Click ()
  NomFitxerNou = ""
  Unload frmFitxerCrear
End Sub

En aquest procediment la variable NomFitxerNou queda buida i es tanca el formulari.

Per al botó D'acord:

El procediment associat fa que la variable NomFitxerNou tingui un valor que és el camí (Path) i el nom del fitxer que l'usuari vol crear. També comprova si el nom ja existeix al disc i tanca el formulari.

cmdDacord_Click ()
  Dim i As Integer
  Dim Contestació As Integer
  Dim FitxerExistent As Integer

  On Error GoTo ErrDacord

  FitxerExistent = False
  Contestació = IDYES
  If txtNomFitxer <> "" Then
    ' Si el path del directori destí té solament una 
    ' unitat de directori porta "\", sinó no en porta
    If Right(dirDirectoriDestí.Path, 1) <> "\" Then
      NomFitxerNou = dirDirectoriDestí.Path + "\" + txtNomFitxer
    Else
      NomFitxerNou = dirDirectoriDestí.Path + txtNomFitxer
    End If
    For i = 0 To filLlistaFitxers.ListCount - 1
      If txtNomFitxer = filLlistaFitxers.List(i) Then
        FitxerExistent = True
      End If
    Next i
    If FitxerExistent Then
      Contestació = MsgBox("Fitxer ja existent. Ho buido?", MB_YESNO + MB_ICONSTOP)
    End If
    If Contestació = IDYES And FitxerExistent Then
      Kill NomFitxerNou
    End If
    If Contestació = IDYES Then
      Unload frmFitxerCrear
    End If
  End If
   Exit Sub

ErrDacord:
  MsgBox "Hi ha un error de disc", MB_OK
  Exit Sub
End Sub

Codi de les llistes de frmFitxerCrear

Mètodes associats a l'event Change en el formulari frmFitxerCrear

El codi de la llista d'unitats actua quan l'usuari canvia d'unitat, i actualitza les altres dues llistes, la de directoris i la d'arxius.

Sub drvDiscDestí_Change ()
  On Error GoTo ErrDiscDestí

  dirDirectoriDestí.Path = drvDiscDestí.Drive
  dirDirectoriDestí_Change
  Exit Sub

ErrDiscDestí:
  MsgBox "Hi ha un error de disc", MB_OK
  drvDiscDestí.ListIndex = AnteriorDrive
  Exit Sub
End Sub

El procediment anterior fa ús d'una variable global a nivell de formulari que guarda el nom de la unitat del disc anterior, per tal que si es produeix un error en el moment de canviar d'unitat torni a aparèixer el nom d'unitat d'acord amb els directoris i fitxers:

Heu de definir d'àmbit el formulari

Dim AnteriorDrive As String

Sub dirDirectoriDestí_Change ()
  ChDir dirDirectoriDestí.Path
  filLlistaFitxers.Path = dirDirectoriDestí.Path
End Sub

El codi de la llista de directoris actua quan l'usuari canvia de directori, i actualitza la llista d'arxius.

Mètodes associats a l'event GotFocus

Aquest event es dóna, per a un control determinat, quan l'usuari canvia de qualsevol lloc al control anterior. En aquest cas,

Sub drvDiscDestí_GotFocus ()
  AnteriorDrive = drvDiscDestí.ListIndex
End Sub

Codi auxiliar

Per tal que aparegui el cursor en el quadre de text heu de fer que el quadre tingui el focus quan es carrega el formulari:

Sub Form_Activate ()
  txtNomFitxer.SetFocus
End Sub

També heu de fer que les tecles Esc i Retorn funcionin de forma adient quan l'usuari escriu el text:

Sub txtNomFitxer_KeyDown (KeyCode As Integer, Shift As Integer)
  If KeyCode = KEY_ESCAPE Then cmdCancelar_Click
  If KeyCode = KEY_RETURN Then cmdDacord_Click
End Sub

Mètode associat a l'opció de menú Obrir

Aquesta opció crida un quadre de diàleg per tal de triar un fitxer de disc. També tanca una possible base de dades oberta i carrega el primer registre si és que n'hi ha algun.

Sub mnuObrir_Click ()
  Dim BéLlegit As Integer

  On Error GoTo ErrmnuObrir

  BéLlegit = True
  CMDialog.Filter = "Tots els fitxers (*.*)|*.*"
  CMDialog.FilterIndex = 1
  CMDialog.Action = DLG_FILE_OPEN
  If NomFitxerActual <> "" Then
    mnuTancar_Click
  End If
  NomFitxerActual = CMDialog.Filename
  txtNomFitxer = NomFitxerActual
  txtNomFitxer.SelStart = Len(txtNomFitxer)
  Open NomFitxerActual For Random As #1 Len = LongitudRegistre
  NúmRegistres = LOF(1) / LongitudRegistre
  If NúmRegistres > 0 Then
    NúmRegistreActual = 1
    BéLlegit = LlegeixRegistre(NúmRegistreActual)
    If (Not BéLlegit) Then Exit Sub
  Else
    NúmRegistreActual = 1
    lblNúmRegistreActual.Caption = NúmRegistreActual
  End If
  Exit Sub
ErrmnuObrir:
  MsgBox "Hi ha un error", MB_OK
  Exit Sub
End Sub

Mètode associat a l'opció de menú Sortir

Crida el procediment que tanca una base de dades i acaba el programa.

Sub mnuSortir_Click ()
  mnuTancar_Click
  End
End Sub

Mètode associat a l'opció de menú Tancar

Si hi ha una base de dades oberta la tanca i esborra el que teniu a la pantalla:

Sub mnuTancar_Click ()
  Dim BéGravat As Integer

  On Error GoTo ErrmnuTancar

  If NomFitxerActual <> "" Then
    BéGravat = GravaDadesPantalla()
    NomFitxerActual=""
    EsborraDadesPantalla
    txtNomFitxer = ""
    Close #1
  End If
  Exit Sub
ErrmnuTancar:
  MsgBox "Hi ha un error", MB_OK
  Exit Sub
End Sub

Exercicis

No n'hi ha.