PROGRAMACIÓ D'APLICACIONS EDUCATIVES AMB VISUAL BASICMÒDUL 5

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