China DOS Union

'Please use this format when starting QB! QB/L
'$INCLUDE: 'qb.bi'
DIM SHARED ok%(16, 16) 'Read the data for the two Chinese characters “确定”
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 'Set the mouse
start 'Initialize
an 260, 150, "ok", 1 'Display the button
mouse.show 'Display the mouse
'Demo Program demonstration
LOCATE 1, 65: PRINT "Esc Key To Exit" 'Press the ESC key to exit
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 'When ESC is pressed, exit the DO loop
IF button.st(260, 150) THEN EXIT DO 'When the mouse presses the OK button, exit the DO loop
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)
'Subroutine to display the button
Mouse.Hide 'Hide the mouse
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 button released state
'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 button pressed state
SWAP brwhite, black: SWAP brwhite1, gray1
hz an.x + 1, an.y, an.word$, white 'Display Chinese characters
hz an.x + 2, an.y + 1, an.word$, brwhite
END SELECT
'xuan ankey top border
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 bottom border
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 'Display the mouse
END SUB

FUNCTION button.st (x1, y1)
'Subroutine to determine whether the button has been pressed
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)
'Subroutine to display Chinese characters
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)
'Subroutine to draw a box
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 top border
LINE (x1 - 2, y1 - 2)-(x2 + 2, y2 + 2), brwhite, B
LINE (x1 - 1, y1 - 1)-(x2 + 1, y2 + 1), brwhite1, B
'xuan ankey bottom border
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%)
'Subroutine for mouse calls
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%)
'Subroutine to determine whether the mouse button is pressed
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
'Hide the mouse
Mouse 2, 0, 0, 0
END SUB

FUNCTION Mouse.InBox (box.x, box.y, box.w, box.h)
'Subroutine to determine whether the mouse is within the specified area
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%)
'Set the mouse movement range
Mouse 7, 0, x%, x% + w%
Mouse 8, 0, y%, y% + H%
END SUB

SUB mouse.show
'Display the mouse
Mouse 1, 0, 0, 0
END SUB

SUB Mouse.State (x%, y%, Mouse.button%)
'Mouse state
Mouse 3, Mouse.button%, x%, y%
END SUB

FUNCTION Mouse.X
'Mouse horizontal coordinate
Mouse 3, Mouse.button%, x%, y%
Mouse.X = x%

END FUNCTION

FUNCTION Mouse.Y
'Mouse vertical coordinate
Mouse 3, Mouse.button%, x%, y%
Mouse.Y = y%
END FUNCTION

SUB setcolor (color.num, red, green, blue)
'Set the palette
PALETTE color.num, 65536 * red + 256 * green + blue
END SUB

SUB start
'Initialize
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

Support

Currently learning.

setcolor seems to use RGB(64,64,64); can it be changed to the more familiar 256,256,256?
It seems very simple...

Notes:
setcolor()
1. When modifying the background color, just set color.num = 0
2. No matter how you modify the colors, remember that under screen 12, the screen can only display 16 colors total, so for colors that can be produced with dithering effects, try not to waste color slots on them.
mouse
I don't want to say much more about it. It implements mouse calls by invoking the mouse driver's interrupt, but it has slight incompatibility with ctmouse. For example:
mouseon
do
print "aaaaaaaaaaaaaaaaaaaaaaaaaa"
loop

If you run the above program and keep moving the mouse, when using ctmouse 1.9/2.0, a stacks overflow error will appear very quickly, but M$'s mouse.com will not.

Also, I hope qb45 can write a VESA (that is, SVGA universal interface) function library with more convenient calling soon.

Being able to write this stuff in QB is really pretty impressive.
It would be more distinctive if the mouse cursor were self-drawn.
Keep it up!

Is there any C source code??

The following is quoted from iceboy's post on 2003-10-24 22:03:40:
Also,&nbsp;I hope&nbsp;qb45&nbsp;can write a&nbsp;VESA(that is,&nbsp;SVGA&nbsp;universal interface)&nbsp;function library with more convenient calling soon.

There already is one, it supports up to 1024×768×16M colors

The source code is here, feel free to modify and use it!
I don't know C! I can't write functions, but once you know the principle, it isn't hard to write it in any language!
Changing the mouse shape is also very simple! MOUSE （M1%，M2%，M3%，M4%） is the mouse call, and when M1%=9 you can change the shape!
Look up some materials yourself and give it a try, it's not hard!
You may need the following statements when doing it, so I'll tell you how to use them!
OUT P,D 'Function: output to the I/O channel, P is the address, D is the data
INP (P) 'Function: input from the I/O channel, P is the address
POKE A,D 'Function: write memory, A is the offset, D is the data
PEEK(A) 'Function: read memory
DEF SEG＝A 'Function: set segment address, A is the segment address
VARSEG(A$) 'Function: returns the segment address of A$
SADD(A$) 'Function: returns the offset address of A$