

Fitxer: m5p4.frm
Definició dels objectes. Interfície d'usuari
Recordeu que això no ho podeu editar directament. Per fer-ho incorporeu nous objectes
de la paleta en el vostre formulari. I per canviar els valors seleccioneu l'objecte i
escolliu la propietat a canviar en la finestra Properties.
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmAlumnes
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "Dades alumnes"
ClientHeight = 3630
ClientLeft = 2130
ClientTop = 4710
ClientWidth = 7365
ControlBox = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
LinkTopic = "Form1"
MaxButton = 0 'False
PaletteMode = 1 'UseZOrder
ScaleHeight = 3630
ScaleWidth = 7365
Begin MSComDlg.CommonDialog CMDialog
Left = 6480
Top = 2400
_ExtentX = 847
_ExtentY = 847
_Version = 393216
FontSize = 0
MaxFileSize = 256
End
Begin VB.CommandButton cmdGravar
Appearance = 0 'Flat
Caption = "Gravar pantalla"
Height = 255
Left = 4560
TabIndex = 12
Top = 2880
Width = 1575
End
Begin VB.CommandButton cmdNou
Appearance = 0 'Flat
Caption = "Nou"
Height = 255
Left = 4800
TabIndex = 11
Top = 2400
Width = 1095
End
Begin VB.CommandButton cmdAnterior
Appearance = 0 'Flat
Caption = "Anterior"
Height = 255
Left = 4800
TabIndex = 10
Top = 1920
Width = 1095
End
Begin VB.CommandButton cmdSegüent
Appearance = 0 'Flat
Caption = "Següent"
Height = 255
Left = 4800
TabIndex = 9
Top = 1440
Width = 1095
End
Begin VB.CommandButton cmdÚltim
Appearance = 0 'Flat
Caption = "Últim"
Height = 255
Left = 4800
TabIndex = 8
Top = 960
Width = 1095
End
Begin VB.CommandButton cmdPrimer
Appearance = 0 'Flat
Caption = "Primer"
Height = 255
Left = 4800
TabIndex = 7
Top = 480
Width = 1095
End
Begin VB.TextBox txtCodiPostal
Appearance = 0 'Flat
Height = 285
Left = 1440
TabIndex = 6
Top = 2400
Width = 2895
End
Begin VB.TextBox txtNomFitxer
Appearance = 0 'Flat
Height = 285
Left = 1440
TabIndex = 5
Top = 360
Width = 1575
End
Begin VB.TextBox txtTelèfon
Appearance = 0 'Flat
Height = 285
Left = 1440
TabIndex = 4
Top = 2880
Width = 2895
End
Begin VB.TextBox txtPoblació
Appearance = 0 'Flat
Height = 285
Left = 1440
TabIndex = 3
Top = 1920
Width = 2895
End
Begin VB.TextBox txtAdreça
Appearance = 0 'Flat
Height = 285
Left = 1440
TabIndex = 2
Top = 1440
Width = 2895
End
Begin VB.TextBox txtNom
Appearance = 0 'Flat
Height = 285
Left = 1440
TabIndex = 1
Top = 960
Width = 2895
End
Begin VB.Label lblNomFitxer
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Nom fitxer:"
ForeColor = &H80000008&
Height = 255
Left = 120
TabIndex = 18
Top = 360
Width = 1215
End
Begin VB.Shape Shape2
Height = 3255
Left = 4560
Top = 120
Width = 1575
End
Begin VB.Shape Shape1
Height = 3255
Left = 0
Top = 120
Width = 4455
End
Begin VB.Label Label5
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Telèfon:"
ForeColor = &H80000008&
Height = 255
Left = 120
TabIndex = 17
Top = 2880
Width = 1215
End
Begin VB.Label Label4
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Població:"
ForeColor = &H80000008&
Height = 255
Left = 120
TabIndex = 16
Top = 2400
Width = 1215
End
Begin VB.Label Label3
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Codi postal:"
ForeColor = &H80000008&
Height = 255
Left = 120
TabIndex = 15
Top = 1920
Width = 1215
End
Begin VB.Label Label2
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Adreça:"
ForeColor = &H80000008&
Height = 255
Left = 120
TabIndex = 14
Top = 1440
Width = 1095
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Nom:"
ForeColor = &H80000008&
Height = 255
Left = 120
TabIndex = 13
Top = 960
Width = 1215
End
Begin VB.Label lblNúmRegistreActual
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 255
Left = 3840
TabIndex = 0
Top = 360
Width = 495
End
Begin VB.Menu mnuFitxer
Caption = "&Fitxer"
Begin VB.Menu mnuCrear
Caption = "&Crear"
Checked = -1 'True
End
Begin VB.Menu mnuObrir
Caption = "&Obrir"
End
Begin VB.Menu mnuTancar
Caption = "&Tancar"
End
Begin VB.Menu mnuSortir
Caption = "&Sortir"
End
End
End
Codi del programa. Programació de respostes a events
Attribute VB_Name = "frmAlumnes"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim longitudRegistre As Integer
Dim Alumne As AdrecesAlumnes
Dim NúmRegistreActual As Integer
Dim NúmRegistres As Integer
Private Sub cmdAnterior_Click()
Dim BeGravat As Integer
Dim bellegit As Integer
If (NomFitxerActual <> "") And (NúmRegistreActual > 1) Then
BeGravat = GravaDadesPantalla()
If BeGravat Then
bellegit = LlegeixRegistre(NúmRegistreActual - 1)
If bellegit Then NúmRegistreActual = NúmRegistreActual - 1
End If
End If
End Sub
Private Sub cmdGravar_Click()
Dim BeGravat As Integer
If (NomFitxerActual <> "") Then
BeGravat = GravaDadesPantalla()
If Not (BeGravat) Then MsgBox "No desat", MB_OK
End If
End Sub
Private Sub cmdNou_Click()
Dim BeGravat As Integer
Dim bellegit As Integer
If (NomFitxerActual <> "") Then
BeGravat = GravaDadesPantalla()
If BeGravat Then
EsborraDadesPantalla
NúmRegistres = NúmRegistres + 1
NúmRegistreActual = NúmRegistres
lblNúmRegistreActual.Caption = NúmRegistreActual
End If
End If
End Sub
Private Sub cmdPrimer_Click()
Dim BeGravat As Integer
Dim bellegit As Integer
If (NomFitxerActual <> "") Then
BeGravat = GravaDadesPantalla()
If BeGravat Then
bellegit = LlegeixRegistre(1)
If bellegit Then NúmRegistreActual = 1
End If
End If
End Sub
Private Sub cmdSegüent_Click()
Dim BeGravat As Integer
Dim bellegit As Integer
If (NomFitxerActual <> "") And (NúmRegistreActual < NúmRegistres) Then
BeGravat = GravaDadesPantalla()
If BeGravat Then
bellegit = LlegeixRegistre(NúmRegistreActual + 1)
If bellegit Then NúmRegistreActual = NúmRegistreActual + 1
End If
End If
End Sub
Private Sub cmdÚltim_Click()
Dim BeGravat As Integer
Dim bellegit As Integer
If (NomFitxerActual <> "") Then
BeGravat = GravaDadesPantalla()
If BeGravat Then
bellegit = LlegeixRegistre(NúmRegistres)
If bellegit Then NúmRegistreActual = NúmRegistres
End If
End If
End Sub
Private Sub EsborraDadesPantalla()
lblNúmRegistreActual.Caption = ""
txtNom = ""
txtAdreça = ""
txtPoblació = ""
txtCodiPostal = ""
txtTelèfon = ""
End Sub
Private Sub Form_Load()
NúmRegistreActual = 0
NúmRegistres = 0
NomFitxerActual = ""
longitudRegistre = 107
End Sub
Private 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
Private 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
Private 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 hagut un error", MB_OK
Exit Sub
End Sub
Private Sub mnuObrir_Click()
Dim bellegit As Integer
On Error GoTo ErrMnuObrir
bellegit = 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
bellegit = LlegeixRegistre(NúmRegistreActual)
If Not (bellegit) Then Exit Sub
Else
NúmRegistreActual = 1
lblNúmRegistreActual.Caption = NúmRegistreActual
End If
Exit Sub
ErrMnuObrir:
MsgBox "Hi ha un error de disc", MB_OK
Exit Sub
End Sub
Private Sub mnuSortir_Click()
mnuTancar_Click
End
End Sub
Private Sub mnuTancar_Click()
On Error GoTo ErrmnuTancar
Dim BeGravat As Integer
If NomFitxerActual <> "" Then
BeGravat = GravaDadesPantalla()
EsborraDadesPantalla
Close #1
End If
Exit Sub
ErrmnuTancar:
MsgBox "Hi ha un error de disc", MB_OK
Exit Sub
End Sub
Fitxer: m5p4frm2.frm
Definició dels objectes. Interfície d'usuari
Recordeu que això no ho podeu editar directament. Per fer-ho incorporeu nous objectes
de la paleta en el vostre formulari. I per canviar els valors seleccioneu l'objecte i
escolliu la propietat a canviar en la finestra Properties.
VERSION 5.00
Begin VB.Form frmFitxerCrear
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "Crear fitxer"
ClientHeight = 2310
ClientLeft = 2250
ClientTop = 2475
ClientWidth = 4365
ControlBox = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
LinkTopic = "Form1"
MaxButton = 0 'False
PaletteMode = 1 'UseZOrder
ScaleHeight = 2310
ScaleWidth = 4365
Begin VB.TextBox txtNomFitxer
Appearance = 0 'Flat
Height = 375
Left = 120
TabIndex = 5
Text = "Text1"
Top = 240
Width = 1815
End
Begin VB.FileListBox filLlistaFitxers
Appearance = 0 'Flat
Enabled = 0 'False
Height = 1395
Left = 120
TabIndex = 4
Top = 720
Width = 1815
End
Begin VB.DriveListBox drvDiscDestí
Appearance = 0 'Flat
Height = 315
Left = 2040
TabIndex = 3
Top = 1800
Width = 2175
End
Begin VB.DirListBox dirDirectoriDestí
Appearance = 0 'Flat
Height = 930
Left = 2040
TabIndex = 2
Top = 720
Width = 2175
End
Begin VB.CommandButton cmdCancelar
Appearance = 0 'Flat
Caption = "Cancel.lar"
Height = 375
Left = 3240
TabIndex = 1
Top = 240
Width = 975
End
Begin VB.CommandButton cmdDacord
Appearance = 0 'Flat
Caption = "D'acord"
Height = 375
Left = 2040
TabIndex = 0
Top = 240
Width = 975
End
End
Codi del programa. Programació de respostes a events
Attribute VB_Name = "frmFitxerCrear"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim AnteriorDrive As String
Private Sub cmdCancelar_Click()
NomFitxerNou = ""
Unload frmFitxerCrear
End Sub
Private Sub 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
If Right(dirDirectoriDestí.Path, 1) <> "\" Then
NomFitxerNou = dirDirectoriDestí.Path + "\" + txtNomFitxer
Else
NomFitxerNou = dirDirectoriDestí.Path + txtNomFitxer
End If
NomFitxerActual = NomFitxerNou
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. L'esborro?", MB_YESNO + MB_ICONSTOP)
End If
If Contestació = IDYES And FitxerExistent Then
Kill NomFitxerNou
End If
Unload frmFitxerCrear
End If
Exit Sub
ErrDacord:
MsgBox "Hi ha un error de disc", MB_OK
Exit Sub
End Sub
Private Sub dirDirectoriDestí_Change()
ChDir dirDirectoriDestí.Path
filLlistaFitxers.Path = dirDirectoriDestí.Path
End Sub
Private Sub dirDirectoriDestí_GotFocus()
AnteriorDrive = drvDiscDestí.ListIndex
End Sub
Private 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
Private Sub Form_Activate()
txtNomFitxer.SetFocus
End Sub
Private 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
Fitxer: m5p4mod.BAS
Attribute VB_Name = "M5P4MOD"
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
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