русский

Кто возьмёт миллион 28.04.2024

27.05.24 07:27
Re: Кто возьмёт миллион 28.04.2024
 
uscheswoi_82 коренной житель
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
 

Sprung zu