回 帖 发 新 帖 刷新版面

主题:给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

回复列表 (共2个回复)

沙发

呵呵,原来在这
眼睛不好
脑袋不好
不敢看仔细
只好拱拱手
佩服

板凳

太谢谢了!
我只有上班的时候才在线
我星期6和星期7不上班,所以不在
你记得经常上QQ,我还有很多事情请教你呢!

我来回复

您尚未登录,请登录后再回复。点此登录或注册