Создаем базу анекдотов
(Vb.net + XML)
1 - 2
| Программа |
18 кб |
|
| База (2500+) |
310 кб |
|
| База (39000+) |
4700 кб |
|
'================МЕНЮ===============
'-меню-Случайный----------------
Private Sub СлучайныйToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles СлучайныйToolStripMenuItem.Click
maxIDxml(fileName)
Dim r As New Random
Dim max = Val(Me.Text)
Randomize()
Dim randoms
randoms = r.Next(1, max)
NumericUpDown1.Value = randoms
element1()
End Sub
'-меню-+1 (-->)
Private Sub ToolStripMenuItem3_Click(sender As Object, e As EventArgs) Handles ToolStripMenuItem3.Click
If NumericUpDown1.Value < Val(Me.Text) Then
NumericUpDown1.Value += 1
End If
End Sub
'-меню--1 (<--)
Private Sub ToolStripMenuItem2_Click(sender As Object, e As EventArgs) Handles ToolStripMenuItem2.Click
If NumericUpDown1.Value > 1 Then
NumericUpDown1.Value -= 1
End If
End Sub
'-меню-из ТХТ в ANK (***) Конвертирование из ТХТ в АНК
Private Sub Txt2AnkToolStripMenuItem1_Click(sender As Object, e As EventArgs) Handles Txt2AnkToolStripMenuItem1.Click
' Указываем начальную папку
OFD1.InitialDirectory = Application.StartupPath
' Указываем заголовок
OFD1.Title = "Откр файл ТХТ "
' При помощи фильтра можно отбросить ненужные типы файлов
OFD1.Filter = "TXT|*.txt"
If OFD1.ShowDialog = DialogResult.OK Then
Dim filestxt = OFD1.FileName
Dim fileAnk = FileIO.FileSystem.GetFileInfo(filestxt).Name + ".ank"
importFromTXT(filestxt, fileAnk)
End If
End Sub
'-меню-ФАЙЛ-Новая база--------------------
Private Sub НоваяБазаToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles НоваяБазаToolStripMenuItem.Click
newFile()
element1()
End Sub
Для загрузки любой базы запускается ОпенФайлДиалог, где мы выбираем файлы следующих расширений - ank, bu или любой другой файл, например ХМЛ.
'-меню-ФАЙЛ-загрузка базы
Private Sub ЗагрузитьToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ЗагрузитьToolStripMenuItem.Click
' Указываем начальную папку
OFD1.InitialDirectory = Application.StartupPath
' Указываем заголовок
OFD1.Title = "Откр Базу "
' При помощи фильтра можно отбросить ненужные типы файлов
OFD1.Filter = "Анекдоты|*.ank|РезКоп|*.bu|Все|*.*"
' Если есть список выбора типов, то можно указать какой тип будет выбран при загрузке диалога
OFD1.FilterIndex = 1
If OFD1.ShowDialog = DialogResult.OK Then
fileName = OFD1.FileName
NumericUpDown1.Value = 1
element1()
End If
End Sub
'-меню-ФАЙЛ-сохранить копию базы
Private Sub СохранитьКопиюToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles СохранитьКопиюToolStripMenuItem.Click
' Указываем начальную папку
SFD1.InitialDirectory = Application.StartupPath
' Указываем заголовок
SFD1.Title = "Сохранить Базу "
' При помощи фильтра можно отбросить ненужные типы файлов
SFD1.Filter = "Анекдоты|*.ank|РезКоп|*.bu"
' Если есть список выбора типов, то можно указать какой тип будет выбран при загрузке диалога
SFD1.FilterIndex = 1
If SFD1.ShowDialog = DialogResult.OK Then
Dim fileSave = SFD1.FileName
IO.File.Copy(fileName, fileSave)
End If
End Sub
'-меню-ФАЙЛ-Выход--------------------
Private Sub ВыходToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ВыходToolStripMenuItem.Click
Close()
End Sub
Самая сложная операция - это удаление записи. Тк нам необходимо сохранить структуру файлов, а так же порядок записей.
Удалять мы можем, если у нас больше 1 записи.
'-меню-НАСТРОЙКА-Удалить запись---------------
Private Sub УдалитьЗаписьToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles УдалитьЗаписьToolStripMenuItem.Click
maxIDxml(fileName)
If Me.Text > 1 Then
del1()
delOstatok()
delTempFile()
element1()
maxIDxml(fileName)
End If
End Sub
Для добавления новой записи открывается новое окно (2 форма) - ее код ниже.
'-меню-НАСТРОЙКА-Добавить запись---------------
Private Sub ДобавитьЗаписьToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ДобавитьЗаписьToolStripMenuItem.Click
frmDobavka.Show()
Me.Enabled = False
End Sub
За включение - отключение этой функции отвечает параметр TopMost - в свойствах формы.
'-меню-НАСТРОЙКА-Поверх всех окон
Private Sub ПоверхВсехToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ПоверхВсехToolStripMenuItem.Click
If ПоверхВсехToolStripMenuItem.Checked = True Then
ПоверхВсехToolStripMenuItem.Checked = False
Me.TopMost = False
Else
ПоверхВсехToolStripMenuItem.Checked = True
Me.TopMost = True
End If
End Sub
Включение-отключение часов происходит по такому алгоритму, если галочка в меню есть - часы ходят и их видно, иначе их нет.
'-меню-НАСТРОЙКА-часы
Private Sub ЧасыToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ЧасыToolStripMenuItem.Click
If ЧасыToolStripMenuItem.Checked = True Then
ЧасыToolStripMenuItem.Checked = False
lblChas.Visible = False
Shape1.Visible = False
Timer1.Enabled = False
Else
ЧасыToolStripMenuItem.Checked = True
lblChas.Visible = True
Shape1.Visible = True
Timer1.Enabled = True
End If
End Sub
'========END========МЕНЮ===============
'==========Элементы=Управление======================
'в зависимости от числа в нумераторе открывается запись с выбранным номером.
'переключение нумератора (переключение между зап)
Private Sub NumericUpDown1_ValueChanged(sender As Object, e As EventArgs) Handles NumericUpDown1.ValueChanged
element1()
End Sub
'изменение ранга по выбору в комбобоксе. (его мы заполняем при добавлении на форму)
'изменение ранга на вариант из комбобокса
Private Sub ComboBox1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ComboBox1.SelectedIndexChanged
RANG(Val(ComboBox1.Text))
End Sub
'Таймер для времени
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
lblChas.Text = TimeOfDay
End Sub
'=====END=====Элементы=Управление======================
'Копирование в буфер обмена содержимого RTB
'=========контекстное меню==
'скопировать в буф обм
Private Sub ToolStripMenuItem6_Click(sender As Object, e As EventArgs) Handles ToolStripMenuItem6.Click
My.Computer.Clipboard.SetText(rtxOtvet.Text)
End Sub
End Class
Вторая форма - добавление записи
Imports System.Xml
Public Class frmDobavka
'закрытие формы
Private Sub frmDobavka_FormClosed(sender As Object, e As FormClosedEventArgs) Handles Me.FormClosed
Form1.Enabled = True
End Sub
'добавляем текст
Private Sub cmdOk_Click(sender As Object, e As EventArgs) Handles cmdOk.Click
'добавление в конец файла
'загружаем xml файл
Dim reader = New XmlTextReader(Form1.fileName)
Dim readElement = XElement.Load(reader)
reader.Close()
Form1.maxIDxml(Form1.fileName)
Dim maxi = Val(Form1.Text)
Dim nextID = Str(maxi + 1)
Dim newText = " *** " + vbCrLf + vbCrLf + rtx1.Text + vbCrLf + vbCrLf
Dim xml_value = <anek>
<id><%= nextID %></id>
<text><%= newText %></text>
<rang>0</rang>
</anek>
readElement.Add(xml_value)
'сохраняем
readElement.Save(Form1.fileName)
Form1.maxIDxml(Form1.fileName)
Me.Close()
End Sub
End Class
Таким образом у нас получается простая база анекдотов(стихов, афоризмов).
Если использовать данную структуру, то
~2500 записей займут 1,5 мб - работает мгновенно.
~40 000 записей займут 22 мб. - любое изменение базы подвешивает программу на 1-3 сек.
Конечно, это условное разделение, все зависит от длины записей.
Но все же, я не рекомендовал бы файлы больше 10 мб.
1 - 2
Смотреть видео
В начало
| 
