Статьи

  Резюме
  [+] IT
    [+] Asterisk
    [+] Ubuntu Desktop
    [+] Ubuntu Server
    [+] Windows Server
  [-] Программирование
    [+] 1C
    ASP.NET & VB.NET
    bash & sh
    [+] HTML + CSS
    [+] Java
    PHP
    [-] QB - Quick Basic 4-4.5
      [+] Nbase 2 (1994)
      [+] Nbase 33
    [+] T-SQL
    [+] VB - Visual Basic 1-6
    VBScript & JScript
  [+] Творчество
    Кофейная тема
    Наброски
    Размышления
QB - Quick Basic 4-4.5

Сохранение части экрана в массив

DIM winss(10000) 
SUB winssc (x1!, y1!, x2, y2)
SHARED winss()
GET ((x1! - 1) * 8 - 2, (y1! - 1) * 16 + 1)-(x2 * 8 + 2, y2 * 16 + 2), winss
END SUB

Размерность массива расчитывалась путем определения кол-ва точек и цветов. Однако приходилось подбирать это значение имперически, поскольку задать размерность требовалось в самом начале программы. 

 

Загрузка части изображения

SUB winlsc (x1!, y1!)
SHARED winss()
PUT ((x1! - 1) * 8 - 2, (y1! - 1) * 16 + 1), winss, PSET
END SUB
 

Пример сохранения изображения в файл

GET ((4 - 1) * 8 - 2, (3 - 1) * 16 + 1)-(35 * 8 + 2, 20 * 16 + 2), winss
OPEN pathes$(1) + "nbase.grf" FOR BINARY AS #4
FOR t = 0 TO 10000
PUT #4, , winss(t)
NEXT
CLOSE #4

 

Пример загрузки изображения из файла

OPEN pathes$(1) + "nbase.grf" FOR BINARY AS #4
FOR t = 0 TO 10000
GET #4, , winss(t)
NEXT
CLOSE #4
PUT ((36 - 1) * 8 - 2, (3 - 1) * 16 + 1), winss, PSET 

 

Процедура печати на нечерном фоне

Как сделать красивую программу, если QB мог печатать только на черном фоне в графическом режиме?  Придумать, как обойти это ограничение. Можно считать прямоугольную область (где потом будут напечатаны символы на черном фоне) в память, напечатать символы на черном фоне и наложить считанный прямоугольник на черный фон в режиме объединения цветов.

Самое сложное в этом процессе это понять каким цветом печатать текст. В большинстве случаев это разница по модулю между цветом символа и фона ABS(fg! - BG!).  

SUB printer (x1!, y1!, s$, fg!, BG!)
DIM a!(1900)
IF s$ = CHR$(1) OR s$ = CHR$(32) THEN LINE ((x1! - 1) * 8, (y1! - 1) * 16)-(x1! * 8, y1! * 16 - 1), BG!, BF: GOTO Printers
IF s$ = CHR$(2) THEN LINE ((x1! - 1) * 8, (y1! - 1) * 16)-(x1! * 8, y1! * 16 - 1), BG!, BF: LINE ((x1! - 1) * 8, y1! * 16 - 4)-(x1! * 8 - 1, y1! * 16 - 2), fg!, B: GOTO Printers
fgg! = ABS(fg! - BG!)
COLOR fgg!: LOCATE y1!, x1!: PRINT s$
GET ((x1! - 1) * 8, (y1! - 1) * 16)-((x1! + LEN(s$) - 1) * 8, y1! * 16 - 1), a!
PUT ((x1! - 1) * 8, (y1! - 1) * 16), a!
LINE ((x1! - 1) * 8, (y1! - 1) * 16)-((x1! + LEN(s$) - 1) * 8, y1! * 16 - 1), BG!, BF
PUT ((x1! - 1) * 8, (y1! - 1) * 16), a!
LINE ((x1! + LEN(s$) - 1) * 8, (y1! - 1) * 16)-((x1! + LEN(s$) - 1) * 8, y1! * 16 - 1), BG!
Printers:
END SUB

Работа с струкутурированными файлами (аналог базы данных)

z = 1
OPEN "R", 1, ""
   WHILE f$ = ""
       IF z = LOF(1) / 128 + 1 THEN g$ = "Record not found.": GOTO End ' IF NOT FOUND
   FIELD #1, 3 AS e$, 5 AS f$, 25 AS g$, 5 AS peace$   ' 3 символа на первую переменную, 5 на вторую, 25 на третью и 5 на четвертую
   GET #1, z  ' Считать запись
   z = z + 1
   WEND
' Запись в файл
LSET e$ = "": LSET f$ = "": LSET g$ = "": LSET peace$ = "": PUT #1, z - 1
g$ = "File succesfuly deleted" 


Другие записи

  [+] Nbase 2 (1994)
    Листинг
  [+] Nbase 33
    Листинг


X
ПнВтСрЧтПтСбВс