您所在位置：主题：鼠标、按纽、汉字的源程序,启动时用 QB/L
qb45
[专家分：2880] 发布于 2004-04-15 18:17:00
'$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
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