Игры ч3, воспоминание 31.05.2024
Всем привет! Когда был маленьким, у нас на компьютере был установлен GW-Basic, и я на нём программировал, а не гулял на улице, как это делали другие дети. Потом позже с MS-DOS 6.22 появился QBasic. QBasic был продвинутее и интерфейс лучше, чем у GW-Basic, но QBasic не умеет компилировать в машинный язык, а лишь интерпретирует. Сегодня хочу QBasic вспомнить, и сделать программу для конвертации картинок, в понятный для бейсика формат изображения, т.е. чтобы изображение можно было отобразить в QBasic.
QBasic входит в MS-DOS начиная 5.0, Windows 95, и Windows NT.
Так выглядели лицензионные MS-DOS 5.0 и Windows NT 4.0:
1. Создадим такую форму:
2. Добавим из API Viewer функцию GetPixel:
Вот код:
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long Private Sub cmdConvert_Click() Dim s As String If Me.txtInput.Text = "" Then Exit Sub If Me.txtOutput.Text = "" Then Exit Sub Me.picImage.Picture = LoadPicture(Me.txtInput.Text, vbLPCustom, vbLPVGAColor, 320, 200) Me.txtInput.Enabled = False Me.txtOutput.Enabled = False Me.cmdOpen.Enabled = False Me.cmdSave.Enabled = False Me.cmdConvert.Enabled = False s = "" For y = 0 To 200 For x = 0 To 320 For c = 0 To 15 If GetPixel(Me.picImage.hdc, x, y) = QBColor(c) Then s = s & Chr(c) End If Next c Next x Next y Open Me.txtOutput.Text For Binary Access Write As #1 Put #1, , s Close #1 Me.txtInput.Enabled = True Me.txtOutput.Enabled = True Me.cmdOpen.Enabled = True Me.cmdSave.Enabled = True Me.cmdConvert.Enabled = False End Sub Private Sub cmdOpen_Click() Me.cmdConvert.Enabled = True With CommonDialog1 .Filter = "All Files (*.*)|*.*" .DialogTitle = "Open File" .ShowOpen Me.txtInput.Text = .FileName Me.picImage.Picture = LoadPicture(.FileName) End With End Sub Private Sub cmdSave_Click() Me.cmdConvert.Enabled = True With CommonDialog1 .Filter = "All Files (*.*)|*.*" .DialogTitle = "Save File" .ShowSave Me.txtOutput.Text = .FileName End With End Sub Private Sub Form_Load() Me.cmdConvert.Enabled = False Me.picImage.BackColor = vbBlack End Sub
3. Запустим нашу программу:
4. Код для QBasic:
DIM c AS STRING * 1 OPEN "xxaa2x" FOR BINARY ACCESS READ AS #1 SCREEN 7 FOR y = 0 TO 200 FOR x = 0 TO 319 GET #1, , c PSET (x, y), ASC(c) NEXT x NEXT y
5. Запустим в эмуляторе DOSBox, Вуаля! А вот и результат!
Улучшил код, теперь можно меня размер, и генерирует DATA:
Попробуем спрайт марио превратить в DATA:
Вот код:
DATA 15,15,15,15,15,7,12,12,12,12,12,12,12,15,15,15,15,15,15,15,0 DATA 15,15,15,15,8,12,12,12,12,12,12,12,12,12,12,12,12,15,15,15,0 DATA 15,15,15,15,6,4,6,6,6,12,12,12,6,12,8,8,8,15,15,15,0 DATA 15,15,15,15,6,6,6,6,6,6,14,14,6,14,7,15,15,15,15,15,0 DATA 15,15,15,6,6,6,14,6,14,14,14,14,6,14,14,14,14,15,15,15,0 DATA 15,15,15,6,6,6,14,6,6,6,14,14,14,6,6,14,14,6,7,15,0 DATA 15,15,15,6,6,6,6,6,6,14,14,14,6,6,6,6,6,15,15,15,0 DATA 15,15,15,8,7,8,6,14,14,14,14,14,6,6,6,6,8,15,15,15,0 DATA 15,15,15,15,15,7,6,6,6,6,6,6,6,7,7,7,15,15,15,15,0 DATA 15,15,15,15,6,6,6,6,12,6,6,6,6,15,15,15,15,15,15,15,0 DATA 15,15,15,6,6,6,6,6,12,6,6,6,12,6,6,6,6,15,15,15,0 DATA 15,7,6,6,6,6,6,6,12,12,12,12,12,6,6,6,6,6,7,15,0 DATA 15,7,6,6,6,6,6,6,12,12,12,12,12,6,6,6,6,6,7,15,0 DATA 15,15,14,14,14,6,6,12,14,12,12,12,14,12,6,6,14,14,15,15,0 DATA 15,15,14,14,14,14,14,12,12,12,12,12,12,12,12,14,14,14,15,15,0 DATA 15,15,14,14,14,12,12,12,12,12,12,12,12,12,12,12,14,14,15,15,0 DATA 15,15,15,15,12,12,12,12,12,7,7,12,12,12,12,12,15,15,15,15,0 DATA 15,15,15,8,6,6,6,6,7,15,15,7,6,6,6,6,8,15,15,15,0 DATA 15,15,7,6,6,6,6,6,15,15,15,15,6,6,6,6,6,7,15,15,0 DATA 15,7,6,6,6,6,6,6,15,15,15,15,6,6,6,6,6,6,7,15,0 DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 SCREEN 7 FOR Y = 0 TO 20 FOR X = 0 TO 20 READ c PSET (X, Y), c NEXT X NEXT Y
Результат:
Теперь пусть белый цвет будет прозрачным см.:
DATA 15,15,15,15,15,7,12,12,12,12,12,12,12,15,15,15,15,15,15,15,0 DATA 15,15,15,15,8,12,12,12,12,12,12,12,12,12,12,12,12,15,15,15,0 DATA 15,15,15,15,6,4,6,6,6,12,12,12,6,12,8,8,8,15,15,15,0 DATA 15,15,15,15,6,6,6,6,6,6,14,14,6,14,7,15,15,15,15,15,0 DATA 15,15,15,6,6,6,14,6,14,14,14,14,6,14,14,14,14,15,15,15,0 DATA 15,15,15,6,6,6,14,6,6,6,14,14,14,6,6,14,14,6,7,15,0 DATA 15,15,15,6,6,6,6,6,6,14,14,14,6,6,6,6,6,15,15,15,0 DATA 15,15,15,8,7,8,6,14,14,14,14,14,6,6,6,6,8,15,15,15,0 DATA 15,15,15,15,15,7,6,6,6,6,6,6,6,7,7,7,15,15,15,15,0 DATA 15,15,15,15,6,6,6,6,12,6,6,6,6,15,15,15,15,15,15,15,0 DATA 15,15,15,6,6,6,6,6,12,6,6,6,12,6,6,6,6,15,15,15,0 DATA 15,7,6,6,6,6,6,6,12,12,12,12,12,6,6,6,6,6,7,15,0 DATA 15,7,6,6,6,6,6,6,12,12,12,12,12,6,6,6,6,6,7,15,0 DATA 15,15,14,14,14,6,6,12,14,12,12,12,14,12,6,6,14,14,15,15,0 DATA 15,15,14,14,14,14,14,12,12,12,12,12,12,12,12,14,14,14,15,15,0 DATA 15,15,14,14,14,12,12,12,12,12,12,12,12,12,12,12,14,14,15,15,0 DATA 15,15,15,15,12,12,12,12,12,7,7,12,12,12,12,12,15,15,15,15,0 DATA 15,15,15,8,6,6,6,6,7,15,15,7,6,6,6,6,8,15,15,15,0 DATA 15,15,7,6,6,6,6,6,15,15,15,15,6,6,6,6,6,7,15,15,0 DATA 15,7,6,6,6,6,6,6,15,15,15,15,6,6,6,6,6,6,7,15,0 DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 SCREEN 7 FOR Y = 0 TO 20 FOR X = 0 TO 20 READ c if c <> 15 then PSET (X, Y), c NEXT X NEXT Y
Вуаля! А вот и результат, белый у нас теперь прозрачный:
Кстати GW-Basic в отличие от QBasic сохранял код в бинарном формате, возможно это связано с тем, что тогда мало было место на жёстком диске. Первый бейсик имхо был сделан для ALTAIR 8800:
Вот как работал тогда бейсик на ALTAIR 8800: