Keskustelu: Koodit: QB: Nappeja hiirellä paineltavaksi

DECLARE SUB tsekNappi (num!)
DECLARE SUB tutkiNappi (num!, mode!)               'Tässä on koodia,
DECLARE SUB Txt (tek$, mika.x!, mika.y!, vari!)    'jolla saa melkoisen
DECLARE FUNCTION onOver! (nappinum!)               'helposti hienoja nappeja
DECLARE FUNCTION AsetaNappi! (x!, y!, xx!, yy!)    'joita voi painella :)
DECLARE SUB PNappi (num!, col!, tek$, tcol)                       '-Dj Wolf
DECLARE SUB AlustaHiiri ()
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%)
COMMON SHARED VAPAANAPPI, x%, y%, v%, k%, o%, ZC, ZOC, ZAC
DIM SHARED Hiiri$

TYPE tNappi       'tietoja napista:
vx AS INTEGER     'vasen x
vy AS INTEGER     'vasen y
ox AS INTEGER     'oikea x
oy AS INTEGER     'oikea y
paal AS INTEGER   'hiiri päällä
klik AS INTEGER   'hiiren klikkaus
onPaal AS INTEGER 'jos hiiri on jo päällä
onKlik AS INTEGER 'jos hiirellä on klikattu
END TYPE

DIM SHARED Nappi(100) AS tNappi 'max. määrä on 100 sekä napeissa
DIM SHARED t(100) AS STRING               'että näiden teksteissä
DIM SHARED kirjain(1 TO 8, 1 TO 8, 1 TO 255) AS INTEGER

CLS : SCREEN 13: AlustaHiiri: GOSUB fontti.muistiin: COLOR 15

ZC = 1  '<-----                                 NAPIN PERUSVŽRI
ZOC = 3 '<-----            TEKSTIN VŽRI, JOS HIIRI NAPIN PŽŽLLŽ
ZAC = 9 '<--- NAPIN KEHYKSEN VŽRI, JOS HIIRELLŽ KLIKATTU NAPPIA

n1 = AsetaNappi(10, 170, 70, 190)     'asetetaan N1 -nappi
n2 = AsetaNappi(80, 170, 140, 190)
n3 = AsetaNappi(150, 170, 230, 190)
n4 = AsetaNappi(240, 170, 300, 190)

t(1) = "UUSI": t(2) = "LATAA"         'nappien tekstit!
t(3) = "ASETUKSET": t(4) = "POISTU"

PNappi n1, ZC, t(1), ZC               'piirretään N1 -nappi T(1) -tekstillä
PNappi n2, ZC, t(2), ZC'
PNappi n3, ZC, t(3), ZC'
PNappi n4, ZC, t(4), ZC'

HiiriEsiin
DO                                                              'looppi alkaa
FOR i = 1 TO 1000
  HiiriLue v%, o%, k%, x%, y%
  tutkiNappi 1, 1: tutkiNappi 2, 2: tutkiNappi 3, 1: tutkiNappi 4, 1
  IF Nappi(4).klik THEN LOCATE 1, 10: PRINT "ohjelma loppuu...": EXIT DO
NEXT
IF Nappi(2).paal = 0 THEN Nappi(2).paal = 1 ELSE Nappi(2).paal = 0   'vilkutetaan toista nappia :)
LOOP                                                             'ja loppuu
END

fontti.muistiin:          'mun 'print joka ei sotke taustaa'-koodista
FOR asciikoodi = 1 TO 255
IF asciikoodi = 7 THEN asciikoodi = 8 ELSE
COLOR 16: LOCATE 1, 1: PRINT CHR$(asciikoodi)
FOR y = 1 TO 8
FOR x = 1 TO 8
vari = POINT(x - 1, y - 1)
kirjain(x, y, asciikoodi) = vari
NEXT x
NEXT y
NEXT asciikoodi
RETURN

DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B 'hiiriajurit
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

SUB AlustaHiiri
Hiiri$ = SPACE$(57)
FOR i% = 1 TO 57
     READ A$
     h$ = CHR$(VAL("&H" + A$))
     MID$(Hiiri$, i%, 1) = h$
NEXT i%
END SUB

FUNCTION AsetaNappi (x, y, xx, yy)
VAPAANAPPI = VAPAANAPPI + 1
Nappi(VAPAANAPPI).vx = x
Nappi(VAPAANAPPI).vy = y
Nappi(VAPAANAPPI).ox = xx
Nappi(VAPAANAPPI).oy = yy
AsetaNappi = VAPAANAPPI  'palauttaa tehdyn napin numeron
END FUNCTION

SUB HiiriAjuri (ax%, bx%, cx%, dx%)
     DEF SEG = VARSEG(Hiiri$)                'Segmentti talteen
     Hiiri% = SADD(Hiiri$)                   'Offsetti talteen
     CALL Absolute(ax%, bx%, cx%, dx%, Hiiri%)    'Kutsu
END SUB

SUB HiiriEsiin
     ax% = 1                  'Funktio 1
     HiiriAjuri ax%, 0, 0, 0  'Kutsutaan hiiriajuria
END SUB

SUB HiiriLue (vasen%, oikea%, keski%, x%, y%)
     ax% = 3                            'Funktio 3
     HiiriAjuri ax%, bx%, cx%, dx%      'Kutsutaan hiiriajuria
     vasen% = ((bx% AND 1) <> 0)        'Luetaan nappien asennot
     oikea% = ((bx% AND 2) <> 0)        'bx:stä
     keski% = ((bx% AND 4) <> 0)
     x% = cx%                           'ja hiiren koordinaatit
     y% = dx%                           'cx:stä ja dx:stä
END SUB

SUB HiiriPiiloon
     ax% = 2                  'Funktio 2
     HiiriAjuri ax%, 0, 0, 0  'Kutsutaan hiiriajuria
END SUB

SUB HiiriRajat (x1%, y1%, x2%, y2%)
     ax% = 7                       'Funktio 7
     cx% = x1%                     'Rajat cx:ään ja dx:ään
     dx% = y2%
     HiiriAjuri ax%, 0, cx%, dx%   'Kutsutaan hiiriajuria
END SUB

FUNCTION HiiriTarkista%
     ax% = 0                       'Funktio 0
     HiiriAjuri ax%, bx%, 0, 0     'Kutsutaan hiiriajuria
     IF (ax% = 0) THEN             'Onko ajuri käytössä?
          HiiriTarkista% = 0       'jos ei, palautetaan 0
     ELSEIF (bx% = 3) THEN         'Kolminappinen hiiri?
          HiiriTarkista% = 3
     ELSEIF (bx% = 0) THEN         'Epästandardi hiiri?
          HiiriTarkista% = 1
     ELSE
          HiiriTarkista% = 2       'Tavallinen 2-nappinen hiiri?
     END IF
END FUNCTION

FUNCTION onOver (nappinum)
IF x% / 2 >= Nappi(nappinum).vx AND x% / 2 <= Nappi(nappinum).ox AND y% >= Nappi(nappinum).vy AND y% <= Nappi(nappinum).oy THEN
onOver = 1
ELSE
onOver = 0
END IF
END FUNCTION

SUB PNappi (num, col, tek$, tcol)
LINE (Nappi(num).vx, Nappi(num).vy)-(Nappi(num).ox, Nappi(num).oy), col, B
cenx = (Nappi(num).ox + Nappi(num).vx) / 2: ceny = (Nappi(num).oy + Nappi(num).vy) / 2
Txt tek$, cenx - (LEN(tek$) * 4), ceny - 4, tcol  'keskitetään teksti
END SUB

SUB tutkiNappi (num, mode)
SELECT CASE mode
CASE 1 'klikkauksen ja hiiren päälle menon tunnistava nappi
  IF onOver(num) = 1 THEN Nappi(num).paal = 1 ELSE Nappi(num).paal = 0
  IF -v% = 1 AND onOver(num) = 1 THEN Nappi(num).klik = 1 ELSE Nappi(num).klik = 0
  IF Nappi(num).paal = 1 AND Nappi(num).onPaal = 0 THEN Nappi(num).onPaal = 1: HiiriPiiloon: PNappi num, ZC, t(num), ZOC ELSE
  IF Nappi(num).klik = 1 AND Nappi(num).onKlik = 0 THEN Nappi(num).onKlik = 1: HiiriPiiloon: PNappi num, ZAC, t(num), ZOC ELSE
  IF Nappi(num).paal = 0 AND Nappi(num).onPaal = 1 THEN Nappi(num).onPaal = 0: HiiriPiiloon: PNappi num, ZC, t(num), ZC ELSE
  IF Nappi(num).klik = 0 AND Nappi(num).onKlik = 1 THEN Nappi(num).onKlik = 0: HiiriPiiloon: PNappi num, ZC, t(num), ZC ELSE

CASE 2 'vain klikkauksen tunnistava nappi, päällemeno saadaan manuaalisesti
  IF -v% = 1 AND onOver(num) = 1 THEN Nappi(num).klik = 1 ELSE Nappi(num).klik = 0
  IF Nappi(num).paal = 1 AND Nappi(num).onPaal = 0 THEN Nappi(num).onPaal = 1: IF onOver(num) THEN HiiriPiiloon: PNappi num, ZC, t(num), ZOC ELSE : PNappi num, ZC, t(num), ZOC ELSE
  IF Nappi(num).klik = 1 AND Nappi(num).onKlik = 0 THEN Nappi(num).onKlik = 1: IF onOver(num) THEN HiiriPiiloon: PNappi num, ZAC, t(num), ZOC ELSE : PNappi num, ZAC, t(num), ZOC ELSE
  IF Nappi(num).paal = 0 AND Nappi(num).onPaal = 1 THEN Nappi(num).onPaal = 0: IF onOver(num) THEN HiiriPiiloon: PNappi num, ZC, t(num), ZC ELSE : PNappi num, ZC, t(num), ZC ELSE
  IF Nappi(num).klik = 0 AND Nappi(num).onKlik = 1 THEN Nappi(num).onKlik = 0: IF onOver(num) THEN HiiriPiiloon: PNappi num, ZC, t(num), ZC ELSE : PNappi num, ZC, t(num), ZC ELSE
END SELECT
HiiriEsiin
END SUB

SUB Txt (tek$, mika.x, mika.y, vari)
FOR kerrat = 1 TO LEN(tek$)                      'näitä ei kannata
asciikoodi = ASC(MID$(tek$, kerrat, LEN(tek$))) 'kauheasti tutkia
FOR y = 1 TO 8                                 'koska koodi on
FOR x = 1 TO 8                                'aivan hirveää
IF NOT kirjain(x, y, asciikoodi) = 0 THEN
kirjain(x, y, asciikoodi) = vari
PSET (x + mika.x, y + mika.y), kirjain(x, y, asciikoodi)
ELSE
END IF
NEXT x
NEXT y
mika.x = mika.x + 8
NEXT kerrat
END SUB