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

Fitxer: m4p1.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 frmEditor 
   Appearance      =   0  'Flat
   BackColor       =   &H80000005&
   Caption         =   "Editor de textos"
   ClientHeight    =   3465
   ClientLeft      =   1020
   ClientTop       =   2070
   ClientWidth     =   5640
   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"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   3465
   ScaleWidth      =   5640
   Begin MSComDlg.CommonDialog CMDialog1 
      Left            =   1320
      Top             =   -120
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      FontSize        =   0
      MaxFileSize     =   256
   End
   Begin VB.TextBox txtQuadreText 
      Appearance      =   0  'Flat
      Height          =   3495
      Left            =   0
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Top             =   0
      Width           =   5655
   End
   Begin VB.Menu mnuArxiu 
      Caption         =   "Arxiu"
      Begin VB.Menu mnuObrir 
         Caption         =   "Obrir"
      End
      Begin VB.Menu mnuDesar 
         Caption         =   "Desar"
      End
      Begin VB.Menu mnuTancar 
         Caption         =   "Tancar"
      End
      Begin VB.Menu mnuSeparador 
         Caption         =   "-"
      End
      Begin VB.Menu mnuSortir 
         Caption         =   "Sortir"
         Shortcut        =   ^S
      End
   End
   Begin VB.Menu mnuEdició 
      Caption         =   "Edició"
      Begin VB.Menu mnuEdicióRetallar 
         Caption         =   "Retallar"
         Enabled         =   0   'False
         Shortcut        =   {F1}
      End
      Begin VB.Menu mnuEdicióCopiar 
         Caption         =   "Copiar"
         Enabled         =   0   'False
         Shortcut        =   {F2}
      End
      Begin VB.Menu mnuEdicióEnganxar 
         Caption         =   "Enganxar"
         Enabled         =   0   'False
         Shortcut        =   {F3}
      End
   End
   Begin VB.Menu mnuOpcions 
      Caption         =   "Opcions"
      Begin VB.Menu mnuFonts 
         Caption         =   "Fonts"
         Begin VB.Menu mnuFont 
            Caption         =   "Courier New"
            Index           =   0
         End
         Begin VB.Menu mnuFont 
            Caption         =   "Arial"
            Checked         =   -1  'True
            Index           =   1
         End
         Begin VB.Menu mnuFont 
            Caption         =   "Symbol"
            Index           =   2
         End
      End
      Begin VB.Menu mnuMides 
         Caption         =   "Mida"
         Begin VB.Menu mnuMida 
            Caption         =   "10"
            Checked         =   -1  'True
            Index           =   0
         End
         Begin VB.Menu mnuMida 
            Caption         =   "12"
            Index           =   1
         End
         Begin VB.Menu mnuMida 
            Caption         =   "24"
            Index           =   2
         End
      End
      Begin VB.Menu mnuColors 
         Caption         =   "Colors"
         Begin VB.Menu mnuColorsFons 
            Caption         =   "Fons"
            Begin VB.Menu mnuColorFons 
               Caption         =   "Negre"
               Index           =   0
            End
            Begin VB.Menu mnuColorFons 
               Caption         =   "Verd"
               Index           =   1
            End
            Begin VB.Menu mnuColorFons 
               Caption         =   "Blau"
               Index           =   2
            End
         End
         Begin VB.Menu mnuColorsText 
            Caption         =   "Text"
            Begin VB.Menu mnuColorText 
               Caption         =   "Blanc"
               Index           =   0
            End
            Begin VB.Menu mnuColorText 
               Caption         =   "Verd"
               Index           =   1
            End
            Begin VB.Menu mnuColorText 
               Caption         =   "Blau"
               Index           =   2
            End
         End
      End
   End
End


Codi del programa. Programació de respostes a events

Attribute VB_Name = "frmEditor"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Dim IndexFont As Integer
Dim IndexMida As Integer
Dim TextModificat As Integer
Const SI = True
Const NO = False
Const DLG_FILE_OPEN = 1
Const DLG_FILE_SAVE = 2
Const IDYES = 6
Const MB_YESNO = 4
Const MB_OK = 0
Const MB_ICONSTOP = 16


Private Sub Desa()
  On Error GoTo TractamentErrorsDesar

  CMDialog1.CancelError = True
  CMDialog1.Filter = "Tots els fitxers (*.*)|*.*|Fitxers de text (*.txt)|*.txt|"
  CMDialog1.FilterIndex = 2
  CMDialog1.Action = DLG_FILE_SAVE

  Open CMDialog1.FileName For Output As #1
  Print #1, txtQuadreText.Text
  Close #1
  TextModificat = False
  Exit Sub

TractamentErrorsDesar:
    MsgBox "Ho sento, no he gravat el fitxer", MB_ICONSTOP
  Exit Sub
End Sub

Private Sub Form_Load()
  IndexFont = 1
  txtQuadreText.FontName = "Arial"
  IndexMida = 0
  txtQuadreText.FontSize = 10
  TextModificat = NO
End Sub

Private Sub mnuColorFons_Click(Index As Integer)
  Select Case Index
  Case 0  'Color negre de fons
    txtQuadreText.BackColor = RGB(0, 0, 0)
  Case 1  'Color verd de fons
    txtQuadreText.BackColor = RGB(0, 255, 0)
  Case 2  'Color blau de fons
    txtQuadreText.BackColor = RGB(0, 0, 255)
  End Select
End Sub

Private Sub mnuColorText_Click(Index As Integer)
  Select Case Index
  Case 0  'Color blanc
    txtQuadreText.ForeColor = RGB(255, 255, 255)
  Case 1  'Color verd
    txtQuadreText.ForeColor = RGB(0, 255, 0)
  Case 2  'Color blau
    txtQuadreText.ForeColor = RGB(0, 0, 255)
  End Select
End Sub

Private Sub mnuDesar_Click()
  Desa
End Sub

Private Sub mnuEdició_Click()
  mnuEdicióRetallar.Enabled = (txtQuadreText.SelLength) > 0
  mnuEdicióCopiar.Enabled = (txtQuadreText.SelLength) > 0
  mnuEdicióEnganxar.Enabled = (Len(Clipboard.GetText())) > 0
End Sub

Private Sub mnuEdicióCopiar_Click()
  Clipboard.SetText txtQuadreText.SelText
End Sub

Private Sub mnuEdicióEnganxar_Click()
  txtQuadreText.SelText = Clipboard.GetText()
End Sub

Private Sub mnuEdicióRetallar_Click()
  Clipboard.SetText txtQuadreText.SelText
  txtQuadreText.SelText = ""
End Sub

Private Sub mnuFont_Click(Index As Integer)
  mnuFont(IndexFont).Checked = NO
  txtQuadreText.FontName = mnuFont(Index).Caption
  mnuFont(Index).Checked = SI
  IndexFont = Index
End Sub

Private Sub mnuMida_Click(Index As Integer)
  mnuMida(IndexMida).Checked = NO
  txtQuadreText.FontSize = Val(mnuMida(Index).Caption)
  mnuMida(Index).Checked = SI
  IndexMida = Index
End Sub

Private Sub mnuObrir_Click()
  On Error GoTo TractamentErrorsObrir

  Dim QueVol As Integer, Text As String

  If TextModificat Then
    Text = "Tens un text sense guardar." + Chr(13) + Chr(10)
    Text = Text + "Ho vols desar?"
    QueVol = MsgBox(Text, MB_ICONSTOP + MB_YESNO, "!!!! Atenció !!!!")
    If QueVol = IDYES Then Desa
  End If
  CMDialog1.CancelError = True
  CMDialog1.Filter = "Tots els fitxers (*.*)|*.*|Fitxers de text (*.txt)|*.txt|"
  CMDialog1.FilterIndex = 2
  CMDialog1.Action = DLG_FILE_OPEN
  Open CMDialog1.FileName For Input As #1
  If LOF(1) > 65536 Then
    MsgBox "Text massa llarg. Ho sento", MB_ICONSTOP
  Else
    TextModificat = False
    txtQuadreText.Text = Input$(LOF(1), 1)
  End If
  Close #1
  Exit Sub

TractamentErrorsObrir:
    MsgBox "Ho sento, no he carregat cap fitxer", MB_ICONSTOP
  Exit Sub
End Sub

Private Sub mnuSortir_Click()
  Dim Text As String
  Dim QueVol As Integer

  Text = "Tens un text sense guardar." + Chr(13) + Chr(10)
  Text = Text + "Ho vols desar?"
  If TextModificat Then
    QueVol = MsgBox(Text, MB_ICONSTOP + MB_YESNO, "!!!! Atenció !!!!")
    If QueVol = IDYES Then Desa
  End If
  End
End Sub

Private Sub mnuTancar_Click()
  Dim Text As String
  Dim QueVol As Integer

  Text = "Tens un text sense guardar." + Chr(13) + Chr(10)
  Text = Text + "Ho vols desar?"
  If TextModificat Then
    QueVol = MsgBox(Text, MB_ICONSTOP + MB_YESNO, "!!!! Atenció !!!!")
    If QueVol = IDYES Then Desa
  End If
  txtQuadreText = ""
  TextModificat = NO
End Sub

Private Sub txtQuadreText_Change()
  TextModificat = SI
End Sub