use copy/paste, the unit contains
a sample program at the end.
lars...
please give response.....
{this is a simple mouse unit
for 480 * 640 ega mode}
{unit must be in regular pascal
graphic mode}
{see samplecode at the end of
this document, use the copy and paste}
{function to make the programfile
out of the sample program}
(************************** INTERFACE *********************)
{
Function getmousex : word;
Function getmousey : word;
Function leftpressed : boolean;
Function rightpressed : boolean;
Procedure mousewindow(l, t,
r, b : word);
Procedure move_cursor_to(movetoX,
movetoY : word);
Procedure Initiate_mouse;
init_item(set_x1, set_y1, set_x2,
set_y2 : word; set_do_procedure : string);
constructor init_map;
procedure add_item(item_to_add
: map_item_pointer);
function check(x_position,
y_position : word) : string;
procedure dispose_map(map_name
: map_pointer);
}
interface
uses graph;
const cursor_width = 14;
cursor_height
= 14;
cursor_image
: array [0..cursor_width - 1, 0..cursor_height - 1]
of byte =(
(16,00,16,16,16,16,16,16,16,16,16,16,16,16),
(00,15,00,00,16,16,16,16,16,16,16,16,16,16),
{the color 16 is not }
(16,00,15,15,00,00,16,16,16,16,16,16,16,16),
{defined, it will not}
(16,00,15,15,15,15,00,00,16,16,16,16,16,16),
{be drawed either..}
(16,16,00,15,15,15,15,15,00,00,16,16,16,16),
(16,16,00,15,15,15,15,15,15,15,00,00,16,16),
(16,16,16,00,15,15,15,15,15,15,15,15,00,16),
(16,16,16,00,15,15,15,15,15,15,15,00,16,16),
(16,16,16,16,00,15,15,15,15,15,00,16,16,16),
(16,16,16,16,00,15,15,15,15,15,15,00,16,16),
(16,16,16,16,16,00,15,15,00,15,15,15,00,16),
(16,16,16,16,16,00,15,00,16,00,15,15,15,00),
(16,16,16,16,16,16,00,16,16,16,00,15,00,16),
(16,16,16,16,16,16,16,16,16,16,16,00,16,16));
type
map_item_pointer =
^map_item;
map_item = object
x1, y1, h, w
: word;
do_procedure
: string;
next_item :
pointer;
constructor
init_item(set_x1, set_y1, set_w, set_h : word;
set_do_procedure : string);
end;
map_pointer =^map;
map = object
last_map_item
: pointer;
constructor
init_map;
procedure add_item(item_to_add
: map_item_pointer);
function
check(x_position, y_position : word) : string;
procedure dispose_map(map_name
: map_pointer);
end;
var old_mouse_x, old_mouse_y : word;
picture_pointer : pointer;
picture_size : word;
Function getmousex : word;
Function getmousey : word;
Function leftpressed : boolean;
Function rightpressed : boolean;
Procedure mousewindow(l, t, r, b : word);
Procedure move_cursor_to(movetoX, movetoY :
word);
Procedure Initiate_mouse;
implementation
function getmousex : word; assembler; asm
mov ax,3; int 33h; mov ax,cx end;
function getmousey : word; assembler; asm
mov ax,3; int 33h; mov ax,dx end;
function leftpressed : boolean; assembler; asm
mov ax,3; int 33h; and bx,1; mov ax,bx end;
function rightpressed : boolean; assembler;
asm
mov ax,3; int 33h; and bx,2; mov ax,bx end;
procedure mousewindow(l, t, r, b : word); assembler;
asm
mov ax,7; mov cx,l; mov dx,r; int 33h; mov
ax,8
mov cx,t; mov dx,b; int 33h end;
procedure fetch_image(x, y : word);
var x2, y2 : word;
begin;
picture_size := ImageSize(x, y, x +
cursor_width, y + cursor_height);
GetMem(Picture_pointer, picture_size);
x2 := x + cursor_width;
If x2>639 then x2 := 639;
{never take snapshot outside of screen}
y2 := y + cursor_height; If y2>479
then y2 := 479;
{ this will cause an error..}
getimage(x, y, x2, y2, picture_pointer^);
{remember background}
end;
Procedure move_cursor_to(movetoX, movetoY :
word);
var cnt_1, cnt_2 : Integer;
color : byte;
begin;
If (old_mouse_x<>movetoX) or (old_mouse_y<>movetoY)
then
{update cursor if mouseposition has changed}
begin;
PutImage(old_mouse_x, old_mouse_y,
picture_pointer^, normalput);
{restore background}
old_mouse_x := movetoX;
{remeber old cordinates}
old_mouse_y := movetoY;
fetch_image(old_mouse_x,
old_mouse_y);
{take a snapshot of cursor background}
{=================== draw cursor===========================}
For cnt_1 := 0 to cursor_width
- 1 do
begin;
For cnt_2 :=
0 to cursor_height - 1 do
begin;
color := cursor_image[cnt_2, cnt_1];
If (color<>16) then
PutPixel(movetoX + cnt_1, movetoY + cnt_2,color);
end;
end;
{==========================================================}
end;
end;
Procedure Initiate_mouse;
begin;
mousewindow(0,0, 640, 480);
{initiate cursor}
old_mouse_x := 1;
old_mouse_y := 1;
fetch_image(old_mouse_x, old_mouse_y);
end;
constructor map.init_map;
begin;
last_map_item := nil;
end;
procedure map.add_item(item_to_add : map_item_pointer);
begin;
item_to_add^.next_item := last_map_item;
last_map_item := item_to_add;
end;
function map.check(x_position, y_position
: word) : string;
var check_item : map_item_pointer;
continue_loop : boolean;
begin;
continue_loop := true;
check_item := last_map_item;
while (check_item <> nil) and
(continue_loop) do
begin; {loop,
reads all the items and checks the cordinates}
{=========== Check cordinates
'n return do_procedure ===========}
If ((x_position > check_item^.x1)
and {greater than x1}
(x_position < check_item^.x1 + check_item^.w))
{not greater than x2}
and
((y_position > check_item^.y1) and
{greater than y1}
(y_position < check_item^.y1 + check_item^.h))
{not greater than y2}
then
begin; {if cordinate is within the defined
area do: }
check := check_item^.do_procedure;
continue_loop := false;
end;
{==================================================================}
check_item := check_item^.next_item;
end;
end;
procedure map.dispose_map(map_name : map_pointer);
var item_to_dispose : map_item_pointer;
begin;
while last_map_item <> nil do
begin;
item_to_dispose := last_map_item;
last_map_item := item_to_dispose^.next_item;
dispose(item_to_dispose);
end;
end;
constructor map_item.init_item(set_x1, set_y1,
set_w, set_h : word;
set_do_procedure : String);
begin;
x1 := set_x1;
y1 := set_y1;
w := set_w;
h := set_h;
do_procedure := set_do_procedure;
end;
end.
{=============== Sample Program
==============================}
{== Copy and paste everthing
underneath to a seperate file =========}
Program test_mouse_unit;
Uses mouse, graph, crt;
var temp_str : String;
{used to write text in graphic mode}
cnt : integer;
{used in procedure to remove text}
var Gd, Gm: Integer;
{used to initiate graphic mode}
use_map : map_pointer;
temp_string : String;
Begin {===== Initiate
graph ====}
Gd := Detect;
InitGraph(Gd, Gm, '');
if GraphResult <> grOk then
Halt(1);
cleardevice;
{make sure that screen is really clear}
delay(250);
cleardevice;
{======= graph initiated ========}
Initiate_mouse;
new(use_map, init_map);
{====== make some drawings
======}
setcolor(green); circle(200,200,100);
putpixel(150,150,red);
setcolor(yellow);
line(30,90,250,360);
rectangle(120,120,220,220);
setcolor(blue); for cnt :=250 to 300 do line(50,cnt,250,cnt);
{draw blue square}
{add maps}
use_map^.add_item(new(map_item_pointer, init_item(0,0,640,480,
'background image map')));
use_map^.add_item(new(map_item_pointer, init_item(120,
120, 220, 220 ,
'rectangle 120,120,220,220')));
use_map^.add_item(new(map_item_pointer, init_item(50,250,250,300,
'blue rectangle')));
moveto(50,10); outtext('Program to test mouse
unit. Lars Indres‘ter 1998');
moveto(50,30); setcolor(cyan); outtext('Hit
<ESC> to abandon program');
moveto(50,40); outtext('Left click to get mousecordinates');
repeat
{main loop}
move_cursor_to(getmousex, getmousey);
If leftpressed then
{write cordinates..}
begin;
setcolor(black);
for cnt:=70 to 86 do line(122,
cnt, 144, cnt);
setcolor(white);
moveto(50,70); str(getmousex,
temp_str);
outtext('Mouse
X= ' + temp_str);
moveto(50,80); str(getmousey,
temp_str);
outtext('Mouse
Y= ' + temp_str);
setcolor(black);
for cnt:=450 to 458 do
line(50,cnt,250,cnt);
setcolor(yellow);
temp_string := '';
temp_string := use_map^.check(GetMouseX,
GetMouseY);
If temp_string <> '' then moveto(50,450);
outtext(temp_string);
end;
until keypressed;
{end of main loop}
closegraph;
use_map^.dispose_map(use_map);
End.
Turbo Pascal links:
http://geo.meg-glaser.at/tp.html
Get your own FREE HOMEPAGE