Line with repeated numbers

[bplus]

Heres one from today:

Code: QB64: [Select]

1. _Title "BlinkingScreenLabel Sub" ' b+ 2021-08-04  for Carlos
2.  
3. 'just put the sub call in the loop you use to display the screen it will blink according to limit
4. Do
5.     For i = 1 To 15
6.         BlinkingScreenLabel 1, i, "This is line" + Str$(i), i, 0
7.     Next
8.     _Limit 1
9. Loop
10.  
11. Sub BlinkingScreenLabel (x, y, txt$, c1~&, c2~&)
12.     Static blink
13.     blink = 1 - blink
14.     saveFore~& = _DefaultColor
15.     If blink Then Color c1~& Else Color c2~&
16.     _PrintString (x, y), txt$
17.     Color saveFore~& 'restore color
18. End Sub
19.  

[carloscordeiro]

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]

1. [/_Title "Qbasic 64" ' Many lines, created with help friend Bplus
2. Screen _NewImage(600, 600, 256)
3. _Delay .25
4. _ScreenMove 50, 50
5.  
6. 'Moldura...
7. Line (0, 0)-(599, 599), 11, B 'Moldura inteira
8. Line (1, 1)-(598, 598), 11, B
9. Line (2, 2)-(597, 597), 11, B
10. Line (3, 3)-(596, 596), 11, B
11. Line (4, 4)-(595, 595), 11, B
12.  
13. Line (599, 43)-(2, 43), 11, B 'Linha Horizontal
14. Line (599, 44)-(2, 44), 11, B
15.  
16. 'Mostra Data
17. d$ = Mid$(Date$, 1, 3)
18. c$ = Mid$(Date$, 4, 3)
19. e$ = Mid$(Date$, 7, 4)
20. f$ = c$ + d$ + e$
21.  
22. Color 11: Locate 2, 28: Print "* * * Mega Sena * * *"
23. Locate 2, 65: Print Time$
24. Locate 2, 4: Print f$
25. '--------------------------------------------------------------------------------
26. Dim nt(0 To 3000) As String
27. Dim cadastro As Long
28.  
29. _ControlChr Off
30.  
31. If _FileExists("mega.txt") Then
32.      Open "mega.txt" For Input As #1
33.      cadastro = LOF(1) \ 19
34.      For t = 1 To cadastro
35.           Line Input #1, nt$(t)
36.      Next
37.      Close
38.      Open "mega.txt" For Append As #1
39. Else
40.      Open "mega.txt" For Output As #1
41. End If
42. Do
43.      done = 1
44.  
45.      Color 30
46.      Locate 12, 3: Print "Concurso =>"; cadastro; "= "; nt$(cadastro)
47.      Locate 30, 3: Print "Pressione [ESC] para sair."
48.      Locate 4, 3: Print "N" + Chr$(163); "meros de concursos =>"; cadastro
49.  
50.      Locate 6, 14: Print "_____________"
51.      Locate 6, 3: Print "Dezenas => ";
52.      a$ = ExtendedInput$ 'code Mr. SMcNeill
53.  
54.      For r = 6 To 30
55.           Locate r, 2: Print Spc(72)
56.      Next
57.  
58.      For i = 1 To 12 Step 2
59.           x$ = x$ + Mid$(a$, i, 2) + " "
60.      Next
61.  
62.      x$ = _Trim$(x$)
63.  
64.      For i = 1 To cadastro
65.           If x$ = nt$(i) Then
66.                done = 0
67.                Color 48
68.                Locate 15, 25: Print "Contest:"; i; "exists!!!! "
69.                Locate 17, 29: Print ; nt$(i);
70.                Locate 18, 29: Print "================="
71.                Color 30
72.                Beep
73.                Exit For
74.           End If
75.      Next
76.  
77.      Locate 8, 3: Print "Dezenas => "; x$
78.      Locate 10, 3: Print "N£meros de digitos ="; Len(a$)
79.  
80.  
81.      If Len(a$) = 12 And done = 1 Then
82.           Print #1, x$
83.           Color 48
84.           Locate 15, 24: Print "Dezenas salvas com sucesso!!!"
85.           Locate 16, 24: Print "============================="
86.           Locate 18, 30: Print x$
87.           Locate 19, 30: Print "================="
88.           cadastro = cadastro + 1
89.           nt$(cadastro) = x$
90.           nt$ = x$
91.           Beep
92.      ElseIf Len(a$) > 12 Then
93.           Color 48
94.           Locate 20, 23: Print "Number of digits greater than 12 =>"; Len(a$)
95.           Locate 22, 30: Print ; a$
96.           Locate 23, 31: Print "============="
97.           Color 30
98.           Beep
99.      End If
100.  
101.      x$ = ""
102.      Scrn$ = InKey$
103. Loop Until Scrn$ = Chr$(27)
104. Close
105.  
106. Play "o3l32ceff+g"
107. Play "mfo4l64ceg>c"
108. Cls
109.  
110. OE20 = _LoadFont("century.ttf", 82)
111. _Font OE20
112. Color 11 ' &H200000FF
113. Locate 4, 90: Print " QBasic 64 "
114. Locate 5, 90: Print " -------------- "
115. _Delay 2
116. System
117.  
118. '--------------------------------------------------------------------------------
119.  
120. Function ExtendedInput$ 'code Mr. SMcNeill
121.      PCopy 0, 1
122.      A = _AutoDisplay: X = Pos(0): Y = CsrLin
123.      CP = 0: OldCP = 0 'Cursor Position
124.      _KeyClear
125.      Do
126.           PCopy 1, 0
127.           If _KeyDown(100307) Or _KeyDown(100308) Then AltDown = -1 Else AltDown = 0
128.           k = _KeyHit
129.           If AltDown Then
130.                Select Case k 'ignore all keypresses except ALT-number presses
131.                     Case 48 TO 57: AltWasDown = -1: alt$ = alt$ + Chr$(k)
132.                End Select
133.           Else
134.                Select Case k 'without alt, add any keypresses to our input
135.                     Case 8
136.                          oldin$ = in$
137.                          If CP > 0 Then OldCP = CP: CP = CP - 1
138.                          in$ = Left$(in$, CP) + Mid$(in$, CP + 2) 'backspace to erase input
139.                     Case 9
140.                          oldin$ = in$
141.                          in$ = Left$(in$, CP) + Space$(4) + Mid$(in$, CP + 1) 'four spaces for any TAB entered
142.                          OldCP = CP
143.                          CP = CP + 4
144.                     Case 32 TO 128
145.                          If _KeyDown(100305) Or _KeyDown(100306) Then
146.                               If k = 118 Or k = 86 Then
147.                                    oldin$ = in$
148.                                    in$ = Left$(in$, CP) + _Clipboard$ + Mid$(in$, CP + 1) 'ctrl-v paste
149.                                    'CTRL-V leaves cursor in position before the paste, without moving it after.
150.                                    'Feel free to modify that behavior here, if you want it to move to after the paste.
151.                                    CP = CP + Len(_Clipboard$)
152.                               End If
153.                               If k = 122 Or k = 90 Then Swap in$, oldin$: Swap OldCP, CP 'ctrl-z undo
154.                          Else
155.                               oldin$ = in$
156.                               in$ = Left$(in$, CP) + Chr$(k) + Mid$(in$, CP + 1) 'add input to our string
157.                               OldCP = CP
158.                               CP = CP + 1
159.                          End If
160.                     Case 18176 'Home
161.                          CP = 0
162.                     Case 20224 'End
163.                          CP = Len(in$)
164.                     Case 21248 'Delete
165.                          oldin$ = in$
166.                          in$ = Left$(in$, CP) + Mid$(in$, CP + 2)
167.                     Case 19200 'Left
168.                          CP = CP - 1
169.                          If CP < 0 Then CP = 0
170.                     Case 19712 'Right
171.                          CP = CP + 1
172.                          If CP > Len(in$) Then CP = Len(in$)
173.                End Select
174.           End If
175.           alt$ = Right$(alt$, 3)
176.           If AltWasDown = -1 And AltDown = 0 Then
177.                v = Val(alt$)
178.                If v >= 0 And v <= 255 Then in$ = in$ + Chr$(v)
179.                alt$ = "": AltWasDown = 0
180.           End If
181.           blink = (blink + 1) Mod 30
182.           Locate Y, X
183.           Print Left$(in$, CP);
184.           If blink \ 15 Then Print " "; Else Print "_";
185.           Print Mid$(in$, CP + 1)
186.  
187.           _Display
188.           _Limit 30
189.      Loop Until k = 13
190.  
191.      PCopy 1, 0
192.      Locate Y, X: Print in$
193.      ExtendedInput$ = in$
194.      If A Then _AutoDisplay
195. End Function
196. ]

[carloscordeiro]

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]

1. _Title "Qbasic 64" ' Many lines, created with help friend Bplus
2. Screen _NewImage(700, 740, 256)
3. _Delay .25
4. _ScreenMove 20, 30
5.  
6. 'Moldura...
7. Line (0, 0)-(699, 719), 11, B 'Moldura inteira
8. Line (1, 1)-(698, 718), 11, B
9. Line (2, 2)-(697, 717), 11, B
10. Line (3, 3)-(696, 716), 11, B
11. Line (4, 4)-(695, 715), 11, B
12.  
13. Line (699, 43)-(2, 43), 11, B 'Linha Horizontal
14. Line (699, 44)-(2, 44), 11, B
15.  
16. Line (336, 716)-(336, 44), 11, B 'Linha Vertical
17. Line (335, 716)-(335, 44), 11, B
18.  
19. 'Mostra Data
20. d$ = Mid$(Date$, 1, 3)
21. c$ = Mid$(Date$, 4, 3)
22. e$ = Mid$(Date$, 7, 4)
23. f$ = c$ + d$ + e$
24.  
25. Color 11: Locate 2, 34: Print "* * * Mega Sena * * *"
26. Locate 2, 77: Print Time$
27. Locate 2, 4: Print f$: Color 7
28.  
29. '------------------------------------------------------------------------
30. Dim nt(1 To 3000) As String
31. Dim soma1(1 To 500) As String
32. Dim soma2(1 To 500) As String
33. Dim cor1(80) As _Integer64
34. Dim seq(500) As _Integer64
35. 'Dim re As _Integer64
36. Dim file(1 To 50) As String
37. '------------------------------------------------------------------------
38.  
39. Open "mega.txt" For Input As #1
40. total = LOF(1) \ 19
41. For t = 1 To total
42.      Line Input #1, nt$(t)
43. Next
44. Close
45.  
46. _ControlChr Off
47.  
48. Color 30: Locate 4, 3: Print "N" + Chr$(163); "meros de concursos =>"; total
49. Do
50.      g = 0
51.      h = 3
52.      qu = 0
53.      te = 0
54.      Color 30
55.      Locate 6, 14: Print "_____________"
56.      Locate 6, 3: Print "Dezenas => ";
57.      a$ = ExtendedInput$ 'code Mr. SMcNeill
58.  
59.      For i = 1 To 12 Step 2
60.           x$ = x$ + Mid$(a$, i, 2) + " "
61.      Next
62.      Pes$ = _Trim$(x$)
63.      If Len(Pes$) = 17 Then
64.  
65.           For S = 4 To 44
66.                Locate S, 44: Print Spc(40)
67.           Next S
68.  
69.           Color 78
70.           Locate 8, 3: Print "Dezenas => "; Pes$; " ="; Len(Pes$)
71.           Locate 9, 14: Print "================="
72.  
73.           For re = 1 To total
74.                If h > 41 Then
75.                     _KeyClear
76.                     Color 13: Locate 44, 44: Print "Pressione Enter para continuar..."
77.                     Color 7
78.                     Do
79.                          _Limit 30
80.                     Loop Until InKey$ = Chr$(13)
81.                     For S = 4 To 44
82.                          Locate S, 44: Print Spc(40)
83.                     Next S
84.                     h = 3
85.                End If
86.  
87.                h = h + 1
88.                x = 49
89.  
90.                Color 15: Locate h, x - 5: Print Right$("0000" + LTrim$(Str$(re)), 4); " => "
91.  
92.                For i = 1 To 17 Step 3
93.                     x = x + 3
94.                     For r = 1 To 17 Step 3
95.                          If Mid$(nt$(re), i, 2) = Mid$(Pes$, r, 2) Then
96.                               g = g + 1
97.                               cor1(g) = i
98.                               Exit For
99.                          Else
100.                               Color 7: Locate h, x: Print Mid$(nt$(re), i, 2)
101.                          End If
102.                     Next r
103.                Next i
104.  
105.                If g <= 2 Then
106.                     Locate h, 44: Print Spc(29)
107.                     h = h - 1
108.                End If
109.  
110.                If g = 3 Then
111.                     Color 12
112.                     Locate h, x + 3: Print "=>";: Print " TERNO"
113.                     For ag = 1 To 3
114.                          te = te + 1
115.                          Locate h, 51 + cor1(ag): Print Mid$(nt$(re), cor1(ag), 2)
116.                          soma2(te) = Mid$(nt$(re), cor1(ag), 2)
117.                     Next ag
118.                     Color 7
119.                End If
120.  
121.                If g = 4 Then
122.                     Color 10
123.                     Locate h, x + 3: Print "=>";: Print " QUADRA"
124.                     For ag = 1 To 4
125.                          qu = qu + 1
126.                          Locate h, 51 + cor1(ag): Print Mid$(nt$(re), cor1(ag), 2)
127.                          soma1$(qu) = Mid$(nt$(re), cor1(ag), 2)
128.                     Next ag
129.                     Color 7
130.                End If
131.  
132.                If g = 5 Then
133.                     Color 3
134.                     Locate h, x + 3: Print "=>";: Print " QUINA"
135.                     For ag = 1 To 5
136.                          Locate h, 51 + cor1(ag): Print Mid$(nt$(re), cor1(ag), 2)
137.                     Next ag
138.                     Color 7
139.                End If
140.  
141.                If g = 6 Then
142.                     Color 14
143.                     Locate h, x + 3:: Print "=>";: Print " SENA "
144.                     For ag = 1 To 6
145.                          Locate h, 51 + cor1(ag): Print Mid$(nt$(re), cor1(ag), 2)
146.                     Next ag
147.                     Color 7
148.                End If
149.                g = 0
150.           Next
151.           a = 12
152.           For e = 10 To 22
153.                Locate e, 2: Print Spc(35)
154.           Next
155.           '-------------------------------------------------------------------
156.           For i = 1 To qu '- 1
157.                t = 1
158.                For j = i + 1 To qu
159.                     If _Trim$(soma1(i)) = _Trim$(soma1(j)) And _Trim$(soma1(i)) <> "" Then
160.                          t = t + 1
161.                          soma1(j) = ""
162.                     End If
163.                Next
164.                seq(i) = t
165.                If soma1(i) <> "" Then
166.                     a = a + 1
167.                     Color 30
168.                     Locate a, 3
169.                     Print "Dez = ";
170.                     Color 10
171.                     Locate a, 8
172.                     Print " "; soma1(i);
173.                     Color 30
174.                     Locate a, 12
175.                     Print "="; seq(i)
176.                End If
177.           Next
178.           '---------------------------------------------------------------------
179.           a = 12
180.           For i = 1 To te '- 1
181.                t = 1
182.                For j = i + 1 To te
183.                     If _Trim$(soma2(i)) = _Trim$(soma2(j)) And _Trim$(soma2(i)) <> "" Then
184.                          t = t + 1
185.                          soma2(j) = ""
186.                     End If
187.                Next
188.                seq(i) = t
189.                If soma2(i) <> "" Then
190.                     a = a + 1
191.                     Color 30
192.                     Locate a, 23
193.                     Print "Dez = ";
194.                     Color 12
195.                     Locate a, 28
196.                     Print " "; soma2(i);
197.                     Color 30
198.                     Locate a, 32
199.                     Print "="; seq(i)
200.                End If
201.           Next
202.           '-----------------------------------------------------------------------
203.  
204.      Else
205.           Beep
206.      End If
207.      Color 13: Locate 44, 58: Print "Pressione [ESC] para sair..."
208.      x$ = ""
209.      Scrn$ = InKey$
210. Loop Until Scrn$ = Chr$(27)
211.  
212. Play "o3l32ceff+g"
213. Play "mfo4l64ceg>c"
214. Cls
215.  
216. OE20 = _LoadFont("century.ttf", 82)
217. _Font OE20
218. Color 11 ' &H200000FF
219. Locate 4, 125: Print " QBasic 64 "
220. Locate 5, 125: Print " -------------- "
221. _Delay 2
222. System
223.  
224. '-------------------------------------------------------------------------------------
225. Function ExtendedInput$ ' Mr. McNeill's extended entrance
226.      PCopy 0, 1
227.      A = _AutoDisplay: X = Pos(0): Y = CsrLin
228.      CP = 0: OldCP = 0 'Cursor Position
229.      _KeyClear
230.      Do
231.           PCopy 1, 0
232.           If _KeyDown(100307) Or _KeyDown(100308) Then AltDown = -1 Else AltDown = 0
233.           k = _KeyHit
234.           If AltDown Then
235.                Select Case k 'ignore all keypresses except ALT-number presses
236.                     Case 48 TO 57: AltWasDown = -1: alt$ = alt$ + Chr$(k)
237.                End Select
238.           Else
239.                Select Case k 'without alt, add any keypresses to our input
240.                     Case 8
241.                          oldin$ = in$
242.                          If CP > 0 Then OldCP = CP: CP = CP - 1
243.                          in$ = Left$(in$, CP) + Mid$(in$, CP + 2) 'backspace to erase input
244.                     Case 9
245.                          oldin$ = in$
246.                          in$ = Left$(in$, CP) + Space$(4) + Mid$(in$, CP + 1) 'four spaces for any TAB entered
247.                          OldCP = CP
248.                          CP = CP + 4
249.                     Case 32 TO 128
250.                          If _KeyDown(100305) Or _KeyDown(100306) Then
251.                               If k = 118 Or k = 86 Then
252.                                    oldin$ = in$
253.                                    in$ = Left$(in$, CP) + _Clipboard$ + Mid$(in$, CP + 1) 'ctrl-v paste
254.                                    'CTRL-V leaves cursor in position before the paste, without moving it after.
255.                                    'Feel free to modify that behavior here, if you want it to move to after the paste.
256.                                    CP = CP + Len(_Clipboard$)
257.                               End If
258.                               If k = 122 Or k = 90 Then Swap in$, oldin$: Swap OldCP, CP 'ctrl-z undo
259.                          Else
260.                               oldin$ = in$
261.                               in$ = Left$(in$, CP) + Chr$(k) + Mid$(in$, CP + 1) 'add input to our string
262.                               OldCP = CP
263.                               CP = CP + 1
264.                          End If
265.                     Case 18176 'Home
266.                          CP = 0
267.                     Case 20224 'End
268.                          CP = Len(in$)
269.                     Case 21248 'Delete
270.                          oldin$ = in$
271.                          in$ = Left$(in$, CP) + Mid$(in$, CP + 2)
272.                     Case 19200 'Left
273.                          CP = CP - 1
274.                          If CP < 0 Then CP = 0
275.                     Case 19712 'Right
276.                          CP = CP + 1
277.                          If CP > Len(in$) Then CP = Len(in$)
278.                End Select
279.           End If
280.           alt$ = Right$(alt$, 3)
281.           If AltWasDown = -1 And AltDown = 0 Then
282.                v = Val(alt$)
283.                If v >= 0 And v <= 255 Then in$ = in$ + Chr$(v)
284.                alt$ = "": AltWasDown = 0
285.           End If
286.           blink = (blink + 1) Mod 30
287.           Locate Y, X
288.           Print Left$(in$, CP);
289.           If blink \ 15 Then Print " "; Else Print "_";
290.           Print Mid$(in$, CP + 1)
291.  
292.           _Display
293.           _Limit 30
294.      Loop Until k = 13
295.  
296.      PCopy 1, 0
297.      Locate Y, X: Print in$
298.      ExtendedInput$ = in$
299.      If A Then _AutoDisplay
300. End Function
301.  
302.  

A lot for next and if

Code: QB64: [Select]

1.                If g <= 2 Then
2.                     Locate h, 44: Print Spc(29)
3.                     h = h - 1
4.                End If
5.  
6.                If g = 3 Then
7.                     Color 12
8.                     Locate h, x + 3: Print "=>";: Print " TERNO"
9.                     For ag = 1 To 3
10.                          te = te + 1
11.                          Locate h, 51 + cor1(ag): Print Mid$(nt$(re), cor1(ag), 2)
12.                          soma2(te) = Mid$(nt$(re), cor1(ag), 2)
13.                     Next ag
14.                     Color 7
15.                End If
16.  
17.                If g = 4 Then
18.                     Color 10
19.                     Locate h, x + 3: Print "=>";: Print " QUADRA"
20.                     For ag = 1 To 4
21.                          qu = qu + 1
22.                          Locate h, 51 + cor1(ag): Print Mid$(nt$(re), cor1(ag), 2)
23.                          soma1$(qu) = Mid$(nt$(re), cor1(ag), 2)
24.                     Next ag
25.                     Color 7
26.                End If
27.  
28.                If g = 5 Then
29.                     Color 3
30.                     Locate h, x + 3: Print "=>";: Print " QUINA"
31.                     For ag = 1 To 5
32.                          Locate h, 51 + cor1(ag): Print Mid$(nt$(re), cor1(ag), 2)
33.                     Next ag
34.                     Color 7
35.                End If
36.  
37.                If g = 6 Then
38.                     Color 14
39.                     Locate h, x + 3:: Print "=>";: Print " SENA "
40.                     For ag = 1 To 6
41.                          Locate h, 51 + cor1(ag): Print Mid$(nt$(re), cor1(ag), 2)
42.                     Next ag
43.                     Color 7
44.                End If
45.                g = 0
46.           Next

[bplus]

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 :)

[carloscordeiro]

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