Russian English
   Basic.net
Среда, 23.09.2020, 03:31
Меню сайта
Категории раздела
Basic [28]
У нас вы можете бесплатно скачать QBasic, VisualBasic, FreeBasic, GW-Basic.
QBasic [4]
Visual Basic [4]
GW-Basic [0]
Игры [1]
FreeBasic [1]
PowerBasic [1]
Облако тегов
Статистика

Онлайн всего: 1
Гостей: 1
Пользователей: 0

Форма входа
Главная » Файлы » Basic

Примеры готовых программ
Share |
25.03.2010, 22:57
Примеры готовых программ на QBasic. В них используется текстовая, графическая и звуковая информация. Отличное предложение начинающему программисту в QBasic.

Инструкция по вставке кода в файл QBasic.

Примеры готовых игр на QBasic здесь.


Графика


Программа рисует простой рисунок с дорогой:

Code
CLS
SCREEN 12
CIRCLE (320, 200), 50, 14
PAINT (320, 200), 14
LINE (0, 300)-(640, 300), 2
PAINT (0, 422), 2
LINE (0, 370)-(640, 370), 3
LINE (0, 400)-(640, 400), 3
PAINT (100, 380), 3
LINE (0, 301)-(640, 301), 9
PAINT (0, 200), 9
CIRCLE (320, 200), 50, 14
PAINT (320, 200), 14
LINE (0, 385)-(640, 385), 15
LINE (100, 370)-(100, 360), 15
CIRCLE (100, 355), 5, 4
CIRCLE (100, 355), 4, 15
CIRCLE (100, 355), 3, 15
CIRCLE (100, 355), 6, 4
CIRCLE (100, 355), 2, 15
CIRCLE (100, 355), 1, 15
LINE (101, 370)-(101, 360), 0
LINE (101, 370)-(96, 375), 0
CIRCLE (96, 380), 5, 0
PAINT (96, 380), 0
LINE (150, 375)-(200, 350), 4, BF
LINE (201, 375)-(220, 355), 1, BF
LINE (208, 370)-(213, 365), 15, BF
CIRCLE (155, 375), 4, 0
CIRCLE (200, 375), 4, 0
CIRCLE (217, 375), 4, 0
PAINT (155, 375), 0
PAINT (200, 375), 0
PAINT (217, 375), 0


"Ликующая блоха":

Code
CLS
SCREEN 9
COLOR 9, 1
DRAW "C2 L20 U20 R20 D20 F10 D10 R2"
DRAW "BM300, 175 C2 G10 D10 L2"
DRAW "BM300, 155 C2 H10 E10 L2"
DRAW "BM320, 155 C2 E10 H10 R2"
DRAW "BM310, 155 C2 U4"
DRAW "BM307, 151 C2 R10 H6 G6"
PAINT (310, 170), 2, 2
BYTES = INT((55 * 2 + 7) / 8) * 60
DIM BUG(BYTES)
GET (285, 135)-(340, 195), BUG
CLS
PUT (250, 80), BUG: SLEEP 1
PLAY " A A"
PUT (250, 80), BUG: SLEEP 1
PLAY " B B"
PUT (30, 60), BUG: SLEEP 1
PLAY " C C"
PUT (30, 60), BUG: SLEEP 1
PLAY "D D"
PUT (460, 130), BUG: SLEEP 1
PLAY "E E"
PUT (460, 130), BUG: SLEEP 1
PLAY "F F"
PUT (180, 70), BUG: SLEEP 1
PLAY "G G"
PUT (180, 70), BUG: SLEEP 1
PLAY "D D"
PLAY "F F"
PUT (300, 70), BUG: SLEEP 1
END


Графики Cos(x) и Sin(x):

Code
SCREEN 12
VIEW (20, 150)-(620, 250)
WINDOW (-6.28, 1)-(6.28, -1)
LINE (-6.28, 0)-(6.28, 0), 14
LINE (0, -1)-(0, 1), 14
LOCATE 14, 60
PRINT "pi"
LOCATE 14, 40
PRINT "0"
LOCATE 14, 20
PRINT "-pi"
LOCATE 14, 30
PRINT "-pi/2"
LOCATE 14, 50
PRINT "pi/2"
FOR x = -6.28 TO 6.28 STEP .005
  PSET (x, SIN(x)), 10
  PSET (x, COS(x)), 3
NEXT x
LOCATE 15, 4
COLOR 3
PRINT "y = cos (x)"
LOCATE 17, 26
COLOR 10
PRINT "y = sin (x)"


Красивые цифровые часы:

Code
DECLARE SUB MakeBmp (NameBmp$)
DECLARE SUB Prepare ()
  ' Процедуры печати
DECLARE SUB DrawChar (x%, y%, Ch%, Poz%, Mshtb!)
DECLARE SUB DrawClock (xDr%, yDr%, Tm$, Mashtab!)
  ' Массивы
CONST DataDL = 228
DIM SHARED Sizes%(1 TO 7), Sost%(9, 1 TO 7), i%, k%
DIM SHARED X1%(1 TO 7, 1 TO 6), X2%(1 TO 7, 1 TO 6)
DIM SHARED Y1%(1 TO 7, 1 TO 6), Y2%(1 TO 7, 1 TO 6)
DIM SHARED PZx%(1 TO 7), PZy%(1 TO 7) ' Paint zone - зона закраски
  SCREEN 12 ' 640x480x16цв.
  Prepare
  ' Читаем размерности
FOR i% = 1 TO 7
  READ Sizes%(i%)
NEXT
  ' Читаем координаты
FOR i% = 1 TO 7
  zx% = 0: zy% = 0
  FOR k% = 1 TO Sizes%(i%)
  READ X1%(i%, k%), Y1%(i%, k%), X2%(i%, k%), Y2%(i%, k%)
  zx% = zx% + X1%(i%, k%) + X2%(i%, k%)
  zy% = zy% + Y1%(i%, k%) + Y2%(i%, k%)
  NEXT
  PZx%(i%) = zx% / (Sizes%(i%) * 2): PZy%(i%) = zy% / (Sizes%(i%) * 2)
NEXT
  ' Читаем состояния
  i% = 0
DO: READ k%
  IF k% = -1 THEN
  i% = i% + 1
  ELSE
  IF k% <> -2 THEN Sost%(i%, k%) = 1
  END IF
LOOP UNTIL k% = -2
   
DO: Kb$ = INKEY$
  G! = TIMER: WHILE G! + .5 < TIMER: WEND
  DrawClock 100, 250, TIME$, 4
  IF INT(TIMER * 2) AND 1 THEN
  LINE (215, 220)-(225, 230), 2, BF
  LINE (215, 270)-(225, 280), 2, BF
  LINE (394, 220)-(404, 230), 2, BF
  LINE (394, 270)-(404, 280), 2, BF
  ELSE
  LINE (215, 220)-(225, 230), 4, BF
  LINE (215, 270)-(225, 280), 4, BF
  LINE (394, 220)-(404, 230), 4, BF
  LINE (394, 270)-(404, 280), 4, BF
  END IF
  IF Kb$ = CHR$(32) THEN MakeBmp "Clock"
LOOP UNTIL Kb$ = CHR$(27)
   
END
  ' Размеры
DATA 5, 6, 5, 6, 5, 6, 5
  ' 1 > Левый верх
DATA -105,-196,-114,-187
DATA -105,-196,-57,-148
DATA -114,-187,-114,-3
DATA -57,-148,-57,-40
DATA -114,-3,-57,-40
  ' 2 > Верх
DATA -93,-208,-102,-199
DATA -102,-199,-54,-151
DATA -93,-208, 93,-208
DATA -54,-151, 54,-151
DATA 93,-208, 102,-199
DATA 102,-199, 54,-151
  ' 3 > Правый верх
DATA 105,-196, 114,-187
DATA 105,-196, 57,-148
DATA 114,-187, 114,-3
DATA 57,-148, 57,-40
DATA 57,-40, 114,-3
  ' 4 > Центр
DATA -109, 0,-59,-33
DATA -109, 0,-59, 33
DATA -59,-33, 59,-33
DATA -59, 33, 59, 33
DATA 59,-33, 109, 0
DATA 109, 0, 59, 33
  ' 5 > Левый низ
DATA -114, 3,-57, 40
DATA -114, 3,-114, 187
DATA -57, 40,-57, 148
DATA -114, 187,-105, 196
DATA -57, 148,-105, 196
  ' 6 > Низ
DATA -102, 199,-54, 151
DATA -102, 199,-93, 208
DATA -54, 151, 54, 151
DATA -93, 208, 93, 208
DATA 54, 151, 102, 199
DATA 102, 199, 93, 208
  ' 7 > Правый низ
DATA 114, 3, 57, 40
DATA 57, 40, 57, 148
DATA 114, 3, 114, 187
DATA 57, 148, 105, 196
DATA 114, 187, 105, 196
' Состояния
  DATA 2, 1, 3, 5, 7, 6, -1
  DATA 3, 7, -1
  DATA 2, 3, 4, 5, 6, -1
  DATA 2, 3, 4, 7, 6, -1
  DATA 1, 4, 3, 7, -1
  DATA 2, 1, 4, 7, 6, -1
  DATA 2, 1, 4, 5, 7, 6, -1
  DATA 2, 3, 7, -1
  DATA 2, 1, 3, 4, 5, 7, 6, -1
  DATA 2, 1, 3, 4, 7, 6, -1, -2
' Заголовок *.BMP*
bgdt: DATA 66,77,54,254,0,0,0,0,0,0,54,4,0,0,40,0,0
DATA 0,128,2,0,0,224,1,0,0,1,0,8,0,0,0,0,0,0
DATA 250,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0
   
SUB DrawChar (x%, y%, Ch%, Poz%, Mshtb!)
PCvtL% = 1: PCvtZ% = 2 ' Цвета для присутствующих
OCvtL% = 3: OCvtZ% = 4 ' Цвета для отсутствующих
   
xPls% = ((DataDL / Mshtb!) * 1.05) * Poz%
  FOR i% = 1 TO 7 ' От 1-го до 7-ми частей
  IF Sost%(Ch%, i%) = 1 THEN ' Если часть включена, рисуем
  CvtL% = PCvtL%: CvtZ% = PCvtZ%
  ELSE CvtL% = OCvtL%: CvtZ% = OCvtZ%
  END IF
  FOR k% = 1 TO Sizes%(i%) ' Рисуем все линии
  x11% = X1%(i%, k%) / Mshtb!: x22% = X2%(i%, k%) / Mshtb!
  y11% = Y1%(i%, k%) / Mshtb!: y22% = Y2%(i%, k%) / Mshtb!
  LINE (x11% + xPls% + x%, y11% + y%)-(x22% + xPls% + x%, y22% + y%), CvtL%
  NEXT
  PAINT (PZx%(i%) / Mshtb! + xPls% + x%, PZy%(i%) / Mshtb! + y%), CvtZ%, CvtL%
  NEXT
END SUB
   
SUB DrawClock (xDr%, yDr%, Tm$, Mashtab!)
  FOR u% = 1 TO LEN(Tm$)
  Tc% = ASC(MID$(Tm$, u%, 1))
  IF Tc% > 47 AND Tc% < 58 THEN
  DrawChar xDr%, yDr%, Tc% - 48, u% - 1, Mashtab!
  END IF
  NEXT
END SUB
   
SUB MakeBmp (NameBmp$)
' Создаём *.BMP*
  OPEN NameBmp$ + ".Bmp" FOR BINARY AS #3
  RESTORE bgdt
  FOR byte& = 1 TO 54
  READ Zglv%: PUT #3, byte&, Zglv%
  NEXT byte&: byte& = 55
  FOR ii% = 0 TO 255
  OUT &H3C7, ii%: R% = INP(&H3C9) * 4: G% = INP(&H3C9) * 4: B% = INP(&H3C9) * 4
  bt1% = CVI(CHR$(B%) + CHR$(G%)): bt2% = CVI(CHR$(R%) + "№")
  PUT #3, byte&, bt1%: PUT #3, byte& + 2, bt2%
  byte& = byte& + 4
  NEXT ii%
  FOR y% = 479 TO 0 STEP -1
  FOR x% = 0 TO 639
  cve% = POINT(x%, y%)
  PUT #3, byte&, cve%: byte& = byte& + 1
  NEXT x%
  NEXT y%
  CLOSE #3
END SUB
   
SUB Prepare
  OUT &H3C8, 1
  OUT &H3C9, 92 / 4: OUT &H3C9, 93 / 4: OUT &H3C9, 77 / 4
  OUT &H3C9, 21 / 4: OUT &H3C9, 26 / 4: OUT &H3C9, 19 / 4
  OUT &H3C9, 120 / 4: OUT &H3C9, 124 / 4: OUT &H3C9, 87 / 4
  OUT &H3C9, 110 / 4: OUT &H3C9, 118 / 4: OUT &H3C9, 86 / 4
  OUT &H3C9, 120 / 4: OUT &H3C9, 124 / 4: OUT &H3C9, 87 / 4
  LINE (50, 180)-(590, 320), 5, BF
END SUB


Программа построения фракталов:

Code
SCREEN 12
Kc = 15 'количество цветов для фрактала
a = 640: b = 480 'размер экрана в пикселах по x и y
'Нужно задавать (менять) значения p,q
'для получения различных рисунков
'p = -.1: q = -1.92
'p = .5: q = -.1
'p = -.5: q = -.9
'p = -.5: q = .9
p = .5: q = 1
100
Xmin = -1.75: Ymin = -1.25 ' миним. коорд. фрактала
Xmax = 1.75: Ymax = 1.25 ' максим.коорд. фрактала
M = 100 'максимальное расстояние для поиска атрактора
dx = (Xmax - Xmin) / (a - 1) 'размер пиксела по оси x
dy = (Ymax - Ymin) / (b - 1) 'размер пиксела по оси y
FOR Nx = 1 TO a - 1 'цикл сканирования всех пикселов для
FOR Ny = 1 TO b - 1 'определения их цвета
xk = Xmin + Nx * dx
yk = Ymin + Ny * dy
k = 0
200 'формулы определения координат атрактора
xk1 = xk * xk - yk * yk + p
yk1 = 2 * xk * yk + q
k = k + 1 'число итер. для данного начального пиксела
c = k 'цвет пиксела, соответствующий данному числу
300
r = xk1 * xk1 + yk1 * yk1 'расст.от нач. до кон.точки
xk = xk1: yk = yk1
IF r > M THEN c = k: GOTO 400 'условие сходимости
IF k = Kc THEN c = 0: GOTO 400 'повторение палитры
GOTO 200
400
PSET (Nx, Ny), c
NEXT Ny
NEXT Nx


Ещё один фрактал - папоротник:

Code
DECLARE SUB MakeBmp (NameBmp$)
   
  CONST Iterations = 1000000
   
DIM t AS DOUBLE, x AS DOUBLE, y AS DOUBLE, p AS DOUBLE
DIM k AS LONG
DIM Midx AS INTEGER, Midy AS INTEGER, radius AS INTEGER
   
ON TIMER(1) GOSUB ShowIter
TIMER ON
   
  SCREEN 12
  FOR k = 1 TO 15
  OUT &H3C8, k
  IF k < 16 THEN
  OUT &H3C9, k: OUT &H3C9, 25 + k * 2: OUT &H3C9, 0
  ELSE OUT &H3C9, k: OUT &H3C9, 54: OUT &H3C9, 0
  END IF
  NEXT: k = 10
  Midx = 320
  Midy = 480
  radius = .1 * Midy
  RANDOMIZE TIMER
  x = 1
  y = 0
   
  FOR k = 1 TO Iterations
  p = RND
  t = x
  IF p <= .85 THEN
  x = .85 * x + .04 * y
  y = -.04 * t + .85 * y + 1.6
  ELSE
  IF p <= .92 THEN
  x = .2 * x - .26 * y
  y = .23 * t + .22 * y + 1.6
  ELSE
  IF p <= .99 THEN
  x = -.15 * x + .28 * y
  y = .26 * t + .24 * y + .44
  ELSE
  x = 0
  y = .16 * y
  END IF
   
  END IF
  END IF
  PSET (Midx + radius * x, Midy - radius * y), POINT(Midx + radius * x, Midy - radius * y) + 1
  NEXT
MakeBmp "Paporotn"
END
ShowIter: LOCATE 1: PRINT "Iterations: "; k: IF INKEY$ <> "" THEN END
RETURN
bgdt: DATA 66,77,54,254,0,0,0,0,0,0,54,4,0,0,40,0,0
DATA 0,128,2,0,0,224,1,0,0,1,0,8,0,0,0,0,0,0
DATA 250,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0
   
SUB MakeBmp (NameBmp$)
' Создаём *.BMP*
  OPEN NameBmp$ + ".Bmp" FOR BINARY AS #3
  RESTORE bgdt
  FOR byte& = 1 TO 54
  READ Zglv%: PUT #3, byte&, Zglv%
  NEXT byte&: byte& = 55
  FOR ii% = 0 TO 255
  OUT &H3C7, ii%: R% = INP(&H3C9) * 4: G% = INP(&H3C9) * 4: B% = INP(&H3C9) * 4
  bt1% = CVI(CHR$(B%) + CHR$(G%)): bt2% = CVI(CHR$(R%) + "№")
  PUT #3, byte&, bt1%: PUT #3, byte& + 2, bt2%
  byte& = byte& + 4
  NEXT ii%
  FOR y% = 479 TO 0 STEP -1
  FOR x% = 0 TO 639
  cve% = POINT(x%, y%)
  PUT #3, byte&, cve%: byte& = byte& + 1
  NEXT x%
  NEXT y%
  CLOSE #3
END SUB


Массивы



Среднее арифметическое всех элементов массива:

Code

CLS
N = 15
DIM M(N)
SUMM = 0
FOR I = 1 TO N
M(I) = INT(RND * 100)
PRINT I; "-"; M(I)
SUMM = SUMM + M(I)
NEXT I
PRINT "Среднее арифметическое чисел = "; SUMM/N


Определить минимальный элемент массива:

Code

CLS
INPUT "N"; n
DIM e(n)
FOR i = 1 TO n
  INPUT e(i)
NEXT
CLS
min1 = e(1)
PRINT "Массив:"
FOR i = 1 TO n
  PRINT e(i);
  IF e(i) < min1 THEN min1 = e(i): min2 = i
NEXT
PRINT
PRINT "Минимальный :"; min1;
PRINT "Порядковый номер:"; min2
SWAP e(min2), e(n)
PRINT "Новый массив:"
FOR i = 1 TO n
  PRINT e(i);
NEXT


Вычисления


Программа, определяющая, простое число, или нет:

Code

CLS
INPUT "Введите число N=", N
IF N <= 3 THEN GOTO 10
d = 2
IF N MOD 2 = 0 THEN GOTO 20
d = 3
FOR i = 1 TO N
d = d + 2
IF N MOD d = 0 THEN GOTO 20
IF N <= d * d THEN GOTO 10
NEXT i
10 PRINT "Число N-простое."
INPUT "Для продолжения - Enter.", z
END
20 PRINT "Число N-составное. Оно делится на"; d
INPUT "Для продолжения - Enter.", w
END


Определение чётности или нечётности числа:

Code

CLS
INPUT "Введите число N=", N
IF N MOD 2 THEN PRINT "Число нечётное" ELSE PRINT "Число чётное"
END



Работа с мышью


Cтандартные ф-ии для работы с мышью:


Code

DECLARE SUB Mouse (ax%, bx%, cx%, dx%)

DECLARE SUB MouseActive (a%)
DECLARE SUB MouseReset ()
DECLARE SUB MouseShowCursor ()
DECLARE SUB MouseHideCursor ()
DECLARE SUB MouseBorders (x1%, y1%, x2%, y2%)
DECLARE SUB MouseGetStat (b%, x%, y%)
DECLARE SUB MouseSetXY (x%, y%)
DECLARE SUB MouseSetMickey (x%, y%)

TYPE RegType
  ax AS INTEGER: bx AS INTEGER: cx AS INTEGER: dx AS INTEGER
  bp AS INTEGER: si AS INTEGER: di AS INTEGER: f AS INTEGER
END TYPE
DIM SHARED regs AS RegType

MouseActive a%: IF a% = 0 THEN PRINT "Need a mouse to run!": END
MouseReset
MouseShowCursor
DO
MouseGetStat a%, b%, c%
LOCATE 1, 1: PRINT a% / 8, b% / 8, c%
LOOP UNTIL INKEY$ <> ""

SUB Mouse (ax%, bx%, cx%, dx%)
  regs.ax = ax%
  regs.bx = bx%
  regs.cx = cx%
  regs.dx = dx%
  CALL interrupt(&H33, regs, regs)
  ax% = regs.ax
  bx% = regs.bx
  cx% = regs.cx
  dx% = regs.dx
END SUB

SUB MouseActive (a%)
  DEF SEG = 0
  mseg% = CVI(CHR$(PEEK(207)) + CHR$(PEEK(206)))
  mofs% = CVI(CHR$(PEEK(205)) + CHR$(PEEK(204)))
  IF mseg% OR mofs% THEN
  DEF SEG = mseg%
  IF PEEK(mofs%) = 207 THEN a% = 0 ELSE a% = -1
  ELSE
  a% = 0
  END IF
  DEF SEG
END SUB

SUB MouseBorders (x1%, y1%, x2%, y2%)
  Mouse 7, 0, x1%, x2%
  Mouse 8, 9, y1%, y2%
END SUB

SUB MouseGetStat (x%, y%, b%)
  Mouse 3, b%, x%, y%
END SUB

SUB MouseHideCursor
  Mouse 2, 0, 0, 0
END SUB

SUB MouseReset
  Mouse 0, 0, 0, 0
END SUB

SUB MouseSetMickey (x%, y%)
  Mouse 15, 0, x%, y%
END SUB

SUB MouseSetXY (x%, y%)
  Mouse 4, 0, x%, y%
END SUB

SUB MouseShowCursor
  Mouse 1, 0, 0, 0
END SUB


Изменение графического курсора мыши
:


Code

'

' M e e s e s . B a s from B. Roche

'

' Demonstrates Graphical Mouse Cursors

' Translated over from VBDOS Program

' Make sure to enter Environment with /L for Interrupt Support

' Currently set up to run *AS IS* in QB ..REM/UNREM the appropriate

' spots to use Far Strings ..

' Multiple Versions of some Cursors are given because some look

' Better on White BG, some better on Black BG

DECLARE FUNCTION HaveMouse% () ' Checks to See if Driver Installed

DECLARE SUB PrintR (A$, X%, Y%, StepX%, StepY%, CO%, BackGround%, Shadow%)

  ' Prints Text in Graphics Mode 12

DECLARE SUB ChangeCursor (A$) ' Changes Graphics Mouse Cursor

DECLARE SUB Mouse (M0, M1, M2, M3) ' Mouse Driver

DECLARE SUB MouseShow () ' Displays Mouse Cursor

DECLARE SUB MouseHide () ' Hides Mouse Cursor

  ' $INCLUDE: 'QB.BI' ' Use for QB45 (Keep at least One REM here!)

  REM '$INCLUDE: 'VBDOS.BI'

  ' Use 'VBDOS.BI' for VBDOS, 'QBX.BI' for PDS

DIM Regs AS RegType ' Interrupt needed for Regular Mouse Routines,

  ' QB also uses Interrupt for Mouse

  ' Cursor Routines

REM 'DIM RegsX AS RegTypeX ' InterruptX needed for PDS/VBDOS

  ' Far Strings, but both Interrupt calls

  ' Still needed for QBX/VBDOS

ON ERROR GOTO NOVGA: ' Make sure we've got VGA ..

  SCREEN 12

ON ERROR GOTO 0

  ' Now Blank the Monitor while Drawing the Screen ..

  OUT &H3C4, 1: CMR% = INP(&H3C5): OUT &H3C5, CMR% OR &H20

  LINE (0, 0)-(640, 480), 7, BF ' Use a White backGround

  LINE (320, 20)-(600, 305), 0, BF ' Black "Window" to also check Cursors

  ' Yeah, I know using DATA statements is not an example of

  ' Programming Virtuosity, but this is just Demo code ...

  FOR I% = 1 TO 14

  READ Prompt$

  Prompt$ = CHR$(I% + 64) + ") " + Prompt$

  PrintR Prompt$, 25, I% * 20 + 5, 8, 0, 15, 7, 1

  NEXT

  Prompt$ = "Q) Quit program."

  PrintR Prompt$, 25, 305, 8, 0, 15, 7, 1

  Prompt$ = "Press the Letter of the Cursor you want, or <Q> to Quit."

  PrintR Prompt$, 45, 400, 8, 0, 11, 7, 1

  Prompt$ = ""

  ' Now that the screen is Drawn, Turn the Screen back on..

  OUT &H3C4, 1: CMR% = INP(&H3C5): OUT &H3C5, CMR% AND &HDF

  ' And Check for the Rodent ...

  IF HaveMouse% THEN ' Check For Mouse Driver

  Mouse 0, 0, 0, 0 ' Initialize Mouse

  MouseShow ' Show Mouse Cursor

  ELSE

  SCREEN 0

  LOCATE 15, 28: PRINT "You need a Mouse for a Mouse Cursor Program, Silly!"

  WHILE INKEY$ = "": WEND

  SYSTEM

  END IF

  ' Now Run a Loop, Checking Input, and Change the Mouse Cursor accordingly ..

  DO

  DO: A$ = INKEY$: LOOP UNTIL LEN(A$)

  A$ = UCASE$(A$)

  IF A$ = "Q" THEN

  MouseHide

  SCREEN 0, , 0, 0: SYSTEM

  END IF

  IF A$ >= "A" AND A$ <= "N" THEN ChangeCursor A$

  LOOP

NOVGA: ' VGA Error Trap

  SCREEN 0, , 0, 0

  LOCATE 15, 25: PRINT "You Must have a VGA to run this program"

  SYSTEM

' Menu Data ...

DATA "Bulls Eye Cursor #1","Bulls Eye Cursor #2"

DATA "Hour Glass Cursor #1","Hour Glass Cursor #2"

DATA "Hour Glass Cursor #3", "Hour Glass Cursor #4"

DATA "Hour Glass Cursor #5","Stop Watch Cursor"

DATA "Smiley Face Cursor", "Smiley Face Cursor #2"

DATA "Cross Hair Cursor", "Cross Hair Cursor #2"

DATA "Pointing Hand Cursor","Pointing Hand Cursor #2"

'---------------- Start of Mouse Cursor Data ----------------

BullsEye1:

DATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF

DATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF

DATA &HFFFF,&H8001,&H8001,&H8001,&H8FF1,&H8811,&H8811,&H8811

DATA &H8811,&H8811,&H8811,&H8FF1,&H8001,&H8001,&H8001,&HFFFF

DATA 7,0

'------------------ End of Mouse Cursor Data ------------------

'---------------- Start of Mouse Cursor Data ----------------

BullsEye2:

DATA &H0,&H0,&H0,&H0,&HFF0,&HFF0,&HFF0,&HFF0

DATA &HFF0,&HFF0,&HFF0,&HFF0,&H0,&H0,&H0,&H0

DATA &H0,&H7FFE,&H7FFE,&H6006,&H6006,&H6006,&H6006,&H6006

DATA &H6006,&H6006,&H6006,&H6006,&H6006,&H7FFE,&H7FFE,&H0

DATA 7,8

'------------------ End of Mouse Cursor Data ------------------

'---------------- Start of Mouse Cursor Data ----------------

HourGlass1:

DATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF

DATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF

DATA &HFFFF,&H2004,&H2004,&H2004,&H1008,&H990,&H420,&H240

DATA &H240,&H420,&H810,&H1008,&H2084,&H2144,&H22A4,&HFFFF

DATA 5 ,0

'------------------ End of Mouse Cursor Data ------------------

'---------------- Start of Mouse Cursor Data ----------------

HourGlass2:

DATA &H0,&HDFFB,&HDFFB,&HDFFB,&HEFF7,&HF66F,&HFBDF,&HFDBF

DATA &HFDBF,&HFBDF,&HF7EF,&HEFF7,&HDF7B,&HDE3B,&HDC1B,&H0

DATA &H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0

DATA &H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0

DATA 5 ,0

'------------------ End of Mouse Cursor Data ------------------

'---------------- Start of Mouse Cursor Data ----------------

HourGlass3:

DATA &H0,&HC003,&HC003,&HC003,&HE007,&HF00F,&HF81F,&HFC3F

DATA &HFC3F,&HF81F,&HF00F,&HE007,&HC003,&HC003,&HC003,&H0

DATA &H400,&H1FF8,&H1FF8,&H1FF8,&HC30,&H660,&H3C0,&H180

DATA &H180,&H3C0,&H7E0,&HFF0,&H1E78,&H1C38,&H1818,&H0

DATA 5 ,0

'------------------ End of Mouse Cursor Data ------------------

'---------------- Start of Mouse Cursor Data ----------------

HourGlass4:

DATA &H0,&H8001,&H8001,&H8001,&HA185,&HB00D,&HB81D,&HBC3D

DATA &HBC3D,&HB81D,&HB00D,&HA005,&H8181,&H83C1,&H87E1,&H0

DATA &H0,&H1FF8,&H1FF8,&H1FF8,&HC30,&H660,&H3C0,&H180

DATA &H180,&H3C0,&H7E0,&HFF0,&H1E78,&H1DB8,&H1FF8,&H0

DATA 5 ,0

'------------------ End of Mouse Cursor Data ------------------

'---------------- Start of Mouse Cursor Data ----------------

StopWatch:

DATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF

DATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF

DATA &H3000,&H63E0,&HDC18,&H1004,&H2002,&H2602,&H4301,&H4181

DATA &H40C1,&H4081,&H4081,&H2082,&H2082,&H1004,&HC18,&H3E0

DATA 1 ,1

'------------------ End of Mouse Cursor Data ------------------

'---------------- Start of Mouse Cursor Data ----------------

Smiley1:

DATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF

DATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF

DATA &HE70,&H1FE8,&H3C3C,&H381C,&H6006,&H8422,&H8421,&H8001

DATA &H8181,&H9011,&H4822,&H43C2,&H2004,&H100C,&H399C,&H700E

DATA 5 ,0

'------------------ End of Mouse Cursor Data ------------------

'---------------- Start of Mouse Cursor Data ----------------

Smiley2:

DATA &HE70,&H1FE8,&H3C3C,&H381C,&H6006,&H8422,&H8421,&H8421

DATA &H8001,&H9191,&H4812,&H4422,&H23C4,&H1008,&H399C,&H700E

DATA &HF18F,&HE017,&HC3C3,&HC7E3,&H9FF9,&H7BDD,&H7BDE,&H7BDE

DATA &H7FFE,&H6E6E,&HB7ED,&HBBDD,&HDC3B,&HEFF7,&HC663,&H8FF1

DATA 5 ,0

'------------------ End of Mouse Cursor Data ------------------

'---------------- Start of Mouse Cursor Data ----------------

CrossHair1:

DATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF

DATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF

DATA &H100,&H100,&H100,&H100,&H100,&H100,&H100,&H100

DATA &HFFFE,&H100,&H100,&H100,&H100,&H100,&H100,&H100

DATA 7 ,0

'------------------ End of Mouse Cursor Data ------------------

'---------------- Start of Mouse Cursor Data ----------------

CrossHair2:

DATA &HFFFF,&HFC7F,&HFC7F,&HFC7F,&HFC7F,&HFC7F,&HFC7F,&H1

DATA &H101,&H1,&HFC7F,&HFC7F,&HFC7F,&HFC7F,&HFC7F,&HFC7F

DATA &H0,&H0,&H100,&H100,&H100,&H100,&H100,&H0

DATA &H7C7C,&H0,&H100,&H100,&H100,&H100,&H100,&H0

DATA 7 ,0

'------------------ End of Mouse Cursor Data ------------------

'---------------- Start of Mouse Cursor Data ----------------

Hand1:

DATA &HF3FF,&HEDFF,&HEDFF,&HEC7F,&HED8F,&HEDB1,&HEDB6,&H8DB6

DATA &H6DB6,&H6FFE,&H6FFE,&H7FFE,&H7FFE,&H7FFE,&HBFFD,&HC003

DATA &HC00,&H1200,&H1200,&H1380,&H1270,&H124E,&H1249,&H7249

DATA &H9249,&H9001,&H9001,&H8001,&H8001,&H8001,&H4002,&H3FFC

DATA 5 ,0

'------------------ End of Mouse Cursor Data ------------------

'---------------- Start of Mouse Cursor Data ----------------

Hand2:

DATA &HF3FF,&HE1FF,&HE1FF,&HE07F,&HE00F,&HE001,&HE000,&H8000

DATA &H0,&H0,&H0,&H0,&H0,&H0,&H8001,&HC003

DATA &H0,&HC00,&HC00,&HC00,&HD80,&HDB0,&HDB6,&HDB6

DATA &H6DB6,&H6FFE,&H6FFE,&H7FFE,&H7FFE,&H7FFE,&H3FFC,&H0

DATA 5 ,0

'------------------ End of Mouse Cursor Data ------------------

SUB ChangeCursor (A$)

  DIM Regs AS RegType ' Use for QB45 Near Strings

  REM DIM Regs as RegTypeX ' Use for QBX/VBDOS Far Strings

  ' Assigns Custom Cursor Shape Depending on String Passed.

  ' Use RegType in QB; need ES Register for PDS/VBDOS Far String support.

  SELECT CASE A$

  CASE "A"

  RESTORE BullsEye1:

  CASE "B"

  RESTORE BullsEye2:

  CASE "C"

  RESTORE HourGlass1:

  CASE "D"

  RESTORE HourGlass2:

  CASE "E"

  RESTORE HourGlass3:

  CASE "F"

  RESTORE HourGlass4:

  CASE "G"

  RESTORE HourGlass4:

  CASE "H"

  RESTORE StopWatch:

  CASE "I"

  RESTORE Smiley1:

  CASE "J"

  RESTORE Smiley2:

  CASE "K"

  RESTORE CrossHair1:

  CASE "L"

  RESTORE CrossHair2:

  CASE "M"

  RESTORE Hand1:

  CASE "N"

  RESTORE Hand2:

  CASE "Q:"

  SCREEN 0, , 0, 0

  CLS : SYSTEM

  CASE ELSE

  EXIT SUB

  END SELECT

  '====================================================================

  ' Below is the part you're most interested in. I read it in as a

  ' String * 1 (BYTE) .. 16 Bytes for the Cursor Mask, 16 Bytes for

  ' the Screen Mask, and the last two Integers the location of the Cursor

  ' Hot Spot - the Point actually referenced in Mouse Coordinates.

  ' Read in Graphical Mouse Cursor Data

  FOR I% = 1 TO 32

  READ Wrd%

  MMsk$ = MMsk$ + MKI$(Wrd%) ' Cursor Graphical Data

  NEXT I%

  READ Hotx, Hoty ' Cursor HotSpot

  ' Now For the Interrupt call ..

  ' Use Function 9 from Int 33 ..

  Regs.ax = 9: Regs.bx = Hotx: Regs.cx = Hoty

  Regs.dx = SADD(MMsk$) ' Use with ALL Basics ..

  ' Next Line not needed for QB, (Optional for PDS ??), needed for VBDOS

  ' But using it stores Data as a Far String.

  REM Regs.es = SSEG(MMsk$) ' Need InterruptX for this One ..

  INTERRUPT &H33, Regs, Regs ' Call QB45 Near string Interrupt

  REM INTERRUPTX &H33, Regs,Regs ' Call VBDOS/PDS Far String Interrupt

END SUB

FUNCTION HaveMouse%

  ' Checks to see if Mouse is Installed

  DEF SEG = 0

  MouseSegment& = 256& * PEEK(207) + PEEK(206)

  MouseOffset& = 256& * PEEK(205) + PEEK(204)

  DEF SEG = MouseSegment&

  IF (MouseSegment& = 0 AND MouseOffset& = 0) OR PEEK(MouseOffset&) = 207 THEN

  HaveMouse% = 0

  ELSE

  HaveMouse% = 1

  END IF

  DEF SEG

END FUNCTION

SUB Mouse (M0, M1, M2, M3) STATIC

  ' Note: VBDOS will move the "STATIC" in front of this SUB Name.

  ' If you then go back into QB, you'll have to manually put the "STATIC"

  ' back at the end of the Sub Declaration, or generate an Error.

  ' M0 = 0 : Initialize the Rodent

  ' 1 - Show Mouse

  ' 2 - Hide Mouse

  ' 3 - Mouse Location/Button Status

  DIM Regs AS RegType ' Use for ALL Basic's ..

  ' Calls interrupt &H33 to invoke mouse functions in the MS Mouse Driver.

  Regs.ax = M0: Regs.bx = M1: Regs.cx = M2: Regs.dx = M3

  INTERRUPT &H33, Regs, Regs ' Use for ALL Basic's ..

  M0 = Regs.ax: M1 = Regs.bx: M2 = Regs.cx: M3 = Regs.dx

END SUB

SUB MouseHide ' Hides Mouse cursor

  Mouse 2, 0, 0, 0

END SUB

SUB MouseShow ' Shows mouse Cursor

  Mouse 1, 0, 0, 0

END SUB

SUB PrintR (A$, X%, Y%, StepX%, StepY%, CO%, BackGround%, Shadow%)

  ' Prints Graphical Chars from Rom Data Table

  ' A$ Param is string to print

  ' X%=Graphics Horz pixel Position

  ' Y%=Graphics Vert pixel Position

  ' StepX% and StepY% control size of chars

  ' CO%= Foreground color

  ' BackGround%= BackGround Color

  ' Shadow% is a Boolean for Shadow enabling

  ExtX% = StepX%: ExtY% = StepY%

  DEF SEG = &HFFA6 ' ROM Segment for Character Shape Tables

  FOR I% = 1 TO LEN(A$)

  Addr% = 8 * ASC(MID$(A$, I%)) + 14 'Address character shape table

  IF BackGround% THEN 'Color background

  IF BackGround% = 256 THEN BG% = FALSE ELSE BG% = BackGround%

  IF I% = LEN(A$) THEN ExtX% = FALSE: ExtY% = FALSE

  LINE (X%, Y%)-(X% + 7 + ExtX%, Y% + 7 + ExtY%), BG%, BF

  END IF

  FOR J% = 0 TO 7

  Mask% = PEEK(Addr% + J%) * 128

  IF Shadow% THEN

  LINE (X% + 9, Y% + J% + 2)-(X% + 2, Y% + J% + 2), 0, , Mask%

  END IF

  LINE (X% + 7, Y% + J%)-(X%, Y% + J%), CO%, , Mask%

  NEXT

  X% = X% + ExtX%

  Y% = Y% + ExtY%

  NEXT

  DEF SEG 'Back to DGROUP

END SUB



Работа с модемом/сетью


Доступ к COM-портам через ф-ии BIOS:

Compot.bas (основной файл):


Code

'
' This subroutine initializes COM port PORT (1, 2, 3, or 4) for
' communication at transmission rate BAUD (1200 or less), data bits DBITS
' (5 - 8), parity PAR$ = "E" (even), "O" (odd), or "N" (none), and stop
' bits SBITS (1 or 2). All parameters but PAR$ are of INTEGER type. (Do
' not use COMREAD$ or COMPRINT with a PORT parameter before using COMOPEN
' to initialize that port.)
'
' These routines require the ASM code in QBUTIL.INC.
'
SUB COMOPEN(PORT AS INTEGER,BAUD AS INTEGER,DBITS AS INTEGER,PAR$,SBITS AS INTEGER)
DIM OS AS INTEGER,S AS STRING*1
'
' Bios thinks port numbers are zero-based. Make that conversion and
' constrain port number to valid values.
'
PT=PORT-1 : IF PT<0 THEN PT=0
IF PT>3 THEN PT=3
'
' Define port in machine code routine.
'
DEF SEG=VARSEG(MCODE(1))
OS=VARPTR(MCODE(1))
POKE OS+10,PT : POKE OS+11,0
'
' Stop bits are also zero-based at bios level. Constrain to valid range
' and convert to string representing binary number.
'
SL=SBITS-1 : IF SL<0 THEN SL=0
IF SL>1 THEN SL=1
S=LTRIM$(RTRIM$(STR$(SL)))
'
' Constrain baud rate to valid value. (Default is 600 baud.)
'
BD=BAUD
IF BD<>110 AND BD<>150 AND BD<>300 AND BD<>1200 THEN BD=600
'
' Convert initialization parameters to binary string.
'
INTSTR$=""
IF BD=150 THEN INTSTR$="001"
IF BD=300 THEN INTSTR$="010"
IF BD=600 THEN INTSTR$="011"
IF BD=1200 THEN INTSTR$="100"
P$=MID$(LTRIM$(RTRIM$(UCASE$(PAR$))),1,1)
IF P$="N" THEN INTSTR$=INTSTR$+"10"
IF P$="E" THEN INTSTR$=INTSTR$+"11"
IF P$="O" THEN INTSTR$=INTSTR$+"01"
INTSTR$=INTSTR$+S
IF DBITS<6 THEN INTSTR$=INTSTR$+"00"
IF DBITS=6 THEN INTSTR$=INTSTR$+"01"
IF DBITS=7 THEN INTSTR$=INTSTR$+"10"
IF DBITS>7 THEN INTSTR$=INTSTR$+"11"
'
' Convert binary initialization string to decimal value.
'
INIT=0
FOR I=1 TO 8
INIT=INIT+2^(8-I)*VAL(MID$(INTSTR$,I,1))
NEXT I
'
' Finish machine code set up and call it.
'
POKE OS+1,INIT : POKE OS+2,0 : POKE OS+16,&H14
CALL ABSOLUTE(OS)
DEF SEG
END SUB
'
' This function returns directly the character STRING read from COM port
' PORT (1, 2, 3, or 4). N is the number of characters in the string to
' input from the port and return to the calling routine and TERMCHR is the
' ascii code for a termination character. This latter parameter is not
' used if N is positive. If N is zero or negative, rather than input a
' specific number of N characters, COMREAD$ simply returns a string
' containing all characters input from the COM port up until a character
' with ascii code TERMCHR is input. (TERMCHR is not included in the
' returned string. All parameters are of INTEGER type.)
'
FUNCTION COMREAD$(PORT AS INTEGER,N AS INTEGER,TERMCHR AS INTEGER)
DIM OS AS INTEGER,AX AS INTEGER,BX AS INTEGER,CX AS INTEGER,DX AS INTEGER
'
' Define port, bios function number, and interrupt in machine code
' routine.
'
PT=PORT-1 : IF PT<0 THEN PT=0
IF PT>3 THEN PT=3
DEF SEG=VARSEG(MCODE(1))
OS=VARPTR(MCODE(1))
POKE OS+10,PT : POKE OS+11,0 : POKE OS+16,&H14
POKE OS+2,2
'
' Input data from COM port.
'
STRNG$=""
IF N>0 THEN
'
' Number of characters to input is predefined.
'
FOR I=1 TO N
CALL ABSOLUTE(AX,BX,CX,DX,OS)
STRNG$=STRNG$+CHR$(AX AND &HFF)
NEXT I
ELSE
'
' Number of characters to input is determined by input of TERMCHR.
'
C=-1
WHILE C<>TERMCHR
CALL ABSOLUTE(AX,BX,CX,DX,OS)
'
' Character read is in subregister AL.
'
C=AX AND &HFF
IF C<>TERMCHR THEN STRNG$=STRNG$+CHR$©
WEND
END IF
DEF SEG
COMREAD$=STRNG$
END FUNCTION
'
' This subroutine sends character STRING STRNG$ out COM port PORT (1, 2,
' 3, or 4--an INTEGER variable). If STRNG$ is terminated with a ";",
' carriage return and line feed characters are not sent out the port after
' STRNG$; otherwise, they are.
'
SUB COMPRINT(PORT AS INTEGER,STRNG$)
DIM OS AS INTEGER
'
' Define port, bios function number, and interrupt in machine code
' routine.
'
PT=PORT-1 : IF PT<0 THEN PT=0
IF PT>3 THEN PT=3
DEF SEG=VARSEG(MCODE(1))
OS=VARPTR(MCODE(1))
POKE OS+10,PT : POKE OS+11,0 : POKE OS+2,1 : POKE OS+16,&H14
'
' Send character string out COM port one character at a time. Process
' last character separately in case it is ";".
'
L=LEN(STRNG$)-1
IF L>0 THEN
FOR I=1 TO L
C=ASC(MID$(STRNG$,I,1))
POKE OS+1,C
CALL ABSOLUTE(OS)
NEXT I
END IF
RT=ASC(RIGHT$(STRNG$,1))
IF RT<>59 THEN
POKE OS+1,RT
CALL ABSOLUTE(OS)
POKE OS+1,13
CALL ABSOLUTE(OS)
POKE OS+1,10
CALL ABSOLUTE(OS)
END IF
DEF SEG
END SUB


Qbutil.inc (дополнительный файл):

Code

'
' This is an include file to be used with the COMPORT.BAS, PALREAD.BAS,
' and READSCRN.BAS routines. (Put it at the top of your MAIN routine.)
'
DECLARE FUNCTION COMREAD$(PORT AS INTEGER,N AS INTEGER,TERMCHR AS INTEGER)
DECLARE FUNCTION READSCRN$()
'
' Set up machine code. Various bytes are changed by routines in
' COMPORT.BAS, PALREAD.BAS, or READSCRN.BAS.
'
DIM SHARED MCODE(1 TO 10) AS LONG
DIM OS AS INTEGER
DEF SEG=VARSEG(MCODE(1))
OS=VARPTR(MCODE(1))
POKE OS,&HB8 : POKE OS+1,0 : POKE OS+2,2 'MOV AX,[AHAL]
POKE OS+3,&HBB : POKE OS+4,&HFF : POKE OS+5,0 'MOV BX,[BHBL]
POKE OS+6,&HB9 : POKE OS+7,0 : POKE OS+8,0 'MOV CX,[CHCL]
POKE OS+9,&HBA : POKE OS+10,&HAB : POKE OS+11,&HCD 'MOV DX,[DHDL]
POKE OS+12,&H55 'PUSH BP
POKE OS+13,&H89 : POKE OS+14,&HE5 'MOV BP,SP
POKE OS+15,&HCD : POKE OS+16,&H10 'INT [INT]
POKE OS+17,&H8B : POKE OS+18,&H7E : POKE OS+19,6 'MOV DI,[BP+6]
POKE OS+20,&H89 : POKE OS+21,&H15 'MOV [DI],DX
POKE OS+22,&H8B : POKE OS+23,&H7E : POKE OS+24,8 'MOV DI,[BP+8]
POKE OS+25,&H89 : POKE OS+26,&HD 'MOV [DI],CX
POKE OS+27,&H8B : POKE OS+28,&H7E : POKE OS+29,&HA 'MOV DI,[BP+A]
POKE OS+30,&H89 : POKE OS+31,&H1D 'MOV [DI],BX
POKE OS+32,&H8B : POKE OS+33,&H7E : POKE OS+34,&HC 'MOV DI,[BP+C]
POKE OS+35,&H89 : POKE OS+36,5 'MOV [DI],AX
POKE OS+37,&H5D 'POP BP
POKE OS+38,&HCB 'RETF
DEF SEG


Инструкция по использованию файлов в коде программы.



Разное


"Привет мир!":

Code
PRINT "Hello world!"


Игра "Орёл или решка":


Code

CLS
PLAY "A B C "
COLOR , 3
PRINT "Введите ваше имя."
INPUT name$
CLS
PRINT "Здравствуйте,"; name$; " ! "
PRINT "Загадайте орла или решку и нажмите <ENTER> для начала игры."
SLEEP
RANDOMIZE TIMER
X = INT(RND(1) * 2)
IF X = 0 THEN PRINT "У вас выпала решка" ELSE PRINT "У вас выпал орёл"
SLEEP 2
PRINT "До свидания,"; name$; ". Играйте ещё!"
PLAY "C B A"

Категория: Basic | Добавил: Admin | Теги: примеры программ на qbasic, примеры программ на quickbasic, готовые коды на qbasic, готовые программы на qbasic
Просмотров: 126316 | Загрузок: 636 | Комментарии: 14 | Рейтинг: 4.8/30
Всего комментариев: 141 2 »
14 Илья   (21.02.2014 21:51) [Материал]
На любом языке пишет просо надо задать через номерацию букв в одном или другом видах!

13 Михаил   (23.01.2014 20:23) [Материал]
помогите плиз..... решите этот массив - решить уравнение AX=B для десяти пар значений А и В, заданных в виде двух массивов А(10) и В(10). результат поместить в массив Х(10).(при составлении программ учесть, что среди А(I) могут быть нулевые элементы, т.е. исключить деление на ноль)

12 Катерина   (24.10.2013 16:54) [Материал]
Здравствуйте, помогите, пожалуйста, составить программу. Задача-Сформулируйте и выведите на экран массив из 9 элементов, каждые три последовательных элемента которого составлены по следующему правилу:
1-й равен квадрату текущего индекса, увеличенному на 5;
2-й равен целой части квадратного корня из предыдущего элемента;
3-й равен целой части от деления двух предыдущих элементов.

11 Admin   (12.04.2013 22:57) [Материал]
nicke23[b]андрей ханджиян  - вам нужно на форум, здесь такие вопросы не задавайте, не ответят.  :exclaim:[/b]

10 nicke23   (04.04.2013 13:53) [Материал]
программа которая выдает на экран 5 слов максимальной длины из слова "электричество" в программе qbasic

9 андрей ханджиян   (03.04.2013 18:39) [Материал]
покажите программу авто стоянка написанную на бейсике в раскрытом виду

8 ivs   (02.06.2012 15:48) [Материал]
для семерки используйте qb64

6 Mr_Popler   (26.05.2012 18:38) [Материал]
Алексей, QBasic на 7ке по русски не пишет.

7 Admin   (29.05.2012 21:41) [Материал]
На XP пишет, на 7 нет. Да на 7 даже графичекий режим не запускается, что уж говорить. angry

5 Евгений   (23.04.2012 05:47) [Материал]
уматная прога

3 Алексей   (21.05.2011 14:07) [Материал]
Уматные примеры)) Правда почему у вас выводимая информация на экран написана английскими словами по-русски? Я уже давно по-русски пишу. Менять нада нажав одновременно на правый шифт и контрл. А обратно на английский перейти тоже самое только на левые нажимать.

4 Admin   (21.05.2011 15:56) [Материал]
Спасибо. Я, если честно, даже и не знал, как переключать язык в QBasic - именно что нужно правый Shift нажимать.

1-10 11-11
Добавлять комментарии могут только зарегистрированные пользователи.
[ Регистрация | Вход ]
Поиск
Наш опрос
Какую версию Basic вы предпочитаете?
Всего ответов: 2028

© Basic.ucoz.net, 2020