Print Page - Line with repeated numbers

Title: Line with repeated numbers
Post by: carloscordeiro on November 19, 2020, 06:23:06 pm

Hi Bplus
I come again to ask for your help.
The subject is basically the same as always, but the purpose is different.
This time, I want to count in the numbers.txt file how many lines have the same repeated numbers.
I made a very poor code, if you don't understand I can design my purpose this time.
Here is the file and the faulty code that I tried to make.
Carlos

Code: QB64: [Select]

DIM repetitions(1 TO 25) AS STRING
DIM repetitions2(1 TO 25)
DIM total AS LONG
 
OPEN "numbers.txt" FOR INPUT AS #1
FOR i = 1 TO 25
    LINE INPUT #1, repetitions(i)
NEXT
CLOSE #1
 
total = 1
FOR e = 1 TO 25 'Imperfect code
    a$ = repetitions$(e)
    FOR i = e + 1 TO 25
        IF VAL(repetitions$(i)) = VAL((a$)) THEN
            total = total + 1
            repetitions2(e) = total
        END IF
    NEXT
    total = 1
NEXT
 
FOR e = 1 TO 25
    IF repetitions2(e) <> 0 THEN
        PRINT repetitions2(e); "  -  "; repetitions$(e) 'Imperfect code
    END IF
NEXT
 

Title: Re: Line with repeated numbers
Post by: bplus on November 19, 2020, 07:00:14 pm

Hi @carloscordeiro

Code: QB64: [Select]

SCREEN _NEWIMAGE(800, 440, 32)
REDIM fileLines(1 TO 25) AS STRING, repeats(1 TO 25), repeatLines$(1 TO 25)
OPEN "numbers.txt" FOR INPUT AS #1 ' get data from file
FOR i = 1 TO 25
    LINE INPUT #1, fileLines(i)
    PRINT i, fileLines(i) 'check the lines
NEXT
CLOSE #1
FOR f = 1 TO 25
    FOR i = 1 TO 4 ' 4 number for each file line
        n = VAL(MID$(fileLines(f), i * 3 - 2, 2))
        repeats(n) = repeats(n) + 1 ' count number of occurances of this number
        repeatLines$(n) = repeatLines$(n) + STR$(f) + ","
    NEXT
NEXT
'report repeats
FOR i = 1 TO 25
    LOCATE i, 30: PRINT i; " repeats:"; repeats(i); " at:"; repeatLines$(i)
NEXT
 
 

Title: Re: Line with repeated numbers
Post by: carloscordeiro on November 19, 2020, 07:58:41 pm

Hello, bplus
Once again I am unable to express the purpose of the code.
I want him to count the entire line.
In the file number.txt, there are 2 lines with the same numbers.
Ex1: 04 05 06 07 there are two (02) repeated lines.
Ex2. 03 04 05 06 there are three (03) repeated lines.
Regardless of the position of the line, I want only the numbers of the entire line and the number of times.

I attach an image marking the lines of my code with errors, as it counts the lines in excess or duplicates those that it has already counted.

Thanking you in advance for your quick response.
Carlos

Title: Re: Line with repeated numbers
Post by: bplus on November 19, 2020, 09:05:50 pm

This?

Code: QB64: [Select]

SCREEN _NEWIMAGE(800, 440, 32)
REDIM fileLines(1 TO 25) AS STRING
OPEN "numbers.txt" FOR INPUT AS #1 ' get data from file
FOR i = 1 TO 25
    LINE INPUT #1, fileLines(i)
NEXT
CLOSE #1
FOR i = 1 TO 24
    t = 1
    FOR j = i + 1 TO 25
        IF _TRIM$(fileLines(i)) = _TRIM$(fileLines(j)) AND _TRIM$(fileLines(i)) <> "" THEN
            t = t + 1
            fileLines(j) = ""
        END IF
    NEXT
    IF t > 1 THEN PRINT t; " "; fileLines(i)
NEXT
 
 

Title: Re: Line with repeated numbers
Post by: carloscordeiro on November 20, 2020, 09:09:37 am

That's right, Bplus.
I think the ease you have in finding quick solutions to my questions is agile.

Great!!!

The only return, and to thank

Thank you one more time
Carlos

Title: Re: Line with repeated numbers
Post by: carloscordeiro on July 11, 2021, 08:16:52 pm

Good night, Bplus

Before I come to ask for your help, I try very hard to resolve it on my own.

This code of yours, to separate lines with repeated numbers, served me a lot at the time you created it.

Code: QB64: [Select]

SCREEN _NEWIMAGE(800, 440, 32)
REDIM fileLines(1 TO 25) AS STRING
OPEN "numbers.txt" FOR INPUT AS #1 ' get data from file
FOR i = 1 TO 25
    LINE INPUT #1, fileLines(i)
NEXT
CLOSE #1
FOR i = 1 TO 24
    t = 1
    FOR j = i + 1 TO 25
        IF _TRIM$(fileLines(i)) = _TRIM$(fileLines(j)) AND _TRIM$(fileLines(i)) <> "" THEN
            t = t + 1
            fileLines(j) = ""
        END IF
    NEXT
    IF t > 1 THEN PRINT t; " "; fileLines(i)
NEXT
 
 

used it to count repeated numbers from the attached code.

Bplus, could you modify or have another idea to count numbers that come out only once?

When I insert it in the attached code, it doesn't count the number 37 as the attached image.

Code: QB64: [Select]

          For i = 1 To qu - 1 'Line with repeated numbers Bplus
               t = 1
               For j = i + 1 To qu
                    If _Trim$(soma1(i)) = _Trim$(soma1(j)) And _Trim$(soma1(i)) <> "" Then
                         t = t + 1
                         soma1(j) = ""
                    End If
               Next
 
               If t > 1 Then
                    Color 30
                    Locate i + 10, 5
                    Print "Dezena = ";
                    Color 10
                    Locate i + 10, 8
                    Print " "; soma1(i);
                    Color 30
                    Locate i + 10, 12
                    Print "="; t
               End If
          Next
     Else

Put this string when running the code
083033374548

Carlos

Title: Re: Line with repeated numbers
Post by: bplus on July 11, 2021, 10:30:19 pm

@carloscordeiro

Sorry not interested in immersing into this again, since last time I built an Interpreter, fixed String Math and made nice Pool game. My head and heart is a million miles away from this.

Title: Re: Line with repeated numbers
Post by: carloscordeiro on July 12, 2021, 09:32:39 am

Quote

Sorry not interested in immersing into this again, since last time I built an Interpreter, fixed String Math and made nice Pool game. My head and heart is a million miles away from this.

All right, Bplus
I didn't know you were too busy.
A hug.
Carlos.

Title: Re: Line with repeated numbers
Post by: bplus on August 03, 2021, 11:17:41 am

@carloscordeiro

This tells if lines are repeated and how many times, so all the lines are accounted for from the file, numbers.txt:

Code: QB64: [Select]

Screen _NewImage(800, 440, 32)
ReDim fileLines(1 To 25) As String
Open "numbers.txt" For Input As #1 ' get data from file
For i = 1 To 25
    Line Input #1, fl$: fileLines(i) = _Trim$(fl$)
Next
Close #1
For i = 1 To 25
    t = 0
    For j = i + 1 To 25
        If _Trim$(fileLines(i)) = fileLines(j) And Left$(fileLines(i), 7) <> "Repeat " Then
            t = t + 1
            fileLines(j) = "Repeat " + fileLines(i)
        End If
    Next
    If Left$(fileLines(i), 7) <> "Repeat " Then Print fileLines(i); " repeated"; t; "times." Else Print fileLines(i)
Next
 

Title: Re: Line with repeated numbers
Post by: carloscordeiro on August 03, 2021, 05:31:23 pm

Good night, Bplus.

That's what I wasn't seeing.

A small change on line 8 from 24 to 25.
FOR i = 1 TO 24

FOR i = 1 TO 24
t = 1
FOR j = i + 1 TO 25

For

FOR i = 1 TO 25
t = 0
FOR j = i + 1 TO 25

That's what you did and I didn't see it.

Bplus, around here, things are very complicated.

So I created this code with your help, I mean, almost every line of code was with your help and willingness to respond.

I'm trying to find a pattern in the numbers.

More already realized that there is not.

I was trying to help luck when I sometimes make a bet.

Title: Re: Line with repeated numbers
Post by: carloscordeiro on August 03, 2021, 05:53:51 pm

Before thanking,

I would like to ask if there is color in Qbasic 64 as in the example below.

Code: QB64: [Select]

[Color 30
Print "qbasic"
Print
Print "Bplus"]

The names keep flashing.

I searched the wiki and I didn't find anything

I always use:

_Title "Qbasic 64"
Screen _NewImage(700, 740, 256)
_Delay .25
_ScreenMove 20, 30

The _Newlmage screen seems to disable this old qbsic effect.

As always, thank you in advance.

Carlos

Title: Re: Line with repeated numbers
Post by: carloscordeiro on August 03, 2021, 06:12:55 pm

line 8 from 24 to 25.
FOR i = 1 TO 24

FOR i = 1 TO 24
t = 1
FOR j = i + 1 TO 25

For

FOR i = 1 TO 25
t = 0
FOR j = i + 1 TO 25

The t=0 I left as the previous one
t=1

Title: Re: Line with repeated numbers
Post by: bplus on August 03, 2021, 07:15:41 pm

Quote from: carloscordeiro on August 03, 2021, 05:53:51 pm

Before thanking,

I would like to ask if there is color in Qbasic 64 as in the example below.

Code: QB64: [Select]
[Color 30
Print "qbasic"
Print
Print "Bplus"]

The names keep flashing.

I searched the wiki and I didn't find anything

I always use:

_Title "Qbasic 64"
Screen _NewImage(700, 740, 256)
_Delay .25
_ScreenMove 20, 30

The _Newlmage screen seems to disable this old qbsic effect.

As always, thank you in advance.

Carlos

Blinking colors and other weird stuff with _NEWIMAGE 0 color setting (or default screen 0):

Code: QB64: [Select]

Screen _NewImage(80, 30, 0) ' oh! using 0 means char cells not pixels in _newimage command!
For i = 0 To 15
    Color i, 0
    Locate i + 1, 1: Print "This is color"; i; "for line"; i + 1; "."
    Color i + 16
    Locate i + 1, 40: Print "This is color"; i + 16; "for line"; i + 1; "."
Next
 
 

Title: Re: Line with repeated numbers
Post by: carloscordeiro on August 03, 2021, 09:41:44 pm

Okay, Bplus

I thought that with the settings I use, I could do the same

I wanted for a kind of alert.

Thanks again.

Carlos

Title: Re: Line with repeated numbers
Post by: bplus on August 04, 2021, 12:36:24 pm

Wouldn't be hard to setup blinking text label for graphics screen.

Here's an old one:

Code: QB64: [Select]

_Title "Blinking and more with text string" 'b+ 2020-02-15
 
'===================================================================================
' Lets blink between colors white and blue, expanding and shrinking text for 10 secs
'===================================================================================
 
s$ = "Blink colors white and blue, expanding and shrinking centered text for 10 secs"
Screen _NewImage(800, 600, 32)
th = 16 'Text Height - start normal
dh = 1 'change height
flashTimes = 100 'with limit 10 this will take 10 times a second and be done in 100/10 secs
start$ = Time$
While _KeyDown(27) = 0
    Cls
    Print start$; ", ";
    If flashTimes Then
        If toggle = 1 Then C~& = &HFFFFFFFF Else C~& = &HFF0000FF
        cText _Width / 2, _Height / 2, th, C~&, s$
        toggle = 1 - toggle
        th = th + dh
        If th > 64 Then th = 64: dh = -dh
        If th < 6 Then th = 6: dh = -dh
        flashTimes = flashTimes - 1
        lastFlash$ = Time$
    Else
        cText _Width / 2, _Height / 2, 16, &HFFFFFF00, s$
    End If
    Print lastFlash$; " <<<< notice these numbers are not flashing even though we CLS every frame"
    _Display '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> eliminates blinking screens when use CLS
    _Limit 10 '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>  allows maximum number of loops of 10 per sec
Wend
 
'center the text at x, y with given height and color
Sub cText (x, y, textHeight, K As _Unsigned Long, txt$)
    Dim fg As _Unsigned Long, cur&, I&, mult, xlen
    fg = _DefaultColor
    'screen snapshot
    cur& = _Dest
    I& = _NewImage(8 * Len(txt$), 16, 32)
    _Dest I&
    Color K, _RGBA32(0, 0, 0, 0)
    _PrintString (0, 0), txt$
    mult = textHeight / 16
    xlen = Len(txt$) * 8 * mult
    _PutImage (x - .5 * xlen, y - .5 * textHeight)-Step(xlen, textHeight), I&, cur&
    Color fg
    _FreeImage I&
End Sub
 

Another one:

Code: QB64: [Select]

Randomize Timer
Screen _NewImage(220, 50, 32)
_Title ""
Const H$ = "Hello World"
Dim Shared r&, g&, b&, old&, new&
update
While _KeyDown(27) = 0
    If Rnd < 1 / 20 And m = 10 Then update
    Cls
    m = (m + 1) Mod 11
    If m = 0 Then Swap old&, new&
    x = 65 + m * 8
    Color old&
    _PrintString (65, 15), Mid$(H$, 1, m)
    Color new&
    _PrintString (x, 15), Mid$(H$, m + 1)
    _Display
    _Limit 30
Wend
 
Sub update
    r& = Rnd * 255: g& = Rnd * 255: b& = Rnd * 255
    old& = _RGB32(r&, g&, b&)
    new& = _RGB32((r& + 128) Mod 255, (g& + 128) Mod 255, (b& + 128) Mod 255)
End Sub
 
 

Title: Re: Line with repeated numbers
Post by: bplus on August 04, 2021, 01:00:27 pm

Heres one from today:

Code: QB64: [Select]

_Title "BlinkingScreenLabel Sub" ' b+ 2021-08-04  for Carlos
 
'just put the sub call in the loop you use to display the screen it will blink according to limit
Do
    For i = 1 To 15
        BlinkingScreenLabel 1, i, "This is line" + Str$(i), i, 0
    Next
    _Limit 1
Loop
 
Sub BlinkingScreenLabel (x, y, txt$, c1~&, c2~&)
    Static blink
    blink = 1 - blink
    saveFore~& = _DefaultColor
    If blink Then Color c1~& Else Color c2~&
    _PrintString (x, y), txt$
    Color saveFore~& 'restore color
End Sub
 

Title: Re: Line with repeated numbers
Post by: carloscordeiro on August 04, 2021, 05:55:44 pm

Bplus

Below is an image of the alert that I intended to insert, to make the code more elegant.

As there is no simple way to do this.

I'll leave it as it is.

I want you to know, that when you answer my weird questions.

You make me so happy.

Thank you from the heart.

Carlos

Code: QB64: [Select]

[/_Title "Qbasic 64" ' Many lines, created with help friend Bplus
Screen _NewImage(600, 600, 256)
_Delay .25
_ScreenMove 50, 50
 
'Moldura...
Line (0, 0)-(599, 599), 11, B 'Moldura inteira
Line (1, 1)-(598, 598), 11, B
Line (2, 2)-(597, 597), 11, B
Line (3, 3)-(596, 596), 11, B
Line (4, 4)-(595, 595), 11, B
 
Line (599, 43)-(2, 43), 11, B 'Linha Horizontal
Line (599, 44)-(2, 44), 11, B
 
'Mostra Data
d$ = Mid$(Date$, 1, 3)
c$ = Mid$(Date$, 4, 3)
e$ = Mid$(Date$, 7, 4)
f$ = c$ + d$ + e$
 
Color 11: Locate 2, 28: Print "* * * Mega Sena * * *"
Locate 2, 65: Print Time$
Locate 2, 4: Print f$
'--------------------------------------------------------------------------------
Dim nt(0 To 3000) As String
Dim cadastro As Long
 
_ControlChr Off
 
If _FileExists("mega.txt") Then
     Open "mega.txt" For Input As #1
     cadastro = LOF(1) \ 19
     For t = 1 To cadastro
          Line Input #1, nt$(t)
     Next
     Close
     Open "mega.txt" For Append As #1
Else
     Open "mega.txt" For Output As #1
End If
Do
     done = 1
 
     Color 30
     Locate 12, 3: Print "Concurso =>"; cadastro; "= "; nt$(cadastro)
     Locate 30, 3: Print "Pressione [ESC] para sair."
     Locate 4, 3: Print "N" + Chr$(163); "meros de concursos =>"; cadastro
 
     Locate 6, 14: Print "_____________"
     Locate 6, 3: Print "Dezenas => ";
     a$ = ExtendedInput$ 'code Mr. SMcNeill
 
     For r = 6 To 30
          Locate r, 2: Print Spc(72)
     Next
 
     For i = 1 To 12 Step 2
          x$ = x$ + Mid$(a$, i, 2) + " "
     Next
 
     x$ = _Trim$(x$)
 
     For i = 1 To cadastro
          If x$ = nt$(i) Then
               done = 0
               Color 48
               Locate 15, 25: Print "Contest:"; i; "exists!!!! "
               Locate 17, 29: Print ; nt$(i);
               Locate 18, 29: Print "================="
               Color 30
               Beep
               Exit For
          End If
     Next
 
     Locate 8, 3: Print "Dezenas => "; x$
     Locate 10, 3: Print "N£meros de digitos ="; Len(a$)
 
 
     If Len(a$) = 12 And done = 1 Then
          Print #1, x$
          Color 48
          Locate 15, 24: Print "Dezenas salvas com sucesso!!!"
          Locate 16, 24: Print "============================="
          Locate 18, 30: Print x$
          Locate 19, 30: Print "================="
          cadastro = cadastro + 1
          nt$(cadastro) = x$
          nt$ = x$
          Beep
     ElseIf Len(a$) > 12 Then
          Color 48
          Locate 20, 23: Print "Number of digits greater than 12 =>"; Len(a$)
          Locate 22, 30: Print ; a$
          Locate 23, 31: Print "============="
          Color 30
          Beep
     End If
 
     x$ = ""
     Scrn$ = InKey$
Loop Until Scrn$ = Chr$(27)
Close
 
Play "o3l32ceff+g"
Play "mfo4l64ceg>c"
Cls
 
OE20 = _LoadFont("century.ttf", 82)
_Font OE20
Color 11 ' &H200000FF
Locate 4, 90: Print " QBasic 64 "
Locate 5, 90: Print " -------------- "
_Delay 2
System
 
'--------------------------------------------------------------------------------
 
Function ExtendedInput$ 'code Mr. SMcNeill
     PCopy 0, 1
     A = _AutoDisplay: X = Pos(0): Y = CsrLin
     CP = 0: OldCP = 0 'Cursor Position
     _KeyClear
     Do
          PCopy 1, 0
          If _KeyDown(100307) Or _KeyDown(100308) Then AltDown = -1 Else AltDown = 0
          k = _KeyHit
          If AltDown Then
               Select Case k 'ignore all keypresses except ALT-number presses
                    Case 48 TO 57: AltWasDown = -1: alt$ = alt$ + Chr$(k)
               End Select
          Else
               Select Case k 'without alt, add any keypresses to our input
                    Case 8
                         oldin$ = in$
                         If CP > 0 Then OldCP = CP: CP = CP - 1
                         in$ = Left$(in$, CP) + Mid$(in$, CP + 2) 'backspace to erase input
                    Case 9
                         oldin$ = in$
                         in$ = Left$(in$, CP) + Space$(4) + Mid$(in$, CP + 1) 'four spaces for any TAB entered
                         OldCP = CP
                         CP = CP + 4
                    Case 32 TO 128
                         If _KeyDown(100305) Or _KeyDown(100306) Then
                              If k = 118 Or k = 86 Then
                                   oldin$ = in$
                                   in$ = Left$(in$, CP) + _Clipboard$ + Mid$(in$, CP + 1) 'ctrl-v paste
                                   'CTRL-V leaves cursor in position before the paste, without moving it after.
                                   'Feel free to modify that behavior here, if you want it to move to after the paste.
                                   CP = CP + Len(_Clipboard$)
                              End If
                              If k = 122 Or k = 90 Then Swap in$, oldin$: Swap OldCP, CP 'ctrl-z undo
                         Else
                              oldin$ = in$
                              in$ = Left$(in$, CP) + Chr$(k) + Mid$(in$, CP + 1) 'add input to our string
                              OldCP = CP
                              CP = CP + 1
                         End If
                    Case 18176 'Home
                         CP = 0
                    Case 20224 'End
                         CP = Len(in$)
                    Case 21248 'Delete
                         oldin$ = in$
                         in$ = Left$(in$, CP) + Mid$(in$, CP + 2)
                    Case 19200 'Left
                         CP = CP - 1
                         If CP < 0 Then CP = 0
                    Case 19712 'Right
                         CP = CP + 1
                         If CP > Len(in$) Then CP = Len(in$)
               End Select
          End If
          alt$ = Right$(alt$, 3)
          If AltWasDown = -1 And AltDown = 0 Then
               v = Val(alt$)
               If v >= 0 And v <= 255 Then in$ = in$ + Chr$(v)
               alt$ = "": AltWasDown = 0
          End If
          blink = (blink + 1) Mod 30
          Locate Y, X
          Print Left$(in$, CP);
          If blink \ 15 Then Print " "; Else Print "_";
          Print Mid$(in$, CP + 1)
 
          _Display
          _Limit 30
     Loop Until k = 13
 
     PCopy 1, 0
     Locate Y, X: Print in$
     ExtendedInput$ = in$
     If A Then _AutoDisplay
End Function
]

Title: Re: Line with repeated numbers
Post by: carloscordeiro on August 04, 2021, 06:13:23 pm

Bplus, I'm going to overdo the questions a bit.

Would you have an idea, to reduce the number of for next and if, in this other code?

You don't need to create other code, only if you have a better idea than mine.

Carlos

Code: QB64: [Select]

_Title "Qbasic 64" ' Many lines, created with help friend Bplus
Screen _NewImage(700, 740, 256)
_Delay .25
_ScreenMove 20, 30
 
'Moldura...
Line (0, 0)-(699, 719), 11, B 'Moldura inteira
Line (1, 1)-(698, 718), 11, B
Line (2, 2)-(697, 717), 11, B
Line (3, 3)-(696, 716), 11, B
Line (4, 4)-(695, 715), 11, B
 
Line (699, 43)-(2, 43), 11, B 'Linha Horizontal
Line (699, 44)-(2, 44), 11, B
 
Line (336, 716)-(336, 44), 11, B 'Linha Vertical
Line (335, 716)-(335, 44), 11, B
 
'Mostra Data
d$ = Mid$(Date$, 1, 3)
c$ = Mid$(Date$, 4, 3)
e$ = Mid$(Date$, 7, 4)
f$ = c$ + d$ + e$
 
Color 11: Locate 2, 34: Print "* * * Mega Sena * * *"
Locate 2, 77: Print Time$
Locate 2, 4: Print f$: Color 7
 
'------------------------------------------------------------------------
Dim nt(1 To 3000) As String
Dim soma1(1 To 500) As String
Dim soma2(1 To 500) As String
Dim cor1(80) As _Integer64
Dim seq(500) As _Integer64
'Dim re As _Integer64
Dim file(1 To 50) As String
'------------------------------------------------------------------------
 
Open "mega.txt" For Input As #1
total = LOF(1) \ 19
For t = 1 To total
     Line Input #1, nt$(t)
Next
Close
 
_ControlChr Off
 
Color 30: Locate 4, 3: Print "N" + Chr$(163); "meros de concursos =>"; total
Do
     g = 0
     h = 3
     qu = 0
     te = 0
     Color 30
     Locate 6, 14: Print "_____________"
     Locate 6, 3: Print "Dezenas => ";
     a$ = ExtendedInput$ 'code Mr. SMcNeill
 
     For i = 1 To 12 Step 2
          x$ = x$ + Mid$(a$, i, 2) + " "
     Next
     Pes$ = _Trim$(x$)
     If Len(Pes$) = 17 Then
 
          For S = 4 To 44
               Locate S, 44: Print Spc(40)
          Next S
 
          Color 78
          Locate 8, 3: Print "Dezenas => "; Pes$; " ="; Len(Pes$)
          Locate 9, 14: Print "================="
 
          For re = 1 To total
               If h > 41 Then
                    _KeyClear
                    Color 13: Locate 44, 44: Print "Pressione Enter para continuar..."
                    Color 7
                    Do
                         _Limit 30
                    Loop Until InKey$ = Chr$(13)
                    For S = 4 To 44
                         Locate S, 44: Print Spc(40)
                    Next S
                    h = 3
               End If
 
               h = h + 1
               x = 49
 
               Color 15: Locate h, x - 5: Print Right$("0000" + LTrim$(Str$(re)), 4); " => "
 
               For i = 1 To 17 Step 3
                    x = x + 3
                    For r = 1 To 17 Step 3
                         If Mid$(nt$(re), i, 2) = Mid$(Pes$, r, 2) Then
                              g = g + 1
                              cor1(g) = i
                              Exit For
                         Else
                              Color 7: Locate h, x: Print Mid$(nt$(re), i, 2)
                         End If
                    Next r
               Next i
 
               If g <= 2 Then
                    Locate h, 44: Print Spc(29)
                    h = h - 1
               End If
 
               If g = 3 Then
                    Color 12
                    Locate h, x + 3: Print "=>";: Print " TERNO"
                    For ag = 1 To 3
                         te = te + 1
                         Locate h, 51 + cor1(ag): Print Mid$(nt$(re), cor1(ag), 2)
                         soma2(te) = Mid$(nt$(re), cor1(ag), 2)
                    Next ag
                    Color 7
               End If
 
               If g = 4 Then
                    Color 10
                    Locate h, x + 3: Print "=>";: Print " QUADRA"
                    For ag = 1 To 4
                         qu = qu + 1
                         Locate h, 51 + cor1(ag): Print Mid$(nt$(re), cor1(ag), 2)
                         soma1$(qu) = Mid$(nt$(re), cor1(ag), 2)
                    Next ag
                    Color 7
               End If
 
               If g = 5 Then
                    Color 3
                    Locate h, x + 3: Print "=>";: Print " QUINA"
                    For ag = 1 To 5
                         Locate h, 51 + cor1(ag): Print Mid$(nt$(re), cor1(ag), 2)
                    Next ag
                    Color 7
               End If
 
               If g = 6 Then
                    Color 14
                    Locate h, x + 3:: Print "=>";: Print " SENA "
                    For ag = 1 To 6
                         Locate h, 51 + cor1(ag): Print Mid$(nt$(re), cor1(ag), 2)
                    Next ag
                    Color 7
               End If
               g = 0
          Next
          a = 12
          For e = 10 To 22
               Locate e, 2: Print Spc(35)
          Next
          '-------------------------------------------------------------------
          For i = 1 To qu '- 1
               t = 1
               For j = i + 1 To qu
                    If _Trim$(soma1(i)) = _Trim$(soma1(j)) And _Trim$(soma1(i)) <> "" Then
                         t = t + 1
                         soma1(j) = ""
                    End If
               Next
               seq(i) = t
               If soma1(i) <> "" Then
                    a = a + 1
                    Color 30
                    Locate a, 3
                    Print "Dez = ";
                    Color 10
                    Locate a, 8
                    Print " "; soma1(i);
                    Color 30
                    Locate a, 12
                    Print "="; seq(i)
               End If
          Next
          '---------------------------------------------------------------------
          a = 12
          For i = 1 To te '- 1
               t = 1
               For j = i + 1 To te
                    If _Trim$(soma2(i)) = _Trim$(soma2(j)) And _Trim$(soma2(i)) <> "" Then
                         t = t + 1
                         soma2(j) = ""
                    End If
               Next
               seq(i) = t
               If soma2(i) <> "" Then
                    a = a + 1
                    Color 30
                    Locate a, 23
                    Print "Dez = ";
                    Color 12
                    Locate a, 28
                    Print " "; soma2(i);
                    Color 30
                    Locate a, 32
                    Print "="; seq(i)
               End If
          Next
          '-----------------------------------------------------------------------
 
     Else
          Beep
     End If
     Color 13: Locate 44, 58: Print "Pressione [ESC] para sair..."
     x$ = ""
     Scrn$ = InKey$
Loop Until Scrn$ = Chr$(27)
 
Play "o3l32ceff+g"
Play "mfo4l64ceg>c"
Cls
 
OE20 = _LoadFont("century.ttf", 82)
_Font OE20
Color 11 ' &H200000FF
Locate 4, 125: Print " QBasic 64 "
Locate 5, 125: Print " -------------- "
_Delay 2
System
 
'-------------------------------------------------------------------------------------
Function ExtendedInput$ ' Mr. McNeill's extended entrance
     PCopy 0, 1
     A = _AutoDisplay: X = Pos(0): Y = CsrLin
     CP = 0: OldCP = 0 'Cursor Position
     _KeyClear
     Do
          PCopy 1, 0
          If _KeyDown(100307) Or _KeyDown(100308) Then AltDown = -1 Else AltDown = 0
          k = _KeyHit
          If AltDown Then
               Select Case k 'ignore all keypresses except ALT-number presses
                    Case 48 TO 57: AltWasDown = -1: alt$ = alt$ + Chr$(k)
               End Select
          Else
               Select Case k 'without alt, add any keypresses to our input
                    Case 8
                         oldin$ = in$
                         If CP > 0 Then OldCP = CP: CP = CP - 1
                         in$ = Left$(in$, CP) + Mid$(in$, CP + 2) 'backspace to erase input
                    Case 9
                         oldin$ = in$
                         in$ = Left$(in$, CP) + Space$(4) + Mid$(in$, CP + 1) 'four spaces for any TAB entered
                         OldCP = CP
                         CP = CP + 4
                    Case 32 TO 128
                         If _KeyDown(100305) Or _KeyDown(100306) Then
                              If k = 118 Or k = 86 Then
                                   oldin$ = in$
                                   in$ = Left$(in$, CP) + _Clipboard$ + Mid$(in$, CP + 1) 'ctrl-v paste
                                   'CTRL-V leaves cursor in position before the paste, without moving it after.
                                   'Feel free to modify that behavior here, if you want it to move to after the paste.
                                   CP = CP + Len(_Clipboard$)
                              End If
                              If k = 122 Or k = 90 Then Swap in$, oldin$: Swap OldCP, CP 'ctrl-z undo
                         Else
                              oldin$ = in$
                              in$ = Left$(in$, CP) + Chr$(k) + Mid$(in$, CP + 1) 'add input to our string
                              OldCP = CP
                              CP = CP + 1
                         End If
                    Case 18176 'Home
                         CP = 0
                    Case 20224 'End
                         CP = Len(in$)
                    Case 21248 'Delete
                         oldin$ = in$
                         in$ = Left$(in$, CP) + Mid$(in$, CP + 2)
                    Case 19200 'Left
                         CP = CP - 1
                         If CP < 0 Then CP = 0
                    Case 19712 'Right
                         CP = CP + 1
                         If CP > Len(in$) Then CP = Len(in$)
               End Select
          End If
          alt$ = Right$(alt$, 3)
          If AltWasDown = -1 And AltDown = 0 Then
               v = Val(alt$)
               If v >= 0 And v <= 255 Then in$ = in$ + Chr$(v)
               alt$ = "": AltWasDown = 0
          End If
          blink = (blink + 1) Mod 30
          Locate Y, X
          Print Left$(in$, CP);
          If blink \ 15 Then Print " "; Else Print "_";
          Print Mid$(in$, CP + 1)
 
          _Display
          _Limit 30
     Loop Until k = 13
 
     PCopy 1, 0
     Locate Y, X: Print in$
     ExtendedInput$ = in$
     If A Then _AutoDisplay
End Function
 
 

A lot for next and if

Code: QB64: [Select]

               If g <= 2 Then
                    Locate h, 44: Print Spc(29)
                    h = h - 1
               End If
 
               If g = 3 Then
                    Color 12
                    Locate h, x + 3: Print "=>";: Print " TERNO"
                    For ag = 1 To 3
                         te = te + 1
                         Locate h, 51 + cor1(ag): Print Mid$(nt$(re), cor1(ag), 2)
                         soma2(te) = Mid$(nt$(re), cor1(ag), 2)
                    Next ag
                    Color 7
               End If
 
               If g = 4 Then
                    Color 10
                    Locate h, x + 3: Print "=>";: Print " QUADRA"
                    For ag = 1 To 4
                         qu = qu + 1
                         Locate h, 51 + cor1(ag): Print Mid$(nt$(re), cor1(ag), 2)
                         soma1$(qu) = Mid$(nt$(re), cor1(ag), 2)
                    Next ag
                    Color 7
               End If
 
               If g = 5 Then
                    Color 3
                    Locate h, x + 3: Print "=>";: Print " QUINA"
                    For ag = 1 To 5
                         Locate h, 51 + cor1(ag): Print Mid$(nt$(re), cor1(ag), 2)
                    Next ag
                    Color 7
               End If
 
               If g = 6 Then
                    Color 14
                    Locate h, x + 3:: Print "=>";: Print " SENA "
                    For ag = 1 To 6
                         Locate h, 51 + cor1(ag): Print Mid$(nt$(re), cor1(ag), 2)
                    Next ag
                    Color 7
               End If
               g = 0
          Next

Title: Re: Line with repeated numbers
Post by: bplus on August 04, 2021, 06:26:17 pm

Hi Carlos,

Looks OK to me, but I don't really know what it's all about. If you had many more g's I would suggest using Select Case or ElseIf ... Then and loose some End If lines but right now you are in gray area where there is no big difference.

Your screen layouts look nice :)

Title: Re: Line with repeated numbers
Post by: carloscordeiro on August 04, 2021, 07:06:16 pm

Quote

Your screen layouts look nice :)

Thanks for the compliment

This code is for querying the "mega.txt" database how many times there are 3 numbers, 4 numbers and 5 numbers.

He does just that.

Would using Select Case or ElseIf improve the code?

Would it decrease a little of the "if and for next"?

Insert this sequence in the code: 041112444557

http://loterias.caixa.gov.br/wps/portal/loterias/landing/megasena/

Site where I feed the txt database

Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: carloscordeiro on November 19, 2020, 06:23:06 pm