(***************************************************************************) (* Tento program demonstruje zaklady pouzivani mysi. Obsahuje procedury *) (* a funkce pro praci s mysi, nektere jsou pouzity v hlavnim programu *) (* (inicializace mysi, nastaveni oblasti, ve ktere je mysi dovoleno *) (* se pohybovat, nastaveni pozice mysi, zjisteni stavu mysi - zde pouze *) (* jeji pozice na obrazovce a vypsani, zjisteni stisknuti leveho tlacitka).*) (* Program lze ukoncit stisknutim jakekoliv klavesy. *) (* Pozice mysi je mapovana do textoveho rezimu tak, ze cislo v pixelech *) (* je prevedeno na znaky. Jeden znak ma delku i sirku 8 pixelu, proto *) (* se pouziva deleni prip. nasobeni cislem 8. Souradnice jsou od 0. *) (***************************************************************************) program mys; uses dos; type TTlacitkaMysi = (t_leve, t_prave, t_prostredni); TSTlacitkaMysi = set of TTlacitkaMysi; var JeMys: boolean; { jestlize je funkcni ovladac mysi, je zde true } PocetTl: byte; { pocet tlacitek mysi - 1, 2 nebo 3 } pozice_x, pozice_y: byte; { pozice mysi na obrazovce } s_tlacitka: TSTlacitkaMysi; { ktera tlacitka jsou stlacena (zde nema vyznam) } pocet: word; { pomocna promenna } procedure ZapniKurzorMysi; { zobrazi kurzor mysi } var r: Registers; begin if JeMys then begin r.ax := 1; { sluzba cislo 1 v preruseni cislo 33h } Intr($33, r); end; end; procedure VypniKurzorMysi; { kurzor mysi zmizi z obrazovky } var r: Registers; begin if JeMys then begin r.ax := 2; { sluzba cislo 2 v preruseni cislo 33h } Intr($33, r); end; end; procedure InicializujMys; { resetuje mys, nastavi vsechny promenne, zobrazi kurzor mysi } var r: Registers; begin r.ax := 0; { inicializace mysi, sluzba 0 preruseni 33h } Intr($33, r); if (r.ax = 0) then begin JeMys := false; { pokud je AX=0, potom neni pritomen ovladac mysi } PocetTl := 0; end else begin JeMys := true; PocetTl := r.bx; { v BX je pocet tlacitek mysi } ZapniKurzorMysi; end; end; procedure UklidMys; { tuto proceduru volame pred ukoncenim programu, resetuje mys } var r: Registers; begin r.ax := 0; { reset mysi } Intr($33, r); end; function StavMysi(var stisknuto: TSTlacitkaMysi; var x,y: byte): boolean; { zda jsou jednotliva tlacitka stisknuta a kde je kurzor mysi, pokud se mys pohnula, vraci true, jinak false } var r: Registers; px, py: byte; begin if JeMys then begin px := x; py := y; stisknuto := []; r.ax := 3; { sluzba cislo 3 v preruseni 33h } Intr($33, r); with r do begin { v registru bx je urceno, ktera tlacitka jsou stisknuta } if (bx and 1)>0 then stisknuto := stisknuto + [t_leve]; if (bx and 2)>0 then stisknuto := stisknuto + [t_prave]; if (bx and 4)>0 then stisknuto := stisknuto + [t_prostredni]; x := cx div 8; { v registru cx je horizontalni pozice mysi } y := dx div 8; { v registru dx je vertikalni pozice mysi } end; StavMysi := (px <> x) or (py <> y); end else StavMysi := false; end; procedure NastavPoziciMysi(x,y: byte); { presune mys na zadane souradnice, ve Windows nefunguje } var r: Registers; begin if JeMys then begin r.ax := 4; { sluzba cislo 4 preruseni cislo 33h } r.cx := x * 8; { do registru cx a dx dame pozici mysi, kam ... } r.dx := y * 8; { ... ji chceme presunout } Intr($33, r); end; end; function StisknutoTlacitko(ktere: TTlacitkaMysi; var pocet: word; var x,y: byte): boolean; { pokud bylo od posledniho volani teto funkce stisknuto zadane tlacitko, vraci true, jinak false; v parametru pocet je pocet stisknuti od posledniho volani, v parametrech x, y pozice mysi na obrazovce pri tomto stisknuti } var r: Registers; begin if JeMys then with r do begin ax := 5; { sluzba cislo 5 preruseni cislo 33h } bx := ord(ktere);{ do bx dame urceni tlacitka, jehoz stav chceme zjistit } Intr($33, r); if bx=0 then StisknutoTlacitko := false else begin pocet := bx; { v bx je pocet stisknuti od posledniho volani teto funkce } x := cx div 8; { v cx a dx je pozice mysi pri stisknuti tohoto tlacitka } y := dx div 8; StisknutoTlacitko := true; end; end else StisknutoTlacitko := false; end; function UvolnenoTlacitko(ktere: TTlacitkaMysi; var pocet: word; var x,y: byte): boolean; { pokud bylo od posledniho volani teto funkce uvolneno zadane tlacitko, vraci true, jinak false; v parametru pocet je pocet uvolneni od posledniho volani, v parametrech x, y pozice mysi na obrazovce pri tomto uvolneni, parametry jsou podobne jako u predchozi funkce } var r: Registers; begin if JeMys then with r do begin ax := 6; bx := ord(ktere); Intr($33, r); if bx=0 then UvolnenoTlacitko := false else begin pocet := bx; x := cx div 8; y := dx div 8; UvolnenoTlacitko := true; end; end else UvolnenoTlacitko := false; end; procedure HorizRozsahSouradnic(min_x, max_x: byte); { nastaveni horizontalniho rozsahu souradnic - kam bude mysi dovoleno se pohybovat } var r: Registers; begin if JeMys then with r do begin ax := 7; { sluzba cislo 7 preruseni cislo 33h } cx := min_x * 8; { do cx a dx ulozime minimalni a maximalni hranici } dx := max_x * 8; Intr($33, r); end; end; procedure VertRozsahSouradnic(min_y, max_y: byte); { nastaveni vertikalniho rozsahu souradnic - kam bude mysi dovoleno se pohybovat } var r: Registers; begin if JeMys then with r do begin ax := 8; cx := min_y * 8; dx := max_y * 8; Intr($33, r); end; end; (***************************************************************************) (* pomocne funkce a procedury, pouze pro prezentovani pouziti mysi *) (***************************************************************************) procedure SchovejKurzor; { odstrani z obrazovky textovy kurzor } var r: Registers; begin with r do begin ah := 2; bh := 0; dh := 25; dl := 0; end; Intr($10, r); end; function StisknutaKlavesa: boolean; { zjisti, zda je v bufferu klavesnice nejaka klavesa, tedy zda byla jiz nejaka klavesa stisknuta } var r: Registers; begin r.ah := $11; Intr($16, r); StisknutaKlavesa := (r.Flags and $40)=0; end; procedure PresunTextKurzor(x,y: byte); { presune textovy kurzor na zadane souradnice } var r: Registers; begin with r do begin ah := 2; bh := 0; dh := y; dl := x; end; Intr($10, r); end; procedure VypisSouradniceMysi; { vypise souradnice uschovane v promennych pozice_x a pozice_y } begin if JeMys then begin PresunTextKurzor(0,0); write('[', pozice_x:3, ',' , pozice_y:3, ']'); SchovejKurzor; end; end; procedure PisZnak(x,y: byte; znak: char; b_text, b_pozadi: byte); { vypise na zadanou pozici znak v urcite barve textu a pozadi } var r: Registers; begin PresunTextKurzor(x,y); with r do begin ah := 9; al := ord(znak); bh := 0; cx := 1; bl := (b_pozadi shl 4) + b_text; end; Intr($10, r); SchovejKurzor; end; procedure UklidObrazovku; { resetuje textovy rezim, tedy predevsim vymaze obsah obrazovky } var r: Registers; begin r.ah := 0; r.al := 3; Intr($10, r); end; begin { main } UklidObrazovku; InicializujMys; if JeMys then begin HorizRozsahSouradnic(0,70); VertRozsahSouradnic (5,20); pozice_x := 0; pozice_y := 5; NastavPoziciMysi(pozice_x, pozice_y); VypisSouradniceMysi; repeat if StavMysi(s_tlacitka, pozice_x, pozice_y) then begin VypniKurzorMysi; VypisSouradniceMysi; ZapniKurzorMysi; end; if StisknutoTlacitko(t_leve, pocet, pozice_x, pozice_y) then begin VypniKurzorMysi; PisZnak(pozice_x, pozice_y, #176, 14, 1); ZapniKurzorMysi; end; until StisknutaKlavesa; UklidMys; end; UklidObrazovku; end.