主题:给QB45
在QQ上找不到你,所以发我这里
扩展的功能你自己写了(滚动的)
以下是源码:
DECLARE SUB MouseBorder (x1%, y1%, x2%, y2%)
DECLARE SUB MouseHide ()
DECLARE SUB MouseShow ()
DECLARE SUB SetBack (x%, y%, slen%, BfClr%, BkClr%)
DECLARE SUB RamPrn (x%, y%, pStr$, BfClr%, BkClr%)
DECLARE SUB DrawBox (x1%, y1%, x2%, y2%, BfClr%, BkClr%, Over%)
DECLARE FUNCTION TxtSelect% (x1%, y1%, x2%, y2%)
DECLARE FUNCTION MouseMove% ()
DECLARE FUNCTION MouseDownLeft% ()
DECLARE FUNCTION MouseX% ()
DECLARE FUNCTION MouseY% ()
'INCLUDE: 'general.bi'
DEFINT A-Z
CLS
RamPrn 1, 29, "TxtSelect Demo", 7, 0
DrawBox 2, 4, 21, 71, 7, 0, 0
FOR i% = 3 TO 20
RamPrn i%, 5, "123456789012345678901234567890123456789012345678901234567890123456", 7, 1
NEXT
MouseBorder 3, 5, 20, 70
MouseShow
WHILE INKEY$ <> CHR$(27)
IF MouseDownLeft THEN
a = TxtSelect(x1%, y1%, x2%, y2%)
END IF
WEND
MouseHide
SUB DrawBox (x1%, y1%, x2%, y2%, BfClr%, BkClr%, Over%)
RamPrn x1%, y1%, chr$(218), BfClr%, BkClr%
RamPrn x1%, y2%, chr$(191), BfClr%, BkClr%
RamPrn x2%, y1%, chr$(192), BfClr%, BkClr%
RamPrn x2%, y2%, chr$(217), BfClr%, BkClr%
FOR i% = x1% + 1 TO x2% - 1
RamPrn i%, y1%, chr$(179), BfClr%, BkClr%
RamPrn i%, y2%, chr$(179), BfClr%, BkClr%
NEXT
FOR i% = y1% + 1 TO y2% - 1
RamPrn x1%, i%, chr$(196), BfClr%, BkClr%
RamPrn x2%, i%, chr$(196), BfClr%, BkClr%
NEXT
IF Over% = 0 THEN EXIT SUB
spc$ = SPACE$(y2% - y1% - 1)
FOR i% = x1% + 1 TO x2% - 1
RamPrn i%, y1% + 1, spc$, BfClr%, BkClr%
NEXT
END SUB
SUB RamPrn (x%, y%, pStr$, BfClr%, BkClr%)
'直接写内存 X%,Y%坐标X:1-25,Y:1-80
'pStr$ 要写到屏幕的字符串
'BfClr%,BkClr% 前景色和背景色
IF LEN(pStr$) = 0 THEN EXIT SUB
Clr% = BkClr% * 16 + BfClr%
Bgn% = x% * 160 + y% * 2 - 164
slen% = LEN(pStr$)
DEF SEG = &HB800
FOR i% = 1 TO slen%
POKE Bgn% + i% * 2, ASC(MID$(pStr$, i%, 1))
POKE Bgn% + i% * 2 + 1, Clr%
NEXT
DEF SEG
END SUB
SUB SetBack (x%, y%, slen%, BfClr%, BkClr%)
'设置文本背景色
Clr% = BkClr% * 16 + BfClr%
Bgn% = x% * 160 + y% * 2 - 164
DEF SEG = &HB800
FOR i% = 1 TO slen%
POKE Bgn% + i% * 2 + 1, Clr%
NEXT
DEF SEG
END SUB
FUNCTION TxtSelect% (x1%, y1%, x2%, y2%)
STATIC Mx%, My%, x%, y% '储存上次选择的区域以便下次调用时恢复
CONST Ex1% = 3, Ey1% = 5, Ex2% = 20, Ey2% = 70 '编辑区域
CONST BfClr% = 7, BkClr% = 1 '前景色和背景色
IF x% > Mx% THEN UD% = -1 ELSE UD% = 1 '恢复上次选择的区域
FOR i% = x% TO Mx% STEP UD%
SetBack i%, Ey1%, Ey2% - Ey1% + 1, BfClr%, BkClr%
NEXT
x% = MouseX '得到鼠标按下时的坐标
y% = MouseY
Mx% = x%: My% = y%
MouseShow
WHILE MouseDownLeft = TRUE '鼠标左键抬起时退出
IF MouseMove THEN '鼠标移动到这个位置
MouseHide
Cx% = MouseX
Cy% = MouseY
IF Cx% <> Mx% THEN '鼠标拖动时不在原来的行
IF x% > Mx% THEN UD% = -1 ELSE UD% = 1
FOR i% = x% TO Mx% STEP UD%
SetBack i%, Ey1%, Ey2% - Ey1% + 1, BfClr%, BkClr%
NEXT
IF y% > Cy% THEN
SetBack x%, Cy%, y% - Cy%, BkClr%, BfClr%
ELSE
SetBack x%, y%, Cy% - y%, BkClr%, BfClr%
END IF
IF x% > Cx% THEN UD% = -1 ELSE UD% = 1
IF Cx% <> x% THEN
FOR i% = x% TO Cx% STEP UD%
SetBack i%, Ey1%, Ey2% - Ey1% + 1, BkClr%, BfClr%
NEXT
END IF
Mx% = Cx%
END IF
IF Cy% <> My% AND x% = Cx% THEN '鼠标在原来行拖动
IF y% > My% THEN
SetBack x%, My%, y% - My%, BfClr%, BkClr%
ELSE
SetBack x%, y%, My% - y%, BfClr%, BkClr%
END IF
IF y% > Cy% THEN
SetBack x%, Cy%, y% - Cy%, BkClr%, BfClr%
ELSE
SetBack x%, y%, Cy% - y%, BkClr%, BfClr%
END IF
My% = Cy%
END IF
MouseShow
END IF
WEND
'鼠标最后在原来位置
IF x% = MouseX AND y% = MouseY THEN EXIT FUNCTION
'返回选择的区域
x1% = x%
y1% = y%
x2% = Mx%
y2% = My%
IF x2% < x1% THEN SWAP x2%, x1%
IF y2% < y1% THEN SWAP y2%, y1%
TxtSelect% = -1
END FUNCTION
SUB MouseBorder (x1%, y1%, x2%, y2%)
DIM Regs AS RegType
Regs.ax = 7
Regs.cx = (y1% - 1) * 8
Regs.dx = (y2% - 1) * 8
Interrupt 51, Regs, Regs
Regs.ax = 8
Regs.cx = (x2% - 1) * 8
Regs.dx = (x1% - 1) * 8
Interrupt 51, Regs, Regs
END SUB
FUNCTION MouseDownLeft%
DIM Regs AS RegType
Regs.ax = 3
Interrupt 51, Regs, Regs
IF Regs.bx AND 1 THEN MouseDownLeft% = -1
END FUNCTION
SUB MouseHide
DIM Regs AS RegType
Regs.ax = 2
Interrupt 51, Regs, Regs
END SUB
FUNCTION MouseMove%
STATIC x%, y%, Lc%
IF Lc% = 0 THEN
x% = MouseX
y% = MouseY
Lc% = 1
EXIT FUNCTION
END IF
IF x% = MouseX AND y% = MouseY% THEN EXIT FUNCTION
x% = MouseX
y% = MouseY
MouseMove% = -1
END FUNCTION
SUB MouseShow
DIM Regs AS RegType
Regs.ax = 1
Interrupt 51, Regs, Regs
END SUB
SUB MouseUpLeftXY (x%, y%, count%)
DIM Regs AS RegType
Regs.ax = 6
Regs.bx = 0
Interrupt 51, Regs, Regs
L% = Regs.ax AND 1
IF NOT L% THEN EXIT SUB
x% = Regs.dx / 8 + 1
y% = Regs.cx / 8 + 1
count% = Regs.bx
END SUB
FUNCTION MouseX%
DIM Regs AS RegType
Regs.ax = 3
Interrupt 51, Regs, Regs
MouseX% = Regs.dx / 8 + 1
END FUNCTION
FUNCTION MouseY%
DIM Regs AS RegType
Regs.ax = 3
Interrupt 51, Regs, Regs
MouseY% = Regs.cx / 8 + 1
END FUNCTION
扩展的功能你自己写了(滚动的)
以下是源码:
DECLARE SUB MouseBorder (x1%, y1%, x2%, y2%)
DECLARE SUB MouseHide ()
DECLARE SUB MouseShow ()
DECLARE SUB SetBack (x%, y%, slen%, BfClr%, BkClr%)
DECLARE SUB RamPrn (x%, y%, pStr$, BfClr%, BkClr%)
DECLARE SUB DrawBox (x1%, y1%, x2%, y2%, BfClr%, BkClr%, Over%)
DECLARE FUNCTION TxtSelect% (x1%, y1%, x2%, y2%)
DECLARE FUNCTION MouseMove% ()
DECLARE FUNCTION MouseDownLeft% ()
DECLARE FUNCTION MouseX% ()
DECLARE FUNCTION MouseY% ()
'INCLUDE: 'general.bi'
DEFINT A-Z
CLS
RamPrn 1, 29, "TxtSelect Demo", 7, 0
DrawBox 2, 4, 21, 71, 7, 0, 0
FOR i% = 3 TO 20
RamPrn i%, 5, "123456789012345678901234567890123456789012345678901234567890123456", 7, 1
NEXT
MouseBorder 3, 5, 20, 70
MouseShow
WHILE INKEY$ <> CHR$(27)
IF MouseDownLeft THEN
a = TxtSelect(x1%, y1%, x2%, y2%)
END IF
WEND
MouseHide
SUB DrawBox (x1%, y1%, x2%, y2%, BfClr%, BkClr%, Over%)
RamPrn x1%, y1%, chr$(218), BfClr%, BkClr%
RamPrn x1%, y2%, chr$(191), BfClr%, BkClr%
RamPrn x2%, y1%, chr$(192), BfClr%, BkClr%
RamPrn x2%, y2%, chr$(217), BfClr%, BkClr%
FOR i% = x1% + 1 TO x2% - 1
RamPrn i%, y1%, chr$(179), BfClr%, BkClr%
RamPrn i%, y2%, chr$(179), BfClr%, BkClr%
NEXT
FOR i% = y1% + 1 TO y2% - 1
RamPrn x1%, i%, chr$(196), BfClr%, BkClr%
RamPrn x2%, i%, chr$(196), BfClr%, BkClr%
NEXT
IF Over% = 0 THEN EXIT SUB
spc$ = SPACE$(y2% - y1% - 1)
FOR i% = x1% + 1 TO x2% - 1
RamPrn i%, y1% + 1, spc$, BfClr%, BkClr%
NEXT
END SUB
SUB RamPrn (x%, y%, pStr$, BfClr%, BkClr%)
'直接写内存 X%,Y%坐标X:1-25,Y:1-80
'pStr$ 要写到屏幕的字符串
'BfClr%,BkClr% 前景色和背景色
IF LEN(pStr$) = 0 THEN EXIT SUB
Clr% = BkClr% * 16 + BfClr%
Bgn% = x% * 160 + y% * 2 - 164
slen% = LEN(pStr$)
DEF SEG = &HB800
FOR i% = 1 TO slen%
POKE Bgn% + i% * 2, ASC(MID$(pStr$, i%, 1))
POKE Bgn% + i% * 2 + 1, Clr%
NEXT
DEF SEG
END SUB
SUB SetBack (x%, y%, slen%, BfClr%, BkClr%)
'设置文本背景色
Clr% = BkClr% * 16 + BfClr%
Bgn% = x% * 160 + y% * 2 - 164
DEF SEG = &HB800
FOR i% = 1 TO slen%
POKE Bgn% + i% * 2 + 1, Clr%
NEXT
DEF SEG
END SUB
FUNCTION TxtSelect% (x1%, y1%, x2%, y2%)
STATIC Mx%, My%, x%, y% '储存上次选择的区域以便下次调用时恢复
CONST Ex1% = 3, Ey1% = 5, Ex2% = 20, Ey2% = 70 '编辑区域
CONST BfClr% = 7, BkClr% = 1 '前景色和背景色
IF x% > Mx% THEN UD% = -1 ELSE UD% = 1 '恢复上次选择的区域
FOR i% = x% TO Mx% STEP UD%
SetBack i%, Ey1%, Ey2% - Ey1% + 1, BfClr%, BkClr%
NEXT
x% = MouseX '得到鼠标按下时的坐标
y% = MouseY
Mx% = x%: My% = y%
MouseShow
WHILE MouseDownLeft = TRUE '鼠标左键抬起时退出
IF MouseMove THEN '鼠标移动到这个位置
MouseHide
Cx% = MouseX
Cy% = MouseY
IF Cx% <> Mx% THEN '鼠标拖动时不在原来的行
IF x% > Mx% THEN UD% = -1 ELSE UD% = 1
FOR i% = x% TO Mx% STEP UD%
SetBack i%, Ey1%, Ey2% - Ey1% + 1, BfClr%, BkClr%
NEXT
IF y% > Cy% THEN
SetBack x%, Cy%, y% - Cy%, BkClr%, BfClr%
ELSE
SetBack x%, y%, Cy% - y%, BkClr%, BfClr%
END IF
IF x% > Cx% THEN UD% = -1 ELSE UD% = 1
IF Cx% <> x% THEN
FOR i% = x% TO Cx% STEP UD%
SetBack i%, Ey1%, Ey2% - Ey1% + 1, BkClr%, BfClr%
NEXT
END IF
Mx% = Cx%
END IF
IF Cy% <> My% AND x% = Cx% THEN '鼠标在原来行拖动
IF y% > My% THEN
SetBack x%, My%, y% - My%, BfClr%, BkClr%
ELSE
SetBack x%, y%, My% - y%, BfClr%, BkClr%
END IF
IF y% > Cy% THEN
SetBack x%, Cy%, y% - Cy%, BkClr%, BfClr%
ELSE
SetBack x%, y%, Cy% - y%, BkClr%, BfClr%
END IF
My% = Cy%
END IF
MouseShow
END IF
WEND
'鼠标最后在原来位置
IF x% = MouseX AND y% = MouseY THEN EXIT FUNCTION
'返回选择的区域
x1% = x%
y1% = y%
x2% = Mx%
y2% = My%
IF x2% < x1% THEN SWAP x2%, x1%
IF y2% < y1% THEN SWAP y2%, y1%
TxtSelect% = -1
END FUNCTION
SUB MouseBorder (x1%, y1%, x2%, y2%)
DIM Regs AS RegType
Regs.ax = 7
Regs.cx = (y1% - 1) * 8
Regs.dx = (y2% - 1) * 8
Interrupt 51, Regs, Regs
Regs.ax = 8
Regs.cx = (x2% - 1) * 8
Regs.dx = (x1% - 1) * 8
Interrupt 51, Regs, Regs
END SUB
FUNCTION MouseDownLeft%
DIM Regs AS RegType
Regs.ax = 3
Interrupt 51, Regs, Regs
IF Regs.bx AND 1 THEN MouseDownLeft% = -1
END FUNCTION
SUB MouseHide
DIM Regs AS RegType
Regs.ax = 2
Interrupt 51, Regs, Regs
END SUB
FUNCTION MouseMove%
STATIC x%, y%, Lc%
IF Lc% = 0 THEN
x% = MouseX
y% = MouseY
Lc% = 1
EXIT FUNCTION
END IF
IF x% = MouseX AND y% = MouseY% THEN EXIT FUNCTION
x% = MouseX
y% = MouseY
MouseMove% = -1
END FUNCTION
SUB MouseShow
DIM Regs AS RegType
Regs.ax = 1
Interrupt 51, Regs, Regs
END SUB
SUB MouseUpLeftXY (x%, y%, count%)
DIM Regs AS RegType
Regs.ax = 6
Regs.bx = 0
Interrupt 51, Regs, Regs
L% = Regs.ax AND 1
IF NOT L% THEN EXIT SUB
x% = Regs.dx / 8 + 1
y% = Regs.cx / 8 + 1
count% = Regs.bx
END SUB
FUNCTION MouseX%
DIM Regs AS RegType
Regs.ax = 3
Interrupt 51, Regs, Regs
MouseX% = Regs.dx / 8 + 1
END FUNCTION
FUNCTION MouseY%
DIM Regs AS RegType
Regs.ax = 3
Interrupt 51, Regs, Regs
MouseY% = Regs.cx / 8 + 1
END FUNCTION