Deutsch
Germany.ru → Группы → Архив Досок→ Дневник тяжелобольного инвалида

Игры ч3, воспоминание 31.05.2024

792  
uscheswoi_82 коренной житель31.05.24 13:01
31.05.24 13:01 

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

Если я кому-то отвечаю, это не значит что я ему симпатизирую, каждый остаётся при своём мнении Моя ФЛ Он и Она
#1 
uscheswoi_82 коренной житель31.05.24 17:16
NEW 31.05.24 17:16 
в ответ uscheswoi_82 31.05.24 13:01

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


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



Если я кому-то отвечаю, это не значит что я ему симпатизирую, каждый остаётся при своём мнении Моя ФЛ Он и Она
#2 
uscheswoi_82 коренной житель01.06.24 10:21
NEW 01.06.24 10:21 
в ответ uscheswoi_82 31.05.24 17:16

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


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


Если я кому-то отвечаю, это не значит что я ему симпатизирую, каждый остаётся при своём мнении Моя ФЛ Он и Она
#3