![]() |
1. Заголовок или название темы должно быть информативным !
2. Все тексты фрагментов программ должны помещаться в теги [code] ... [/code] или [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ" и используйте ПОИСК !
4. НЕ используйте форум для личного общения!
5. Самое главное - это раздел теоретический, т.е. никаких задач и программ (за исключением небольших фрагментов) - для этого есть отдельный раздел!
![]() |
Sir |
![]()
Сообщение
#1
|
Пионер ![]() ![]() Группа: Пользователи Сообщений: 95 Пол: Мужской Репутация: ![]() ![]() ![]() |
Как можно сделать кнопку используя mouse.tpu и graph.tpu
Mouse.tpu содержит следующие процедуры и функции ( о назначении , думаю , можно догадаться по названию) : init , show , hide , xpos , ypos ,setpos , lbutton , rbutton , drbutton , dlbutton. Мне нужно по клику на одной кнопке заносить данные в переменную , а на другой вызывать одну процедуру. |
![]() ![]() |
mj |
![]()
Сообщение
#2
|
![]() Adminь ![]() ![]() ![]() ![]() Группа: Администраторы Сообщений: 803 Пол: Мужской Реальное имя: Евгений Репутация: ![]() ![]() ![]() |
Разбирайся сам
Код unit mouse; interface uses dos; type tcursor=record bitmask:array[1..64]of byte; x,y:byte; end; tproc=procedure; function getmousex:word; function getmousey:word; function initmouse:boolean; function getmousevisible:boolean; function getrightkeypress:boolean; function getleftkeypress:boolean; procedure movemouse(x,y:word); procedure setgraphmousecursor(cursor:tcursor); procedure setmovexrenge(minx,maxx:word); procedure setmoveyrenge(miny,maxy:word); procedure seteventprocdure(event:byte;proc:tproc); procedure deleventprocedure(event:byte); procedure mouseoff; procedure mouseon; implementation var leftkeypressproc,leftkeyunpressproc:procedure; rightkeypressproc,rigthkeyunpressproc:procedure; movemouseproc:procedure; standartproc:procedure; visible,rightkeypress,leftkeypress:boolean; sx,sy:word; leftkey,rightkey:boolean; keymouse:word; {$F+} procedure rkm; begin end; procedure lkm; begin write('left key unpress'); end; procedure mm; begin end; {$F-} procedure eventmouse;interrupt; var r:registers; begin inline ($9C); standartproc; if (getmousex<>sx)or(getmousey<>sy)then begin movemouseproc; sx:=getmousex; sy:=getmousey; end; r.ax:=3;intr($33,r); if keymouse<>r.bx then begin if (leftkey)and((r.bx=2)or(r.bx=0))then begin keymouse:=r.bx; write(r.bx); leftkey:=true; leftkeyunpressproc end; end; end; function getmousex:word; var r:registers; begin r.ax:=3; intr($33,r); getmousex:=r.cx; end; function getmousey:word; var r:registers; begin r.ax:=3; intr($33,r); getmousey:=r.dx; end; function initmouse:boolean; var r:registers; begin r.ax:=0;intr($33,r); if r.ax<>0 then begin getintvec($c,@standartproc); setintvec($c,@eventmouse); initmouse:=true end else initmouse:=false; end; function getmousevisible:boolean; begin getmousevisible:=visible end; function getrightkeypress:boolean; begin getrightkeypress:=rightkeypress; end; function getleftkeypress:boolean; begin getleftkeypress:=leftkeypress; end; procedure movemouse(x,y:word); var r:registers; begin r.ax:=4; r.cx:=x; r.dx:=y; intr($33,r); end; procedure setgraphmousecursor(cursor:tcursor); begin end; procedure setmovexrenge(minx,maxx:word); var r:registers; begin r.ax:=7; r.cx:=minx; r.dx:=maxx; intr($33,r) end; procedure setmoveyrenge(miny,maxy:word); var r:registers; begin r.ax:=8; r.cx:=miny; r.dx:=maxy; intr($33,r) end; procedure seteventprocdure(event:byte;proc:tproc); begin case event of 1:leftkeypressproc:=proc; 2:leftkeyunpressproc:=proc; 3:rightkeypressproc:=proc; 4:rigthkeyunpressproc:=proc; 5:movemouseproc:=proc; end; end; procedure deleventprocedure(event:byte); begin end; procedure mouseoff;assembler; asm mov ax,2 int 33h end; procedure mouseon;assembler; asm mov ax,1 int 33h end; begin leftkey:=true; seteventprocdure(5,mm); seteventprocdure(2,lkm); sx:=getmousex; sy:=getmousey; end. |
mj |
![]()
Сообщение
#3
|
![]() Adminь ![]() ![]() ![]() ![]() Группа: Администраторы Сообщений: 803 Пол: Мужской Реальное имя: Евгений Репутация: ![]() ![]() ![]() |
Вот ещё
Код unit mousen; interface uses dos; type tcursor=record bitmask:array[1..64]of byte; x,y:byte; end; tproc=procedure; function getmousex:word; function getmousey:word; function initmouse:boolean; function getmousevisible:boolean; function getrightkeypress:boolean; function getleftkeypress:boolean; procedure movemouse(x,y:word); procedure setgraphmousecursor(cursor:tcursor); procedure setmovexrenge(minx,maxx:word); procedure setmoveyrenge(miny,maxy:word); procedure seteventprocedure(event:byte;proc:tproc); procedure deleventprocedure(event:byte); procedure mouseoff; procedure mouseon; Procedure DoneMouse; implementation var leftkeypressproc,leftkeyunpressproc:procedure; rightkeypressproc,rigthkeyunpressproc:procedure; movemouseproc:procedure; standartproc:procedure; visible,rightkeypress,leftkeypress:boolean; sx,sy:word; mousestop,leftkey,rightkey:boolean; keymouse:word; {$F+} procedure rkm; begin end; procedure lkm; begin end; procedure mm; begin end; {$F-} procedure eventmouse;interrupt; var r:registers; begin inline ($9C); standartproc; if mousestop then exit; if (getmousex<>sx)or(getmousey<>sy)then begin movemouseproc; sx:=getmousex; sy:=getmousey; end; r.ax:=3;intr($33,r); if r.bx<>keymouse then begin keymouse:=r.bx; if ((r.bx=3)or(r.bx=1)) and not(leftkey) then begin leftkey:=true; leftkeypressproc end; if ((r.bx=0)or(r.bx=2)) and leftkey then begin leftkey:=false; leftkeyunpressproc end; if ((r.bx=3)or(r.bx=2)) and not(rightkey) then begin rightkey:=true; rightkeypressproc end; end; if ((r.bx=0)or(r.bx=1)) and rightkey then begin rightkey:=false; rigthkeyunpressproc end; end; function getmousex:word; var r:registers; begin r.ax:=3; intr($33,r); getmousex:=r.cx; end; function getmousey:word; var r:registers; begin r.ax:=3; intr($33,r); getmousey:=r.dx; end; function initmouse:boolean; var r:registers; begin r.ax:=0;intr($33,r); if r.ax<>0 then begin getintvec($c,@standartproc); setintvec($c,@eventmouse); initmouse:=true end else initmouse:=false; end; function getmousevisible:boolean; begin getmousevisible:=visible end; function getrightkeypress:boolean; begin getrightkeypress:=rightkeypress; end; function getleftkeypress:boolean; begin getleftkeypress:=leftkeypress; end; procedure movemouse(x,y:word); var r:registers; begin r.ax:=4; r.cx:=x; r.dx:=y; intr($33,r); end; procedure setgraphmousecursor(cursor:tcursor); begin end; procedure setmovexrenge(minx,maxx:word); var r:registers; begin r.ax:=7; r.cx:=minx; r.dx:=maxx; intr($33,r) end; procedure setmoveyrenge(miny,maxy:word); var r:registers; begin r.ax:=8; r.cx:=miny; r.dx:=maxy; intr($33,r) end; procedure seteventprocedure(event:byte;proc:tproc); begin case event of 1:leftkeypressproc:=proc; 2:leftkeyunpressproc:=proc; 3:rightkeypressproc:=proc; 4:rigthkeyunpressproc:=proc; 5:movemouseproc:=proc; end; end; procedure deleventprocedure(event:byte); begin end; procedure mouseoff; begin mousestop:=true; asm mov ax,2 int 33h end; end; procedure mouseon; begin mousestop:=false; asm mov ax,1 int 33h end; end; Procedure DoneMouse; begin setintvec($C,@standartproc) end; begin leftkey:=false; rightkey:=false; seteventprocedure(5,mm); seteventprocedure(2,lkm); seteventprocedure(1,rkm); seteventprocedure(3,lkm); seteventprocedure(4,rkm); sx:=getmousex; sy:=getmousey; end. |
![]() ![]() |
![]() |
Текстовая версия | 20.07.2025 12:15 |