Вход на сайт
Кто возьмёт миллион 28.04.2024
1569 просмотров
Перейти к просмотру всей ветки
в ответ uscheswoi_82 22.05.24 01:39, Последний раз изменено 27.05.24 07:29 (uscheswoi_82)
Только что усовершенствовал редактор вопросов, теперь можно добавлять новую запись, и даже сохранять вопросы и ответы в файл, так-же подправил заголовок окна, "Редактор вопрос для игры Кто возьмёт миллион?", сейчас так "Редактор вопросов для игры Кто возьмёт миллион?", так-же если при загрузки ввести 0 сообщений, то :

Добавил три кнопки, слева направо добавить вопрос, сохранить вопрос, удалить вопрос. Иконки плюсика, дискеты, и мусорного ведра брал стандартные, которые идут с Microsoft Visual Basic 4.0. Вот свежий код:
Private Type DATABASE
question As String * 255
answ1 As String * 50
answ2 As String * 50
answ3 As String * 50
answ4 As String * 50
answer As Integer
End Type
Private strFileName As String
Private intCnt As Integer
Private Sub add(ByVal strFileName As String, ByVal index As Integer, db As DATABASE)
Open "questions.bin" For Random As #1 Len = Len(db)
Put #1, index, db
Close #1
End Sub
Private Sub read(ByVal strFileName As String, ByVal index As Integer, db As DATABASE)
Open "questions.bin" For Random As #1 Len = Len(db)
Get #1, index, db
Close #1
End Sub
Private Sub cmdNew_Click()
Me.lstQuestions.AddItem "Новый вопрос"
End Sub
Private Sub cmdSave_Click()
On Error Resume Next
Dim db As DATABASE
db.question = Me.txtQuestion.Text
db.answ1 = Me.txtAnsw1.Text
db.answ2 = Me.txtAnsw2.Text
db.answ3 = Me.txtAnsw3.Text
db.answ4 = Me.txtAnsw4.Text
db.answer = CInt(Me.txtAnswRight.Text)
add strFileName, Me.lstQuestions.ListIndex + 1, db
End Sub
Private Sub Form_Load()
Me.Left = 0
Me.Top = 0
End Sub
Private Sub lstQuestions_Click()
Dim db As DATABASE
read strFileName, Me.lstQuestions.ListIndex + 1, db
Me.txtQuestion.Text = db.question
Me.txtAnsw1.Text = db.answ1
Me.txtAnsw2.Text = db.answ2
Me.txtAnsw3.Text = db.answ3
Me.txtAnsw4.Text = db.answ4
Me.txtAnswRight.Text = db.answer
End Sub
Private Sub popupExit_Click()
Unload Me
End Sub
Private Sub popupOpen_Click()
On Error Resume Next
Dim db As DATABASE
Dim q As Long
With CommonDialog1
.DialogTitle = "Открыть файл"
.Filter = "Все файлы (*.*)|*.*"
.ShowOpen
Try:
q = InputBox("Сколько вопросов?", "Загрузка вопросов", 1)
If q < 1 Then
MsgBox "Вопрос должен хотя бы один"
GoTo Try
End If
strFileName = .filename
For i = 1 To q
read .filename, i, db
'read(strFilename As String, index As Integer, db As DATABASE)
Me.lstQuestions.AddItem db.question
Next i
End With
End Sub
'Private Sub popupSave_Click()
' With CommonDialog1
' .DialogTitle = "Сохранить файл"
' .Filter = "Все файлы (*.*)|*.*"
' .ShowSave
'.filename
' End With
'End SubЕсли я кому-то отвечаю, это не значит что я ему симпатизирую, каждый остаётся при своём мнении
Моя ФЛ Он и Она
Моя ФЛ Он и Она