Login
Кто возьмёт миллион 28.04.2024
1447 просмотров
Перейти к просмотру всей ветки
uscheswoi_82 коренной житель
in Antwort uscheswoi_82 22.05.24 01:39, Zuletzt geändert 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
Если я кому-то отвечаю, это не значит что я ему симпатизирую, каждый остаётся при своём мнение
Tagebuch der schwerbehinderten Person