Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Silent pw entry not working
#41
You know.....

I actually love 2FA, has anyone come up with a creative QB64 method?
3 out of 2 people have trouble with fractions

Reply
#42
(12-14-2022, 10:26 PM)Ra7eN Wrote: You know.....

I actually love 2FA, has anyone come up with a creative QB64 method?

https://github.com/CosminPerRam/2fa-CPP
Reply
#43
(12-14-2022, 11:24 PM)SMcNeill Wrote:
(12-14-2022, 10:26 PM)Ra7eN Wrote: You know.....

I actually love 2FA, has anyone come up with a creative QB64 method?

https://github.com/CosminPerRam/2fa-CPP

thats c++

qb64 variant?
3 out of 2 people have trouble with fractions

Reply
#44
What's that? Now you say you need a friggin' form with multiple input lines, the ability to use the mouse to highlight text. A right click popup menu to choose cut, copy, paste, select all, clear, and quit! Oh, and how about a tab function for input fields? Hey, speaking of input fields, you got problems with being too wordy? Well,, no problem. Lets just toss in a decent amount of horizontal text scrolling, too...

Code: (Select All)
DIM SHARED shift%, ctext, chl1, chl2, rt_menu
PALETTE 4, 59 ' 11 15 59 62 Other choices.
ctext = 15: chl1 = 0: chl2 = 4
REDIM SHARED menu$(1)
REDIM yfield(1) ' Row.
REDIM xfield(1) ' Column.
REDIM flen(1) ' Field length.
REDIM maxlen(1) ' Max text length.
REDIM text$(1) ' Text input.

myform nof, yfield(), xfield(), flen(), maxlen(), text$()
LOCATE yfield(nof), xfield(nof)

DO
    myinput nof, yfield(), xfield(), flen(), maxlen(), text$()
LOOP

SUB myinput (nof, yfield(), xfield(), flen(), maxlen(), text$())
    STATIC word$
    ' Single line keyboard routine for input.
    LOCATE , , 1 ' Show cursor.
    start_column = xfield(nof) ' Margin right.
    mr = start_column + flen(nof)
    input_row = yfield(nof)
    y = yfield(nof): x = xfield(nof) ' Initial cursor position.
    DO
        _LIMIT 60
        string_pos = POS(0) - start_column ' Track cursor and word position.

        CALL my_mouse(lb, rb, my, mx, drag, menu$()): CALL my_keyboard(b$)

        IF lb THEN GOSUB mouse_event: IF pop THEN EXIT DO
        IF rb AND rt_menu = 0 OR rt_menu = 2 THEN
            IF menu.var < 1 THEN
                DO
                    rt_menu = -1
                    CALL MyWindow_Menu(menu$(), menu.var, b$)
                    IF menu.var > 0 THEN EXIT DO
                    menu.var = 0 ' Open in another area.
                LOOP UNTIL rt_menu <> 2
                rt_menu = 0
                LOCATE , , 1 ' Show cursor
                COLOR ctext, 0 '''' should be done in popup.
                SELECT CASE menu.var
                    CASE 1: b$ = CHR$(24)
                    CASE 2: b$ = CHR$(3)
                    CASE 3: b$ = CHR$(22)
                    CASE 4: b$ = CHR$(0) + "S"
                    CASE 5: b$ = CHR$(1)
                    CASE 6 ' Do nothing.
                    CASE 7: b$ = CHR$(27)
                END SELECT
                menu.var = 0
            END IF
        END IF

        IF LEN(b$) THEN
            SELECT CASE b$
                CASE CHR$(27) ' Esc key.
                    SYSTEM
                CASE CHR$(9) ' Tab key. Change text fields.
                    IF hl THEN GOSUB hl_off
                    text$(nof) = word$: word$ = "": hscr = 0
                    nof = nof + 1: IF nof > UBOUND(yfield) THEN nof = 1
                    word$ = text$(nof)
                    LOCATE yfield(nof), xfield(nof)
                    EXIT SUB
                CASE CHR$(13) ' Enter key.
                    IF hl THEN GOSUB hl_off
                    text$(nof) = word$: word$ = "": hscr = 0
                    END ' <------------------------------------------ '''
                    EXIT SUB
                CASE CHR$(8) ' Backspace key.
                    GOSUB backspace
                CASE CHR$(0) + "S" ' Delete key.
                    GOSUB delete
                CASE CHR$(0) + "M" ' Arrow right key.
                    GOSUB cursor_forward
                CASE CHR$(0) + "K" ' Arrow left key.
                    GOSUB cursor_back
                CASE CHR$(0) + "t" ' Ctrl + Arrow right key.
                    GOSUB ctrl_rt
                CASE CHR$(0) + "s" ' Ctrl + Arrow left key.
                    GOSUB ctrl_lt
                CASE CHR$(0) + "G" ' Home
                    GOSUB cur_home
                CASE CHR$(0) + "O" ' End
                    GOSUB cur_end
                CASE CHR$(0) + "R" ' Insert/overwrite toggel
                    ovw = 1 - ovw
                    IF ovw = 0 THEN LOCATE , , 1, 7, 7 ELSE LOCATE , , 1, 7, 30
                CASE CHR$(22) ' Ctrl + V - Paste
                    GOSUB paste
                CASE CHR$(3) ' Ctrl + C - Copy
                    GOSUB copy
                CASE CHR$(24) ' Ctrl + X - Cut
                    GOSUB cut
                CASE CHR$(1) ' Select all.
                    GOSUB select_all
                CASE CHR$(32) TO "z"
                    GOSUB print_chr
            END SELECT
            y = CSRLIN: x = POS(0) ' Track cursor.
        END IF
        ''' LOCATE 20, 1: PRINT hl; hscr; "  "; _CLIPBOARD$; "                  ";: LOCATE y, x
    LOOP
    EXIT SUB

    print_chr:
    IF hl THEN GOSUB cut: string_pos = POS(0) - start_column
    ''' s = CSRLIN: d = POS(0): LOCATE 20, 1: PRINT start_column + LEN(word$); mr - 1; LEN(word$); mr - start_column - 1: LOCATE s, d
    IF string_pos + start_column < mr - 1 AND LEN(word$) < mr - start_column - 1 THEN
        IF start_column + LEN(word$) < mr THEN
            word$ = MID$(word$, 1, string_pos) + b$ + MID$(word$, string_pos + 1 + ovw)
            LOCATE , start_column: PRINT SPACE$(mr - start_column);: LOCATE , start_column
            PRINT word$;
            LOCATE , start_column + string_pos + 1
        END IF
    ELSE ' Horizontal scrolling.
        IF LEN(word$) < maxlen(nof) THEN
            '''IF string_pos = mr - start_column OR string_pos = mr - start_column - 1 AND string_pos < LEN(word$) - hscr THEN
            IF string_pos = mr - start_column - 1 OR string_pos = mr - start_column - 2 AND string_pos < LEN(word$) - hscr - 1 THEN
                j = 1 ' At right margin.
            ELSEIF string_pos = LEN(word$) - hscr THEN
                j = 0 ' Cursor leading text.
            ELSE
                j = 0 ' Cursor inside text.
            END IF
            word$ = MID$(word$, 1, hscr + string_pos) + b$ + MID$(word$, hscr + string_pos + 1 + ovw)
            hscr = hscr + j
            LOCATE , start_column
            IF ovw THEN PRINT SPACE$(mr - start_column);: LOCATE , start_column
            PRINT MID$(word$, hscr + 1, mr - start_column);
            LOCATE , start_column + string_pos + 1 - j
        END IF
    END IF
    RETURN

    backspace:
    IF hl AND shift% = 0 THEN GOSUB cut
    IF string_pos = 0 AND hscr > 0 OR string_pos > 0 THEN
        IF hl THEN GOSUB hl_off
        word$ = MID$(word$, 1, hscr + string_pos - 1) + MID$(word$, hscr + string_pos + 1)
        IF hscr THEN hscr = hscr - 1: j = 0 ELSE j = 1
        LOCATE , start_column: PRINT SPACE$(mr - start_column);
        LOCATE , start_column
        PRINT MID$(word$, hscr + 1, mr - start_column);
        LOCATE , x - j
    END IF
    RETURN

    delete:
    IF hl THEN
        GOSUB cut
    ELSE
        word$ = MID$(word$, 1, hscr + string_pos) + MID$(word$, hscr + string_pos + 2)
        LOCATE , start_column: PRINT SPACE$(mr - start_column);
        LOCATE , start_column
        PRINT MID$(word$, hscr + 1, mr - start_column);
        LOCATE , x
    END IF
    RETURN

    cur_home:
    DO
        GOSUB cursor_back
        string_pos = POS(0) - start_column
    LOOP UNTIL hscr = 0 AND string_pos = 0
    RETURN

    cur_end:
    DO
        GOSUB cursor_forward
        string_pos = POS(0) - start_column
    LOOP UNTIL string_pos + 1 > LEN(word$) - hscr
    RETURN

    cursor_forward:
    IF hl AND shift% = 0 THEN GOSUB hl_off
    IF string_pos + 1 <= LEN(word$) - hscr THEN
        IF start_column + string_pos + 1 = mr AND LEN(word$) > mr - start_column AND shift% = 0 THEN
            hscr = hscr + 1
            LOCATE , start_column: PRINT SPACE$(mr - start_column);: LOCATE , start_column
            PRINT MID$(word$, hscr + 1, mr - start_column);
            IF string_pos <> LEN(word$) - hscr THEN LOCATE , POS(0) - 1
        ELSEIF shift% AND string_pos < LEN(word$) - hscr THEN
            IF string_pos = mr - start_column - 1 THEN
                hscr = hscr + 1
                LOCATE , start_column: PRINT SPACE$(mr - start_column);: LOCATE , start_column
                PRINT MID$(word$, hscr + 1, string_pos - hl - 1);
                IF hl < 0 THEN COLOR ctext, 0 ELSE COLOR chl1, chl2
                hl = hl + 1
                IF POS(0) = start_column THEN PRINT MID$(word$, hscr + 1, mr - start_column - 1); ELSE PRINT MID$(word$, hscr + 1 + string_pos - hl, (mr - start_column) - (string_pos - hl) - 1);
            ELSE
                IF hl < 0 THEN COLOR ctext ELSE COLOR chl1, chl2
                hl = hl + 1
                PRINT MID$(word$, hscr + string_pos + 1, 1);
            END IF
        ELSE
            IF hl THEN GOSUB hl_off
            IF POS(0) < mr THEN LOCATE , POS(0) + 1
        END IF
        COLOR ctext
    END IF
    RETURN

    cursor_back:
    IF hl AND shift% = 0 THEN GOSUB hl_off
    IF string_pos = 0 AND shift% = 0 THEN
        IF hscr THEN hscr = hscr - 1: PRINT MID$(word$, hscr + 1, mr - start_column);: LOCATE , start_column
    ELSEIF shift% THEN
        IF string_pos = 0 THEN
            IF hscr THEN
                hscr = hscr - 1
                IF hl > 0 THEN COLOR ctext, 0 ELSE COLOR chl1, chl2
                hl = hl - 1
                j = ABS(hl): IF j > (mr - start_column) THEN j = mr - start_column
                PRINT MID$(word$, hscr + 1, j);
                COLOR ctext, 0: PRINT MID$(word$, hscr + 1 + j, (mr - start_column) - j);
                LOCATE , start_column
            END IF
        ELSE
            LOCATE , POS(0) - 1
            IF hl > 0 THEN COLOR ctext, 0 ELSE COLOR chl1, chl2
            PRINT MID$(word$, hscr + string_pos, 1);
            LOCATE , POS(0) - 1
            hl = hl - 1
        END IF
        COLOR ctext, 0
    ELSE
        IF hl THEN GOSUB hl_off
        LOCATE , POS(0) - 1
    END IF
    RETURN

    ctrl_rt:
    DO
        GOSUB cursor_forward
        string_pos = POS(0) - start_column
    LOOP UNTIL MID$(word$, hscr + string_pos, 1) = " " OR string_pos >= LEN(word$) - hscr
    RETURN

    ctrl_lt:
    DO
        GOSUB cursor_back
        string_pos = POS(0) - start_column
    LOOP UNTIL MID$(word$, hscr + string_pos, 1) = " " OR POS(0) = start_column AND hscr = 0
    RETURN

    hl_off:
    j = POS(0)
    LOCATE , start_column
    COLOR ctext, 0
    PRINT MID$(word$, hscr + 1, mr - start_column);
    LOCATE , j
    hl = 0
    RETURN

    cut:
    COLOR ctext, 0
    SELECT CASE hl
        CASE IS > 0
            IF b$ = CHR$(24) THEN _CLIPBOARD$ = MID$(word$, string_pos + 1 + hscr - hl, hl) ' Only copy to clipboard for 'cut' and not delete or paste over highlighted text calls.
            j = start_column + string_pos - hl
            LOCATE , start_column
            PRINT SPACE$(mr - start_column);
            word$ = MID$(word$, 1, hscr + string_pos - hl) + MID$(word$, hscr + string_pos + 1)
            LOCATE , start_column
            IF j < start_column THEN hscr = hscr + string_pos - hl: j = start_column
            PRINT MID$(word$, hscr + 1, mr - start_column);
            LOCATE , j
        CASE 0
            ' Do nothing
        CASE IS < 0
            IF b$ <> CHR$(0) + "S" THEN _CLIPBOARD$ = MID$(word$, string_pos + 1 + hscr, ABS(hl))
            LOCATE , start_column
            PRINT SPACE$(mr - start_column);
            word$ = MID$(word$, 1, hscr + string_pos) + MID$(word$, hscr + string_pos + 1 + ABS(hl))
            LOCATE , start_column
            PRINT MID$(word$, hscr + 1, mr - start_column);
            LOCATE , start_column + string_pos
    END SELECT
    hl = 0 ' No need for hl_off.
    RETURN

    copy:
    SELECT CASE hl
        CASE LEN(word$) 'Select all.
        CASE 1 TO LEN(word$) - 1
            _CLIPBOARD$ = MID$(word$, string_pos + 1 - hl, hl)
        CASE 0
            ' Do nothing
        CASE IS < 0
            _CLIPBOARD$ = MID$(word$, string_pos + 1, ABS(hl))
    END SELECT
    RETURN

    paste:
    IF LEN(_CLIPBOARD$) THEN
        IF hl THEN GOSUB cut
        tmp$ = _CLIPBOARD$
        IF LEN(word$) + LEN(tmp$) <= maxlen(nof) THEN
            word$ = MID$(word$, 1, hscr + string_pos) + tmp$ + MID$(word$, hscr + string_pos + 1)
            IF string_pos + LEN(tmp$) >= mr - start_column AND LEN(word$) > mr - start_column THEN hscr = LEN(word$) - (mr - start_column)
            LOCATE , start_column: PRINT SPACE$(mr - start_column);: LOCATE , start_column
            PRINT MID$(word$, hscr + 1, mr - start_column);
            IF string_pos + LEN(tmp$) < mr - start_column THEN
                LOCATE , start_column + string_pos + LEN(tmp$)
            END IF
        ELSE
            BEEP ' Too many characters to paste.
        END IF
    END IF
    RETURN

    select_all:
    hl = LEN(word$)
    LOCATE , start_column
    COLOR chl1, chl2
    PRINT MID$(word$, hscr + 1, mr - start_column);
    COLOR ctext, 0
    RETURN

    mouse_event:
    IF my = input_row OR drag THEN
        IF drag = 0 AND hl THEN GOSUB hl_off
        IF mx >= start_column - hscr AND mx <= start_column + LEN(word$) - hscr THEN
            IF drag THEN
                IF drag > 0 THEN
                    IF mx > POS(0) - 1 THEN
                        shift% = -1: GOSUB cursor_forward
                        string_pos = POS(0) - start_column
                        y = CSRLIN: x = POS(0)
                    END IF
                ELSE
                    IF mx < POS(0) THEN
                        shift% = -1: GOSUB cursor_back
                        string_pos = POS(0) - start_column
                        y = CSRLIN: x = POS(0)
                    END IF
                END IF
            ELSE
                LOCATE , mx: y = CSRLIN: x = POS(0)
            END IF
        END IF
    ELSE
        ' Change input_row here.
        IF drag = 0 THEN ' Do not change to another field when highlighting with mouse.
            FOR i = 1 TO UBOUND(yfield)
                IF my = yfield(i) AND mx >= xfield(i) AND mx <= xfield(i) + flen(i) THEN
                    IF hl THEN GOSUB hl_off
                    LOCATE , start_column: PRINT MID$(word$, 1, mr - start_column);
                    text$(nof) = word$: hscr = 0
                    nof = i: pop = -1
                    word$ = text$(nof)
                    LOCATE yfield(nof), xfield(nof)
                    IF mx <= xfield(nof) + LEN(word$) THEN LOCATE my, mx
                    EXIT FOR
                END IF
            NEXT
        END IF
    END IF
    RETURN
END SUB

SUB my_mouse (lb, rb, my, mx, drag, menu$())
    STATIC oldmy, oldmx, z1

    WHILE _MOUSEINPUT: WEND
    my = _MOUSEY
    mx = _MOUSEX
    IF _MOUSEBUTTON(1) THEN
        IF lb = 0 THEN
            ''' IF ABS(TIMER - z1) < .3 THEN SOUND 1000, .1: z1 = TIMER ELSE lb = 1: z1 = TIMER
            lb = 1
        END IF
        IF oldmy AND oldmx <> mx OR oldmy AND oldmy <> my THEN
            IF mx <> oldmx THEN drag = SGN(mx - oldmx) ' Prevent zero which can occur if mouse moves off row when being draged horizontally.
        END IF
    ELSE
        IF lb THEN lb = 0: drag = 0
    END IF
    IF _MOUSEBUTTON(2) AND rb = 0 THEN
        rb = 1
    ELSE
        IF _MOUSEBUTTON(2) = 0 AND rb THEN rb = 0
    END IF
    oldmy = my: oldmx = mx
END SUB

SUB my_keyboard (b$)
    IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN shift% = -1 ELSE IF shift% THEN shift% = 0
    b$ = INKEY$
END SUB

SUB MyWindow_Menu (menu$(), menu.var, b$) ' Self-contained subroutine.
    STATIC initialize_menu, WinCon.noi
    IF initialize_menu = 0 THEN
        initialize_menu = 1
        RESTORE WinMenuData
        WinCon.noi = 0
        DO
            READ tmp$
            IF tmp$ = "eof" THEN EXIT DO
            WinCon.noi = WinCon.noi + 1
            REDIM _PRESERVE menu$(WinCon.noi)
            menu$(WinCon.noi) = tmp$
        LOOP
        WinMenuData:
        '-------------------------------------User Defined here.--------------------------------------
        DATA Cut.........Ctrl+X,Copy........Ctrl+C,Paste.......Ctrl+V,Clear..........Del,Select All..Ctrl+A
        '---------------------------------------------------------------------------------------------
        DATA Close..........Esc,Quit........Alt+F4,eof
    END IF
    y = CSRLIN: x = POS(0)
    LOCATE , , 0 ' Hide cursor
    DIM atmp AS STRING

    DO
        _LIMIT 30
        '''''''z = GetCursorPos(WinMse)
        IF rt_menu <> 2 THEN CALL my_mouse(lb, rb, my, mx, drag, menu$()): CALL my_keyboard(b$)
        IF rb = 0 AND rt_menu = -1 THEN rt_menu = -2
        IF rb AND rt_menu = -2 THEN rt_menu = 2: EXIT DO ' Move to a new position.
        SELECT CASE menu.var
            CASE -1
                IF my > MenuT AND my < MenuB AND mx > MenuL AND mx < MenuR THEN
                    IF (my - MenuT) \ 2 <> (my - MenuT) / 2 AND my <> oldmy THEN ' Works for odd or even number top margins.
                        IF MenuHL THEN ' Remove highlighting from previous hover.
                            atmp = SPACE$(mwidth - 2)
                            MID$(atmp, 2, LEN(menu$((MenuHL - MenuT) \ 2 + 1))) = menu$((MenuHL - MenuT) \ 2 + 1)
                            LOCATE MenuHL, MenuL + 2 - 1
                            COLOR 0, 5: PRINT atmp;
                        END IF
                        atmp = SPACE$(mwidth - 2)
                        MID$(atmp, 2, LEN(menu$((my - MenuT) \ 2 + 1))) = menu$((my - MenuT) \ 2 + 1)
                        LOCATE my, MenuL + 2 - 1
                        COLOR 5, 0
                        PRINT atmp;
                        COLOR 0, 5
                        MenuHL = my
                        oldmy = my
                    END IF
                    IF _MOUSEBUTTON(1) THEN
                        menu.var = (my - MenuT) \ 2 + 1
                        EXIT DO
                    END IF
                ELSE
                    ' Toggle close menu.
                    IF _MOUSEBUTTON(1) THEN
                        IF my >= _SCREENY AND my <= _SCREENY + 24 AND mx >= _SCREENX + 36 AND mx <= _SCREENX + 48 THEN
                            menu.var = 0: EXIT DO ' Close menu.
                        ELSE
                            IF my >= _SCREENY AND my <= _SCREENY + _FONTHEIGHT * (_HEIGHT + 1) AND mx >= _SCREENX AND mx <= _SCREENX + _FONTWIDTH * _WIDTH THEN
                            ELSE ' Outside of app window.
                                menu.var = 0: EXIT DO ' Close menu.
                            END IF
                        END IF
                    END IF
                    IF _MOUSEBUTTON(1) THEN ' Outside of menu closes menu.
                        menu.var = 0 ' Close.
                        EXIT DO
                    END IF
                END IF

                IF b$ = CHR$(27) THEN b$ = "": EXIT DO ' Simply close popup.
                IF LEN(b$) THEN
                    '-----------------------------------------------------------------------------------------------------------
                    ' Valid menu shortcut key list here.
                    SELECT CASE b$
                        CASE CHR$(0) + "S", CHR$(22), CHR$(24), CHR$(1), CHR$(3): EXIT DO
                    END SELECT
                END IF
            CASE ELSE ' Open menu.
                menu_variety = 1 '''''''''''''''
                h = 5 ' Variable to determine margin spaces from the right of menu.
                FOR i = 1 TO WinCon.noi
                    j = LEN(menu$(i))
                    IF j > k THEN k = j
                NEXT
                mwidth = k + h
                mheight = WinCon.noi * 2 + 1 ' Add one for the separate border element.
                SELECT CASE menu_variety
                    CASE 0 ' Fixed menu to left.
                        MenuT = 3: MenuL = 1: MenuR = MenuL + mwidth: MenuB = MenuT + mheight
                    CASE 1 ' Movable menu.
                        WHILE _MOUSEINPUT: WEND
                        MenuT = _MOUSEY
                        MenuL = _MOUSEX
                        IF MenuT + mheight >= _HEIGHT THEN MenuT = _HEIGHT - mheight - 1 ' -1 for shadow.
                        IF MenuL + mwidth >= _WIDTH THEN MenuL = _WIDTH - mwidth - 1 ' -1 for shadow.
                        MenuR = MenuL + mwidth: MenuB = MenuT + mheight
                END SELECT

                menu.var = -1
                PCOPY 0, 1
                PALETTE 5, 63
                PALETTE 1, 8
                PALETTE 3, 56
                COLOR 0, 5
                LOCATE MenuT, MenuL
                PRINT CHR$(218) + STRING$(mwidth - 2, 196) + CHR$(191)
                FOR i = 1 TO mheight - 2
                    COLOR 0, 5: LOCATE , MenuL
                    PRINT CHR$(179); SPACE$(mwidth - 2) + CHR$(179);
                    COLOR 5, 3: PRINT CHR$(SCREEN(CSRLIN, POS(0))) + CHR$(SCREEN(CSRLIN, POS(0) + 1)): COLOR 1, 5
                NEXT
                COLOR 0, 5: LOCATE , MenuL
                PRINT CHR$(192) + STRING$(mwidth - 2, 196) + CHR$(217);
                COLOR 5, 3: PRINT CHR$(SCREEN(CSRLIN, POS(0))) + CHR$(SCREEN(CSRLIN, POS(0) + 1))
                LOCATE , MenuL + 2
                FOR i = 1 TO mwidth
                    PRINT CHR$(SCREEN(CSRLIN, POS(0)));
                NEXT
                COLOR 0, 5
                LOCATE MenuT + 2, MenuL + 2
                FOR i = 0 TO WinCon.noi - 1
                    LOCATE MenuT + 1 + i * 2, MenuL + 2
                    PRINT menu$(i + 1)
                    LOCATE , MenuL
                    IF i + 1 < WinCon.noi THEN PRINT "Ã" + STRING$(mwidth - 2, CHR$(196)) + "´";
                NEXT
                DO: _LIMIT 10: WHILE _MOUSEINPUT: WEND: LOOP UNTIL _MOUSEBUTTON(1) = 0 ' Wait for button release to avoid continuous toggle event.
        END SELECT
    LOOP
    PCOPY 1, 0
    LOCATE y, x
    _KEYCLEAR
    DO: _LIMIT 10: WHILE _MOUSEINPUT: WEND: LOOP UNTIL _MOUSEBUTTON(1) = 0
END SUB

SUB myform (nof, yfield(), xfield(), flen(), maxlen(), text$())
    RESTORE myformdata
    DO
        FOR j = 1 TO 5: READ a$
            IF a$ = "EOF" THEN EXIT DO
        NEXT
        nof = nof + 1 ' Number of fields from our data statement.
    LOOP
    REDIM yfield(nof) ' Row.
    REDIM xfield(nof) ' Column.
    REDIM flen(nof) ' Field length.
    REDIM maxlen(nof) ' Max text length.
    REDIM text$(nof) ' Text input
    RESTORE myformdata
    DO ' Falx loop.
        FOR i = 1 TO nof
            FOR j = 1 TO 5: READ a$: IF a$ = "EOF" THEN EXIT DO
                SELECT CASE j
                    CASE 1: yfield(i) = VAL(a$)
                    CASE 2: xfield(i) = VAL(a$)
                    CASE 3: flen(i) = VAL(a$)
                    CASE 4: maxlen(i) = VAL(a$)
                    CASE 5: text$(i) = a$
                END SELECT
            NEXT j
        NEXT
    LOOP
    PALETTE 6, 8: COLOR 7, 6: CLS
    PALETTE 5, 63: COLOR 0, 5
    mtop = 4: mwidth = 60: mheight = 15: mleft = 10
    LOCATE mtop, mleft
    COLOR 0, 5
    PRINT CHR$(218) + STRING$(mwidth - 2, 196) + CHR$(191)
    FOR i = 1 TO mheight - 2
        LOCATE , mleft
        PRINT CHR$(179); SPACE$(mwidth - 2) + CHR$(179)
    NEXT
    COLOR 0, 5: LOCATE , mleft
    PRINT CHR$(192) + STRING$(mwidth - 2, 196) + CHR$(217);
    FOR i = 1 TO nof
        LOCATE yfield(i), xfield(i) - 8
        COLOR 0, 5
        PRINT "Line "; LTRIM$(STR$(i)); ":";
        LOCATE yfield(i), xfield(i) - 1
        COLOR 8, 5: PRINT CHR$(222);
        COLOR 15, 0: PRINT SPACE$(flen(i));
    NEXT
    COLOR 15, 0
    nof = 1 ' Set to first field.
    EXIT SUB '--------------------------------------------------------->

    form_color_picker: ' Currently not in use.
    'REDIM k(10): k(1) = 4: k(2) = 7: k(3) = 8: k(4) = 17: k(5) = 24: k(6) = 16: k(7) = 32: k(8) = 40: k(9) = 41
    i = 0: DO
        SLEEP
        LOCATE 25, 1: PRINT i; 'PRINT k(i + 1);
        PALETTE 3, i 'k(i + 1)
        i = i + 1: IF i = 64 THEN i = 0 'IF i = 9 THEN i = 0
    LOOP
    RETURN

    myformdata:
    DATA 8,21,20,50,""
    DATA 10,21,45,50,""
    DATA 12,21,35,50,""
    DATA 14,21,35,50,""
    DATA EOF
END SUB

Pete
Reply
#45
Thumbs Up 
Wow @Pete some nice stuff for GUI here, Cut, Copy Paste from Right Click Menu and text selection. Perfect next steps to add to my GUI stuff.
b = b + ...
Reply
#46
Thanks. It's a bit messy right now, which is why you don't find this post in the WIP or Programs section, yet. Once I get it to a point I'm satisfied with whatever other bells and whistles I want included then I'll rename variables to types, and make it into a library.

Pete Smile
Reply
#47
Well the timing of this post is perfect for me! Being able to select text for cut copy paste is just motivator I needed to overhaul List and Text boxes with MONOSPACE fonts.
b = b + ...
Reply




Users browsing this thread: 1 Guest(s)