Incluya una instancia del componente:
- Microsoft Common Dialog Control 6.0
- Microsoft Windows Common Controls 6.0 (SP6)
Diseñe el formulario “frmDialog” e inserte los objetos:
- ListBox name: lstDialog
Height: 5130
Width: 6855
- ToolBar name: tbarDialog
Appearance: 0 – ccFlat
Style: 1 – tbrFlat
- ImageList1 name: imlDialog
Icon-size: 32x32
- ImageList2 name: imlBlack
Icon-size: 32x32
Incluya una instancia del componente:
- Microsoft Common Dialog Control 6.0
- Microsoft Windows Common Controls 6.0 (SP6)
Diseñe el formulario “frmDialog” e inserte los objetos:
- ListBox name: lstDialog
Height: 5130
Width: 6855
- ToolBar name: tbarDialog
Appearance: 0 – ccFlat
Style: 1 – tbrFlat
- ImageList1 name: imlDialog
Icon-size: 32x32
- ImageList2 name: imlBlack
Icon-size: 32x32
Declare un módulo e inserte las siguientes variables
Public i, x, a As Integer
Public ColorFile, colorFile_s As String
Public SrchClr As String
Public s, p As String
Public nuevo, anterior As String
Public AlreadyIn As Boolean
Public SaveClr As String
Inserte el siguiente código:
Private Sub Form_Load()
'Posición del formulario
With Me
.Height = 6150
.Width = 8520
.Top = (Screen.Height - Height) / 2
.Left = (Screen.Width - Width) / 2
End With
'inicializa el toolbar
With tbarDialog
.ImageList = imlDialog
.DisabledImageList = imlBlack
End With
llenaVista
'tbarDialog.Buttons("btndialog2").Enabled = False
a = 0
End Sub
Private Sub llenaVista()
Dim l(1 To 5) As String
(1) = "Abre un nuevo archivo"
(2) = "Ingresa nuevo dato al archivo"
(3) = "Eliminar registro"
(4) = "Guarda un archivo"
(5) = "Salir del sistema"
'llena la barra de gestión
For i = 1 To 5
Set miBoton = tbarDialog.Buttons.Add()
With miBoton
.Key = "btndialog" & i
.Image = i
.ToolTipText = l(i)
End With
Next i
End Sub
Private Sub tbarDialog_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case LCase(Button.Key)
Case "btndialog1"
abreMe (1)
tbarDialog.Buttons("btndialog2").Enabled = True
Case "btndialog2"
abreMe (2)
Case "btndialog3"
Case "btndialog4"
abreMe (4)
Case "btndialog5"
End
End Select
End Sub
Private Sub abreMe(m As Integer)
'establecer cancelerror a true
dlgVarios.CancelError = True
On Error GoTo errHandler
'establece los indicadores
dlgVarios.Flags = cdlOFNHideReadOnly
'establecer los filtros
dlgVarios.Filter = "Archivos de texto(*.txt)|*.txt|Todos los archivos(*.*)|*.*"
'Especificar el filtro predeterminado
dlgVarios.FilterIndex = 1
Select Case m
Case 1
'presentar el cuadro de dialogo
dlgVarios.ShowOpen
'presentar el nombre del archivo seleccionado
ColorFile = dlgVarios.FileName
'colorFile_s = dlgVarios.FileTitle
Load_Colors
Exit Sub
Case 2
Dim go As String
go = InputBox("Ingrese el dato a guardar", "Datos")
saveMe (go)
Case 3
Case 4
'presentar el cuadro de dialogo
dlgVarios.ShowSave
s = dlgVarios.FileName
'presentar el nombre del archivo seleccionado
moveMe (s)
Exit Sub
End Select
errHandler:
'el usuario ha hecho clic en el boton cancelar
Exit Sub
End Sub
Private Sub Load_Colors()
If Dir(ColorFile) = "" Then
MsgBox "The file does not exist.", vbCritical
Exit Sub
End If
lstDialog.Clear
Open ColorFile For Input As #1
Do While Not EOF(1)
Input #1, SrchClr
lstDialog.AddItem SrchClr
Loop
Close #1
End Sub
Private Sub saveMe(m As String)
AlreadyIn = False
SaveClr = m
If Dir(ColorFile) = "" Then
Open ColorFile For Output As #1
Close #1
End If
Open ColorFile For Input As #1
Do While Not EOF(1)
Input #1, SrchClr
If SaveClr = SrchClr Then
AlreadyIn = True
Exit Do
End If
Loop
Close #1
If AlreadyIn = False Then
If a = 0 Then
Open ColorFile For Append As #1
Print #1, ""
Print #1, SaveClr
a = 1
Close #1
Else
Open ColorFile For Append As #1
Print #1, SaveClr
Close #1
End If
Else
MsgBox "The value " & SaveClr & " is already in the file.", vbExclamation
End If
Load_Colors
End Sub
Private Sub moveMe(filem As String)
nuevo = filem
anterior = ColorFile
'se cambia el nombre al archivo
Name anterior As nuevo
End Sub |
