您所在位置：主题：[原创]模拟windows界面
飞鸟12
[专家分：2830] 发布于 2005-05-14 10:38:00
[size=4]关于下面程序的运行[/size]
新建一 记事本 文件，把下面的程序粘贴进记事本，另存为 mouse.bas 所有文件.
再新建一 记事本 文件，输入如下内容：
@echo off
cd E:\qb\qb45
qb mouse.bas /l
echo.
另存为 startqb.bat ，所有文件。
双击这个批处理文件，即可打开QB
'$INCLUDE: 'qb.bi'
DECLARE SUB loadmouse ()
DECLARE SUB clearmouse (cx%, dx%, move%)
DECLARE SUB putmouse (cx%, dx%, move%)
DECLARE SUB Mouse (ax%, bx%, cx%, dx%)
DECLARE SUB loadpalettes ()
DECLARE SUB drawwin (l%, t%, w%, h%, class$)
DECLARE SUB loadletters ()
DECLARE SUB putletters (x%, y%, letters$, colour$)
DIM SHARED mouseshapew(100), mouseshapeb(100), bkground(100)
DIM SHARED fonw(1 TO 1880), fonb(1 TO 1880)
SCREEN 12: CLS
cx% = 1: dx% = 1: move% = 1
CALL loadmouse
CALL loadpalettes
CALL loadletters
LINE (0, 0)-(639, 479), 6, BF
CALL putmouse(cx%, dx%, move%)
CALL drawwin(50, 50, 300, 300, "Window")
CALL putletters(55, 55, "Windows", "White")
CALL drawwin(100, 100, 200, 30, "Text")
CALL drawwin(200, 200, 50, 30, "Buttom")
CALL putletters(215, 210, "YES", "Black")
DO
timenow$ = TIME$
CALL putletters(160, 108, timenow$, "Black")
tim = TIMER + 1
WHILE TIMER < tim
CALL clearmouse(cx%, dx%, move%)
CALL putmouse(cx%, dx%, move%)
WEND
CALL putletters(160, 108, timenow$, "White")
LOOP
SUB loadmouse
' mouseshape1$ = "c8 m+12,+10 m-6,0 m+5,+10 m-2,+1 m-5,-10 m-4,+4 m+0,-15bm+2,+5p7,8bm-2,-5"
' mouseshape2$ = "c8 m+12,+10c7 m-6,0c8 m+5,+10 m-2,+1c15 m-5,-10c8 m-4,+4c15 m+0,-15"
' LINE (1, 1)-(15, 25), 15, BF
' PSET (2, 2): DRAW mouseshape1$ + mouseshape2$
' GET (2, 2)-STEP(12, 21), mouseshapew '取白色背景上的鼠标
' LINE (15, 1)-(30, 25), 0, BF
' PSET (16, 2): DRAW mouseshape1$ + mouseshape2$
' GET (16, 2)-STEP(12, 21), mouseshapeb '取黑色背景上的鼠标
' LINE (1, 1)-(30, 25), 0, BF
mouseshape$ = "d14e3f1d1f1d1f1r2u2h1u1h1u1r5h10"
LINE (1, 1)-(15, 25), 15, BF
PSET (2, 2): DRAW "c0" + mouseshape$
GET (2, 2)-STEP(11, 16), mouseshapew '取白色背景上的鼠标
LINE (15, 1)-(30, 25), 0, BF
PSET (16, 2): DRAW "c15" + mouseshape$ + "bm+2,+6p15,15"
PSET (16, 2): DRAW "c0" + mouseshape$
GET (16, 2)-STEP(11, 16), mouseshapeb '取黑色背景上的鼠标
LINE (1, 1)-(30, 25), 0, BF
END SUB
SUB clearmouse (cx%, dx%, move%)
CALL Mouse(3, bx%, newx%, newy%)
IF cx% < 1 THEN cx% = 1
IF dx% < 1 THEN dx% = 1
IF cx% > 627 THEN cx% = 627
IF dx% > 458 THEN dx% = 458
IF newx% <> cx% OR newy% <> dx% THEN
move% = 1
PUT (cx%, dx%), bkground, PSET
cx% = newx%
dx% = newy%
END IF
END SUB
SUB putmouse (cx%, dx%, move%)
IF cx% < 1 THEN cx% = 1
IF dx% < 1 THEN dx% = 1
IF cx% > 627 THEN cx% = 627
IF dx% > 458 THEN dx% = 458
IF move% = 1 THEN
move% = 0
GET (cx%, dx%)-STEP(12, 21), bkground
PUT (cx%, dx%), mouseshapew, AND
PUT (cx%, dx%), mouseshapeb, OR
END IF
END SUB
SUB Mouse (ax%, bx%, cx%, dx%)
DIM inreg AS RegType, outreg AS RegType
inreg.ax = ax%
inreg.bx = bx%
inreg.cx = cx%
inreg.dx = dx%
INTERRUPT &H33, inreg, outreg
ax% = outreg.ax
bx% = outreg.bx
cx% = outreg.cx
dx% = outreg.dx
END SUB
SUB loadpalettes
PALETTE 0, 0 * (1 + 256 + 65536)
PALETTE 6, 44 * (1 + 256 + 65536)
PALETTE 7, 52 * (1 + 256 + 65536)
PALETTE 8, 28 * (1 + 256 + 65536)
PALETTE 15, 63 * (1 + 256 + 65536)
END SUB
SUB drawwin (l%, t%, w%, h%, class$)
SELECT CASE class$
CASE "Window", "Buttom"
color1% = 6: color2% = 15: color3% = 7: color4% = 6: color5% = 8: color6% = 0
CASE "ButtomGetFocus"
color1% = 0: color2% = 15: color3% = 7: color4% = 6: color5% = 8: color6% = 0
CASE "ButtomPress"
color1% = 6: color2% = 0: color3% = 8: color4% = 6: color5% = 8: color6% = 0
CASE "Text"
color1% = 6: color2% = 8: color3% = 0: color4% = 15: color5% = 7: color6% = 15
CASE ELSE
EXIT SUB
END SELECT
LINE (l% - 1, t% - 1)-STEP(w% + 1, h% + 1), color1%, B
LINE (l%, t%)-STEP(w% - 1, h% - 1), color6%, B
LINE (l% + 1, t% + 1)-STEP(w% - 3, h% - 3), color5%, B
LINE (l% + 2, t% + 2)-STEP(w% - 5, h% - 5), color4%, BF
PSET (l%, t%)
DRAW "c" + STR$(color2%) + "nd" + STR$(h% - 1) + "nr" + STR$(w% - 1) + "bm+1,+1"
DRAW "c" + STR$(color3%) + "nd" + STR$(h% - 3) + "r" + STR$(w% - 3)
IF class$ = "Window" THEN
LINE (l% + 2, t% + 2)-STEP(w% - 5, 20), 1, BF
'画最小化
CALL drawwin(l% + w% - 52, t% + 5, 15, 15, "Buttom")
PSET (l% + w% - 49, t% + 15): DRAW "c0r8u1l8"
'画最大化
CALL drawwin(l% + w% - 36, t% + 5, 15, 15, "Buttom")
PSET (l% + w% - 33, t% + 8): DRAW "c0r8d8l8u7r7"
'画关闭
CALL drawwin(l% + w% - 20, t% + 5, 15, 15, "Buttom")
PSET (l% + w% - 17, t% + 8): DRAW "c0f8r1h8br7g8r1e8"
END IF
END SUB
SUB loadletters
DIM letter(1 TO 20)
FOR i = 0 TO 93
LOCATE 1, 1: PRINT CHR$(i + 32)
GET (0, 0)-STEP(7, 15), letter
FOR j = 1 TO 20
fonw(20 * i + j) = letter(j)
NEXT j
LINE (8, 0)-STEP(7, 15), 15, BF
PUT (8, 0), letter, XOR
GET (8, 0)-STEP(7, 15), letter
FOR j = 1 TO 20
fonb(20 * i + j) = letter(j)
NEXT j
NEXT i
END SUB
SUB putletters (x%, y%, letters$, colour$)
REM colour$: White Black
DIM letter(1 TO 20), bg(1 TO 20)
LettersLen = LEN(letters$)
FOR i = 1 TO LettersLen
LAsc = ASC(MID$(letters$, i, 1)) - 32
IF colour$ = "White" THEN
FOR j = 1 TO 20
letter(j) = fonw(20 * LAsc + j)
NEXT j
PUT (x% + 8 * i - 8, y%), letter, OR
ELSEIF colour$ = "Black" THEN
FOR j = 1 TO 20
letter(j) = fonb(20 * LAsc + j)
NEXT j
PUT (x% + 8 * i - 8, y%), letter, AND
END IF
NEXT i
END SUB
关于程序的几点说明：
1.程序目前还不完善，还未加入对鼠标的响应
2.鼠标透明效果的实现
1 ** 背景 操作 前景 最终效果
2 * * 0 AND 1 0
3 * * 1 1 1
4 * * 即白（11）与背景（01）做AND 操作后仍显示为背景
5 * * 0 OR 0 0
6 * * 1 0 1
7 * * 即黑（00）与背景（01）做OR 操作后仍显示为背景
8 * *
9 * * 背景 操作 前景w 最终效果1
0 * ***** 0 0 0
1 * * * 1 AND 0 0
2 * * * * 0 1 0
3 ** * * 1 1 1
4 * * * 最终效果1 操作 前景b 最终效果2
5 * * 0 0 0
6 *** 0 OR 0 0
0 1 1
1 1 1
注：前景w是指在白色背景上画的鼠标图案，其中白色部分在与背景做AND操作;效果为透明
前景b是指在黑色背景上画的鼠标图案，其中黑色部分在与背景做OR操作;效果也是透明
新建一 记事本 文件，把下面的程序粘贴进记事本，另存为 mouse.bas 所有文件.
再新建一 记事本 文件，输入如下内容：
@echo off
cd E:\qb\qb45
qb mouse.bas /l
echo.
另存为 startqb.bat ，所有文件。
双击这个批处理文件，即可打开QB
'$INCLUDE: 'qb.bi'
DECLARE SUB loadmouse ()
DECLARE SUB clearmouse (cx%, dx%, move%)
DECLARE SUB putmouse (cx%, dx%, move%)
DECLARE SUB Mouse (ax%, bx%, cx%, dx%)
DECLARE SUB loadpalettes ()
DECLARE SUB drawwin (l%, t%, w%, h%, class$)
DECLARE SUB loadletters ()
DECLARE SUB putletters (x%, y%, letters$, colour$)
DIM SHARED mouseshapew(100), mouseshapeb(100), bkground(100)
DIM SHARED fonw(1 TO 1880), fonb(1 TO 1880)
SCREEN 12: CLS
cx% = 1: dx% = 1: move% = 1
CALL loadmouse
CALL loadpalettes
CALL loadletters
LINE (0, 0)-(639, 479), 6, BF
CALL putmouse(cx%, dx%, move%)
CALL drawwin(50, 50, 300, 300, "Window")
CALL putletters(55, 55, "Windows", "White")
CALL drawwin(100, 100, 200, 30, "Text")
CALL drawwin(200, 200, 50, 30, "Buttom")
CALL putletters(215, 210, "YES", "Black")
DO
timenow$ = TIME$
CALL putletters(160, 108, timenow$, "Black")
tim = TIMER + 1
WHILE TIMER < tim
CALL clearmouse(cx%, dx%, move%)
CALL putmouse(cx%, dx%, move%)
WEND
CALL putletters(160, 108, timenow$, "White")
LOOP
SUB loadmouse
' mouseshape1$ = "c8 m+12,+10 m-6,0 m+5,+10 m-2,+1 m-5,-10 m-4,+4 m+0,-15bm+2,+5p7,8bm-2,-5"
' mouseshape2$ = "c8 m+12,+10c7 m-6,0c8 m+5,+10 m-2,+1c15 m-5,-10c8 m-4,+4c15 m+0,-15"
' LINE (1, 1)-(15, 25), 15, BF
' PSET (2, 2): DRAW mouseshape1$ + mouseshape2$
' GET (2, 2)-STEP(12, 21), mouseshapew '取白色背景上的鼠标
' LINE (15, 1)-(30, 25), 0, BF
' PSET (16, 2): DRAW mouseshape1$ + mouseshape2$
' GET (16, 2)-STEP(12, 21), mouseshapeb '取黑色背景上的鼠标
' LINE (1, 1)-(30, 25), 0, BF
mouseshape$ = "d14e3f1d1f1d1f1r2u2h1u1h1u1r5h10"
LINE (1, 1)-(15, 25), 15, BF
PSET (2, 2): DRAW "c0" + mouseshape$
GET (2, 2)-STEP(11, 16), mouseshapew '取白色背景上的鼠标
LINE (15, 1)-(30, 25), 0, BF
PSET (16, 2): DRAW "c15" + mouseshape$ + "bm+2,+6p15,15"
PSET (16, 2): DRAW "c0" + mouseshape$
GET (16, 2)-STEP(11, 16), mouseshapeb '取黑色背景上的鼠标
LINE (1, 1)-(30, 25), 0, BF
END SUB
SUB clearmouse (cx%, dx%, move%)
CALL Mouse(3, bx%, newx%, newy%)
IF cx% < 1 THEN cx% = 1
IF dx% < 1 THEN dx% = 1
IF cx% > 627 THEN cx% = 627
IF dx% > 458 THEN dx% = 458
IF newx% <> cx% OR newy% <> dx% THEN
move% = 1
PUT (cx%, dx%), bkground, PSET
cx% = newx%
dx% = newy%
END IF
END SUB
SUB putmouse (cx%, dx%, move%)
IF cx% < 1 THEN cx% = 1
IF dx% < 1 THEN dx% = 1
IF cx% > 627 THEN cx% = 627
IF dx% > 458 THEN dx% = 458
IF move% = 1 THEN
move% = 0
GET (cx%, dx%)-STEP(12, 21), bkground
PUT (cx%, dx%), mouseshapew, AND
PUT (cx%, dx%), mouseshapeb, OR
END IF
END SUB
SUB Mouse (ax%, bx%, cx%, dx%)
DIM inreg AS RegType, outreg AS RegType
inreg.ax = ax%
inreg.bx = bx%
inreg.cx = cx%
inreg.dx = dx%
INTERRUPT &H33, inreg, outreg
ax% = outreg.ax
bx% = outreg.bx
cx% = outreg.cx
dx% = outreg.dx
END SUB
SUB loadpalettes
PALETTE 0, 0 * (1 + 256 + 65536)
PALETTE 6, 44 * (1 + 256 + 65536)
PALETTE 7, 52 * (1 + 256 + 65536)
PALETTE 8, 28 * (1 + 256 + 65536)
PALETTE 15, 63 * (1 + 256 + 65536)
END SUB
SUB drawwin (l%, t%, w%, h%, class$)
SELECT CASE class$
CASE "Window", "Buttom"
color1% = 6: color2% = 15: color3% = 7: color4% = 6: color5% = 8: color6% = 0
CASE "ButtomGetFocus"
color1% = 0: color2% = 15: color3% = 7: color4% = 6: color5% = 8: color6% = 0
CASE "ButtomPress"
color1% = 6: color2% = 0: color3% = 8: color4% = 6: color5% = 8: color6% = 0
CASE "Text"
color1% = 6: color2% = 8: color3% = 0: color4% = 15: color5% = 7: color6% = 15
CASE ELSE
EXIT SUB
END SELECT
LINE (l% - 1, t% - 1)-STEP(w% + 1, h% + 1), color1%, B
LINE (l%, t%)-STEP(w% - 1, h% - 1), color6%, B
LINE (l% + 1, t% + 1)-STEP(w% - 3, h% - 3), color5%, B
LINE (l% + 2, t% + 2)-STEP(w% - 5, h% - 5), color4%, BF
PSET (l%, t%)
DRAW "c" + STR$(color2%) + "nd" + STR$(h% - 1) + "nr" + STR$(w% - 1) + "bm+1,+1"
DRAW "c" + STR$(color3%) + "nd" + STR$(h% - 3) + "r" + STR$(w% - 3)
IF class$ = "Window" THEN
LINE (l% + 2, t% + 2)-STEP(w% - 5, 20), 1, BF
'画最小化
CALL drawwin(l% + w% - 52, t% + 5, 15, 15, "Buttom")
PSET (l% + w% - 49, t% + 15): DRAW "c0r8u1l8"
'画最大化
CALL drawwin(l% + w% - 36, t% + 5, 15, 15, "Buttom")
PSET (l% + w% - 33, t% + 8): DRAW "c0r8d8l8u7r7"
'画关闭
CALL drawwin(l% + w% - 20, t% + 5, 15, 15, "Buttom")
PSET (l% + w% - 17, t% + 8): DRAW "c0f8r1h8br7g8r1e8"
END IF
END SUB
SUB loadletters
DIM letter(1 TO 20)
FOR i = 0 TO 93
LOCATE 1, 1: PRINT CHR$(i + 32)
GET (0, 0)-STEP(7, 15), letter
FOR j = 1 TO 20
fonw(20 * i + j) = letter(j)
NEXT j
LINE (8, 0)-STEP(7, 15), 15, BF
PUT (8, 0), letter, XOR
GET (8, 0)-STEP(7, 15), letter
FOR j = 1 TO 20
fonb(20 * i + j) = letter(j)
NEXT j
NEXT i
END SUB
SUB putletters (x%, y%, letters$, colour$)
REM colour$: White Black
DIM letter(1 TO 20), bg(1 TO 20)
LettersLen = LEN(letters$)
FOR i = 1 TO LettersLen
LAsc = ASC(MID$(letters$, i, 1)) - 32
IF colour$ = "White" THEN
FOR j = 1 TO 20
letter(j) = fonw(20 * LAsc + j)
NEXT j
PUT (x% + 8 * i - 8, y%), letter, OR
ELSEIF colour$ = "Black" THEN
FOR j = 1 TO 20
letter(j) = fonb(20 * LAsc + j)
NEXT j
PUT (x% + 8 * i - 8, y%), letter, AND
END IF
NEXT i
END SUB
关于程序的几点说明：
1.程序目前还不完善，还未加入对鼠标的响应
2.鼠标透明效果的实现
1 ** 背景 操作 前景 最终效果
2 * * 0 AND 1 0
3 * * 1 1 1
4 * * 即白（11）与背景（01）做AND 操作后仍显示为背景
5 * * 0 OR 0 0
6 * * 1 0 1
7 * * 即黑（00）与背景（01）做OR 操作后仍显示为背景
8 * *
9 * * 背景 操作 前景w 最终效果1
0 * ***** 0 0 0
1 * * * 1 AND 0 0
2 * * * * 0 1 0
3 ** * * 1 1 1
4 * * * 最终效果1 操作 前景b 最终效果2
5 * * 0 0 0
6 *** 0 OR 0 0
0 1 1
1 1 1
注：前景w是指在白色背景上画的鼠标图案，其中白色部分在与背景做AND操作;效果为透明
前景b是指在黑色背景上画的鼠标图案，其中黑色部分在与背景做OR操作;效果也是透明
