中国DOS联盟论坛 - Powered by Discuz! Board

标题: 调用鼠标、按钮、汉字的源程序 [打印本页]

作者: qb45 时间: 2003-10-22 00:00 标题: 调用鼠标、按钮、汉字的源程序

'启动 QB 时请用此格式！ QB/L
'$INCLUDE: 'qb.bi'
DIM SHARED ok%(16, 16)  '读取“确定”这两个汉字的数据
FOR i = 1 TO 2
FOR j1 = 0 TO 12
      READ ok%(i, j1 + 1)
      ok%(i, 0) = -5
NEXT j1
NEXT i
ok%(0, 0) = i
ok%(0, 1) = 12
ok%(0, 2) = 12
Mouse.Setrage 0, 40, 600, 400  '设置鼠标
start '初始化
an 260, 150, "ok", 1  '显示按钮
mouse.show  '显示鼠标
'Demo  程序演示
LOCATE 1, 65: PRINT "Esc Key To Exit"  '按ESC键退出
DO
LOCATE 1, 1: PRINT "Mouse Left  "; mouse.down(1), "Mouse X = "; Mouse.X
LOCATE 2, 1: PRINT "Mouse Right "; mouse.down(2), "Mouse Y = "; Mouse.Y
k$ = INKEY$: IF k$ = CHR$(27) THEN EXIT DO  '当按下ESC键时退出DO循环
IF button.st(260, 150) THEN EXIT DO '当鼠标按下确定键时退出DO循环
LOOP
END

DATA 256 ,-1568 , 8768 , 10224 , 17040 , 31376 ,-13328 , 19088 , 19440 , 31376 , 17552 , 2224 ,
DATA 1024 , 512 , 32736 , 16416 , 16320 , 512 , 4608 , 5056 , 4608 , 10752 , 17920 ,-31760 ,

SUB an (an.x, an.y, word$, an.state)
'显示按纽的子程序
Mouse.Hide '隐藏鼠标
an.word$ = word$
an.w = 65: an.h = 16
black = 0
white = 7
brwhite = 15
brwhite1 = 14
gray = 11
gray1 = 8
an.x1 = an.x + an.w: an.y1 = an.y + an.h
ank.x = an.x - 3: ank.y = an.y - 3
ank.x1 = an.x1 + 3: ank.y1 = an.y1 + 3
SELECT CASE an.state
CASE 1 'xuan zhong 按纽释放状态
   'LINE (ank.x, ank.y)-(ank.x1, ank.y1), black, B
   hz an.x + 2, an.y + 1, an.word$, white
   hz an.x + 1, an.y, an.word$, black
CASE 2 'an xia  按纽按下状态
   SWAP brwhite, black: SWAP brwhite1, gray1
   hz an.x + 1, an.y, an.word$, white '显示汉字
   hz an.x + 2, an.y + 1, an.word$, brwhite
END SELECT
'xuan ankey shang xian
LINE (ank.x + 1, ank.y + 1)-(ank.x1 - 1, ank.y1 - 1), brwhite, B
LINE (ank.x + 2, ank.y + 2)-(ank.x1 - 2, ank.y1 - 2), brwhite1, B
'xuan ankey xia xian
LINE (ank.x + 1, ank.y1 - 1)-STEP(an.w + 4, 0), black
LINE (ank.x1 - 1, ank.y + 1)-STEP(0, an.h + 4), black
LINE (an.x - 1, an.y1 + 1)-STEP(an.w + 2, 0), gray1
LINE (an.x1 + 1, an.y - 1)-STEP(0, an.h + 2), gray1
mouse.show '显示鼠标
END SUB

FUNCTION button.st (x1, y1)
'判断按纽是否被按下的子程序
x = x1: y = y1: w$ = "ok"
an.w = 65: an.h = 16
button.st = 0
IF mouse.down(1) THEN
   DO WHILE Mouse.InBox(x, y, an.w, an.h)
   an x, y, w$, 2
   DO
      IF mouse.down(1) = 0 THEN an x, y, w$, 1: button.st=-1: EXIT FUNCTION
      IF Mouse.InBox(x, y, an.w, an.h) THEN
      ELSE
         an x, y, w$, 1
         EXIT DO
      END IF
   LOOP
   LOOP
END IF
END FUNCTION

SUB hz (hz.x, hz.y, hz.word$, hz.color)
'显示汉字的子程序
hz.x = hz.x + 20
hz.w = ok%(0, 2): hz.h = ok%(0, 1)
FOR i1 = 1 TO ok%(0, 0)
FOR i = 1 TO hz.h
      LINE (hz.x, hz.y + i)-STEP(hz.w, 0), hz.color, , ok%(i1, i)
NEXT i
hz.space = ok%(i1, 0)
hz.x = hz.x + 16 + hz.space
NEXT i1
END SUB

SUB kuang (x1, y1, x2, y2, mode)
'画方框的子程序
black = 0
white = 7
brwhite = 15
brwhite1 = 14
gray = 11
gray1 = 8
SELECT CASE mode
CASE 0
   LINE (x1, y1)-(x2, y2), white, BF
'xuan ankey shang xian
LINE (x1 - 2, y1 - 2)-(x2 + 2, y2 + 2), brwhite, B
LINE (x1 - 1, y1 - 1)-(x2 + 1, y2 + 1), brwhite1, B
'xuan ankey xia xian
LINE (x1 - 1, y2 + 1)-(x2 + 1, y2 + 1), black
LINE (x2 + 1, y1 - 1)-(x2 + 1, y2), black
LINE (x1 - 2, y2 + 2)-(x2 + 2, y2 + 2), gray1
LINE (x2 + 2, y1 - 2)-(x2 + 2, y2 + 2), gray1
END SELECT
EXIT SUB

END SUB

SUB Mouse (m1%, m2%, m3%, m4%)
'鼠标调用的子程序
DIM inreg  AS RegType, outreg AS RegType
inreg.ax = m1%
inreg.bx = m2%
inreg.cx = m3%
inreg.dx = m4%
INTERRUPT &H33, inreg, outreg
m1% = outreg.ax
m2% = outreg.bx
m3% = outreg.cx
m4% = outreg.dx
END SUB

FUNCTION mouse.down (button%)
'判断鼠标是否按下的子程序
   Mouse 3, Mouse.button%, x%, y%
   mouse.down = 0
IF button% = 1 THEN
   IF Mouse.button% = 1 THEN mouse.down = -1
END IF
IF button% = 2 THEN
   IF Mouse.button% = 2 THEN mouse.down = -1
END IF
END FUNCTION

SUB Mouse.Hide
'隐藏鼠标
Mouse 2, 0, 0, 0
END SUB

FUNCTION Mouse.InBox (box.x, box.y, box.w, box.h)
'判断鼠标是否在指定区域内的子程序
box.x1 = box.x + box.w: box.y1 = box.y + box.h
Mouse.InBox = 0
IF Mouse.X > box.x AND Mouse.Y > box.y THEN
      IF Mouse.X < box.x1 AND Mouse.Y < box.y1 THEN
      Mouse.InBox = -1
      END IF
END IF
END FUNCTION

SUB Mouse.Setrage (x%, y%, w%, H%)
'设置鼠标的移动范围
Mouse 7, 0, x%, x% + w%
Mouse 8, 0, y%, y% + H%
END SUB

SUB mouse.show
'显示鼠标
Mouse 1, 0, 0, 0
END SUB

SUB Mouse.State (x%, y%, Mouse.button%)
'鼠标状态
Mouse 3, Mouse.button%, x%, y%
END SUB

FUNCTION Mouse.X
'鼠标横坐标
Mouse 3, Mouse.button%, x%, y%
Mouse.X = x%

END FUNCTION

FUNCTION Mouse.Y
'鼠标竖坐标
Mouse 3, Mouse.button%, x%, y%
Mouse.Y = y%
END FUNCTION

SUB setcolor (color.num, red, green, blue)
'设置调色板
PALETTE color.num, 65536 * red + 256 * green + blue
END SUB

SUB start
'初始化
SCREEN 12
setcolor 7, 48, 48, 48
setcolor 15, 63, 63, 63
setcolor 14, 55, 55, 55
setcolor 8, 32, 32, 32
setcolor 0, 0, 0, 0
setcolor 1, 42, 42, 0
setcolor 2, 42, 42, 0
LINE (0, 40)-(640, 480), 1, BF
kuang 200, 100, 400, 250, 0
END SUB

作者: lemonhall 时间: 2003-10-23 00:00
支持。

作者: warm 时间: 2003-10-23 00:00
正在学习。

作者: iceboy 时间: 2003-10-24 00:00
setcolor 好像是 RGB(64,64,64) 的，能不能改成大家更习惯的 256,256,256 呢？
似乎很简单。。。

注释：
setcolor()
1.修改背景颜色时就把 color.num = 0 就行了
2.无论怎样修改颜色, 记住, 在 screen 12 下, 屏幕上一共只能显示 16 色, 所以能用抖动效果产生的颜色就尽量不要耗费 color 的数量。
mouse
我不想多说了, 它是通过调用 mouse 驱动程序的中断实现的鼠标调用, 不过和 ctmouse 有微小的不兼容。比如：
mouseon
do
print "aaaaaaaaaaaaaaaaaaaaaaaaaa"
loop

如果你执行上面这个程序，然后不停地移动鼠标，在使用 ctmouse 1.9/2.0 的情况下, 很快就会出现 stacks overflow error，而 M$ 的 mouse.com 就不会。

另外, 希望 qb45 尽快写出一个调用比较方便的 VESA(即 SVGA 通用接口) 函数库。

作者: 凌晨一点 时间: 2003-10-24 00:00
能用QB写出这些东东，真的满不错啊。
鼠标的光标用自己画的更个性点。
加油啊！

作者: liangkove 时间: 2003-10-25 00:00
有没有Ｃ的源程序呀？？请问

作者: Bander 时间: 2003-10-27 00:00

Quote:

以下是引用iceboy在2003-10-24 22:03:40的发言：
另外, 希望 qb45 尽快写出一个调用比较方便的 VESA(即 SVGA 通用接口) 函数库。

已经有了，支持到1024×768×16M色的

作者: qb45 时间: 2003-10-28 00:00
源程序在此，请随便修改使用！
我不会C！没发写函数，不过知道原理了用什么语言写都不难！
要改变鼠标的形状也是很简单的！MOUSE （M1%，M2%，M3%，M4%）是鼠标调用，M1%=9的时候就可以改变形状了！
你自己找找资料，试试看，并不难！做的时候有可能要用到以下语句，我告诉你用法！
OUT P,D '功能I O通道的输出，P是地址，D是数据
INP (P) '功能I O通道的输入，P是地址
POKE A,D '功能写内存，A是偏移量，D是数据
PEEK(A) '功能读内存
DEF SEG＝A '功能设置段址，A是段址
VARSEG(A$) '功能,返回A$的段址
SADD(A$) '功能,返回A$的偏移地址