Posts: 3,343
Threads: 83
Joined: Mar 2003
If you guys have seen the passwords and asterisks (*) topic you'll know what this is about... Create the best password program. It should display characters as stars. This will probably be too easy for most, so make it as graphically pleasing as you can. Use screen 12 etc, include the mouse for bonus points etc. If you think the code is too long then pm it to me.
Posts: 2,765
Threads: 138
Joined: Nov 2002
like this?
Code:
CLS
DO
p$ = ""
DO WHILE p$ = ""
p$ = INKEY$
IF p$ = " " THEN b = 1
IF p$ = CHR$(13) THEN done = 1
IF p$ = CHR$(8) THEN
IF LEN(pass$) <> 0 THEN
MID$(pass$, LEN(pass$), 1) = " "
MID$(a$, LEN(a$), 1) = " "
END IF
b = 1
LOCATE 1, 1: PRINT a$;
END IF
LOOP
pass$ = RTRIM$(pass$)
a$ = RTRIM$(a$)
IF done = 0 AND b = 0 THEN pass$ = pass$ + p$
IF done = 0 AND b = 0 THEN a$ = a$ + "*"
LOCATE 1, 1: PRINT a$;
b = 0
LOOP UNTIL done = 1
PRINT
PRINT pass$
After typing hit enter
It then prints it out.
And click backspace to backspace.
Back by popular demand!
I will byte and nibble you bit by bit until nothing remains but crumbs.
Posts: 1,439
Threads: 15
Joined: Apr 2003
I'll hack up a quick one with arrow key support... shouldn't be too hard... the mouse might be more challenging. I haven't done that since my FirstBasic days...
Posts: 3,343
Threads: 83
Joined: Mar 2003
whitetiger is winning, but it is pretty poor really. No prompt, screen 0, no asterisk for space, accept the F keys as input, but it is functional. You get 5 challenge points.
Please do dig out your mouse commands. Or check the tutorials right here at qbnews for a mouse routine.
Posts: 2,020
Threads: 24
Joined: Jun 2002
We lose points for not using our own fonts in a graphical screen mode?
i]"I know what you're thinking. Did he fire six shots or only five? Well, to tell you the truth, in all this excitement, I've kinda lost track myself. But being as this is a .44 Magnum ... you've got to ask yourself one question: 'Do I feel lucky?' Well, do ya punk?"[/i] - Dirty Harry
Posts: 480
Threads: 24
Joined: Mar 2003
Code:
y% = CSRLIN
x% = POS(0)
accepted$ = " abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
p$ = ""
a$ = ""
DO
LOCATE y%, x%
PRINT "Enter Password: "; a$; " ";
k$ = INPUT$(1)
SELECT CASE k$
CASE CHR$(8)
IF LEN(p$) THEN
p$ = LEFT$(p$, LEN(p$) - 1)
a$ = LEFT$(a$, LEN(a$) - 1)
END IF
CASE CHR$(13)
EXIT DO
CASE ELSE
IF POS(0) < 80 AND INSTR(accepted$, k$) THEN
p$ = p$ + k$
a$ = a$ + "*"
END IF
END SELECT
LOOP
Posts: 3,343
Threads: 83
Joined: Mar 2003
In my scoring method you can't lose points, but you will gain them for something like your own fonts too (as long as they look good :wink: )
Edit: Meg's program...
Better. Doesn't accept F keys, accepts backspace, prompt, accepts and displays star for space key. However screen 0 and uninviting. Meg gets 11 challenge points.
Please guys, when you send something, make a default password and check that the password is correct, then display some sort of message based on the password given.
----- SCORE TABLE -----
Meg - - - - - - - - - - - 11
whitetiger0990 - - - - 5
Posts: 480
Threads: 24
Joined: Mar 2003
Here's a password program with a theme
Code:
TYPE BGType '*** BACKGROUND ARRAY ***
YPos AS INTEGER
cycl AS SINGLE
chng AS SINGLE
Speed AS INTEGER
Blot AS INTEGER
END TYPE
DIM BG(1 TO 40) AS BGType
DECLARE SUB ShowMessage (Message$)
DECLARE SUB Background (BG() AS BGType)
SCREEN 13
FOR c% = 0 TO 63 '*** SET UP GREEN PALETTE ***
OUT &H3C8, c%
OUT &H3C9, 0
OUT &H3C9, c%
OUT &H3C9, 0
NEXT c%
accepted$ = " abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
p$ = ""
a$ = ""
DO
LOCATE 12, 7: COLOR 40: PRINT "Enter Password: "; a$; " ";
DO
CALL Background(BG()) '*** MOVE STREAKS ***
k$ = INKEY$
LOOP UNTIL k$ <> ""
SELECT CASE k$
CASE CHR$(8) '*** BACKSPACE ***
IF LEN(p$) THEN
p$ = LEFT$(p$, LEN(p$) - 1)
a$ = LEFT$(a$, LEN(a$) - 1)
END IF
CASE CHR$(13) '*** ENTER ***
EXIT DO
CASE ELSE
IF LEN(a$) < 9 AND INSTR(accepted$, k$) THEN
p$ = p$ + k$
a$ = a$ + "*"
END IF
END SELECT
LOOP
IF p$ = "matrix" THEN
Message$ = " SECURITY ACCESS GRANTED "
ELSE
Message$ = " WARNING: SYSTEM FAILURE "
END IF
CALL ShowMessage(Message$) '*** FLASH MESSAGE ***
SUB Background (BG() AS BGType)
FOR column% = 1 TO 40
IF BG(column%).YPos THEN '*** STREAK EXISTS ***
LOCATE BG(column%).YPos, column%
COLOR INT(BG(column%).cycl)
IF (column% < 6 OR column% > 32) OR (BG(column%).YPos < 11 OR BG(column%).YPos > 13) THEN
IF BG(column%).Blot THEN '*** ERASING STREAK ***
PRINT " ";
ELSE
PRINT CHR$(INT(RND * 94) + 33); '*** DRAWING STREAK ***
END IF
END IF
IF INT(RND * BG(column%).Speed) = 0 THEN BG(column%).YPos = BG(column%).YPos + 1
IF BG(column%).YPos = 24 THEN
IF BG(column%).Blot THEN '*** END ERASER ***
BG(column%).YPos = 0
BG(column%).Blot = 0
ELSE
BG(column%).YPos = 1 '*** START ERASER ***
BG(column%).Blot = 1
END IF
ELSE
BG(column%).cycl = BG(column%).cycl + BG(column%).chng
IF BG(column%).cycl > 63 THEN '*** LOOP COLOR ***
BG(column%).cycl = 63
BG(column%).chng = -.1
END IF
IF BG(column%).cycl < 0 THEN '*** LOOP COLOR ***
BG(column%).cycl = 0
BG(column%).chng = .1
END IF
END IF
ELSE
IF INT(RND * 550) = 0 THEN '*** CREATE STREAK ***
BG(column%).YPos = 1
BG(column%).cycl = INT(RND * 61) + 1
BG(column%).chng = .1 * (-1) ^ (INT(RND * 2))
BG(column%).Speed = (INT(RND * 10) + 1) * 5
END IF
END IF
NEXT column%
END SUB
SUB ShowMessage (Message$)
c% = 0
ch% = 1
DO
c% = c% + ch%
IF c% = 63 THEN ch% = -1
IF c% = 0 THEN ch% = 1
LOCATE 12, 7
COLOR c%
PRINT Message$
FOR t = 1 TO 15000: NEXT t
LOOP UNTIL INKEY$ <> ""
END SUB
correct password = "matrix"
*peace*
Meg.
Posts: 480
Threads: 24
Joined: Mar 2003
Posts: 3,343
Threads: 83
Joined: Mar 2003
Excellent! That's what I'm posting about! Lets see some more of those!
Remember: Bonus points for mouse control.
Meg's new program: Has a theme, checks for correct entry and displays appropriate response, accepts proper keys (but not tidle). Your new total is 31 points, well done.
C'mon other would-be challengers: give Meg a hard time!
----- SCORE TABLE -----
Meg - - - - - - - - - - - 31
whitetiger0990 - - - - 5