'------------------------------------------------------------------.
' |
' Nämä Windoze-rutiinit on kirjoittanut |
' Sami Kyöstilä (HiTECK IRC:ssä, KEMPLE OY MBnetissä) 12.4.1997 |
' |
'Tätä koodia saa levittää vapaasti, kunhan tätä laatikkoa |
'ei siirretä, poisteta, muuteta jne. |
' |
'EN OTA MITÄÄN VASTUUTA TÄMÄN OHJELMAN AIHEUTTAMISTA VAHINGOISTA! |
' |
'Jos sinulla on kysymyksiä, kommentteja etc. lähetä postia |
'osoitteeseen: |
' |
' |
' hiteck@freenet.hut.fi |
' |
'tai: |
' |
' kemple.oy@mbnet.fi |
' |
' |
' |
' (C) Sami Kyöstilä 1997|
' |
'------------------------------------------------------------------'
DECLARE SUB KillTextfield (Textnum!, Erasecolor!)
DECLARE SUB KillPBar (PBarnum!, Erasecolor!)
DECLARE SUB DrawPBar (PBarnum!)
DECLARE SUB CreatePBar (PBarnum!, x!, y!, x2!, y2!, Value!, Total!)
DECLARE SUB DisableButton (Buttonnum%)
DECLARE SUB EnableButton (Buttonnum%)
DECLARE SUB Textfield (Textnum!, x!, y!, Lenght!)
DECLARE SUB KillDialog (x!, y!, x2!, y2!)
DECLARE SUB Dialog (x!, y!, x2!, y2!, Topic$, Prompt$, Button1$, Button2$, Button3$, Getbackrnd)
DECLARE SUB Getpic (x, y, x2, y2, File$)
DECLARE SUB Putpic (x, y, File$)
DECLARE SUB Hiirilue (vasen%, oikea%, keski%, x%, y%)
DECLARE SUB Hiirirajat (x1%, y1%, x2%, y2%)
DECLARE SUB Hiiripiiloon ()
DECLARE SUB Hiiriesiin ()
DECLARE FUNCTION Hiiritarkista% ()
DECLARE SUB Hiiriajuri (ax%, bx%, cx%, dx%)
DECLARE SUB ShowBMP (StartX!, StartY!, File$)
DECLARE SUB HELP ()
DECLARE SUB Playwav (File$)
DECLARE SUB FMVolume (Right, Left, Getvol%)
DECLARE SUB VocVolume (Right, Left, Getvol%)
DECLARE SUB MasterVolume (Right, Left, Getvol%)
DECLARE SUB MicVolume (Volume, Getvol%)
DECLARE SUB LineVolume (Right, Left, Getvol%)
DECLARE SUB CDVolume (Right, Left, Getvol%)
DECLARE SUB InputSource (InputSrc, GetSrc)
DECLARE SUB Getblaster ()
DECLARE SUB XORLine (x!, y!, x2!, y2!, Box%, Pixels)
DECLARE SUB CreateHScrollbar (Scrollbarnum, x!, y!, x2!, Large!, Default!)
DECLARE SUB UpdateHScrollbar (Scrollbarnum!)
DECLARE SUB Text (x.pos, y.pos, Text$, frontcolor, backcolor, wrappos, Size)
DECLARE SUB GetFont ()
DECLARE SUB DrawWindow (x, y, x2, y2, Topiccol, fillcol, Topic$, Topictextcol)
DECLARE SUB Createbutton (Buttonnum, x, y, x2, y2, Text$, colr, Size)
DECLARE SUB CreateScrollbar (Scrollbarnum, x, y, y2, Large, Default)
DECLARE SUB Animbutton (Buttonnum, updown)
DECLARE SUB EraseText (x, y, EraseText$, col)
DECLARE SUB Initscreen ()
DECLARE SUB Handlebuttons ()
DECLARE SUB Initmouse ()
DECLARE SUB Box3D (x, y, x2, y2, colr, in)
DECLARE SUB Box3D2 (x, y, xlen, ylen, colr, in)
DECLARE SUB Killbutton (Buttonnum, colr)
DECLARE SUB UpdateScrollbar (Scrollbarnum)
DECLARE SUB Killbar (Scrollbarnum, colr)
DECLARE SUB ChangeButtonColor (Buttonnum, colr)
DECLARE SUB ChangeButtonPos (Buttonnum, x, y, x2, y2, colr)
DECLARE SUB ChangeButtonText (Buttonnum!, NewText$, Size)
DECLARE SUB KillHbar (Scrollbarnum!, colr!)
DECLARE SUB WriteDSP (byte%)
DECLARE SUB SBReset ()
DECLARE FUNCTION Samplebyte% ()
OPTION BASE 0
'DeActivoidaan Ctrl-Break ja Ctrl-C
KEY 15, CHR$(4 + 128 + 32 + 64) + CHR$(70)
ON KEY(15) GOSUB HandleBreak: KEY(15) ON
KEY 16, CHR$(4 + 128) + CHR$(70): ON KEY(16) GOSUB HandleBreak: KEY(16) ON
KEY 17, CHR$(4 + 128 + 32) + CHR$(70): ON KEY(17) GOSUB HandleBreak
KEY(17) ON: KEY 18, CHR$(4 + 128 + 64) + CHR$(70): ON KEY(18) GOSUB HandleBreak
KEY(18) ON: KEY 19, CHR$(4) + CHR$(70): ON KEY(21) GOSUB HandleBreak
KEY(21) ON: KEY 22, CHR$(4 + 64) + CHR$(70)
ON KEY(22) GOSUB HandleBreak: KEY(22) ON: KEY 23, CHR$(4 + 32) + CHR$(46)
ON KEY(23) GOSUB HandleBreak: KEY(23) ON: KEY 24, CHR$(4 + 64) + CHR$(46)
ON KEY(24) GOSUB HandleBreak: KEY(24) ON
KEY 25, CHR$(4 + 32 + 64) + CHR$(46): ON KEY(25) GOSUB HandleBreak: KEY(25) ON
'-------------Pakolliset muuttujat------------------
DIM SHARED bitmap(8, 256) AS INTEGER 'Fonttitaulukko
DIM SHARED MaxButtons 'Nappien maksimimäärä
MaxButtons = 50
DIM SHARED MaxScrollbars 'Vierityspalkkien maksimimäärä
MaxScrollbars = 50
DIM SHARED Maxfields 'Tekstikenttien maksimimäärä
Maxfields = 20
DIM SHARED MaxPBars 'Prosenttipalkkien maksimimäärä
MaxPBars = 10
DIM SHARED Screenmode 'Ruutumode
DIM SHARED hiiri$ 'Hiiriajurin muuttuja
DIM SHARED ButtonX(MaxButtons + MaxScrollbars * 2) 'Napin X - koordinaatti
DIM SHARED ButtonY(MaxButtons + MaxScrollbars * 2) 'Napin Y - koordinaatti
DIM SHARED ButtonX2(MaxButtons + MaxScrollbars * 2) 'Napin leveys
DIM SHARED ButtonY2(MaxButtons + MaxScrollbars * 2) 'Napin korkeus
DIM SHARED Buttontext$(MaxButtons + MaxScrollbars * 2) 'Napin teksti
DIM SHARED Buttoncol(MaxButtons + MaxScrollbars * 2) 'Napin väri
DIM SHARED Nextbutton 'Seuraava vapaa nappipaikka taulukossa
DIM SHARED LastButton 'Viimeisen napin numero taulukossa
DIM SHARED Pressedbutton 'Painettu nappi
DIM SHARED Scrollbar(MaxScrollbars) 'Vierityspalkkiin liitetyt napit
DIM SHARED SValue(MaxScrollbars) 'Vierityspalkin arvo
DIM SHARED Scrollstep(MaxScrollbars) 'Vierityspalkin askelkoko
DIM SHARED SbarX(MaxScrollbars) 'Vierityspalkin vasen yläkulma X
DIM SHARED SBarY(MaxScrollbars) 'Vierityspalkin vasen yläkulma Y
DIM SHARED SBarY2(MaxScrollbars) 'Vierityspalkin alareuna Y
DIM SHARED Nextbar 'Seuraava vapaa vierityspalkkipaikka taulukossa
DIM SHARED Lastbar 'Viimeisen vierityspalkin numero taulukossa
DIM SHARED ScrollMin(MaxScrollbars) 'Vierityspalkin pienin arvo (0)
DIM SHARED ScrollMax(MaxScrollbars) 'Vierityspalkin suurin arvo
DIM SHARED HScrollbar(MaxScrollbars) 'Katso ylhäältä
DIM SHARED HSvalue(MaxScrollbars) 'Katso ylhäältä
DIM SHARED HScrollstep(MaxScrollbars) 'Katso ylhäältä
DIM SHARED HSbarX(MaxScrollbars) 'Katso ylhäältä
DIM SHARED HSBarY(MaxScrollbars) 'Katso ylhäältä
DIM SHARED HSBarX2(MaxScrollbars) 'Katso ylhäältä
DIM SHARED HScrollMin(MaxScrollbars) 'Katso ylhäältä
DIM SHARED HScrollMax(MaxScrollbars) 'Katso ylhäältä
DIM SHARED Oldvalue(MaxScrollbars) 'Vierityspalkin vanha arvo
DIM SHARED OldHvalue(MaxScrollbars) 'Vierityspalkin vanha arvo
DIM SHARED HLastbar 'Katso ylhäältä
DIM SHARED HNextbar 'Katso ylhäältä
DIM SHARED Nextbartag 'Seuraava vapaa Vierityspalkin napin numero
DIM SHARED Left, Right 'SB-kanavien äänenvoimakkuus: Vasen, Oikea
DIM SHARED BasePort%, DMA, IRQ 'SB:n Osoite, DMA, IRQ
DIM SHARED Movedbar 'Viimeksi liikutettu Vierityspalkki
DIM SHARED HMovedbar 'Viimeksi liikutettu vaakatasossa oleva Vierityspalkki
DIM SHARED Tavu AS STRING * 1 '1 tavun pituinen merkkijono
DIM SHARED Hiiriax%, Hiiribx%, Hiiricx%, Hiiridx% 'Hiiriajurin rekisterit
DIM SHARED HiiriX, HiiriY 'Katso alhaalta
DIM SHARED HiiriX%, HiiriY% 'Katso alhaalta
DIM SHARED Hiiriv%, Hiirio%, hiirik% 'Katso alhaalta
DIM SHARED Hiirix1%, Hiirix2% 'Katso alhaalta
DIM SHARED Hiiriy1%, Hiiriy2% 'Katso alhaalta
DIM SHARED DialogActive 'Onko valintaikkuna aktiivinen? 1 = On, 0 = Ei
DIM SHARED DialogX 'Valintaikkunan koordinaatit
DIM SHARED DialogY
DIM SHARED DialogX2
DIM SHARED DialogY2
DIM SHARED DialogBackround 'Valintaikkunan taustaväri
DIM SHARED DialogPressedButton 'Painettu valintaikkunan nappi
DIM SHARED Key$ 'Painettu näppäimistön nappi
DIM SHARED TextfieldX(Maxfields) 'Tekstikentän X koord.
DIM SHARED TextfieldY(Maxfields) 'Tekstikentän Y koord.
DIM SHARED TextFieldLen(Maxfields) 'Tekstikentän pituus
DIM SHARED TextF$(Maxfields) 'Tekstikentän teksti
DIM SHARED ActiveTextField AS INTEGER 'Aktiivinen tekstikenttä
DIM SHARED LastTextfield AS INTEGER 'Viimeinen luotu tekstikenttä
DIM SHARED DisabledButton(MaxButtons + MaxScrollbars) AS INTEGER 'Onko nappi lukittu? 1 = on, 0 = ei
DIM SHARED PBarX(MaxPBars) 'Prosenttipalkin koordinaatit
DIM SHARED PBarY(MaxPBars)
DIM SHARED PBarX2(MaxPBars)
DIM SHARED PBarY2(MaxPBars)
DIM SHARED PBarTotal(MaxPBars) 'Prosenttipalkin max. arvo
DIM SHARED PBarValue(MaxPBars) 'Prosenttipalkin arvo
DIM SHARED OldPBarValue(MaxPBars) 'Prosenttipalkin vanha arvo
CALL Initmouse
Nextbartag = MaxButtons
Screenmode = 12 'Ruutumode
Nextbutton = 0 'Katso ylhäältä
LastButton = 0 'Katso ylhäältä
ButtonHeld = -1 'Nappi, jota pidetään pohjassa
Pressedbutton = -1 'Painettu nappi (katso SUB Handlebuttons)
Hiirix1% = 0 'Hiiren liikkumarajat X
Hiirix2% = 639 ' Y
Hiiriy1% = 0 ' X2
Hiiriy2% = 479 ' Y2
'Muuta tietoa:
'--------------------------------------------------------------
'hiirix, hiiriy 'Hiiren koordinaatit
'hiiriv%, hiirik%, hiirio% 'Hiiren napin asennot
'Oikea, Keski, Vasen
'0 = Ylhäällä
'-1 = Painettu
'Hiiripiiloon 'Piilottaa hiiren kursorin
'Hiiriesiin 'Palauttaa hiiren kursorin
'GOSUB Hiirirajat 'Asettaa hiiren liikkumarajat
'Katso ylhäältä
'Mousemove 'Onko hiiri liikkunut?
'0 = ei, 1 = on
'Movedbar 'Mitä vierityspalkkia on liikutettu
'HMovedbar '(numero) (-1 = ei mitään)
'Hiiritarkista% 'Hiiren nappien määrä
'Key$ 'Painettu näppäimistön nappi
'--------------------------------------------------------------
'---------------------------------------------------
' Valinnaiset muuttujat
'---------------------------------------------------
'---------------------------------------------------
SCREEN Screenmode: CLS
napit% = Hiiritarkista%
IF (napit% = 0) THEN
PRINT "Hiirtä ei löydy!"
END
END IF
Hiiriesiin
Hiiripiiloon
CALL Getblaster
CALL GetFont
CALL Initscreen
OldHiiriX = 10
OldHiiriY = 10
Hiiriesiin
Hiirirajat Hiirix1%, Hiiriy1%, Hiirix2%, Hiiriy2%
DO
Key$ = INKEY$
Hiirilue Hiiriv%, Hiirio%, hiirik%, HiiriX%, HiiriY%
HiiriX = HiiriX%
HiiriY = HiiriY%
IF Screenmode = 13 OR Screenmode = 7 THEN HiiriX = HiiriX / 2
IF HiiriX <> OldHiiriX OR HiiriY <> OldHiiriY THEN
Mousemove = 1
OldHiiriX = HiiriX
OldHiiriY = HiiriY
ELSE
Mousemove = 0
END IF
IF ButtonHeld > -1 AND Hiiriv% = 1 THEN
Buttons = ButtonHeld
IF HiiriX < ButtonX(Buttons) AND HiiriX > ButtonX2(Buttons) AND HiiriY < ButtonY(Buttons) AND HiiriY > ButtonY2(Buttons) THEN
ButtonHeld = -1
Hiiripiiloon
CALL Animbutton(Buttons, 1)
Hiiriesiin
GOTO Mainloop
END IF
END IF
IF Hiiriv% = -1 AND ButtonHeld = -1 THEN
FOR Buttons = 0 TO LastButton
IF HiiriX >= ButtonX(Buttons) AND HiiriX <= ButtonX2(Buttons) AND HiiriY >= ButtonY(Buttons) AND HiiriY <= ButtonY2(Buttons) THEN
Hiiripiiloon
CALL Animbutton(Buttons, 0)
Hiiriesiin
ButtonHeld = Buttons
END IF
NEXT
END IF
IF Hiiriv% = 0 AND ButtonHeld > -1 THEN
Buttons = ButtonHeld
IF HiiriX >= ButtonX(Buttons) AND HiiriX <= ButtonX2(Buttons) AND HiiriY >= ButtonY(Buttons) AND HiiriY <= ButtonY2(Buttons) THEN
ButtonHeld = -1
Pressedbutton = Buttons
Hiiripiiloon
CALL Animbutton(Buttons, 1)
Hiiriesiin
ELSE
Hiiripiiloon
FOR Buttons = 0 TO LastButton
CALL Animbutton(Buttons, 1)
NEXT
Hiiriesiin
END IF
ButtonHeld = -1
END IF
FOR i = 0 TO Lastbar
IF Scrollbar(i) <> -1 AND Scrollbar(i) <> 0 THEN
IF ButtonHeld = Scrollbar(i) THEN SValue(i) = SValue(i) - 1: Hiiripiiloon: CALL UpdateScrollbar(i): Hiiriesiin
IF ButtonHeld = Scrollbar(i) + 1 THEN SValue(i) = SValue(i) + 1: Hiiripiiloon: CALL UpdateScrollbar(i): Hiiriesiin
END IF
NEXT
FOR i = 0 TO HLastbar
IF HScrollbar(i) <> -1 AND HScrollbar(i) <> 0 THEN
IF ButtonHeld = HScrollbar(i) THEN HSvalue(i) = HSvalue(i) - 1: Hiiripiiloon: CALL UpdateHScrollbar(i): Hiiriesiin
IF ButtonHeld = HScrollbar(i) + 1 THEN HSvalue(i) = HSvalue(i) + 1: Hiiripiiloon: CALL UpdateHScrollbar(i): Hiiriesiin
END IF
NEXT
FOR i = 0 TO Lastbar
IF Scrollbar(i) <> -1 AND Scrollbar(i) <> 0 THEN
IF HiiriX > SbarX(i) AND HiiriX < SbarX(i) + 16 AND HiiriY > SBarY(i) + 16 AND HiiriY < SBarY2(i) - 16 AND Hiiriv% = -1 THEN
SValue(i) = (HiiriY - (SBarY(i) + 17)) / Scrollstep(i)
Hiiripiiloon
CALL UpdateScrollbar(i)
Hiiriesiin
END IF
END IF
NEXT
FOR i = 0 TO HLastbar
IF HScrollbar(i) <> -1 AND HScrollbar(i) <> 0 THEN
IF HiiriX > HSbarX(i) + 16 AND HiiriX < HSBarX2(i) - 16 AND HiiriY > HSBarY(i) AND HiiriY < HSBarY(i) + 16 AND Hiiriv% = -1 THEN
HSvalue(i) = (HiiriX - (HSbarX(i) + 17)) / HScrollstep(i)
Hiiripiiloon
CALL UpdateHScrollbar(i)
Hiiriesiin
END IF
END IF
NEXT
FOR i = 0 TO Lastbar
IF Scrollbar(i) <> -1 AND Scrollbar(i) <> 0 THEN
IF SValue(i) <> Oldvalue(i) THEN Movedbar = i
Oldvalue(i) = SValue(i)
ELSE
Movedbar = -1
END IF
NEXT
FOR i = 0 TO HLastbar
IF HScrollbar(i) <> -1 AND HScrollbar(i) <> 0 THEN
IF HSvalue(i) <> OldHvalue(i) THEN HMovedbar = i
OldHvalue(i) = HSvalue(i)
ELSE
HMovedbar = -1
END IF
NEXT
FOR i = 0 TO Lastbar
IF Scrollbar(i) <> -1 AND Scrollbar(i) <> 0 THEN
IF Pressedbutton = Scrollbar(i) + MaxButtons THEN SValue(i) = SValue(i) - 1: Hiiripiiloon: CALL UpdateScrollbar(i): Hiiriesiin
IF Pressedbutton = Scrollbar(i) + 1 + MaxButtons THEN SValue(i) = SValue(i) + 1: Hiiripiiloon: CALL UpdateScrollbar(i): Hiiriesiin
END IF
NEXT
FOR i = 0 TO HLastbar
IF HScrollbar(i) <> -1 AND HScrollbar(i) <> 0 THEN
IF Pressedbutton = HScrollbar(i) + MaxButtons THEN HSvalue(i) = HSvalue(i) - 1: Hiiripiiloon: CALL UpdateHScrollbar(i): Hiiriesiin
IF Pressedbutton = HScrollbar(i) + 1 + MaxButtons THEN HSvalue(i) = HSvalue(i) + 1: Hiiripiiloon: CALL UpdateHScrollbar(i): Hiiriesiin
END IF
NEXT
FOR i = 0 TO LastButton
IF DisabledButton(i) = 1 AND Pressedbutton = i THEN Pressedbutton = -1
NEXT
IF Pressedbutton <> -1 OR Movedbar > -1 OR HMovedbar > 1 THEN
Hiiripiiloon
CALL Handlebuttons
Hiiriesiin
END IF
IF Pressedbutton = MaxButtons AND DialogActive = 1 THEN DialogPressedButton = MaxButtons - Pressedbutton + 1: KillDialog DialogX, DialogY, DialogX2, DialogY2
IF Pressedbutton = MaxButtons - 1 AND DialogActive = 1 THEN DialogPressedButton = MaxButtons - Pressedbutton + 1: KillDialog DialogX, DialogY, DialogX2, DialogY2
IF Pressedbutton = MaxButtons - 2 AND DialogActive = 1 THEN DialogPressedButton = MaxButtons - Pressedbutton + 1: KillDialog DialogX, DialogY, DialogX2, DialogY2
IF Hiiriv% = -1 THEN
FOR i = 0 TO LastTextfield
IF HiiriX > TextfieldX(i) AND HiiriY > TextfieldY(i) AND HiiriX < TextfieldX(i) + (TextFieldLen(i) * 8) + 24 AND HiiriY < TextfieldY(i) + 16 THEN
IF TextFieldLen(ActiveTextField) > 0 THEN CALL Text((TextfieldX(ActiveTextField) + 4) + LEN(TextF$(ActiveTextField)) * 8 + 8, TextfieldY(ActiveTextField) + 5, "_", 15, 16, -1, 8)
ActiveTextField = i
IF TextFieldLen(ActiveTextField) > 0 THEN CALL Text((TextfieldX(ActiveTextField) + 4) + LEN(TextF$(ActiveTextField)) * 8 + 8, TextfieldY(ActiveTextField) + 5, "_", 0, 16, -1, 8)
END IF
NEXT
END IF
TKey$ = Key$
IF TKey$ = CHR$(9) THEN
IF TextFieldLen(ActiveTextField) > 0 THEN CALL Text((TextfieldX(ActiveTextField) + 4) + LEN(TextF$(ActiveTextField)) * 8 + 8, TextfieldY(ActiveTextField) + 5, "_", 15, 16, -1, 8)
ActiveTextField = ActiveTextField + 1
IF ActiveTextField > LastTextfield THEN ActiveTextField = 0
IF TextFieldLen(ActiveTextField) > 0 THEN CALL Text((TextfieldX(ActiveTextField) + 4) + LEN(TextF$(ActiveTextField)) * 8 + 8, TextfieldY(ActiveTextField) + 5, "_", 0, 16, -1, 8)
TKey$ = ""
END IF
IF TKey$ = CHR$(0) + CHR$(15) THEN
IF TextFieldLen(ActiveTextField) > 0 THEN CALL Text((TextfieldX(ActiveTextField) + 4) + LEN(TextF$(ActiveTextField)) * 8 + 8, TextfieldY(ActiveTextField) + 5, "_", 15, 16, -1, 8)
ActiveTextField = ActiveTextField - 1
IF ActiveTextField < 0 THEN ActiveTextField = LastTextfield
IF TextFieldLen(ActiveTextField) > 0 THEN CALL Text((TextfieldX(ActiveTextField) + 4) + LEN(TextF$(ActiveTextField)) * 8 + 8, TextfieldY(ActiveTextField) + 5, "_", 0, 16, -1, 8)
TKey$ = ""
END IF
IF TextFieldLen(ActiveTextField) > 0 THEN
IF TKey$ <> "" THEN
IF HiiriX > TextfieldX(ActiveTextField) - 15 AND HiiriY > TextfieldY(ActiveTextField) - 15 AND HiiriX < TextfieldX(ActiveTextField) + (TextFieldLen(ActiveTextField) * 8) + 16 AND HiiriY < TextfieldY(ActiveTextField) + 16 THEN Hiiripiiloon
CALL Text((TextfieldX(ActiveTextField) + 4) + LEN(TextF$(ActiveTextField)) * 8 + 8, TextfieldY(ActiveTextField) + 5, "_", 15, 16, -1, 8)
IF TKey$ = CHR$(8) AND LEN(TextF$(ActiveTextField)) > 0 THEN TextF$(ActiveTextField) = LEFT$(TextF$(ActiveTextField), LEN(TextF$(ActiveTextField)) - 1): Key$ = ""
IF TKey$ = CHR$(8) THEN TKey$ = ""
IF TKey$ = CHR$(13) THEN TKey$ = ""
IF TKey$ = CHR$(9) THEN TKey$ = ""
IF TKey$ = CHR$(27) THEN TKey$ = ""
TextF$(ActiveTextField) = TextF$(ActiveTextField) + TKey$
IF LEN(TextF$(ActiveTextField)) > TextFieldLen(ActiveTextField) THEN TextF$(ActiveTextField) = LEFT$(TextF$(ActiveTextField), TextFieldLen(ActiveTextField))
CALL EraseText((TextfieldX(ActiveTextField) + 4) + LEN(TextF$(ActiveTextField)) * 8 + 8, TextfieldY(ActiveTextField) + 5, STRING$(TextFieldLen(ActiveTextField) - LEN(TextF$(ActiveTextField)), " "), 15)
CALL Text((TextfieldX(ActiveTextField) + 4) + LEN(TextF$(ActiveTextField)) * 8, TextfieldY(ActiveTextField) + 5, RIGHT$(TextF$(ActiveTextField), 1), 0, 16, -1, 8)
CALL Text((TextfieldX(ActiveTextField) + 4) + LEN(TextF$(ActiveTextField)) * 8 + 8, TextfieldY(ActiveTextField) + 5, "_", 0, 16, -1, 8)
Hiiriesiin
END IF
END IF
FOR i = 0 TO MaxPBars
IF OldPBarValue(i) <> PBarValue(i) THEN
IF HiiriX > PBarX(i) - 15 AND HiiriY > PBarY(i) - 15 AND HiiriX < PBarX2(i) AND HiiriY < PBarY2(i) THEN Hiiripiiloon
CALL DrawPBar(i)
Hiiriesiin
END IF
NEXT
Mainloop:
'Omat rutiinit
'*****************************************************
'*****************************************************
DialogPressedButton = 0
Pressedbutton = -1
Movedbar = -1
HMovedbar = -1
Mousemove = 0
OldHiiriX = HiiriX
OldHiiriY = HiiriY
LOOP
END
Mousedata:
DATA 55, 89, E5, 8B, 5E, 0C, 8B, 07, 50, 8B, 5E, 0A, 8B, 07, 50, 8B
DATA 5E, 08, 8B, 0F, 8B, 5E, 06, 8B, 17, 5B, 58, 1E, 07, CD, 33, 53
DATA 8B, 5E, 0C, 89, 07, 58, 8B, 5E, 0A, 89, 07, 8B, 5E, 08, 89, 0F
DATA 8B, 5E, 06, 89, 17, 5D, CA, 08, 00
'Käsittelee Ctrl-Break ja Ctrl-C näppäimien painallukset.
HandleBreak:
Hiiripiiloon
CALL DrawWindow(10, 10, 320, 100, 4, 7, "Järjestelmäviesti", 15)
Text 20, 50, "Ctrl-Break tai Ctrl-C näppäimiä", 0, 16, -1, 6
Text 20, 65, "painettu. Ohjelman suoritus", 0, 16, -1, 6
Text 20, 80, "pysäytetään.", 0, 16, -1, 6
END
'===========================================================================
' Animbutton - Muuttaa napin asentoa
'
' Parametrit: Buttonnum = Napin numero
' updown = 0 (ylös) tai 1 (alas)
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB Animbutton (Buttonnum, updown)
IF DisabledButton(Buttonnum) = 1 THEN EXIT SUB
x = ButtonX(Buttonnum)
y = ButtonY(Buttonnum)
x2 = ButtonX2(Buttonnum)
y2 = ButtonY2(Buttonnum)
IF x <= 0 OR y <= 0 THEN GOTO Nodraw
IF Buttoncol(Buttonnum) = 8 THEN highlight = 7
IF Buttoncol(Buttonnum) = 7 THEN fillcol = 7: shadowcol = 8: GOTO color.ok2: ELSE fillcol = Buttoncol(Buttonnum): shadowcol = Buttoncol(Buttonnum) - 8
IF Buttoncol(Buttonnum) < 8 THEN fillcol = Buttoncol(Buttonnum): shadowcol = 0: highlight = Buttoncol(Buttonnum) + 8
color.ok2:
IF highlight = 0 THEN highlight = 15
0
IF updown = 0 THEN
LINE (x, y)-(x2, y2), fillcol, B
LINE (x2, y)-(x2 - 3, y + 3), fillcol
LINE (x, y2)-(x + 3, y2 - 3), fillcol
PAINT (x + 5, y + 1), shadowcol, fillcol
PAINT (x + 5, y2 - 1), highlight, fillcol
LINE (x, y)-(x2, y2), 0, B
PSET (x, y), POINT(x - 1, y - 1)
PSET (x2, y), POINT(x - 1, y - 1)
PSET (x, y2), POINT(x - 1, y - 1)
PSET (x2, y2), POINT(x - 1, y - 1)
' Nämä rivit on poistettu nopeuden vuoksi
' jos sinulla on 500 MHz Alpha-prosessorilla varustettu tietokone,
' voit ehkä laittaa ne päälle.
' CALL EraseText(x + (((x2 - x) / 2) - (8 * (LEN(Buttontext$(Buttonnum))) / 2)), y + (((y2 - y) / 2) - 3), Buttontext$(Buttonnum), Fillcol)
' CALL Text(x + 1 + (((x2 - x) / 2) - (8 * (LEN(Buttontext$(Buttonnum))) / 2)), y + 1 + (((y2 - y) / 2) - 3), Buttontext$(Buttonnum), 0, 16, -1)
END IF
IF updown = 1 THEN
LINE (x, y)-(x2, y2), fillcol, B
LINE (x + 3, y + 3)-(x2 - 3, y2 - 3), fillcol, B
LINE (x2, y)-(x2 - 3, y + 3), fillcol
LINE (x, y2)-(x + 3, y2 - 3), fillcol
PAINT (x + 2, y + 1), highlight, fillcol
PAINT (x + 2, y2 - 1), shadowcol, fillcol
LINE (x, y)-(x2, y2), 0, B
PSET (x, y), POINT(x - 1, y - 1)
PSET (x2, y), POINT(x - 1, y - 1)
PSET (x, y2), POINT(x - 1, y - 1)
PSET (x2, y2), POINT(x - 1, y - 1)
' Nämä rivit on poistettu nopeuden vuoksi
' jos sinulla on 500 MHz Alpha-prosessorilla varustettu tietokone,
' voit ehkä laittaa ne päälle.
' CALL EraseText(x + 1 + (((x2 - x) / 2) - (8 * (LEN(Buttontext$(Buttonnum))) / 2)), y + 1 + (((y2 - y) / 2) - 3), Buttontext$(Buttonnum), Fillcol)
' CALL Text(x + (((x2 - x) / 2) - (8 * (LEN(Buttontext$(Buttonnum))) / 2)), y + (((y2 - y) / 2) - 3), Buttontext$(Buttonnum), 0, 16, -1)
END IF
Nodraw:
END SUB
'===========================================================================
' Box3D - Piirtää upotetun tai nostetun 3D-suorakulmion
'
' Parametrit: x, y = Vasen Yläkulma
' x2, y2 = Oikea Alakulma
' Colr = Väri (neg. = ei täytetty)
' in = 1 (Alas) tai 0 (Ylös)
'========================================(C) Sami Kyöstilä 1997=============
'
SUB Box3D (x, y, x2, y2, colr, in)
IF colr < 0 THEN colr = -colr: Filled = 0: ELSE Filled = 1
IF colr < 8 THEN fillcol = colr: shadowcol = 0: highlight = colr + 8
IF colr = 7 THEN fillcol = 7: shadowcol = 8 ELSE fillcol = colr: shadowcol = colr - 8
IF highlight = 0 THEN highlight = 15
IF colr = 15 THEN shadowcol = 8
IF Filled = 0 THEN
LINE (x + 2, y + 2)-(x2 - 2, y2 - 2), fillcol, B
ELSE
LINE (x + 2, y + 2)-(x2 - 2, y2 - 2), fillcol, BF
END IF
IF in = 0 THEN
LINE (x, y)-(x2, y), highlight, BF
LINE (x, y)-(x, y2), highlight, BF
LINE (x2, y2)-(x2, y), shadowcol, BF
LINE (x2, y2)-(x, y2), shadowcol, BF
ELSE
LINE (x, y)-(x2, y), shadowcol, BF
LINE (x, y)-(x, y2), shadowcol, BF
LINE (x2, y2)-(x2, y), highlight, BF
LINE (x2, y2)-(x, y2), highlight, BF
LINE (x + 1, y + 1)-(x2 - 1, y + 1), 0, BF
LINE (x + 1, y + 1)-(x + 1, y2 - 1), 0, BF
END IF
END SUB
'===========================================================================
' Box3D2 - Piirtää upotetun tai nostetun 3D-suorakulmion
'
' Parametrit: x, y = Vasen Yläkulma
' x2, y2 = Pituus, Leveys
' Colr = Väri (-1 = ei täytetty)
' in = 1 (Alas) tai 0 (Ylös)
'========================================(C) Sami Kyöstilä 1997=============
SUB Box3D2 (x, y, x2, y2, colr, in)
x2 = x + x2
y2 = y + y2
IF colr < 0 THEN colr = -colr: Filled = 0: ELSE Filled = 1
IF colr < 8 THEN fillcol = colr: shadowcol = 0: highlight = colr + 8
IF colr = 7 THEN fillcol = 7: shadowcol = 8 ELSE fillcol = colr: shadowcol = colr - 8
IF highlight = 0 THEN highlight = 15
IF colr = 15 THEN shadowcol = 8
IF Filled = 0 THEN
LINE (x + 2, y + 2)-(x2 - 2, y2 - 2), fillcol, B
ELSE
LINE (x + 2, y + 2)-(x2 - 2, y2 - 2), fillcol, BF
END IF
IF in = 0 THEN
LINE (x, y)-(x2, y), highlight, BF
LINE (x, y)-(x, y2), highlight, BF
LINE (x2, y2)-(x2, y), shadowcol, BF
LINE (x2, y2)-(x, y2), shadowcol, BF
ELSE
LINE (x, y)-(x2, y), shadowcol, BF
LINE (x, y)-(x, y2), shadowcol, BF
LINE (x2, y2)-(x2, y), highlight, BF
LINE (x2, y2)-(x, y2), highlight, BF
LINE (x + 1, y + 1)-(x2 - 1, y + 1), 0, BF
LINE (x + 1, y + 1)-(x + 1, y2 - 1), 0, BF
END IF
END SUB
'===========================================================================
' CDVolume - Asettaa CD:n äänenvoimakkuuden
'
' Parametrit: Left, Right = Kanavan äänenvoimakkuus
' Getvol = Jos 1, ääntä ei muuteta vaan luetaan
'
'========================================(C) Sami Kyöstilä 1997=============
SUB CDVolume (Left, Right, Getvol%)
OUT BasePort% + 4, &H28
IF Getvol% THEN
Left = INP(BasePort% + 5) \ 16
Right = INP(BasePort% + 5) AND &HF
RETURN
ELSE
OUT BasePort% + 5, (Right + Left * 16) AND &HFF
END IF
END SUB
'===========================================================================
' ChangeButtoncolor - Vaihtaa napin väriä
'
' Parametrit: Buttonum = Napin numero
' Colr = Väri
'
'========================================(C) Sami Kyöstilä 1997=============
SUB ChangeButtonColor (Buttonnum, colr)
IF colr = 8 THEN highlight = 7
IF colr = 7 THEN fillcol = 7: shadowcol = 8: GOTO color.ok3 ELSE fillcol = colr: shadowcol = colr - 8
IF colr < 8 THEN fillcol = colr: shadowcol = 0: highlight = colr + 8
color.ok3:
IF highlight = 0 THEN highlight = 15
x = ButtonX(Buttonnum)
y = ButtonY(Buttonnum)
x2 = ButtonX2(Buttonnum)
y2 = ButtonY2(Buttonnum)
Me$ = Buttontext$(Buttonnum)
LINE (x, y)-(x2, y2), highlight, BF
LINE (x + 3, y + 3)-(x2 - 3, y2 - 3), fillcol, BF
LINE (x, y)-(x2, y2), fillcol, B
LINE (x2, y)-(x2 - 3, y + 3), fillcol
LINE (x, y2)-(x + 3, y2 - 3), fillcol
PAINT (x + 5, y2 - 1), shadowcol, fillcol
LINE (x, y)-(x2, y2), 0, B
PSET (x, y), POINT(x - 1, y - 1)
PSET (x2, y), POINT(x - 1, y - 1)
PSET (x, y2), POINT(x - 1, y - 1)
PSET (x2, y2), POINT(x - 1, y - 1)
Buttoncol(Buttonnum) = colr
CALL Text(x + (((x2 - x) / 2) - (8 * (LEN(Me$)) / 2)), y + (((y2 - y) / 2) - 3), Me$, 0, 16, -1, 8)
END SUB
'===========================================================================
' ChangeButtonPos - Vaihtaa napin kokoa ja sijaintia
'
' Parametrit: Buttonum = Napin numero
' x,y = Vasen yläkulma
' xx2, yy2 = Korkeus, leveys
' Colr = Pyyhintäväri
'
'========================================(C) Sami Kyöstilä 1997=============
SUB ChangeButtonPos (Buttonnum, x, y, xx2, yy2, colr)
xx = ButtonX(Buttonnum)
yy = ButtonY(Buttonnum)
xxx2 = ButtonX2(Buttonnum)
yyy2 = ButtonY2(Buttonnum)
LINE (xx, yy)-(xxx2, yyy2), colr, BF
colr = Buttoncol(Buttonnum)
Me$ = Buttontext$(Buttonnum)
IF colr = 8 THEN highlight = 7
IF colr = 7 THEN fillcol = 7: shadowcol = 8: GOTO color.ok5 ELSE fillcol = colr: shadowcol = colr - 8
IF colr < 8 THEN fillcol = colr: shadowcol = 0: highlight = colr + 8
color.ok5:
IF highlight = 0 THEN highlight = 15
ButtonX(Buttonnum) = x
ButtonY(Buttonnum) = y
ButtonX2(Buttonnum) = x + xx2
ButtonY2(Buttonnum) = y + yy2
x2 = ButtonX2(Buttonum)
y2 = ButtonY2(Buttonum)
LINE (x, y)-(x2, y2), highlight, BF
LINE (x + 3, y + 3)-(x2 - 3, y2 - 3), fillcol, BF
LINE (x, y)-(x2, y2), fillcol, B
LINE (x2, y)-(x2 - 3, y + 3), fillcol
LINE (x, y2)-(x + 3, y2 - 3), fillcol
PAINT (x + 5, y2 - 1), shadowcol, fillcol
LINE (x, y)-(x2, y2), 0, B
PSET (x, y), POINT(x - 1, y - 1)
PSET (x2, y), POINT(x - 1, y - 1)
PSET (x, y2), POINT(x - 1, y - 1)
PSET (x2, y2), POINT(x - 1, y - 1)
CALL Text(x + (((x2 - x) / 2) - (8 * (LEN(Me$)) / 2)), y + (((y2 - y) / 2) - 3), Me$, 0, 16, -1, 8)
END SUB
'===========================================================================
' ChangeButtontext - Vaihtaa napin tekstiä
'
' Parametrit: Buttonnum = Napin numero
' NewText$ = Teksti
' Size = Koko
'
'========================================(C) Sami Kyöstilä 1997=============
SUB ChangeButtonText (Buttonnum, NewText$, Size)
colr = Buttoncol(Buttonnum)
IF colr = 8 THEN highlight = 7
IF colr = 7 THEN fillcol = 7: shadowcol = 8: GOTO color.ok4 ELSE fillcol = colr: shadowcol = colr - 8
IF colr < 8 THEN fillcol = colr: shadowcol = 0: highlight = colr + 8
color.ok4:
IF highlight = 0 THEN highlight = 15
x = ButtonX(Buttonnum)
y = ButtonY(Buttonnum)
x2 = ButtonX2(Buttonnum)
y2 = ButtonY2(Buttonnum)
LINE (x, y)-(x2, y2), highlight, BF
LINE (x + 3, y + 3)-(x2 - 3, y2 - 3), fillcol, BF
LINE (x, y)-(x2, y2), fillcol, B
LINE (x2, y)-(x2 - 3, y + 3), fillcol
LINE (x, y2)-(x + 3, y2 - 3), fillcol
PAINT (x + 5, y2 - 1), shadowcol, fillcol
LINE (x, y)-(x2, y2), 0, B
PSET (x, y), POINT(x - 1, y - 1)
PSET (x2, y), POINT(x - 1, y - 1)
PSET (x, y2), POINT(x - 1, y - 1)
PSET (x2, y2), POINT(x - 1, y - 1)
Me$ = NewText$
Buttontext$(Buttonnum) = NewText$
CALL Text(x + (((x2 - x) / 2) - (8 * (LEN(Me$)) / 2)), y + (((y2 - y) / 2) - 3), Me$, 0, 16, -1, Size)
END SUB
'===========================================================================
' Createbutton - Luo uuden painikkeen
'
' Parametrit: Nextbutton = Napin numero
' x, y = Vasen Yläkulma
' xx2, yy2 = Pituus, Leveys
' Me$ = Teksti
' Colr = Väri
'
'========================================(C) Sami Kyöstilä 1997=============
SUB Createbutton (Nextbutton, x, y, xx2, yy2, Me$, colr, Size)
IF colr = 8 THEN highlight = 7
IF colr = 7 THEN fillcol = 7: shadowcol = 8: GOTO color.ok ELSE fillcol = colr: shadowcol = colr - 8
IF colr < 8 THEN fillcol = colr: shadowcol = 0: highlight = colr + 8
color.ok:
IF highlight = 0 THEN highlight = 15
ButtonX(Nextbutton) = x
ButtonY(Nextbutton) = y
ButtonX2(Nextbutton) = x + xx2
ButtonY2(Nextbutton) = y + yy2
x2 = ButtonX2(Nextbutton)
y2 = ButtonY2(Nextbutton)
LINE (x, y)-(x2, y2), highlight, BF
LINE (x + 3, y + 3)-(x2 - 3, y2 - 3), fillcol, BF
LINE (x, y)-(x2, y2), fillcol, B
LINE (x2, y)-(x2 - 3, y + 3), fillcol
LINE (x, y2)-(x + 3, y2 - 3), fillcol
PAINT (x + 5, y2 - 1), shadowcol, fillcol
LINE (x, y)-(x2, y2), 0, B
PSET (x, y), POINT(x - 1, y - 1)
PSET (x2, y), POINT(x - 1, y - 1)
PSET (x, y2), POINT(x - 1, y - 1)
PSET (x2, y2), POINT(x - 1, y - 1)
Buttontext$(Nextbutton) = Me$
Buttoncol(Nextbutton) = colr
CALL Text(x + (((x2 - x) / 2) - (8 * (LEN(Me$)) / 2)), y + (((y2 - y) / 2) - 3), Me$, 0, 16, -1, Size)
FOR i = 0 TO MaxButtons + MaxScrollbars
IF ButtonX(i) <> 0 AND ButtonY(i) <> 0 AND ButtonX2(i) <> 0 AND ButtonY2(i) <> 0 THEN LastButton = i
NEXT
FOR i = MaxButtons TO MaxScrollbars + MaxButtons
IF ButtonX(i) = 0 AND ButtonY(i) = 0 AND ButtonX2(i) = 0 AND ButtonY2(i) = 0 THEN Nextbartag = i: EXIT FOR
NEXT
END SUB
'===========================================================================
' CreateHScrollbar - Luo vaakatasossa olevan vierityspalkin
'
' Parametrit: HNextbar = Vierityspalkin numero
' x, y = Vasen Yläkulma
' x2 = Oikea reuna
' Large = Suurin mahdollinen arvo (HUOM! ei neg.)
' Default = Aloitusarvo
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB CreateHScrollbar (HNextbar, x, y, x2, Large, Default)
Small = 0
y2 = y + 16
HScrollbar(HNextbar) = Nextbartag
HScrollstep(HNextbar) = (x2 - x - 51) / (Large - Small)
HSvalue(HNextbar) = Default
HSbarX(HNextbar) = x
HSBarY(HNextbar) = y
HSBarX2(HNextbar) = x2
HScrollMin(HNextbar) = 0
HScrollMax(HNextbar) = Large
CALL Createbutton(Nextbartag, x, y, 16, 16, "<", 7, 8)
CALL Createbutton(Nextbartag, x2 - 16, y, 16, 16, ">", 7, 8)
CALL Box3D(x + 17, y, x2 - 17, y + 16, 8, 1)
CALL Box3D(x + 17 + (HSvalue(HNextbar) * HScrollstep(HNextbar)), y + 2, x + 34 + (HSvalue(HNextbar) * HScrollstep(HNextbar)), y + 15, 7, 0)
FOR i = 0 TO MaxScrollbars
IF HScrollbar(i) <> 0 THEN HLastbar = i
NEXT
END SUB
'===========================================================================
' CreatePBar - Luo prosenttipalkin
'
' Parametrit: PBarnum = Palkin numero
' x, y = Vasen yläkulma
' x2, y2 = Leveys, korkeus
' Value = Aloitusarvo
' Total = Suurin mahdollinen arvo
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB CreatePBar (PBarnum, x, y, x2, y2, Value, Total)
PBarX(PBarnum) = x
PBarY(PBarnum) = y
PBarX2(PBarnum) = x2 + x
PBarY2(PBarnum) = y2 + y
PBarValue(PBarnum) = Value
PBarTotal(PBarnum) = Total
CALL DrawPBar(PBarnum)
END SUB
'===========================================================================
' CreateHScrollbar - Luo pystysuunnnassa olevan vierityspalkin
'
' Parametrit: Nextbar = Vierityspalkin numero
' x, y = Vasen Yläkulma
' x2 = Oikea reuna
' Large = Suurin mahdollinen arvo (HUOM! ei neg.)
' Default = Aloitusarvo
'
'========================================(C) Sami Kyöstilä 1997=============
SUB CreateScrollbar (Nextbar, x, y, y2, Large, Default)
Small = 0
x2 = x + 16
Scrollbar(Nextbar) = Nextbartag
Scrollstep(Nextbar) = (y2 - y - 51) / (Large - Small)
SValue(Nextbar) = Default
SbarX(Nextbar) = x
SBarY(Nextbar) = y
SBarY2(Nextbar) = y2
ScrollMin(Nextbar) = Small
ScrollMax(Nextbar) = Large
CALL Createbutton(Nextbartag, x, y, 16, 16, "■", 7, 8)
CALL Createbutton(Nextbartag, x, y2 - 16, 16, 16, "²", 7, 8)
CALL Box3D(x, y + 17, x + 16, y2 - 17, 8, 1)
CALL Box3D(x + 2, (y + 17) + (SValue(Nextbar) * Scrollstep(Nextbar)), x2 - 1, (y + 33) + (SValue(Nextbar) * Scrollstep(Nextbar)), 7, 0)
FOR i = 0 TO MaxScrollbars
IF Scrollbar(i) <> 0 THEN Lastbar = i
NEXT
END SUB
'===========================================================================
' Dialog - Luo valintaikkunan
'
' Parametrit: x, y = Vasen yläkulma
' x2, y2 = Oikea alakulma
' Topic$ = Ikkunan otsikko
' Prompt$ = Ikkunan teksti
' Button1$ = Napin 1 teksti
' Button2$ = Napin 2 teksti (jos tyhjä, niin nappia ei luoda)
' Button3$ = Napin 3 teksti (jos tyhjä, niin nappia ei luoda)
' Backround = Taustan pyyhintäväri (jos -1, niin tausta tallennetaan
' tiedostoon c:\temp.dat ja la-
' dataan sieltä valintaikkunaa
' poistettaessa)
'
' Kun valintaikkunassa olevaa nappia painetaan, palautetaan painetun napin
' arvo muuttujaan DialogPressedButton. Se on väliltä 1-3, riippuen napin
' sijainnista vasemmalta laskien. Esim. jos valintaikkunassa on napit "KYLLÄ",
' "EI" ja "PERUUTA", ja "EI" nappia painetaan, arvo 2 palautetaan. Tämän
' jälkeen valintaikkuna poistetaan.
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB Dialog (x, y, x2, y2, Topic$, Prompt$, Button1$, Button2$, Button3$, Backround)
IF Backround = -1 THEN CALL Getpic(x, y, x2, y2, "c:\temp.dat")
DrawWindow x, y, x2, y2, 1, 7, Topic$, 14
IF Button1$ <> "" AND Button2$ <> "" AND Button3$ <> "" THEN
CALL Createbutton(MaxButtons, (x2 - x) / 8 + x, (y2 - 40), 100, 30, Button1$, 7, 8)
CALL Createbutton(MaxButtons - 1, (x2 - x) / 8 + x * 2.1, (y2 - 40), 100, 30, Button2$, 7, 8)
CALL Createbutton(MaxButtons - 2, (x2 - x) / 8 + x * 3.2, (y2 - 40), 100, 30, Button3$, 7, 8)
END IF
IF Button1$ <> "" AND Button2$ <> "" AND Button3$ = "" THEN
CALL Createbutton(MaxButtons, (x2 - x) / 8 + x, (y2 - 40), 100, 30, Button1$, 7, 8)
CALL Createbutton(MaxButtons - 1, (x2 - x) / 8 + x * 3, (y2 - 40), 100, 30, Button2$, 7, 8)
END IF
IF Button1$ <> "" AND Button2$ = "" AND Button3$ = "" THEN
CALL Createbutton(MaxButtons, (x2 - x) / 8 + x * 2, (y2 - 40), 100, 30, Button1$, 7, 8)
END IF
IF Button1$ = "" AND Button2$ = "" AND Button3$ = "" THEN END
CALL Text(x + 20, (y2 - y) / 4 + y, Prompt$, 0, 16, x2 - 20, 8)
DialogActive = 1
DialogX = x
DialogY = y
DialogX2 = x2
DialogY2 = y2
DialogBackround = Backround
END SUB
'===========================================================================
' DisableButton - Lukittaa napin
'
' Parametrit: Buttonnum% = Napin numero
'
'===========================================================================
'
SUB DisableButton (Buttonnum%)
DisabledButton(Buttonnum%) = 1
END SUB
'===========================================================================
' DrawPBar - Päivittää Prosenttipalkin
'
' Parametrit: PBarnum = Palkin numero
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB DrawPBar (PBarnum)
x = PBarX(PBarnum)
y = PBarY(PBarnum)
x2 = PBarX2(PBarnum)
y2 = PBarY2(PBarnum)
Value = PBarValue(PBarnum)
Total = PBarTotal(PBarnum)
OldPBarValue(PBarnum) = Value
LINE (x, y)-(x2, y2), 0, B
Pr.X = (Value / Total * 100) * ((x2 - x) / 100) + x
LINE (x + 1, y + 1)-(Pr.X, y2 - 1), 1, BF
LINE (x2 - 1, y + 1)-(Pr.X + 1, y2 - 1), 15, BF
CALL Text((x2 - x) / 2 + x - 16, (y2 - y) / 2 + y - 4, STR$(INT(Value / Total * 100)) + "%", 12, 16, -1, 8)
END SUB
'===========================================================================
' DrawWindow - Piirtää ikkunan
'
' Parametrit: x, y = Vasen yläkulma
' x2, y2 = Oikea alakulma
' Topiccol = Otsikkopalkin väri
' Fillcol = Täyttöväri
' Topic$ = Otsikko
' Topiccol = Otsikkotekstin väri
'
'========================================(C) Sami Kyöstilä 1997=============
SUB DrawWindow (x, y, x2, y2, Topiccol, fillcol, Topic$, Topictextcol)
LINE (x + 1, y + 1)-(x2 - 1, y2 - 1), 7, B
LINE (x + 2, y + 2)-(x2 - 2, y2 - 2), 7, B
LINE (x + 4, y + 4)-(x2 - 4, y + 15), Topiccol, BF
LINE (x, y)-(x2, y2), 15, B
LINE (x2, y)-(x2, y2), 8
LINE (x, y2)-(x2, y2), 8
LINE (x + 4, y + 21)-(x2 - 4, y2 - 4), 7, B
LINE (x + 3, y + 20)-(x2 - 3, y2 - 3), 8, B
LINE (x2 - 3, y + 20)-(x2 - 3, y2 - 3), 15
LINE (x + 3, y2 - 3)-(x2 - 3, y2 - 3), 15, B
LINE (x + 3, y + 3)-(x2 - 3, y + 16), 15, B
LINE (x + 3, y + 3)-(x + 3, y + 16), 8
LINE (x + 3, y + 3)-(x2 - 3, y + 3), 8
LINE (x + 3, y + 19)-(x2 - 3, y + 19), 7, B
LINE (x + 3, y + 18)-(x2 - 3, y + 18), 7, B
LINE (x + 3, y + 17)-(x2 - 3, y + 17), 7, B
PSET (x, y), 7
PSET (x2, y), 7
PSET (x2, y2), 0
PSET (x, y2), 7
LINE (x - 1, y - 1)-(x2 + 1, y2 + 1), 0, B
LINE (x + 4, y + 21)-(x + 4, y2 - 4), 0
LINE (x + 4, y + 21)-(x2 - 4, y + 21), 0
Text x + 20, y + 6, Topic$, Topictextcol, 16, x2 - 8, 8
IF fillcol = 7 THEN LINE (x + 3, y + 18)-(x2 - 3, y2 - 3), fillcol, BF: EXIT SUB: ELSE LINE (x + 5, y + 22)-(x2 - 5, y2 - 5), fillcol, BF
END SUB
'===========================================================================
' EnableButton - Vapauttaa napin (DisableButton:in lukitseman)
'
' Parametrit: Buttonnum% = Napin numero
'
'===========================================================================
'
SUB EnableButton (Buttonnum%)
DisabledButton(Buttonnum%) = 0
END SUB
'===========================================================================
' Erasetext - Pyyhkii tekstiä
'
' Parametrit: x, y = Koordinaatit
' Txt$ = Pyyhittävien kirjaimien verran kirjaimia :)
'
' col = Pyyhkimisväri
'
'========================================(C) Sami Kyöstilä 1997=============
SUB EraseText (x, y, Txt$, col)
LINE (x, y - 1)-(x + LEN(Txt$) * 8, y + 8), col, BF
END SUB
'===========================================================================
' FMVolume - Asettaa MIDI:n äänenvoimakkuuden
'
' Parametrit: Left, Right = Kanavan äänenvoimakkuus
' Getvol = Jos 1, ääntä ei muuteta vaan luetaan
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB FMVolume (Left, Right, Getvol%)
OUT BasePort% + 4, &H26
IF Getvol% THEN
Left = INP(BasePort% + 5) \ 16
Right = INP(BasePort% + 5) AND &HF
RETURN
ELSE
OUT BasePort% + 5, (Right + Left * 16) AND &HFF
END IF
END SUB
'===========================================================================
' Getblaster - Lukee äänikortin asetukset ympäristömuuttujasta BLASTER
' Ei parametrejä
'
'
' BLASTER: Laita AUTOEXEC.BAT:iin komento SET BLASTER Axxx Iy Dz,
' jossa xxx on kortin osoite (esim. 220), y on kortin IRQ-
' linja (esim. 5) ja z on kortin DMA-kanava (esim. 1)
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB Getblaster
IF LEN(ENVIRON$("BLASTER")) = 0 THEN PRINT "BLASTER ympäristömuuttujaa ei ole asetettu": EXIT SUB
FOR Length% = 1 TO LEN(ENVIRON$("BLASTER"))
SELECT CASE MID$(ENVIRON$("BLASTER"), Length%, 1)
CASE "A"
BasePort% = VAL("&H" + MID$(ENVIRON$("BLASTER"), Length% + 1, 3))
CASE "I"
IRQ% = VAL(MID$(ENVIRON$("BLASTER"), Length% + 1, 1))
CASE "D"
DMA% = VAL(MID$(ENVIRON$("BLASTER"), Length% + 1, 1))
END SELECT
NEXT
END SUB
'===========================================================================
' Getfont - Lataa fontin, ei parametreja
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB GetFont
FOR i = 0 TO 255
FontText$ = FontText$ + CHR$(i)
NEXT
DEF SEG = &HF000
FOR i = 1 TO LEN(FontText$)
d = i - 1
ch = ASC(MID$(FontText$, i, 1))
chh& = ch * 8 + 1 + &HFA6D
FOR row = 0 TO 7
bitmap(row, d) = PEEK(chh& + row)
NEXT row
NEXT i
DEF SEG
END SUB
'===========================================================================
' Getpic - Tallentaa kuvan kovalevylle (katso SUB Putpic)
'
' Parametrit: x, y = Kuvan vasen yläkulma
' x2, y2 = Kuvan oikea alakulma
' File$ = Tiedoston nimi
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB Getpic (x, y, x2, y2, File$)
OPEN File$ FOR OUTPUT AS #255
startcolor = POINT(x, y)
PRINT #255, x2 - x
PRINT #255, y2 - y
FOR i2 = y TO y2
FOR i = x TO x2
IF POINT(i, i2) <> startcolor THEN
PRINT #255, startcolor
PRINT #255, count
startcolor = POINT(i, i2)
count = 0
ELSE
count = count + 1
END IF
NEXT
NEXT
PRINT #255, startcolor
PRINT #255, count
CLOSE
END SUB
'===========================================================================
' Handlebuttons - Käsittelee nappien painallukset, ei parametrejä
'
' Muuttujia: PressedButton = Painetun napin numero
' Movedbar, HMovedbar = Liikutetun vierityspalkin numero
'
' Laita tänne omat IF Pressedbutton etc. lausekkeet
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB Handlebuttons
IF Pressedbutton = 0 THEN CALL Playwav("sound.wav")
IF Pressedbutton = 1 THEN END
IF Movedbar = 0 THEN CALL MasterVolume(SValue(0), Right, 0)
IF Movedbar = 1 THEN CALL MasterVolume(Left, SValue(1), 0)
Endhandle:
END SUB
'===========================================================================
' HELP - Tämä ei ole varsinainen SUBi, mutta täällä on kaikkea hyödyllistä
' tietoa.
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB HELP
'Nappien etc. tuhoaminen
'-----------------------
'
'Jos asetat jonkin napin tuhoamaan toisen napin etc., niin muista tuhota
'samalla se nappi, jotta sitä ei voi painaa toista kertaa.
'
'
'Äänikortin asetukset
'--------------------
'
'Katso SUB GetBlaster
'
'
'Äänenvoimakkuuden lukeminen muuttujaan
'--------------------------------------
'
'Muuttujaan Vol luetaan esim. Mikrofonin äänenvoimakkuus näin:
'
'CALL MicVolume(Volume, 1)
'Vol = Volume
'
'Tätä voi soveltää myös muihin äänikortin äänenvoimakkuuksiin.
'
END SUB
'===========================================================================
' Hiiriajuri - Kutsuu hiiriajuria
'
' Parametrit: Hiiriax%, Hiiribx%, Hiiricx%, Hiiridx% = rekisterit
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB Hiiriajuri (Hiiriax%, Hiiribx%, Hiiricx%, Hiiridx%)
DEF SEG = VARSEG(hiiri$)
hiiri% = SADD(hiiri$)
CALL absolute(Hiiriax%, Hiiribx%, Hiiricx%, Hiiridx%, hiiri%)
END SUB
'===========================================================================
' Hiiriesiin - Näyttää hiiren kursorin, ei parametrejä
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB Hiiriesiin
Hiiriax% = 1: Hiiribx% = 0
Hiiricx% = 0: Hiiridx% = 0
CALL Hiiriajuri(Hiiriax%, Hiiribx%, Hiiricx%, Hiiridx%)
END SUB
'===========================================================================
' Hiirilue - Lukee hiiren sijainnin ja nappien asennot
'
' Parametrit: vasen%, oikea%, keski% = Nappien asennot
' x%, y% = Hiiren koordinaatit
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB Hiirilue (vasen%, oikea%, keski%, x%, y%)
Hiiriax% = 3
Hiiriajuri Hiiriax%, Hiiribx%, Hiiricx%, Hiiridx%
Hiiriv% = ((Hiiribx% AND 1) <> 0)
Hiirio% = ((Hiiribx% AND 2) <> 0)
hiirik% = ((Hiiribx% AND 4) <> 0)
HiiriX% = Hiiricx%
HiiriY% = Hiiridx%
END SUB
'===========================================================================
' Hiiripiiloon - Piilottaa hiiren kursorin, ei parametrejä
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB Hiiripiiloon
Hiiriax% = 2: Hiiribx% = 0
Hiiricx% = 0: Hiiridx% = 0
CALL Hiiriajuri(Hiiriax%, Hiiribx%, Hiiricx%, Hiiridx%)
END SUB
'===========================================================================
' Hiirirajat - Asettaa hiiren liikkumarajat
'
' Parametrit: x1%, y1% = Vasen yläkulma
' x2%, y2% = Oikea alakulma
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB Hiirirajat (x1%, y1%, x2%, y2%)
Hiiriax% = 7
Hiiribx% = 0
Hiiricx% = Hiirix1%
Hiiridx% = Hiirix2%
CALL Hiiriajuri(Hiiriax%, Hiiribx%, Hiiricx%, Hiiridx%)
Hiiriax% = 8
Hiiricx% = Hiiriy1%
Hiiridx% = Hiiriy2%
CALL Hiiriajuri(Hiiriax%, Hiiribx%, Hiiricx%, Hiiridx%)
END SUB
'===========================================================================
' Hiiritarkista% - Palauttaa hiiren nappien määrän, ei parametrejä
'
'========================================(C) Sami Kyöstilä 1997=============
'
FUNCTION Hiiritarkista%
Hiiriax% = 0
Hiiricx% = 0: Hiiridx% = 0
CALL Hiiriajuri(Hiiriax%, Hiiribx%, Hiiricx%, Hiiridx%)
IF (Hiiriax% = 0) THEN
Hiiritarkista% = 0
ELSEIF (Hiiribx% = 3) THEN
Hiiritarkista% = 3
ELSEIF (Hiiribx% = 0) THEN
Hiiritarkista% = 1
ELSE
Hiiritarkista% = 2
END IF
END FUNCTION
'===========================================================================
' Initmouse - Lataa hiiriajurin, ei parametreja
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB Initmouse
Hiirix1% = 0
Hiirix2% = 640
Hiiriy1% = 0
Hiiriy2% = 480
RESTORE Mousedata
hiiri$ = SPACE$(57)
FOR i% = 1 TO 57
READ a$
h$ = CHR$(VAL("&H" + a$))
MID$(hiiri$, i%, 1) = h$
NEXT i%
END SUB
'===========================================================================
' Initscreen - Piirtää aloituskuvaruudun, ei parametreja
'
' Laita tänne aluksi suoritettavat CALL CreateButton, CALL DrawWindow
' jne. komennot.
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB Initscreen
CALL MasterVolume(Left, Right, 1)
CALL DrawWindow(0, 0, 319, 250, 1, 7, "Äänenvoimakkuus", 14)
CALL Createbutton(0, 20, 30, 100, 50, "Testi", 2, 8)
CALL Createbutton(1, 20, 100, 100, 50, "Lopetus", 4, 8)
CALL CreateScrollbar(0, 180, 30, 200, 15, Left)
CALL CreateScrollbar(1, 200, 30, 200, 15, Right)
Text 183, 210, "L R", 0, 16, -1, 8
Text 20, 340, "Tämä ohjelma koostuu 11:stä rivistä koodia! (katso SUB Initscreen ja SUB Handlebuttons)", 10, 16, -1, 8
END SUB
'===========================================================================
' Killbar - Poistaa vierityspalkin (vain pystysuuntaisen)
'
' Parametrit: Scrollbarnum = Poistettavan palkin numero
' Colr = Pyyhintäväri
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB Killbar (Scrollbarnum, colr)
Num = Scrollbarnum
x = SbarX(Num)
y = SBarY(Num)
y2 = SBarY2(Num)
x2 = x + 16
CALL Killbutton(Scrollbar(Num), colr)
CALL Killbutton(Scrollbar(Num) + 1, colr)
LINE (x, y)-(x + 16, y2), colr, BF
Pressedbutton = -1
Scrollbar(Num) = -1
Scrollstep(Num) = 0
SValue(Num) = 0
SbarX(Num) = 0
SBarY(Num) = 0
SBarY2(Num) = 0
ScrollMin(Num) = 0
ScrollMax(Num) = 0
FOR i = 0 TO MaxScrollbars
IF Scrollbar(i) <> 0 THEN Lastbar = i
NEXT
END SUB
'===========================================================================
' Killbutton - Poistaa napin
'
' Parametrit: Buttonnum = Poistettavan napin numero
' Colr = Pyyhintäväri
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB Killbutton (Buttonnum, colr)
LINE (ButtonX(Buttonnum), ButtonY(Buttonnum))-(ButtonX2(Buttonnum), ButtonY2(Buttonnum)), colr, BF
ButtonX(Buttonnum) = 0
ButtonY(Buttonnum) = 0
ButtonX2(Buttonnum) = 0
ButtonY2(Buttonnum) = 0
FOR i = 0 TO MaxButtons
IF ButtonX(i) = 0 AND ButtonY(i) = 0 AND ButtonX2(i) = 0 AND ButtonY2(i) = 0 THEN Nextbutton = i: EXIT FOR
NEXT
FOR i = 0 TO MaxButtons + MaxScrollbars
IF ButtonX(i) <> 0 AND ButtonY(i) <> 0 AND ButtonX2(i) <> 0 AND ButtonY2(i) <> 0 THEN LastButton = i
NEXT
END SUB
'===========================================================================
' KillDialog - Poistaa valintaikkunan
'
' Parametrit: x, y = Vasen yläkulma
' x2, y2 = Oikea alakulma
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB KillDialog (x, y, x2, y2)
Hiiripiiloon
Killbutton MaxButtons, 7
Killbutton MaxButtons - 1, 7
Killbutton MaxButtons - 2, 7
IF DialogBackround = -1 THEN Putpic x, y, "c:\temp.dat" ELSE LINE (x, y)-(x2, y2), Erasecolor, BF
DialogActive = 0
DialogX = 0
DialogY = 0
IF DialogBackround = -1 THEN KILL "c:\temp.dat"
Hiiriesiin
END SUB
'===========================================================================
' KillHbar - Poistaa vierityspalkin (vain vaakatasoisen)
'
' Parametrit: Scrollbarnum = Poistettavan palkin numero
' Colr = Pyyhintäväri
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB KillHbar (Scrollbarnum, colr)
Num = Scrollbarnum
x = HSbarX(Num)
y = HSBarY(Num)
x2 = HSBarX2(Num)
y2 = y + 16
CALL Killbutton(HScrollbar(Num), colr)
CALL Killbutton(HScrollbar(Num) + 1, colr)
LINE (x, y)-(x2, y + 16), colr, BF
Pressedbutton = -1
HScrollbar(Num) = -1
HScrollstep(Num) = 0
HSvalue(Num) = 0
HSbarX(Num) = 0
HSBarY(Num) = 0
HSBarX2(Num) = 0
HScrollMin(Num) = 0
HScrollMax(Num) = 0
FOR i = 0 TO MaxScrollbars
IF HScrollbar(i) <> 0 THEN HLastbar = i
NEXT
END SUB
'===========================================================================
' KillPBar - Poistaa prosenttipalkin
'
' Parametrit: PBarnum = Palkin numero
' Erasecolor = Pyyhintäväri
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB KillPBar (PBarnum, Erasecolor)
LINE (PBarX(PBarnum), PBarY(PBarnum))-(PBarX2(PBarnum), PBarY2(PBarnum)), Erasecolor, BF
PBarX(PBarnum) = 0
PBarY(PBarnum) = 0
PBarX2(PBarnum) = 0
PBarY2(PBarnum) = 0
PBarValue(PBarnum) = 0
PBarTotal(PBarnum) = 0
END SUB
'===========================================================================
' KillTextfield - Poistaa Tekstikentän
'
' Parametrit: Textnum = Kentän numero
' Erasecolor = Pyyhintäväri
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB KillTextfield (Textnum, Erasecolor)
LINE (TextfieldX(Textnum), TextfieldY(Textnum))-(TextfieldX(Textnum) + 8 * TextFieldLen(Textnum) + 24, TextfieldY(Textnum) + 16), Erasecolor, BF
TextfieldX(Textnum) = 0
TextfieldY(Textnum) = 0
TextFieldLen(Textnum) = 0
FOR i = 0 TO Maxfields
IF TextFieldLen(i) > 0 THEN LastTextfield = i
NEXT
END SUB
'===========================================================================
' LineVolume - Asettaa LINE-IN äänenvoimakkuuden
'
' Parametrit: Left, Right = Kanavan äänenvoimakkuus
' Getvol = Jos 1, ääntä ei muuteta vaan luetaan
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB LineVolume (Left, Right, Getvol%)
OUT BasePort% + 4, &H2E
IF Getvol% THEN
Left = INP(BasePort% + 5) \ 16
Right = INP(BasePort% + 5) AND &HF
RETURN
ELSE
OUT BasePort% + 5, (Right + Left * 16) AND &HFF
END IF
RETURN
END SUB
'===========================================================================
' MasterVolume - Asettaa äänenvoimakkuuden
'
' Parametrit: Left, Right = Kanavan äänenvoimakkuus
' Getvol = Jos 1, ääntä ei muuteta vaan luetaan
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB MasterVolume (Left, Right, Getvol%)
OUT BasePort% + 4, &H22
IF Getvol% THEN
Left = INP(BasePort% + 5) \ 16
Right = INP(BasePort% + 5) AND &HF
EXIT SUB
ELSE
OUT BasePort% + 5, (Right + Left * 16) AND &HFF
END IF
END SUB
'===========================================================================
' CDVolume - Asettaa mikrofonin äänenvoimakkuuden
'
' Parametrit: Volume = Äänenvoimakkuus
' Getvol = Jos 1, ääntä ei muuteta vaan luetaan
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB MicVolume (Volume, Getvol%)
OUT BasePort% + 4, &HA
IF Getvol% THEN
Volume% = INP(BasePort% + 5) AND &HF
RETURN
ELSE
OUT BasePort% + 5, Volume% AND &HF
END IF
END SUB
'===========================================================================
' Playwav - Soittaa .WAV, .SND tai .WAV (tai ihan minkä tahansa)
' äänitiedoston
'
' Parametrit: File$ = Soitettava tiedosto
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB Playwav (File$)
CALL SBReset
CALL WriteDSP(&HD1)
OPEN File$ FOR BINARY AS #255
IF UCASE$(RIGHT$(File$, 3)) = "WAV" THEN
FOR i = 0 TO 44
GET #255, , dummy
NEXT
dummy = 0
END IF
DO UNTIL EOF(255)
CALL WriteDSP(&H10)
GET #255, , byte%
CALL WriteDSP(byte%)
LOOP
CLOSE #255
CALL WriteDSP(&HD3)
END SUB
'===========================================================================
' Putpic - Lataa kuvan kovalevyltä (katso SUB Getpic)
'
' Parametrit: x, y = Kuvan vasen yläkulma
' File$ = Tiedoston nimi
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB Putpic (x, y, File$)
OPEN File$ FOR INPUT AS #255
i = x: i2 = y
INPUT #255, x2
INPUT #255, y2
x2 = x + x2
y2 = y + y2
INPUT #255, colr
INPUT #255, amount
count = 0
PSET (i, i2), colr
DO UNTIL i2 > y2
count = count + 1
i = i + 1
IF i > x2 THEN i = x: i2 = i2 + 1
IF count > amount THEN
count = 0
INPUT #255, colr
IF EOF(255) THEN EXIT DO
INPUT #255, amount
END IF
PSET (i, i2), colr
LOOP
CLOSE #255
END SUB
'===========================================================================
' Samplebyte% - Lukee tavun Sound Blasterin mikrofonista (0-255)
'
'========================================(C) Sami Kyöstilä 1997=============
'
FUNCTION Samplebyte%
CALL WriteDSP(&H20)
datavail% = BasePort% + 14
dly:
IF INP(datavail%) AND &H80 = 0 THEN GOTO dly
datread% = BasePort% + 10
bt% = INP(datread%)
Samplebyte% = bt%
END FUNCTION
'===========================================================================
' SBReset - Resetoi Sound Blasterin
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB SBReset
dspreset% = BasePort% + 6
OUT dspreset%, 1
FOR t% = 1 TO 10
a% = INP(dspreset%)
NEXT t%
OUT dspreset%, 0
dspread% = BasePort% + 10
FOR t% = 1 TO 10
a% = INP(dspread%)
NEXT t%
END SUB
'===========================================================================
' ShowBMP - Lataa BMP-kuvan ruudulle (alkup. latausrutiini by Otso Karhu)
' Latausrutiini on vielä "hieman" puutteellinen (lataa vain joka
' toisen pikselin). Jos Sinulla on parannusehdotuksia, niin lähetä
' postia alussa mainittuun sähköpostiosoitteeseen.
'
' Parametrit: StartX, StartY = Vasen yläkulma
' File$ = Ladattava kuva
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB ShowBMP (StartX, StartY, File$)
IF INSTR(File$, ".") = 0 THEN File$ = File$ + ".BMP"
OPEN File$ FOR BINARY AS #255
IF LOF(255) = 0 THEN
CLOSE #255
KILL File$
EXIT SUB
END IF
FOR Otto = 1 TO 2
GET #255, , Tavu
Tyyppi$ = Tyyppi$ + Tavu
NEXT
IF Tyyppi$ <> "BM" THEN
CLOSE #255
EXIT SUB
END IF
Koko = LOF(255)
GET #255, 11, Tavu
PaletinLoppu = ASC(Tavu)
GET #255, , Tavu
PaletinLoppu = PaletinLoppu + ASC(Tavu) * 256
GET #255, 19, Tavu
Leveys = ASC(Tavu)
GET #255, , Tavu
Leveys = Leveys + ASC(Tavu) * 256
GET #255, 23, Tavu
Korkeus = ASC(Tavu)
GET #255, , Tavu
Korkeus = Korkeus + ASC(Tavu) * 256
GET #255, 29, Tavu
Raja = 28
JotainTarkistuksia = (Koko - PaletinLoppu) / Korkeus - Leveys
RuudulleMahtuvaKorkeus = Korkeus - 1
RuudulleMahtuvaLeveys = Leveys - 1
IF Korkeus - 1 > 479 THEN RuudulleMahtuvaKorkeus = 479
IF Leveys - 1 > 639 THEN RuudulleMahtuvaLeveys = 639
IF Leveys < 320 THEN XAlku = (320 - Leveys) / 2
IF Korkeus < 200 THEN YAlku = (200 - Korkeus) / 2
FOR y = 0 TO RuudulleMahtuvaKorkeus
FOR x = 0 TO RuudulleMahtuvaLeveys
GET #255, (PaletinLoppu + 1 + Korkeus * (Leveys + JotainTarkistuksia) - (y + 1) * (Leveys + JotainTarkistuksia) + x), Tavu
IF Screenmode = 13 THEN
PSET (x + StartX, y + StartY), ASC(Tavu)
ELSE
PSET (x * 2 + StartX, y + StartY), ASC(Tavu) MOD 16
PSET (x * 2 - 1 + StartX, y + StartY), ASC(Tavu) MOD 16
END IF
NEXT
NEXT
CLOSE #255
END SUB
'===========================================================================
' Text - Tulostaa tekstiä ruudulle
'
' Parameters: xpos, ypos = Aloituskoordinaatit
' textz$ = Tulostettava teksti
' frontcolor = Tekstin väri
' backcolor = Taustaväri (16 on läpinäkyvä)
' wrappos = Sijainti, jossa siirrytään seuraavalle
' riville
' 0 = Ei siirrytä seuraavalle riville.
' -1 = Laskee automaattisesti siirtymäkohdan
' ruudun reunalla.
' size = Fonttikoko (8 = normaali)
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB Text (xpos, ypos, Textz$, frontcolor, backcolor, wrappos, Size)
xpos = INT(xpos)
ypos = INT(ypos)
IF wrappos = -1 THEN
IF Screenmode = 12 THEN wrappos = 631
IF Screenmode = 7 OR Screenmode = 13 THEN wrappos = 311
IF Screenmode = 9 THEN wrappos = 631
END IF
Size = Size / 8 * 100
Size2 = Size
YStep = (8 / 100 * Size) / 8
IF wrappos > 0 AND xpos > wrappos THEN GOTO Endsub
IF Screenmode = 13 OR Screenmode = 7 THEN
IF ypos >= (199 - 6) THEN GOTO Endsub
END IF
IF Screenmode = 12 AND ypos > (479 - 6) THEN GOTO Endsub
orgxpos = xpos
IF Textz$ = "" THEN EXIT SUB
FOR wpos = 1 TO LEN(Textz$)
B = 8 * 255
a = 1
startbitpos = ASC(MID$(Textz$, wpos, 1)) * 8
xx$ = MID$(Textz$, wpos, 1)
bitpos = startbitpos
IF xx$ = "■" THEN LINE (xpos, ypos + 3)-(xpos + 4, ypos), frontcolor: LINE (xpos + 4, ypos)-(xpos + 7, ypos + 3), frontcolor
IF xx$ = "■" THEN LINE (xpos, ypos + 4)-(xpos + 4, ypos + 1), frontcolor: LINE (xpos + 4, ypos + 1)-(xpos + 7, ypos + 4), frontcolor: GOTO Loopit.Text
IF xx$ = "²" THEN LINE (xpos, ypos + 3)-(xpos + 4, ypos + 6), frontcolor: LINE (xpos + 4, ypos + 6)-(xpos + 7, ypos + 3), frontcolor
IF xx$ = "²" THEN LINE (xpos, ypos + 4)-(xpos + 4, ypos + 7), frontcolor: LINE (xpos + 4, ypos + 7)-(xpos + 7, ypos + 4), frontcolor: GOTO Loopit.Text
IF xx$ = "ä" THEN startbitpos = 97 * 8: bitpos = startbitpos: PSET (xpos + 1, ypos), frontcolor: PSET (xpos + 5, ypos), frontcolor
IF xx$ = "Ä" THEN startbitpos = 65 * 8: bitpos = startbitpos: PSET (xpos, ypos - 1), frontcolor: PSET (xpos + 5, ypos - 1), frontcolor
IF xx$ = "ö" THEN startbitpos = 111 * 8: bitpos = startbitpos: PSET (xpos + 1, ypos), frontcolor: PSET (xpos + 4, ypos), frontcolor
IF xx$ = "Ö" THEN startbitpos = 79 * 8: bitpos = startbitpos: PSET (xpos + 1, ypos - 1), frontcolor: PSET (xpos + 5, ypos - 1), frontcolor
IF xx$ = "å" THEN startbitpos = 97 * 8: bitpos = startbitpos: PSET (xpos + 3, ypos), frontcolor
IF xx$ = "Å" THEN startbitpos = 65 * 8: bitpos = startbitpos: PSET (xpos + 3, ypos - 2), frontcolor: PSET (xpos + 2, ypos - 2), frontcolor
IF xx$ = "█" THEN LINE (xpos, ypos)-(xpos + 8, ypos + 6), frontcolor, BF: startbitpos = 32 * 8: bitpos = startbitpos
IF xx$ = " " THEN GOTO Loopit.Text
IF xx$ = CHR$(255) THEN GOTO Loopit.Text
FOR x = xpos TO xpos + 7
IF bitpos > B THEN bitpos = 0
c = bitpos \ 8
rm = 2 ^ (7 - bitpos MOD 8)
FOR row = 0 TO 7
ch = bitmap(row, c)
IF (ch AND rm) <> 0 THEN
IF Size <= 100 THEN
PSET (x, ypos + row), frontcolor
ELSE
LINE (x + (((x - xpos) / 100) * Size - YStep), ypos + ((row / 100) * Size) + YStep)-(x + (((x - xpos) / 100) * Size), ypos + ((row / 100) * Size)), frontcolor, BF
END IF
ELSE
IF backcolor <> 16 THEN
IF Size <= 100 THEN PSET (x, ypos + row), backcolor
IF Size > 100 THEN LINE (x + (((x - xpos) / 100) * Size - YStep), ypos + ((row / 100) * Size) - YStep)-(x + (((x - xpos) / 100) * Size), ypos + ((row / 100) * Size)), backcolor, BF
END IF
END IF
NEXT row
bitpos = bitpos + 1
IF bitpos = startbitpos + 8 THEN EXIT FOR
NEXT x
IF xx$ = "ä" THEN startbitpos = 97 * 8: bitpos = startbitpos: PSET (xpos + 1, ypos), frontcolor: PSET (xpos + 5, ypos), frontcolor
IF xx$ = "Ä" THEN startbitpos = 65 * 8: bitpos = startbitpos: PSET (xpos, ypos - 1), frontcolor: PSET (xpos + 5, ypos - 1), frontcolor
IF xx$ = "ö" THEN startbitpos = 111 * 8: bitpos = startbitpos: PSET (xpos + 1, ypos), frontcolor: PSET (xpos + 4, ypos), frontcolor
IF xx$ = "Ö" THEN startbitpos = 79 * 8: bitpos = startbitpos: PSET (xpos + 1, ypos - 1), frontcolor: PSET (xpos + 5, ypos - 1), frontcolor
IF xx$ = "å" THEN startbitpos = 97 * 8: bitpos = startbitpos: PSET (xpos + 3, ypos), frontcolor
IF xx$ = "Å" THEN startbitpos = 65 * 8: bitpos = startbitpos: PSET (xpos + 3, ypos - 2), frontcolor: PSET (xpos + 2, ypos - 2), frontcolor
Loopit.Text:
IF Size = 100 THEN xpos = xpos + 8 ELSE xpos = xpos + (.115555555# * Size)
IF wrappos > 0 THEN
IF xpos > wrappos THEN xpos = orgxpos: ypos = ypos + 8
END IF
NEXT
Endsub:
END SUB
'===========================================================================
' Textfield - Luo tekstikentän
'
' Muuttujat: Textnum = Tekstikentän numero
' x, y = Tekstikentän vasemman yläkulman koordinaatit
' Lenght = Tekstikentän tekstin maksimipituus (kirjaimina)
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB Textfield (Textnum, x, y, Lenght)
Box3D2 x, y, Lenght * 8 + 24, 16, 15, 1
TextF$(Textnum) = ""
TextfieldX(Textnum) = x
TextfieldY(Textnum) = y
TextFieldLen(Textnum) = Lenght
FOR i = 0 TO Maxfields
IF TextFieldLen(i) > 0 THEN LastTextfield = i
NEXT
END SUB
'====================================================================
' UpdateHScrollbar - Päivittää vaakatasossa olevan vierityspalkin
'
' Parametrit: Scrollbarnum = Päivitettävän vierityspalkin numero
'
'========================================(C) Sami Kyöstilä 1997======
SUB UpdateHScrollbar (Scrollbarnum)
IF HScrollbar(Scrollbarnum) = -1 THEN GOTO Sub.End2
IF HSvalue(Scrollbarnum) > HScrollMax(Scrollbarnum) THEN HSvalue(Scrollbarnum) = HScrollMax(Scrollbarnum)
IF HSvalue(Scrollbarnum) < HScrollMin(Scrollbarnum) THEN HSvalue(Scrollbarnum) = HScrollMin(Scrollbarnum)
x = HSbarX(Scrollbarnum)
y = HSBarY(Scrollbarnum)
x2 = HSBarX2(Scrollbarnum)
y2 = y + 16
LINE (x + 17, y + 1)-(x + 16 + (HSvalue(Scrollbarnum) * HScrollstep(Scrollbarnum)), y + 15), 8, BF
LINE (x + 32 + (HSvalue(Scrollbarnum) * HScrollstep(Scrollbarnum)) + 2, y + 1)-(x2 - 18, y2 - 1), 8, BF
CALL Box3D(x + 17, y, x2 - 17, y + 16, 8, 1)
CALL Box3D(x + 17 + (HSvalue(Scrollbarnum) * HScrollstep(Scrollbarnum)), y + 2, x + 34 + (HSvalue(Scrollbarnum) * HScrollstep(Scrollbarnum)), y + 15, 7, 0)
Sub.End2:
END SUB
'===========================================================================
' UpdateScrollbar - Päivittää pystysuunnassa olevan vierityspalkin
'
' Parametrit: Scrollbarnum = Päivitettävän vierityspalkin numero
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB UpdateScrollbar (Scrollbarnum)
IF SValue(Scrollbarnum) > ScrollMax(Scrollbarnum) THEN SValue(Scrollbarnum) = ScrollMax(Scrollbarnum)
IF SValue(Scrollbarnum) < ScrollMin(Scrollbarnum) THEN SValue(Scrollbarnum) = ScrollMin(Scrollbarnum)
x = SbarX(Scrollbarnum)
y = SBarY(Scrollbarnum)
y2 = SBarY2(Scrollbarnum)
x2 = x + 16
IF SValue(Scrollbarnum) * Scrollstep(Scrollbarnum) > y2 - 17 THEN SValue(Scrollbarnum) = (y2 - 17) / Scrollstep(Scrollbarnum)
LINE (x + 1, y + 18)-(x + 15, (y + 17) + (SValue(Scrollbarnum) * Scrollstep(Scrollbarnum)) - 1), 8, BF
LINE (x + 1, (y + 33) + (SValue(Scrollbarnum) * Scrollstep(Scrollbarnum)) + 1)-(x + 15, y2 - 18), 8, BF
CALL Box3D(x, y + 17, x + 16, y2 - 17, 8, 1)
CALL Box3D(x + 2, (y + 17) + (SValue(Scrollbarnum) * Scrollstep(Scrollbarnum)), x2 - 1, (y + 33) + (SValue(Scrollbarnum) * Scrollstep(Scrollbarnum)), 7, 0)
END SUB
'===========================================================================
' VocVolume - Asettaa digitaalisen äänenvoimakkuuden
'
' Parametrit: Left, Right = Kanavan äänenvoimakkuus
' Getvol = Jos 1, ääntä ei muuteta vaan luetaan
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB VocVolume (Left, Right, Getvol%)
OUT BasePort% + 4, &H4
IF Getvol% THEN
Left = INP(BasePort% + 5) \ 16
Right = INP(BasePort% + 5) AND &HF
RETURN
ELSE
OUT BasePort% + 5, (Right + Left * 16) AND &HFF
END IF
END SUB
'===========================================================================
' WriteDSP - Kirjoittaa tavun Sound Blasterin komentoporttiin (DSP)
'
' Parametrit: Byte% = Kirjoitettava tavu
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB WriteDSP (byte%)
dspcmd% = BasePort% + 12
FOR t% = 1 TO 8
q% = INP(dspcmd%) 'Delay to give SB time to process code
NEXT t%
OUT dspcmd%, byte%
END SUB
'===========================================================================
' XORLine - Piirtää viivan tai suorakulmion pyyhkimättä taustaa
'
' Parametrit: x, y = Aloituspiste
' x2, y2 = Lopetuspiste
' Box% = Jos 1, piirretään neliön, muutoin viiva
' Pixels = Viivan "tarkkuus", mitä suurempi, sen hienompi
' ja hitaampi
'
'========================================(C) Sami Kyöstilä 1997=============
'
SUB XORLine (x, y, x2, y2, Box%, Pixels)
StepX = (x2 - x) / Pixels
StepY = (y2 - y) / Pixels
PsetX = x
PsetY = y
IF Box% = 0 THEN
FOR i = 0 TO Pixels
PSET (PsetX, PsetY), 15 XOR POINT(PsetX, PsetY)
PsetX = PsetX + StepX
PsetY = PsetY + StepY
NEXT
ELSE
FOR i = 0 TO Pixels
PSET (PsetX, PsetY), 15 XOR POINT(PsetX, PsetY)
PsetX = PsetX + StepX
NEXT
PsetX = x
PsetY = y
FOR i = 0 TO Pixels
PSET (PsetX, PsetY), 15 XOR POINT(PsetX, PsetY)
PsetY = PsetY + StepY
NEXT
PsetX = x
PsetY = y2
FOR i = 0 TO Pixels
PSET (PsetX, PsetY), 15 XOR POINT(PsetX, PsetY)
PsetX = PsetX + StepX
NEXT
PsetX = x2
PsetY = y
FOR i = 0 TO Pixels
PSET (PsetX, PsetY), 15 XOR POINT(PsetX, PsetY)
PsetY = PsetY + StepY
NEXT
END IF
END SUB
