Всем привет! Когда был маленьким, у нас на компьютере был установлен 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, Вуаля! А вот и результат!

Если я кому-то отвечаю, это не значит что я ему симпатизирую, каждый остаётся при своём мнение Tagebuch der schwerbehinderten Person

Улучшил код, теперь можно меня размер, и генерирует 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

Вуаля! А вот и результат, белый у нас теперь прозрачный:

Если я кому-то отвечаю, это не значит что я ему симпатизирую, каждый остаётся при своём мнение Tagebuch der schwerbehinderten Person

Кстати GW-Basic в отличие от QBasic сохранял код в бинарном формате, возможно это связано с тем, что тогда мало было место на жёстком диске. Первый бейсик имхо был сделан для ALTAIR 8800:

Вот как работал тогда бейсик на ALTAIR 8800:

Если я кому-то отвечаю, это не значит что я ему симпатизирую, каждый остаётся при своём мнение Tagebuch der schwerbehinderten Person