Игры ч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:
Дневник тяжелобольного инвалида
назад
список