home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Pascal / Samples / MCUNIT10.ARJ / MCMICE10.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-01-16  |  15.6 KB  |  433 lines
  1. {*******************************************************************************
  2. *   Unit name: MCMICE10 interface
  3. *      Author: Martin CEKAL
  4. *        Date: January 15, 1993
  5. *     Version: 1.0
  6. *     Purpose:andle with mouse
  7. ********************************************************************************}
  8. UNIT MCMICE10;
  9. {$R-}
  10. interface
  11.  
  12. type mask = array[1..32] of word;
  13.  
  14. const {masks for graphic cursor}
  15.  
  16. Watch:        mask = ($E007,$C003,$8001,$0,$0,$0,$0,$0,$0,$0,$0,$0,$0,$8001,$C003,
  17.                       $E007,$0,$1FF8,$318C,$6186,$4012,$4022,$4042,$718C,$718C,
  18.                       $4062,$4032,$4002,$6186,$318C,$1FF8,$0);
  19.  
  20. Arrow:        mask = ($FFFF,$8FFF,$8FFF,$87FF,$83FF,$81FF,$80FF,$807F,$803F,$801F,
  21.                       $800F,$801F,$807F,$887F,$DC3F,$FC3F,$0,$0,$2000,$3000,$3800,
  22.                       $3C00,$3E00,$3F00,$3F80,$3FC0,$3FE0,$3E00,$3300,$2300,$0180,$0180);
  23.  
  24. UpArrow:      mask = ($f9ff,$f0ff,$e07f,$e07f,$c03f,$c03f,$801f,$801f,$f,$f,$f0ff,
  25.                       $f0ff,$f0ff,$f0ff,$f0ff,$f0ff,$0,$600,$f00,$f00,$1f80,$1f80,
  26.                       $3fc0,$3fc0,$7fe0,$600, $600, $600, $600, $600, $600, $600);
  27.  
  28. LeftArrow:    mask = ($fe1f,$f01f,$0,$0,$0,$f01f,$fe1f,$ffff,$ffff,$ffff,$ffff,
  29.                       $ffff,$ffff,$ffff,$ffff,$ffff,$0,$c0,$7c0,$7ffe,$7c0,$c0,
  30.                       $0,$0,$0,$0,$0,$0,$0,$0,$0,$0);
  31.  
  32. CheckMark:    mask = ($fff0,$ffe0,$ffc0,$ff81,$ff03,$607,$f,$1f,$c03f,$f07f,
  33.                       $ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$0,$6,$c,$18,$30,$60,
  34.                       $70c0,$1d80,$700,$0,$0,$0,$0,$0,$0,$0);
  35.  
  36. PointingHand: mask = ($F3FF,$E1FF,$E1FF,$E1FF,$E1FF,$E049,$E000,$8000,$0,$0,
  37.                       $07FC,$07F8,$9FF9,$8FF1,$C003,$E007,$0C00,$1200,$1200,
  38.                       $1200,$1200,$13B6,$1249,$7249,$9249,$9001,$9001,$8001,
  39.                       $4002,$4002,$2004,$1FF8 );
  40.  
  41. Diagonalcross:mask = ($7e0,$180,$0,$c003,$f00f,$c003,$0,$180,$7e0,$ffff,$ffff,
  42.                       $ffff,$ffff,$ffff,$ffff,$ffff,$0,$700e,$1c38,$660,$3c0,
  43.                       $660, $1c38,$700e,$0,$0,$0,$0,$0,$0,$0,$0);
  44.  
  45. RectCross:    mask = ($fc3f,$fc3f,$fc3f,$0,$0,$0,$fc3f,$fc3f,$fc3f,$ffff,$ffff,
  46.                       $ffff,$ffff,$ffff,$ffff,$ffff,$0,$180,$180,$180,$7ffe,$180,
  47.                       $180,$180,$0,$0,$0,$0,$0,$0,$0,$0);
  48.  
  49. Hourglass:    mask = ($0,$0,$0,$0,$8001,$c003,$e007,$f00f,$e007,$c003,$8001,$0,$0,
  50.                       $0,$0,$ffff,$0,$7ffe,$6006,$300c,$1818,$c30,$660,$3c0,$660,
  51.                       $c30,$1998,$33cc,$67e6,$7ffe,$0,$0);
  52.  
  53. NewWatch:     mask = ($ffff,$c003,$8001,$0,$0,$0,$0,$0,$0,$0,$0,$0,$0,$8001,$c003,
  54.                       $ffff,$0,$0,$1ff8,$2004,$4992,$4022,$4042,$518a,$4782,$4002,
  55.                       $4992,$4002,$2004,$1ff8,$0,$0);
  56.  
  57.  
  58. {*******************************************************************************
  59. *        Name: InitMouse
  60. *  Parametres: result  =0  mouse driver not found
  61. *                      =1  Microsoft mouse mode
  62. *                      =2  mouse system mouse model
  63. *        Date: June 26, 1992
  64. *     Version: 1.0
  65. *     Purpose: Initialization of mouse
  66. ********************************************************************************}
  67. procedure InitMouse(var result:byte);
  68.  
  69. {*******************************************************************************
  70. *        Name: SetGrCrsr
  71. *  Parametres: x,y coordinates of hot point
  72. *              crssrmask mask of cursor
  73. *        Date: June 26, 1992
  74. *     Version: 1.0
  75. *     Purpose: Set type of graphic cursor
  76. ********************************************************************************}
  77. procedure SetGrCrsr(x,y:shortint;crsrmask:mask);
  78.  
  79. {*******************************************************************************
  80. *        Name: SetTxtCrsr
  81. *  Parametres: hwc=true hardware cursor
  82. *                 =false software cursor;
  83. *              par1: def. of cursor mask
  84. *              par2: def. of cursor
  85. *        Date: June 26, 1992
  86. *     Version: 1.0
  87. *     Purpose: Set type of text cursor
  88. ********************************************************************************}
  89. procedure SetTxtCrsr(hwc:boolean;par1,par2:word);
  90.  
  91. {*******************************************************************************
  92. *        Name: SetMRange
  93. *  Parametres: xl,yl,xh,yh corners of range
  94. *        Date: June 26, 1992
  95. *     Version: 1.0
  96. *     Purpose: Mouse Operating range
  97. ********************************************************************************}
  98. procedure SetMRange(xl,yl,xh,yh:integer);
  99.  
  100. {*******************************************************************************
  101. *        Name: SetMPos
  102. *  Parametres: x,y position of cursor
  103. *        Date: June 26, 1992
  104. *     Version: 1.0
  105. *     Purpose: Set cursor position
  106. ********************************************************************************}
  107. procedure SetMPos(x,y:integer);
  108.  
  109. {*******************************************************************************
  110. *        Name: Crsr
  111. *  Parametres: crsron =true cursor ON
  112. *                     =false cursor OFF
  113. *        Date: June 26, 1992
  114. *     Version: 1.0
  115. *     Purpose: Switch cursor ON/OFF
  116. ********************************************************************************}
  117. procedure Crsr(crsron:boolean);
  118.  
  119. {*******************************************************************************
  120. *        Name: GetMPos
  121. *  Parametres: x,y cursor position
  122. *        Date: June 26, 1992
  123. *     Version: 1.0
  124. *     Purpose: Get cursor position
  125. ********************************************************************************}
  126. procedure GetMPos(var x,y:integer);
  127.  
  128. {*******************************************************************************
  129. *        Name: GetMMotion
  130. *  Parametres: x,y movement of cursor
  131. *        Date: June 26, 1992
  132. *     Version: 1.0
  133. *     Purpose: Movement from last GetMMotion
  134. ********************************************************************************}
  135. procedure GetMMotion(var x,y:integer);
  136.  
  137. {*******************************************************************************
  138. *        Name: PressedButton
  139. *                =true if pressed
  140. *  Parametres: button number of botton 1..3
  141. *        Date: June 26, 1992
  142. *     Version: 1.0
  143. *     Purpose: Checks the button status
  144. ********************************************************************************}
  145. function PressedButton(button:byte):boolean;
  146.  
  147. {*******************************************************************************
  148. *        Name: ReleasedButton
  149. *                =true if released
  150. *  Parametres: button number of botton 1..3
  151. *        Date: June 26, 1992
  152. *     Version: 1.0
  153. *     Purpose: Checks the button status
  154. ********************************************************************************}
  155. function ReleasedButton(button:byte):boolean;
  156.  
  157. {*******************************************************************************
  158. *        Name: WherePress
  159. *  Parametres: button number of botton 1..3
  160. *              x,y coordinates of point
  161. *        Date: June 26, 1992
  162. *     Version: 1.0
  163. *     Purpose: Returns coords of last press
  164. ********************************************************************************}
  165. procedure WherePress(Button:Byte;var x,y:integer);
  166.  
  167. {*******************************************************************************
  168. *        Name: WhereRelease
  169. *  Parametres: button number of botton 1..3
  170. *              x,y coordinates of point
  171. *        Date: June 26, 1992
  172. *     Version: 1.0
  173. *     Purpose: Returns coords of last release
  174. ********************************************************************************}
  175. procedure WhereRelease(Button:Byte;var x,y:integer);
  176.  
  177. {*******************************************************************************
  178. *        Name: SetSensitivity
  179. *  Parametres: x,y number of mouse motions to 8 pixels
  180. *        Date: June 26, 1992
  181. *     Version: 1.0
  182. *     Purpose: Sets sensitivity of mouse
  183. ********************************************************************************}
  184. procedure SetSensetivity(x,y : integer);
  185.  
  186.  
  187. {*******************************************************************************
  188. *   Unit name: MCMICE10 imlementation
  189. *      Author: Martin CEKAL
  190. *        Date: January 15, 1993
  191. *     Version: 1.0
  192. *     Purpose:andle with mouse
  193. ********************************************************************************}
  194. implementation
  195.  
  196. uses dos;
  197.  
  198. var regs:registers;
  199.  
  200. {*******************************************************************************
  201. *        Name: InitMouse
  202. *  Parametres: result  =0  mouse driver not found
  203. *                      =1  Microsoft mouse mode
  204. *                      =2  mouse system mouse model
  205. *        Date: June 26, 1992
  206. *     Version: 1.0
  207. *     Purpose: Initialization of mouse
  208. ********************************************************************************}
  209. procedure InitMouse(var result:byte);
  210. var i,b:word;
  211. begin
  212.   if (mem[$0000:$0449]=7) and (mem[$0000:$0465]<>41)
  213.     then begin
  214.       mem[$0000:$0449]:=6;
  215.       regs.AX:=0;
  216.       intr($33,regs);
  217.       i:=regs.AX;
  218.       b:=regs.BX;
  219.       mem[$0000:$0449]:=7;
  220.     end
  221.     else begin
  222.       regs.AX:=0;
  223.       intr($33,regs);
  224.       i:=regs.AX;
  225.       b:=regs.BX;
  226.     end;
  227.   result:=0;                              {Mouse driver not found }
  228.   if (i=$FFFF) and (b=2) then result:=1;  {Microsoft Mouse mode   }
  229.   if (i=$FFFF) and (b=3) then result:=2;  {Mouse System Mouse mode}
  230. end; {*** end InitMouse ***}
  231.  
  232. {*******************************************************************************
  233. *        Name: SetGrCrsr
  234. *  Parametres: x,y coordinates of hot point
  235. *              crssrmask mask of cursor
  236. *        Date: June 26, 1992
  237. *     Version: 1.0
  238. *     Purpose: Set type of graphic cursor
  239. ********************************************************************************}
  240. procedure SetGrCrsr(x,y:shortint;crsrmask:mask);
  241. begin
  242.   regs.AX:=9;
  243.   regs.BX:=x;
  244.   regs.CX:=y;
  245.   regs.DX:=ofs(crsrmask);
  246.   regs.ES:=seg(crsrmask);
  247.   intr($33,regs);
  248. end; {*** end SetGrCrsr ***}
  249.  
  250. {*******************************************************************************
  251. *        Name: SetTxtCrsr
  252. *  Parametres: hwc=true hardware cursor
  253. *                 =false software cursor;
  254. *              par1: def. of cursor mask
  255. *              par2: def. of cursor
  256. *        Date: June 26, 1992
  257. *     Version: 1.0
  258. *     Purpose: Set type of text cursor
  259. ********************************************************************************}
  260. procedure SetTxtCrsr(hwc:boolean;par1,par2:word);
  261. begin
  262.   regs.AX:=10;
  263.   if hwc then regs.BX:=1
  264.          else regs.BX:=0;
  265.   regs.CX:=par1;
  266.   regs.DX:=par2;
  267.   intr($33,regs);
  268. end; {*** end SetTxtCrsr ***}
  269.  
  270. {*******************************************************************************
  271. *        Name: SetMRange
  272. *  Parametres: xl,yl,xh,yh corners of range
  273. *        Date: June 26, 1992
  274. *     Version: 1.0
  275. *     Purpose: Mouse Operating range
  276. ********************************************************************************}
  277. procedure SetMRange(xl,yl,xh,yh:integer);
  278. begin
  279.   regs.AX:=7;
  280.   regs.CX:=xl;
  281.   regs.DX:=xh;
  282.   intr($33,regs);
  283.   regs.AX:=8;
  284.   regs.CX:=yl;
  285.   regs.DX:=yh;
  286.   intr($33,regs);
  287. end; {*** end SetMRange ***}
  288.  
  289. {*******************************************************************************
  290. *        Name: SetMPos
  291. *  Parametres: x,y position of cursor
  292. *        Date: June 26, 1992
  293. *     Version: 1.0
  294. *     Purpose: Set cursor position
  295. ********************************************************************************}
  296. procedure SetMPos(x,y:integer);
  297. begin
  298.   regs.AX:=4;
  299.   regs.CX:=x;
  300.   regs.dx:=y;
  301.   intr($33,regs);
  302. end; {*** end SetMPos ***}
  303.  
  304. {*******************************************************************************
  305. *        Name: Crsr
  306. *  Parametres: crsron =true cursor ON
  307. *                     =false cursor OFF
  308. *        Date: June 26, 1992
  309. *     Version: 1.0
  310. *     Purpose: Switch cursor ON/OFF
  311. ********************************************************************************}
  312. procedure Crsr(crsron:boolean);
  313. begin
  314.   if crsron then regs.AX:=1
  315.             else regs.AX:=2;
  316.   intr($33,regs);
  317. end; {*** end Crsr ***}
  318.  
  319. {*******************************************************************************
  320. *        Name: GetMPos
  321. *  Parametres: x,y cursor position
  322. *        Date: June 26, 1992
  323. *     Version: 1.0
  324. *     Purpose: Get cursor position
  325. ********************************************************************************}
  326. procedure GetMPos(var x,y:integer);
  327. begin
  328.   regs.AX:=3;
  329.   intr($33,regs);
  330.   x:=regs.CX;
  331.   y:=regs.DX;
  332. end; {*** end GetMPos ***}
  333.  
  334. {*******************************************************************************
  335. *        Name: GetMMotion
  336. *  Parametres: x,y movement of cursor
  337. *        Date: June 26, 1992
  338. *     Version: 1.0
  339. *     Purpose: Movement from last GetMMotion
  340. ********************************************************************************}
  341. procedure GetMMotion(var x,y:integer);
  342. begin
  343.   regs.AX:=11;
  344.   intr($33,regs);
  345.   x:=regs.CX;
  346.   y:=regs.DX;
  347. end; {*** end GetMMotion ***}
  348.  
  349. {*******************************************************************************
  350. *        Name: PressedButton
  351. *                =true if pressed
  352. *  Parametres: button number of botton 1..3
  353. *        Date: June 26, 1992
  354. *     Version: 1.0
  355. *     Purpose: Checks the button status
  356. ********************************************************************************}
  357. function PressedButton(button:byte):boolean;
  358. begin
  359.   regs.AX:=3;
  360.   intr($33,regs);
  361.   pressedbutton:=((1 shl (button-1)) and regs.BX)<>0;
  362. end; {*** end PressedButton ***}
  363.  
  364. {*******************************************************************************
  365. *        Name: ReleasedButton
  366. *                =true if released
  367. *  Parametres: button number of botton 1..3
  368. *        Date: June 26, 1992
  369. *     Version: 1.0
  370. *     Purpose: Checks the button status
  371. ********************************************************************************}
  372. function ReleasedButton(button:byte):boolean;
  373. begin
  374.   regs.AX:=6;
  375.   intr($33,regs);
  376.   releasedbutton:=((1 shl (button-1)) and regs.BX)<>0;
  377. end; {*** end ReleaseButton ***}
  378.  
  379. {*******************************************************************************
  380. *        Name: WherePress
  381. *  Parametres: button number of botton 1..3
  382. *              x,y coordinates of point
  383. *        Date: June 26, 1992
  384. *     Version: 1.0
  385. *     Purpose: Returns coords of last press
  386. ********************************************************************************}
  387. procedure WherePress(Button:Byte;var x,y:integer);
  388. begin
  389.   regs.AX := 5;
  390.   regs.BX := Button-1;
  391.   intr($33,regs);
  392.   x:= regs.cx;
  393.   y:= regs.dx;
  394. end; {*** end WherePress ***}
  395.  
  396. {*******************************************************************************
  397. *        Name: WhereRelease
  398. *  Parametres: button number of botton 1..3
  399. *              x,y coordinates of point
  400. *        Date: June 26, 1992
  401. *     Version: 1.0
  402. *     Purpose: Returns coords of last release
  403. ********************************************************************************}
  404. procedure WhereRelease(Button:Byte;var x,y:integer);
  405. begin
  406.   regs.ax := 6;
  407.   regs.bx := Button-1;
  408.   intr($33,regs);
  409.   X := regs.cx;
  410.   Y := regs.dx;
  411. end; {*** end WhereRelease ***}
  412.  
  413. {*******************************************************************************
  414. *        Name: SetSensitivity
  415. *  Parametres: x,y number of mouse motions to 8 pixels
  416. *        Date: June 26, 1992
  417. *     Version: 1.0
  418. *     Purpose: Sets sensitivity of mouse
  419. ********************************************************************************}
  420. procedure SetSensetivity(x,y : integer);
  421. begin
  422.   regs.ax := 15;
  423.   regs.cx := x; {# of mouse motions to horizontal 8 pixels}
  424.   regs.dx := y; {# of mouse motions to vertical 8 pixels}
  425.   intr($33,regs);
  426. end; {*** end SetSensitivity ***}
  427.  
  428. End. {*** unit MCMICE10 ***}
  429.  
  430.  
  431.  
  432.  
  433.