Keskustelu: Projektit: HoneyLib, paranneltuja QB-komentoja

DECLARE FUNCTION HBlank$ ()
DECLARE SUB HInitialize ()
DECLARE FUNCTION HInput$ ()
DECLARE FUNCTION HInt! (HPaValue AS DOUBLE)
DECLARE SUB HLocate (HPaY AS INTEGER, HPaX AS INTEGER)
DECLARE SUB HPrint (HPaText AS STRING)
DECLARE FUNCTION HRnd! (HPaMin AS DOUBLE, HPaMax AS DOUBLE)
DECLARE FUNCTION HRound! (HPaValue AS DOUBLE, HPaCur AS DOUBLE)
DECLARE SUB HScrollUp ()
DECLARE SUB HSetColor (HPaColor AS INTEGER)
DECLARE SUB HSetScroll (HPaTop AS INTEGER, HPaLast AS INTEGER, HPaLeft AS INTEGER, HPaRight AS INTEGER)
DECLARE SUB HSetSystem (Mode AS INTEGER)
DECLARE SUB HSlow (HPaTime AS SINGLE)
DECLARE SUB HStartTimer (HPaSlot AS INTEGER)
DECLARE FUNCTION HString$ (BYVAL PaValue AS DOUBLE)
DECLARE FUNCTION HTimer! (HPaSlot AS INTEGER)
DECLARE SUB HWait (HPaSec AS DOUBLE)
COMMON SHARED HSystem AS INTEGER
COMMON SHARED HReadKey AS STRING
COMMON SHARED HTime() AS DOUBLE
COMMON SHARED HScroll() AS INTEGER
COMMON SHARED HPrintX AS INTEGER, HPrintY AS INTEGER
COMMON SHARED HColor AS INTEGER
COMMON SHARED HscrlTop AS INTEGER, HScrlLast AS INTEGER, HScrlLeft AS INTEGER, HScrlRight AS INTEGER

DIM HTime(1 TO 100) AS DOUBLE
DIM HScroll(1 TO 25, 1 TO 80, 1 TO 2) AS INTEGER

''// HoneyLib version 0.95m //

'T?st? eteenp?in p??ohjelman koodi on vain esimerkkiohjelmaa, jonka voi
'poistaa ja korvata omallaan.

CLS
HInitialize        'T?ytyy kutsua joka kerta ennen kirjaston k?ytt??
                   'muuten voi aiheutua ongelmia

HSetSystem 1       't?ll? ei ole ihmeempi? merkityksi?, ei pakollinen

HSetColor 6                       't?m? on kuten COLOR
HLocate 4, 16                       't?m? taas kuten LOCATE
HPrint "Terve, kirjoita jotain"        't?m? kuten PRINT
HLocate 6, 14
a$ = HInput$                        't?m? kuin INPUT
HLocate 8, 16
HPrint "Kirjoitit juuri "
HPrint a$

HStartTimer 1                    'K?ynnist?? kellon numero 1

HWait 1                     'Odottaa 1 sekunnin

HLocate 12, 10
HPrint "?sken kului" + STR$(HTimer(1)) + " sekuntia."

'HTimer-funktio palauttaa ajan, johon ?skett?in k?ynnistetty kello p??si

HLocate 15, 10
HPrint STR$(HInt(5.5)) + " ja"    'HInt on kuten INT mutta py?rist?? yl?skin
HPrint STR$(HRound(18, 7))         'HRoundin ensimm?inen parametri on
                              'py?ristett?v? numero. Toinen parametri on
                              'numero, jonka tarkkutteen py?ristet??n

HLocate 17, 5
HSetColor 5


FOR a = -12 TO 12
   HPrint HString(a) + " "          'HString palauttaa numeerisen muuttujan
   HSlow 1                          'merkkijonona (parempi kuin STR$)
NEXT a

HSetScroll 1, 25, 10, 70        'Asettaa skrollauksen koordinaatit
                             'yl?, ala, vasen, oikea

HWait .2           'odottaa 0.2 sekuntia

FOR b = 1 TO 25
   HLocate 25, 1

   FOR a = 1 TO 80
      HSetColor INT(HRnd(5, 9))
      HPrint CHR$(INT(HRnd(97, 122)))        'HRnd palauttaa luvun paremetrin
                                           'v?lilt?
   NEXT a

   HScrollUp           'Skrollaa teksti? yl?sp?in
NEXT b

FUNCTION HBlank$

   HBlank$ = STRING$(80, 32)

END FUNCTION

SUB HInitialize

HLocate 1, 1
HSetColor 7
HSetScroll 1, 25, 1, 80

END SUB

FUNCTION HInput$

HTemp1 = HPrintX

DO

HReadKey = INPUT$(1)

SELECT CASE ASC(HReadKey)
CASE 13
   EXIT DO

CASE 8
   HLocate HPrintY, HPrintX - 1
   HPrint " "
   HLocate HPrintY, HPrintX - 1

   IF HPrintX < HTemp1 THEN
      HPrintX = HTemp1
   ELSE
      HTemp1$ = LEFT$(HTemp1$, LEN(HTemp1$) - 1)
   END IF

CASE 32, 48 TO 57, 65 TO 90, 97 TO 122, 128 TO 165
   HPrint HReadKey
   HTemp1$ = HTemp1$ + HReadKey

CASE 27
   IF HSystem THEN END

END SELECT

LOOP

HInput$ = HTemp1$

END FUNCTION

FUNCTION HInt (HPaValue AS DOUBLE)

HTemp1 = HPaValue - INT(HPaValue)
IF HTemp1 < .5 THEN HInt = INT(HPaValue) ELSE HInt = INT(HPaValue) + 1

END FUNCTION

SUB HLocate (HPaY AS INTEGER, HPaX AS INTEGER)

HPrintX = HPaX
HPrintY = HPaY

END SUB

SUB HPrint (HPaText AS STRING)

DEF SEG = &HB800

FOR HLoopA = 1 TO LEN(HPaText)

HTemp1 = (HPrintY - 1) * 160 + (HPrintX - 1) * 2

POKE HTemp1, ASC(MID$(HPaText, HLoopA, 1))
POKE HTemp1 + 1, HColor

HPrintX = HPrintX + 1
IF HPrintX = 81 THEN
   HPrintX = 1
   HPrintY = HPrintY + 1
   IF HPrintY = 26 THEN HPrintY = 1
END IF

NEXT HLoopA

END SUB

FUNCTION HRnd (HPaMin AS DOUBLE, HPaMax AS DOUBLE)

HRnd = HPaMin + RND * (HPaMax - HPaMin + 1)

END FUNCTION

FUNCTION HRound (HPaValue AS DOUBLE, HPaCur AS DOUBLE)

HRound = HInt(HPaValue / HPaCur) * HPaCur

END FUNCTION

SUB HScrollUp

DEF SEG = &HB800

FOR HLoopA = HscrlTop TO HScrlLast
FOR HLoopB = HScrlLeft TO HScrlRight
   HTemp1 = (HLoopA - 1) * 160 + (HLoopB - 1) * 2
   HTemp2 = PEEK(HTemp1)
   HTemp3 = PEEK(HTemp1 + 1)
   HScroll(HLoopA, HLoopB, 1) = HTemp2
   HScroll(HLoopA, HLoopB, 2) = HTemp3
NEXT HLoopB
NEXT HLoopA

FOR HLoopA = HscrlTop TO HScrlLast - 1
FOR HLoopB = HScrlLeft TO HScrlRight
   HTemp1 = (HLoopA - 1) * 160 + (HLoopB - 1) * 2
   POKE HTemp1, HScroll(HLoopA + 1, HLoopB, 1)
   POKE HTemp1 + 1, HScroll(HLoopA + 1, HLoopB, 2)
NEXT HLoopB
NEXT HLoopA

HLocate HScrlLast, 1
HPrint HBlank$

END SUB

SUB HSetColor (HPaColor AS INTEGER)

HColor = HPaColor

END SUB

SUB HSetScroll (HPaTop AS INTEGER, HPaLast AS INTEGER, HPaLeft AS INTEGER, HPaRight AS INTEGER)

HscrlTop = HPaTop
HScrlLast = HPaLast
HScrlLeft = HPaLeft
HScrlRight = HPaRight

END SUB

SUB HSetSystem (Mode AS INTEGER)

IF Mode = 0 THEN HSystem = 0
IF Mode = 1 THEN HSystem = -1

END SUB

SUB HSlow (HPaTime AS SINGLE)

SOUND 32767, HPaTime

END SUB

SUB HStartTimer (HPaSlot AS INTEGER)

HTime(HPaSlot) = TIMER

END SUB

FUNCTION HString$ (BYVAL PaValue AS DOUBLE)

Temp1$ = STR$(PaValue)

IF PaValue < 0 THEN
   HString = MID$(Temp1$, 1, LEN(Temp1$))
ELSE
   HString = MID$(Temp1$, 2, LEN(Temp1$) - 1)
END IF

END FUNCTION

FUNCTION HTimer (HPaSlot AS INTEGER)

HTimer = TIMER - HTime(HPaSlot)

END FUNCTION

SUB HWait (HPaSec AS DOUBLE)

HTemp1 = TIMER
DO
LOOP UNTIL TIMER - HTemp1 >= HPaSec

END SUB