主题：Qb 实用函数讨论
QB71
[专家分：1300] 发布于 2004-03-27 00:50:00
请版主开设一个QB的实用函数讨论区，讨论一些QB中的实用函数
就由我开个头吧：
QB中处理数制的函数：
1.将字符串转成数字
Val(String$)
2.将十进制数转换成十六进制字符串
Hex$(Dig)
3.将十六进制转成十进制数
如：12E3A Val("&H12E3A")
4.将十进制数转成二进制字串
function DtoB$(Dig as long)
dim NN as long
NN=Dig
do
if NN mod 2=0 then Buf$="0"+Buf$ else Buf$="1"+Buf$
NN=Int(NN/2)
loop while NN>0
DtoB$=Buf$
end function
如求 1234567 BinStr$=DtoB(1234567)
5.将二进制字符串转成十进制数
function BtoD&(BinStr as string)
slen=len(Binstr)
NN&=1
for i=sLen to 1 step -1
if mid$(Binstr$,i,1)="1" then K=1 else K=0
Sum&=Sum&+K*NN&
NN&=NN&*2
next
BtoD&=Sum&
end Function
其它不常用的数制也就不说了
3 楼
QB71 [专家分：1300] 发布于 2004-04-10 20:04:00
QB中的文本方式下的单行文本编辑函数：
DEFINT A-Z
CLS
PRINT EditLine(10, 10, 15, "EditLine Test", 0, 7)
END
FUNCTION EditLine$ (lx%, ly%, Lengh%, NowStr$, bfcolor%, bkcolor%)
Inst$ = NowStr$
'----------------------------------------------------------
slen% = LEN(Inst$)
IF slen% > Lengh% THEN
Tmp$ = RIGHT$(Inst$, Lengh% - 1)
lft% = slen% - Lengh% + 1
NN% = Lengh% - 1
ELSE
NN% = LEN(Inst$)
Tmp$ = Inst$
END IF
SelEnd% = slen%
bitp lx%, ly%, SPACE$(Lengh%), bfcolor%, bkcolor%
bitp lx%, ly%, Tmp$, bfcolor%, bkcolor%
GOSUB set.select
LOCATE lx, ly + SelEnd% - lft, 1, 6, 7
WHILE quit = 0
In$ = INKEY$
IF In$ <> "" THEN 'Geting keyCode
Shift% = ShiftDown%
Code% = KeyCode(In$)
IF Shift% = 1 AND Code% = 15 THEN
bkcolor% = -10: quit = 1
EditLine$ = Inst$
END IF
ELSE
Shift% = 0
Code% = 0
END IF
IF In$ = CHR$(27) THEN bkcolor% = -27: quit = 1: EditLine$ = NowStr$
IF In$ = CHR$(13) THEN bkcolor% = -13: quit = 1: EditLine$ = Inst$
IF In$ = CHR$(9) THEN bkcolor% = -9: quit = 1: EditLine$ = Inst$
'********************************
IF Code% = 82 THEN 'Insert
Ins = NOT Ins
IF Ins = 0 THEN
LOCATE , , 1, 6, 7
ELSE
LOCATE , , 1, 0, 7
END IF
END IF
'---------------------------------------------------
IF In$ <> "" THEN 'Input Not NULL
IF ASC(In$) > 31 THEN
Set.Back lx, ly, Lengh, bfcolor, bkcolor
iLen = LEN(In$)
IF SelStar% > SelEnd% THEN SWAP SelStar%, SelEnd%
IF Ins = 0 THEN
Inst$ = LEFT$(Inst$, SelStar%) + In$ + MID$(Inst$, SelEnd% + 1, slen%)
ELSE
Inst$ = LEFT$(Inst$, SelStar%) + In$ + MID$(Inst$, SelEnd% + iLen + 1, slen%)
END IF
SelStar% = SelStar% + iLen%
IF SelStar% - lft% > Lengh% - 1 THEN
lft% = SelStar% - Lengh% + 1
END IF
SelEnd% = SelStar%
Tmp$ = MID$(Inst$, lft% + 1, Lengh%)
bitp lx%, ly%, Tmp$ + SPACE$((Lengh% - LEN(Tmp$))), bfcolor%, bkcolor%
slen% = LEN(Inst$)
LOCATE lx, ly + SelEnd% - lft
END IF
END IF
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
IF Code% = 77 THEN 'Right
Set.Back lx, ly, Lengh, bfcolor, bkcolor
IF SelEnd% < slen% THEN SelEnd% = SelEnd% + 1
IF SelEnd% - lft% > Lengh% - 1 THEN
lft% = lft% + 1
Tmp$ = MID$(Inst$, lft% + 1, Lengh%)
bitp lx%, ly%, Tmp$ + SPACE$((Lengh% - LEN(Tmp$))), bfcolor%, bkcolor%
END IF
IF Shift% = 0 THEN SelStar% = SelEnd%
IF SelStar% <> SelEnd% THEN GOSUB set.select
LOCATE lx, ly + SelEnd - lft
END IF
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
IF Code% = 75 THEN 'Left
Set.Back lx, ly, Lengh, bfcolor, bkcolor
IF SelEnd% > 0 THEN SelEnd% = SelEnd% - 1
IF SelEnd% < lft% THEN
lft% = lft% - 1
Tmp$ = MID$(Inst$, lft% + 1, Lengh%)
bitp lx%, ly%, Tmp$ + SPACE$((Lengh% - LEN(Tmp$))), bfcolor%, bkcolor%
END IF
IF Shift% = 0 THEN SelStar% = SelEnd%
IF SelStar% <> SelEnd% THEN GOSUB set.select
LOCATE lx, ly + SelEnd - lft
END IF
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
IF Code% = 71 THEN 'Home
Set.Back lx, ly, Lengh, bfcolor, bkcolor
IF lft% > 0 THEN
Tmp$ = LEFT$(Inst$, Lengh%)
bitp lx%, ly%, Tmp$ + SPACE$((Lengh% - LEN(Tmp$))), bfcolor%, bkcolor%
END IF
lft% = 0: SelEnd% = 0: curx% = Ex%
IF Shift% = 1 THEN
GOSUB set.select
ELSE
SelStar% = SelEnd%
END IF
LOCATE lx, ly
END IF
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
IF Code% = 79 THEN 'End
Set.Back lx, ly, Lengh, bfcolor, bkcolor
IF slen% > Lengh% - 1 THEN
lft% = slen% - (Lengh% - 1)
Tmp$ = RIGHT$(Inst$, Lengh% - 1)
bitp lx%, ly%, Tmp$ + SPACE$((Lengh% - LEN(Tmp$))), bfcolor%, bkcolor%
END IF
SelEnd% = slen%: curx% = (slen% - lft%) * 8 + Ex%
IF Shift% = 1 THEN
GOSUB set.select
ELSE
SelStar% = SelEnd%
END IF
LOCATE lx, ly + SelEnd - lft
END IF
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
IF Code% = 83 AND slen% > 0 THEN 'Delete
Set.Back lx, ly, Lengh, bfcolor, bkcolor
IF SelStar% > SelEnd% THEN SWAP SelStar%, SelEnd%
IF SelStar% <> SelEnd% THEN
Inst$ = LEFT$(Inst$, SelStar%) + MID$(Inst$, SelEnd% + 1, slen%)
IF SelStar% < lft% THEN lft% = SelStar%
ELSE
Inst$ = LEFT$(Inst$, SelStar%) + MID$(Inst$, SelEnd% + 2, slen%)
END IF
SelEnd% = SelStar%
Tmp$ = MID$(Inst$, lft% + 1, Lengh%)
bitp lx%, ly%, Tmp$ + SPACE$((Lengh% - LEN(Tmp$))), bfcolor%, bkcolor%
slen% = LEN(Inst$)
LOCATE lx, ly + SelEnd - lft
END IF
IF In$ = CHR$(8) AND SelEnd% > 0 THEN
Set.Back lx, ly, Lengh, bfcolor, bkcolor
IF SelStar% > SelEnd% THEN SWAP SelStar%, SelEnd%
IF SelStar% <> SelEnd% THEN
IF SelStar% > 0 THEN
Inst$ = LEFT$(Inst$, SelStar% - 1) + RIGHT$(Inst$, slen% - SelEnd%)
ELSE
Inst$ = LEFT$(Inst$, SelStar%) + RIGHT$(Inst$, slen% - SelEnd%)
END IF
SelEnd% = SelStar% - 1
IF SelEnd% < 0 THEN SelEnd% = 0
IF SelEnd% < lft% THEN
lft% = SelEnd% - 1
IF lft% < 0 THEN lft% = 0
END IF
ELSE
Inst$ = LEFT$(Inst$, SelStar% - 1) + RIGHT$(Inst$, slen% - SelEnd%)
SelEnd% = SelEnd% - 1
IF SelEnd% < lft% THEN
lft% = SelEnd% - 1
IF lft% < 0 THEN lft% = 0
END IF
END IF
Tmp$ = MID$(Inst$, lft% + 1, Lengh%)
bitp lx%, ly%, Tmp$ + SPACE$((Lengh% - LEN(Tmp$))), bfcolor%, bkcolor%
slen% = LEN(Inst$)
curx% = (SelEnd% - lft%) * 8 + Ex%
SelStar% = SelEnd%
LOCATE lx, ly + SelEnd - lft
END IF
WEND
EXIT FUNCTION
set.select:
befor% = SelStar%: after% = SelEnd%
IF befor% > after% THEN SWAP befor%, after%
FOR i = befor% TO after% - 1
IF i - lft >= 0 AND i - lft < Lengh THEN
Set.Back lx%, ly + i - lft, 1, bkcolor%, bfcolor%
END IF
NEXT
RETURN
END FUNCTION
defint a-z
SUB bitp (X%, Y%, PStr$, BfColor%, BkColor%)
Begin% = X% * 160 + Y% * 2 - 162
sLen% = LEN(PStr$)
CLR% = BkColor% * 16 + BfColor%
DEF SEG = &HB800
FOR i = 0 TO sLen - 1
POKE Begin% + i * 2, ASC(MID$(PStr$, i + 1, 1))
POKE Begin% + i * 2 + 1, CLR%
NEXT
DEF SEG
END SUB
FUNCTION KeyCode% (iKey$)
IF LEN(iKey$) < 2 OR LEFT$(iKey$, 1) <> CHR$(0) THEN EXIT FUNCTION
KeyCode% = ASC(MID$(iKey$, 2, 1))
END FUNCTION
SUB Set.Back (X%, Y%, Lengh%, BfColor%, BkColor%)
Begin% = X% * 160 + Y% * 2 - 162
CLR% = BkColor% * 16 + BfColor%
DEF SEG = &HB800
FOR i% = 1 TO Lengh% * 2 STEP 2
POKE i% + Begin%, CLR%
NEXT
DEF SEG
END SUB
FUNCTION ShiftDown%
DEF SEG = 65
Shift = PEEK(7)
DEF SEG
IF (Shift AND 1) OR (Shift AND 2) THEN ShiftDown% = 1
END FUNCTION
4 楼
冷石_jasv [专家分：1570] 发布于 2004-04-14 09:56:00
'响应一下
'模拟电传打印的函数
DECLARE SUB printtext (x, y, t$, col1!, col2!)
col1 = 7: col2 = 1
COLOR col1, col2
CLS
LOCATE 25, 1: PRINT "Inkey any Key Exit !"
text$ = "Please Input Password:"
printtext 5, 10, text$, col1, col2
a$ = INPUT$(1)
SCREEN 0, 0, 0, 0
SUB printtext (x, y, t$, col1, col2)
COLOR col1, col2
text$ = t$
n = 1
DO
LOCATE x, y + n: PRINT MID$(text$, n, 1); : COLOR col1 + 16, col2: PRINT "_"; : COLOR col1, col2
SOUND 1050, .5
FOR i = 1 TO INT(RND * 8 * 45000): NEXT
n = n + 1
LOOP WHILE n <> LEN(text$) + 1
END SUB
您所在位置：
