Windows or Panels

[SMcNeill]

This sounds like my frame library at work.

Code: (Select All)

'$INCLUDE:'FrameLibrary.BI'

CONST FileName$ = "tt.txt"


REDIM SHARED WordGrid(0, 0) AS STRING * 1
REDIM SHARED YLines(0, 0) AS STRING
REDIM SHARED XLines(0, 0) AS STRING

DIM SHARED SearchTerms(1) AS STRING
SearchTerms(0) = "TRICK": SearchTerms(1) = "TREAT"

DIM SHARED X AS INTEGER, Y AS INTEGER

DIM SHARED LeftFrame AS INTEGER, RightFrame AS INTEGER


SCREEN _NEWIMAGE(1280, 720, 32) '720p HD just cause I like it as a standard


LeftFrame = NewTextArea(0, 0, 400, _HEIGHT - 1, False)
ColorTextArea LeftFrame, _RGB32(255, 255, 255), _RGB32(0, 0, 128)
DrawTextArea LeftFrame

RightFrame = NewTextArea(401, 0, _WIDTH - 1, _HEIGHT - 1, False)
ColorTextArea RightFrame, _RGB32(255, 255, 255), _RGB32(0, 0, 0)
DrawTextArea RightFrame



LoadWordGrid
MakeDirectional
ShowGrid
FindWords



SUB FindWords
    FOR j = 0 TO UBOUND(SearchTerms)
        SetPrintStyleX RightFrame, CenterJustify
        SetPrintUpdate RightFrame, NewLine
        SetTextForeground RightFrame, _RGB32(255, 255, 0)
        PrintOut RightFrame, "SEARCHING FOR " + SearchTerms(j)
        SetTextForeground RightFrame, _RGB32(255, 255, 255)
        PrintOut RightFrame, ""
        PrintOut RightFrame, "Finding Left to Right Matches"
        SetPrintStyleX RightFrame, NoJustify
        SetPrintUpdate RightFrame, NoNewLine

        FOR i = 1 TO Y
            foundone = 0
            DO
                foundone = INSTR(foundone + 1, YLines(1, i), SearchTerms(j))
                IF foundone THEN
                    PrintOut RightFrame, "(Line" + STR$(i) + ", Position" + STR$(foundone) + "), "
                    tc = tc + 1
                END IF
            LOOP UNTIL NOT foundone
        NEXT

        SetPrintStyleX RightFrame, CenterJustify
        SetPrintUpdate RightFrame, NewLine
        PrintOut RightFrame, ""
        PrintOut RightFrame, ""
        PrintOut RightFrame, "Finding Right to Left Matches"
        SetPrintUpdate RightFrame, NoNewLine
        SetPrintStyleX RightFrame, NoJustify
        FOR i = 1 TO Y
            foundone = 0
            DO
                foundone = INSTR(foundone + 1, YLines(2, i), SearchTerms(j))
                IF foundone THEN
                    PrintOut RightFrame, "(Line" + STR$(i) + ", Position" + STR$(X - foundone + 1) + "), "
                    tc = tc + 1
                END IF
            LOOP UNTIL NOT foundone
        NEXT

        SetPrintStyleX RightFrame, CenterJustify
        SetPrintUpdate RightFrame, NewLine
        PrintOut RightFrame, ""
        PrintOut RightFrame, ""
        PrintOut RightFrame, "Finding Up to Down Matches"
        SetPrintUpdate RightFrame, NoNewLine
        SetPrintStyleX RightFrame, NoJustify
        FOR i = 1 TO X
            foundone = 0
            DO
                foundone = INSTR(foundone + 1, XLines(1, i), SearchTerms(j))
                IF foundone THEN
                    PrintOut RightFrame, "(Line" + STR$(foundone) + ", Position" + STR$(i) + "), "
                    tc = tc + 1
                END IF
            LOOP UNTIL NOT foundone
        NEXT

        SetPrintStyleX RightFrame, CenterJustify
        SetPrintUpdate RightFrame, NewLine
        PrintOut RightFrame, ""
        PrintOut RightFrame, ""
        PrintOut RightFrame, "Finding Down to Up Matches"
        SetPrintUpdate RightFrame, NoNewLine
        SetPrintStyleX RightFrame, NoJustify
        FOR i = 1 TO X
            foundone = 0
            DO
                foundone = INSTR(foundone + 1, XLines(2, i), SearchTerms(j))
                IF foundone THEN
                    PrintOut RightFrame, "(Line" + STR$(foundone) + ", Position" + STR$(i) + "), "
                    tc = tc + 1
                END IF
            LOOP UNTIL NOT foundone
        NEXT


        SetPrintUpdate RightFrame, NewLine
        PrintOut RightFrame, ""
        PrintOut RightFrame, ""
        PrintOut RightFrame, STR$(tc) + " total matches found."
        PrintOut RightFrame, ""
        PrintOut RightFrame, ""
        tc = 0
    NEXT
END SUB



SUB ShowGrid
    'Print the words in the grid
    SetTextColor LeftFrame, _RGB32(255, 255, 0), 0
    PrintOut LeftFrame, ""
    PrintOut LeftFrame, "                    WORD GRID"
    PrintOut LeftFrame, ""
    SetTextColor LeftFrame, _RGB32(255, 255, 255), 0
    FOR i = 1 TO Y
        PrintOut LeftFrame, "  " + YLines(1, i)
    NEXT
END SUB




SUB LoadWordGrid
    OPEN FileName$ FOR BINARY AS #1
    DO UNTIL EOF(1)
        LINE INPUT #1, junk$
        Y = Y + 1
    LOOP
    X = LEN(junk$): Y = Y
    SEEK #1, 1

    REDIM WordGrid(1 TO X, 1 TO Y) AS STRING * 1 'Properly size our grid, with borders
    REDIM YLines(2, Y) AS STRING
    REDIM XLines(2, X) AS STRING

    FOR i = 1 TO Y
        LINE INPUT #1, junk$
        FOR j = 1 TO X
            WordGrid(j, i) = MID$(junk$, j) 'Fill in the grid with the letters
        NEXT
    NEXT
    CLOSE #1
END SUB

SUB MakeDirectional
    FOR i = 1 TO Y
        FOR j = 1 TO X
            YLines(1, i) = YLines(1, i) + WordGrid(j, i) 'Left to Right Lines
    NEXT j, i
    FOR i = 1 TO Y: FOR j = X TO 1 STEP -1
            YLines(2, i) = YLines(2, i) + WordGrid(j, i) 'Right to Left Lines
    NEXT j, i
    FOR i = 1 TO Y: FOR j = 1 TO X
            XLines(1, i) = XLines(1, i) + WordGrid(j, i) 'Up to Down Lines
    NEXT j, i
    FOR i = 1 TO Y: FOR j = X TO 1 STEP -1
            XLines(2, i) = XLines(1, i) + WordGrid(j, i) 'Right to Left Lines
    NEXT j, i
END SUB

'$INCLUDE:'FrameLibrary.BM'

The demo here sets us up with just 2 frames (leftframe and rightframe here), but there's no reason why you can't have 3 or 12 or 127...

I shared this waaay back on the old *.rip forums, but you can find a copy of the original post on the subject here in you're interested: Frame Library (alephc.xyz)