Recent Posts

1

QB64 Discussion / Not working!

« Last post by Prithak on Today at 03:50:59 AM »

Alright! Back to programming with my exams now gone! Here I coded this stuff:

Code: [Select]

screen _newimage(800,600,32)

dim shared x as integer
dim shared y as integer
dim shared oldx as integer
dim shared oldy as integer

x = 100
y = 200

color , _rgb32(50,200,0)

cls

do
cls

open "blocks.txt" for input as #1

while not eof(1)

input #1, x1,y1,x2,y2,r,g,b

makeobs x1,y1,x2,y2,r,g,b
wend

close #1

    IF _KEYDOWN(CVI(CHR$(0) + "P")) THEN y = y - 5   '_KEYDOWN(20480)
    IF _KEYDOWN(CVI(CHR$(0) + "H")) THEN y = y + 5   '_KEYDOWN(18432)
    IF _KEYDOWN(CVI(CHR$(0) + "K")) THEN x = x + 5   '_KEYDOWN(19200)
    IF _KEYDOWN(CVI(CHR$(0) + "M")) THEN x = x - 5   '_KEYDOWN(19712)

'The sprites will be 20x20 pixels, I believe...
line (_width/2,_height/2)-step(20,20),_rgb32(255,200,100),BF

_printstring(0,0),str$(x) + " " + str$(y)

_limit 100
_Display
loop
 
FUNCTION collision% (b1x, b1y, b1w, b1h, b2x, b2y, b2w, b2h)
    IF (b1y + b1h < b2y) OR (b1y > b2y + b2h) OR (b1x > b2x + b2w) OR (b1x + b1w < b2x) THEN
        collision% = 0
    ELSE
        collision% = 1
    END IF
END FUNCTION

sub makeobs (x1,y1,w,h,r,g,b)

line(x + x1, y + y1)-step(w,h),_rgb32(r,g,b),BF
Line(x + x1, y + y1)-step(w,h),_Rgb32(255,255,255),B
'200, 200 - 220, 220

if collision%(_width/2,_height/2,20,20,x + x1, y + y1,w,h) then
y = oldy
x = oldx
else
oldy = y
oldx = x
end if


end sub

And here's "blocks.txt"

Code: [Select]

200,100,100,100,100,200,255
200,300,100,100,100,200,255
100,200,100,100,100,200,255
300,200,100,100,100,200,255

Ok. For some reason, the character's only being blocked by the first obstacle? WHY??

-Prithak

2

QB64 Discussion / Re: QB64 vs same coded C/C++ program

« Last post by Petr on Today at 03:36:43 AM »

Hi Pete. I know very little C ++, but - do you use OpenGL to draw graphics in a C ++ program? Or you use something else for that? And beyond - I'm no longer absolutely sure here, but if QB64 adds libraries for audio and image decompression (next libraries) automatically, even though no commands using this are used, that might explain the difference in size.

But I say again, I just guess, I never really examined it in depth.

And then there's one more thing. QB64 adds C ++ control mechanisms, many control loops that RhoSigma suggested to turn off over $CHECKING: OFF, which probably doesn't contain your code. We discussed this here:
https://www.qb64.org/forum/index.php?topic=1348.msg105790#msg105790

3

QB64 Discussion / QB64 vs same coded C/C++ program

« Last post by Pete on Today at 01:35:04 AM »

I still have a little finish work to do, but basically, I finished the QB64 version of the C/C++/Wn API program I put together a few weeks ago, and posted here: https://www.qb64.org/forum/index.php?topic=1417.0

So that code is about double the size of the one I just finished in QB64, yet, when compiled, the C/C++ one is approx. 1.5 MB, while the QB64 one is nearly double that, at 2.5 MB. So why so much bigger? I know Rob worked on limiting libraries that were not needed, so does anyone know why half the source code of my QB64 program would turn out to be twice the exe size of the C/C++ clone?

Here is the QB64 source, for comparison.

Code: QB64 [Select]

1. 'DIM lb, mx, my, mz, mf, oldmx, oldmy AS INTEGER 'Mouse variables
2. 'DIM caps AS INTEGER
3. 'DIM SHARED prompt_column AS INTEGER
4. 'DIM SHARED startpos AS INTEGER
5. 'DIM SHARED vertpos AS INTEGER
6. 'DIM SHARED endpos AS INTEGER
7. 'DIM SHARED xx AS INTEGER: ' Cursor row.
8. 'DIM SHARED yy AS INTEGER: ' Cursor column.
9. 'DIM SHARED yyseparator AS INTEGER
10. 'DIM ii, j, j2, k, m1, m2 AS INTEGER
11. 'DIM ins AS INTEGER
12. 'DIM flag AS INTEGER ' Indicates highlighting in progress.
13. 'DIM dir AS INTEGER ' direction of the highlighting left (-) or right (+).
14. 'DIM hmrk, shift, ctrl AS INTEGER ' hmrk is = -1 when void and when in use, indicates the Position in the text array when highlighting begins.
15. 'DIM entryrow(vmax) AS INTEGER 'Tracks rows where prompts are present.
16.  
17. CONST prompt_length = 17 ' Length of longest prompt.
18. CONST c1f = 0: CONST c1b = 7 ' Color 1. Foreground and background.
19. CONST c2f = 7: CONST c2b = 1 ' Color 2. Text highlighting
20. CONST vmax = 4 ' Number of prompts. Must not exceed rows of screen.
21.  
22. DIM entry$(vmax) ' AS STRING 'Text entry array.
23. DIM xntry(MAX_SIZE) AS STRING 'Cut/Copy array.
24. DIM paste(MAX_SIZE) AS STRING 'Paste array
25. DIM prompt(vmax) AS STRING 'Prompt array.
26.  
27. MAX_SIZE = 36
28. debug = 0 'Set to zero to turn of, or non-zero to print variables to screen.
29. prompt_column = 10 'Number of columns to indent prompts.
30. startpos = prompt_column + prompt_length - 1
31. vertpos = 5
32. endpos = startpos + MAX_SIZE
33. yyseparator = 2 ' # of blank rows - 1 between prompts. Do not set lower than 1.
34. ins = 7 ' Cursor vertical height.
35.  
36. SetConsoleTitle
37.  
38. CALL setconsole(c1f, c1b)
39.  
40. CALL GetPrompts(startpos, vertpos, vmax, yyseparator, xx, yy, ins, prompt_column, entryrow(), prompt$())
41.  
42. CALL HideCursor(ins)
43.  
44. WHILE (1)
45.     CALL GetConsoleInput(startpos, endpos, vertpos, vmax, yyseparator, xx, yy, ins, MAX_SIZE, c1f, c1b, c2f, c2b, prompt_column, entryrow(), prompt$(), entry$())
46. WEND
47.  
48. SUB SetConsoleTitle
49.     title$ = "Pete's Custom Keyboard Input App"
50.     _TITLE title$
51. END SUB
52.  
53. SUB setconsole (c1f, c1b)
54.     PALETTE 7, 63
55.     COLOR c1f, c1b
56.     CLS
57. END SUB
58.  
59. SUB GetPrompts (startpos, vertpos, vmax, yyseparator, xx, yy, ins, prompt_column, entryrow(), prompt$())
60.     xx = startpos
61.     yy = vertpos
62.  
63.     prompt$(0) = "Name..........: "
64.     prompt$(1) = "Address.......: "
65.     prompt$(2) = "City/State/Zip: "
66.     prompt$(3) = "Phone.........: "
67.  
68.     yy = vertpos
69.  
70.     FOR ii = 0 TO vmax - 1
71.         LOCATE yy, prompt_column
72.         PRINT prompt$(ii);
73.         entryrow(ii) = yy
74.         yy = yy + yyseparator
75.     NEXT
76.  
77.     LOCATE vertpos, startpos
78.     xx = startpos
79.     yy = vertpos
80. END SUB
81.  
82. SUB HideCursor (ins)
83.     LOCATE , , 1, 7, ins
84. END SUB
85.  
86. SUB copy (startpos, endpos, vertpos, vmax, yyseparator, xx, yy, ins, MAX_SIZE, prompt_column, entryrow(), prompt$(), entry$(), xntry$, hmrk, flag, dir)
87.     IF xx - startpos + 1 < hmrk THEN
88.         m2 = hmrk
89.         m1 = xx - startpos + 1
90.     ELSE
91.         m1 = hmrk
92.         m2 = xx - startpos + 1
93.     END IF
94.     xntry$ = MID$(entry$((yy - vertpos) / yyseparator), m1, m2 - m1)
95. END SUB
96.  
97. SUB replace (startpos, endpos, vertpos, vmax, yyseparator, xx, yy, ins, MAX_SIZE, prompt_column, entryrow(), prompt$(), entry$(), hmrk, flag, dir)
98.     j = LEN(entry$((yy - vertpos) / yyseparator))
99.     COLOR c1f, c1b
100.     IF xx - startpos + 1 < hmrk THEN
101.         m2 = hmrk
102.         m1 = xx - startpos
103.     ELSE
104.         m1 = hmrk - 1
105.         m2 = xx - startpos + 1
106.     END IF
107.     entry$((yy - vertpos) / yyseparator) = MID$(entry$((yy - vertpos) / yyseparator), 1, m1) + MID$(entry$((yy - vertpos) / yyseparator), m2)
108.     LOCATE yy, startpos
109.     PRINT entry$((yy - vertpos) / yyseparator);
110.     PRINT STRING$(j - LEN(entry$((yy - vertpos) / yyseparator)), 32);
111.     IF xx - startpos + 1 > hmrk THEN
112.         xx = hmrk - 1 + startpos
113.     END IF
114.     LOCATE yy, xx
115.     hmrk = 0
116.     flag = 0
117.     dir = 0
118. END SUB
119.  
120. SUB GetConsoleInput (startpos, endpos, vertpos, vmax, yyseparator, xx, yy, ins, MAX_SIZE, c1f, c1b, c2f, c2b, prompt_column, entryrow(), prompt$(), entry$())
121.     STATIC drag, dir, flag, hmrk, xntry$
122.  
123.     DEF SEG = 0
124.     ii = PEEK(&H417) MOD 16
125.     SELECT CASE ii
126.         CASE 1, 2
127.             shift = -1
128.         CASE 4
129.             ctrl = -1
130.     END SELECT
131.     DEF SEG
132.  
133.     oldyy = yy
134.  
135.     IF drag = 0 THEN
136.  
137.         IF flag AND shift = 0 AND hmrk = 0 THEN
138.             flag = 0 ' Disable flag so character value isn't printed after a shift / release event without highlighting.
139.         END IF
140.  
141.         IF hmrk > 0 THEN
142.             IF shift AND flag THEN
143.                 flag = 0
144.             END IF
145.         END IF
146.     END IF
147.  
148.     CALL mouse(startpos, vmax, xx, yy, vertpos, yyseparator, hmrk, dir, flag, c1f, c1b, c2f, c2b, drag, prompt_column, MAX_SIZE, shift, ch$, entry$(), entryrow())
149.  
150.     IF drag = 0 THEN
151.         IF ch$ = "" THEN ch$ = INKEY$
152.         IF ch$ <> "" THEN
153.             IF ctrl THEN
154.                 SELECT CASE LCASE$(ch$)
155.                     CASE CHR$(1) ' Select All
156.                         LOCATE yy, startpos
157.                         COLOR c2f, c2b
158.                         PRINT entry$((yy - vertpos) / yyseparator);
159.                         COLOR c1f, c1b
160.                         hmrk = 1
161.                         flag = -1
162.                         dir = LEN(entry$((yy - vertpos) / yyseparator))
163.                         xx = startpos + dir
164.                         LOCATE yy, xx
165.  
166.                     CASE CHR$(3) ' Copy
167.                         IF hmrk THEN
168.                             CALL copy(startpos, endpos, vertpos, vmax, yyseparator, xx, yy, ins, MAX_SIZE, prompt_column, entryrow(), prompt$(), entry$(), xntry$, hmrk, flag, dir)
169.                         END IF
170.  
171.                     CASE CHR$(24) ' Cut
172.                         IF hmrk THEN
173.                             CALL copy(startpos, endpos, vertpos, vmax, yyseparator, xx, yy, ins, MAX_SIZE, prompt_column, entryrow(), prompt$(), entry$(), xntry$, hmrk, flag, dir)
174.                             CALL replace(startpos, endpos, vertpos, vmax, yyseparator, xx, yy, ins, MAX_SIZE, prompt_column, entryrow(), prompt$(), entry$(), hmrk, flag, dir)
175.                         END IF
176.  
177.                     CASE CHR$(22) ' Paste
178.                         IF xntry$ <> "" THEN
179.                             IF hmrk THEN
180.                                 IF xx - startpos + 1 < hmrk THEN
181.                                     m2 = hmrk
182.                                     m1 = xx - startpos
183.                                 ELSE
184.                                     m1 = hmrk - 1
185.                                     m2 = xx - startpos + 1
186.                                 END IF
187.                             ELSE
188.                                 m1 = xx - startpos
189.                                 m2 = m1 + 1
190.                             END IF
191.                             IF LEN(xntry$) + LEN(entry$((yy - vertpos) / yyseparator)) - (m2 - m1) <= MAX_SIZE - 1 THEN
192.                                 entry$((yy - vertpos) / yyseparator) = MID$(entry$((yy - vertpos) / yyseparator), 1, m1) + xntry$ + MID$(entry$((yy - vertpos) / yyseparator), m2)
193.                                 LOCATE yy, startpos
194.                                 COLOR c1f, c1b
195.                                 PRINT entry$((yy - vertpos) / yyseparator);
196.                                 xx = xx + LEN(xntry$)
197.                                 LOCATE yy, xx
198.                             ELSE
199.                                 BEEP ' Contents too large to paste.
200.                             END IF
201.                         END IF
202.                 END SELECT
203.             ELSE
204.                 SELECT CASE ch$
205.                     CASE CHR$(8) ' Backspace
206.                         ch$ = CHR$(0)
207.                         IF hmrk > 0 THEN
208.                             CALL replace(startpos, endpos, vertpos, vmax, yyseparator, xx, yy, ins, MAX_SIZE, prompt_column, entryrow(), prompt$(), entry$(), hmrk, flag, dir)
209.                         ELSE
210.                             IF xx > startpos THEN
211.                                 xx = xx - 1
212.                                 LOCATE yy, xx
213.                                 PRINT MID$(entry$((yy - vertpos) / yyseparator), xx - startpos + 2); " ";
214.                                 entry$((yy - vertpos) / yyseparator) = MID$(entry$((yy - vertpos) / yyseparator), 1, xx - startpos) + MID$(entry$((yy - vertpos) / yyseparator), xx - startpos + 2)
215.                                 LOCATE yy, xx
216.                             END IF
217.                         END IF
218.                     CASE CHR$(0) + "S" ' Delete
219.                         IF shift THEN
220.                             IF hmrk THEN
221.                                 CALL copy(startpos, endpos, vertpos, vmax, yyseparator, xx, yy, ins, MAX_SIZE, prompt_column, entryrow(), prompt$(), entry$(), xntry$, hmrk, flag, dir)
222.                                 CALL replace(startpos, endpos, vertpos, vmax, yyseparator, xx, yy, ins, MAX_SIZE, prompt_column, entryrow(), prompt$(), entry$(), hmrk, flag, dir)
223.                             END IF
224.  
225.                         ELSE
226.                             ch$ = CHR$(0)
227.                             IF hmrk > 0 THEN
228.                                 CALL replace(startpos, endpos, vertpos, vmax, yyseparator, xx, yy, ins, MAX_SIZE, prompt_column, entryrow(), prompt$(), entry$(), hmrk, flag, dir)
229.                             ELSE
230.                                 IF LEN(entry$((yy - vertpos) / yyseparator)) > 0 AND xx - startpos <= LEN(entry$((yy - vertpos) / yyseparator)) THEN
231.                                     PRINT MID$(entry$((yy - vertpos) / yyseparator), xx - startpos + 2); " ";
232.                                     entry$((yy - vertpos) / yyseparator) = MID$(entry$((yy - vertpos) / yyseparator), 1, xx - startpos) + MID$(entry$((yy - vertpos) / yyseparator), xx - startpos + 2)
233.                                     LOCATE yy, xx
234.                                 END IF
235.                             END IF
236.                         END IF
237.  
238.                     CASE CHR$(0) + "H" ' Arrow up
239.                         ch$ = CHR$(0)
240.                         IF yy > vertpos THEN
241.                             yy = yy - yyseparator
242.                             xx = startpos
243.                             LOCATE yy, xx
244.                         END IF
245.  
246.                     CASE CHR$(0) + "P", CHR$(13) ' Arrow down, Enter
247.                         ch$ = CHR$(0)
248.                         IF (yy - vertpos) / yyseparator + 1 < vmax THEN
249.                             yy = yy + yyseparator
250.                             xx = startpos
251.                             LOCATE yy, xx
252.                         END IF
253.  
254.                     CASE CHR$(0) + "K" ' Arrow left
255.                         ch$ = CHR$(0)
256.                         IF xx > startpos THEN
257.                             IF shift THEN
258.                                 IF dir <= 0 THEN
259.                                     IF dir = 0 THEN
260.                                         hmrk = xx - startpos + 1
261.                                         flag = -1
262.                                     END IF
263.                                     xx = xx - 1
264.                                     LOCATE yy, xx
265.                                     COLOR c2f, c2b
266.                                     PRINT MID$(entry$((yy - vertpos) / yyseparator), xx - startpos + 1, 1)
267.                                     dir = dir - 1
268.                                     LOCATE yy, xx
269.                                 ELSE
270.                                     xx = xx - 1
271.                                     LOCATE yy, xx
272.                                     COLOR c1f, c1b
273.                                     PRINT MID$(entry$((yy - vertpos) / yyseparator), xx - startpos + 1, 1)
274.                                     dir = dir - 1
275.                                     IF dir = 0 THEN
276.                                         hmrk = 0
277.                                     END IF
278.                                     LOCATE yy, xx
279.                                 END IF
280.  
281.                             ELSE
282.                                 xx = xx - 1
283.                                 LOCATE yy, xx
284.                             END IF
285.                         END IF
286.  
287.                     CASE CHR$(0) + "M" ' Arrow right
288.                         ch$ = CHR$(0)
289.                         IF xx < endpos - 1 AND xx - startpos < LEN(entry$((yy - vertpos) / yyseparator)) THEN
290.                             IF shift THEN
291.                                 IF dir >= 0 THEN
292.                                     IF dir = 0 THEN
293.                                         hmrk = xx - startpos + 1
294.                                         flag = -1
295.                                     END IF
296.                                     COLOR c2f, c2b
297.                                     PRINT MID$(entry$((yy - vertpos) / yyseparator), xx - startpos + 1, 1)
298.                                     xx = xx + 1
299.                                     LOCATE yy, xx
300.                                     dir = dir + 1
301.                                     LOCATE yy, xx
302.                                 ELSE
303.                                     COLOR c1f, c1b
304.                                     PRINT MID$(entry$((yy - vertpos) / yyseparator), xx - startpos + 1, 1)
305.                                     xx = xx + 1
306.                                     dir = dir + 1
307.                                     IF dir = 0 THEN
308.                                         hmrk = 0
309.                                         flag = 0
310.                                     END IF
311.                                     LOCATE yy, xx
312.                                 END IF
313.                             ELSE
314.                                 xx = xx + 1
315.                                 LOCATE yy, xx
316.                             END IF
317.                         END IF
318.  
319.                     CASE CHR$(0) + "G" ' Home
320.                         ch$ = CHR$(0)
321.                         IF xx > startpos THEN
322.                             IF shift THEN
323.                                 WHILE xx > startpos
324.                                     IF dir <= 0 THEN
325.                                         IF dir = 0 THEN
326.                                             hmrk = xx - startpos + 1
327.                                             ' flag is already set.
328.                                         END IF
329.                                         xx = xx - 1
330.                                         LOCATE yy, xx
331.                                         COLOR c2f, c2b
332.                                         PRINT MID$(entry$((yy - vertpos) / yyseparator), xx - startpos + 1, 1);
333.                                         dir = dir - 1
334.                                         LOCATE yy, xx
335.                                     ELSE
336.                                         xx = xx - 1
337.                                         LOCATE yy, xx
338.                                         COLOR c1f, c1b
339.                                         PRINT MID$(entry$((yy - vertpos) / yyseparator), xx - startpos + 1, 1);
340.                                         dir = dir - 1
341.                                         IF dir = 0 THEN
342.                                             hmrk = 0
343.                                             flag = 0
344.                                         END IF
345.                                         LOCATE yy, xx
346.                                     END IF
347.                                 WEND
348.                             ELSE
349.                                 xx = startpos
350.                                 LOCATE yy, xx
351.                             END IF
352.                         END IF
353.  
354.                     CASE CHR$(0) + "O" ' End
355.                         ch$ = CHR$(0)
356.                         IF xx < endpos - 1 THEN
357.                             IF shift THEN
358.                                 WHILE xx - startpos < LEN(entry$((yy - vertpos) / yyseparator))
359.                                     IF dir >= 0 THEN
360.                                         IF dir = 0 THEN
361.                                             hmrk = xx - startpos + 1
362.                                             flag = -1
363.                                         END IF
364.                                         COLOR c2f, c2b
365.                                         PRINT MID$(entry$((yy - vertpos) / yyseparator), xx - startpos + 1, 1);
366.                                         xx = xx + 1
367.                                         LOCATE yy, xx
368.                                         dir = dir + 1
369.                                         LOCATE yy, xx
370.                                     ELSE
371.                                         COLOR c1f, c1b
372.                                         PRINT MID$(entry$((yy - vertpos) / yyseparator), xx - startpos + 1, 1);
373.                                         xx = xx + 1
374.                                         dir = dir + 1
375.                                         IF dir = 0 THEN
376.                                             hmrk = 0
377.                                         END IF
378.                                         LOCATE yy, xx
379.                                     END IF
380.                                 WEND
381.                             ELSE
382.                                 xx = startpos + LEN(entry$((yy - vertpos) / yyseparator))
383.                                 LOCATE yy, xx
384.                             END IF
385.                         END IF
386.  
387.                     CASE CHR$(27)
388.                         ch$ = CHR$(0)
389.                         SYSTEM
390.  
391.                     CASE CHR$(0) + CHR$(82) ' Insert
392.                         ch$ = CHR$(0)
393.                         IF ins = 7 THEN ins = 30 ELSE ins = 7
394.                         HideCursor ins
395.  
396.                     CASE CHR$(32) TO CHR$(126)
397.                         IF hmrk > 0 THEN
398.                             CALL replace(startpos, endpos, vertpos, vmax, yyseparator, xx, yy, ins, MAX_SIZE, prompt_column, entryrow(), prompt$(), entry$(), hmrk, flag, dir)
399.                         END IF
400.                         IF ins = 30 THEN
401.                             IF xx - startpos < MAX_SIZE - 1 THEN
402.                                 MID$(entry$((yy - vertpos) / yyseparator), xx - startpos + 1, 1) = ch$
403.                                 LOCATE yy, xx
404.                                 PRINT ch$;
405.                                 xx = xx + 1
406.                                 LOCATE yy, xx
407.                             END IF
408.                         ELSE
409.                             IF LEN(entry$((yy - vertpos) / yyseparator)) < MAX_SIZE - 1 THEN
410.                                 PRINT ch$ + MID$(entry$((yy - vertpos) / yyseparator), xx - startpos + 1);
411.                                 entry$((yy - vertpos) / yyseparator) = MID$(entry$((yy - vertpos) / yyseparator), 1, xx - startpos) + ch$ + MID$(entry$((yy - vertpos) / yyseparator), xx - startpos + 1)
412.                                 xx = xx + 1
413.                                 LOCATE yy, xx
414.                             END IF
415.                         END IF
416.                 END SELECT
417.             END IF
418.         END IF
419.  
420.         IF shift THEN
421.             IF flag = 0 THEN
422.                 flag = -1
423.             END IF
424.         ELSE
425.             IF ch$ <> "" THEN
426.                 IF flag AND shift = 0 AND LCASE$(ch$) <> "x" AND ctrl = 0 AND ch$ <> CHR$(8) AND ch$ <> CHR$(0) + "S" THEN
427.                     COLOR c1f, c1b
428.                     LOCATE oldyy, startpos
429.                     IF ch$ <> CHR$(0) THEN
430.                         PRINT ch$;
431.                     END IF
432.                     PRINT entry$((oldyy - vertpos) / yyseparator);
433.                     LOCATE yy, xx
434.                     hmrk = 0
435.                     flag = 0
436.                     dir = 0
437.                 END IF
438.             END IF
439.         END IF
440.         ch$ = ""
441.     END IF
442. END SUB
443.  
444. SUB mouse (startpos, vmax, xx, yy, vertpos, yyseparator, hmrk, dir, flag, c1f, c1b, c2f, c2b, drag, prompt_column, MAX_SIZE, shift, ch$, entry$(), entryrow())
445.     STATIC doubleclick AS INTEGER, lbdn AS INTEGER, z1, oldmx AS INTEGER, oldmy AS INTEGER, mhl AS INTEGER
446.     DIM mx AS INTEGER, my AS INTEGER, lb AS INTEGER
447.  
448.     LOCATE 20, 1
449.     COLOR c1f, c1b
450.     PRINT " oldmx"; oldmx; "  oldmy"; oldmy; "  mx"; mx; "  my"; my; "  lb"; lb; "  lbdn"; lbdn; "  dblclk"; doubleclick; "        "
451.     PRINT " shift"; shift; "  drag"; drag; "  mhl"; mhl; "  hmrk"; hmrk; "  dir"; dir; "       "
452.     PRINT " mx"; mx - startpos + 1; "  my"; (my - vertpos) / yyseparator; "  xx"; xx - startpos + 1; "  yy"; (yy - vertpos) / yyseparator; "        "
453.     LOCATE yy, xx
454.  
455.  
456.     WHILE _MOUSEINPUT: WEND
457.     mx = _MOUSEX
458.     my = _MOUSEY
459.     lb = _MOUSEBUTTON(1)
460.  
461.     IF lb AND flag AND drag = 0 THEN ' Allows highlighting caused by mouse click to be removed in parent sub.
462.         ch$ = CHR$(0)
463.         shift = 0
464.         EXIT SUB
465.     END IF
466.  
467.     IF shift AND lb OR mhl THEN
468.         IF mhl = 0 THEN ' Shift + click highlighting.
469.             IF my = yy AND mx <> xx AND mx >= startpos AND mx - startpos <= LEN(entry$((yy - vertpos) / yyseparator)) THEN
470.                 mhl = mx - startpos + 1
471.             END IF
472.         ELSE ' Terminal point reached, end highlighting.
473.             IF mhl = xx - startpos + 1 THEN mhl = 0: drag = 0: EXIT SUB
474.         END IF
475.     END IF
476.  
477.     IF LEN(entry$((yy - vertpos) / yyseparator)) THEN
478.         IF lbdn AND xx <> mx OR mhl THEN ' Combined drag and shift + click highlighting.
479.             IF mx >= startpos AND mx - startpos <= LEN(entry$((yy - vertpos) / yyseparator)) + 1 THEN
480.                 IF lb OR mhl THEN
481.                     IF xx > mx THEN
482.                         drag = -1
483.                     ELSE
484.                         drag = 1
485.                     END IF
486.                     GOSUB mousedrag
487.                     EXIT SUB
488.                 ELSE
489.                     drag = 0
490.                 END IF
491.             END IF
492.         END IF
493.     END IF
494.  
495.     IF lb THEN
496.         LOCATE 2, 1: PRINT "left button down    "
497.         IF my = yy THEN
498.             IF mx >= startpos AND mx - startpos <= LEN(entry$((yy - vertpos) / yyseparator)) THEN
499.                 IF drag = 0 AND shift = 0 THEN yy = my ' Prevents changing rows if a drag is in progress.
500.                 xx = mx
501.                 LOCATE yy, xx
502.                 IF lbdn = 0 THEN lbdn = -1: oldmx = mx: oldmy = my
503.             END IF
504.         ELSE
505.             FOR ii = 0 TO vmax - 1
506.                 IF my = entryrow(ii) THEN
507.                     EXIT FOR
508.                 END IF
509.             NEXT
510.             IF my = entryrow(ii) AND drag = 0 AND shift = 0 THEN
511.                 IF mx >= prompt_column AND mx - startpos <= MAX_SIZE THEN
512.                     IF mx - startpos > 0 AND mx - startpos <= LEN(entry$(ii)) THEN
513.                         yy = my: xx = mx
514.                     ELSE
515.                         yy = my: xx = startpos
516.                     END IF
517.                     LOCATE yy, xx
518.                     IF lbdn = 0 THEN lbdn = -1
519.                 END IF
520.             END IF
521.         END IF
522.     ELSE
523.         IF lbdn THEN
524.             z1 = TIMER
525.             LOCATE 2, 1: PRINT "left button released"
526.             doubleclick = doubleclick + 1
527.             lbdn = 0
528.             drag = 0
529.             mhl = 0
530.         END IF
531.     END IF
532.  
533.     IF doubleclick = 1 THEN
534.         IF ABS(z1 - TIMER) > .33 THEN doubleclick = 0
535.     END IF
536.  
537.     IF doubleclick = 2 THEN
538.         ' Any double click events go here...
539.         doubleclick = 0
540.     END IF
541.     LOCATE yy, xx
542.  
543.     EXIT SUB
544.  
545.     mousedrag:
546.     SELECT CASE drag
547.         CASE IS < 0
548.             IF dir <= 0 THEN ' highlight to left
549.                 IF dir = 0 THEN
550.                     hmrk = xx - startpos + 1
551.                     shift = -2 ' emulated shift key down
552.                     flag = -1
553.                 END IF
554.                 xx = xx - 1
555.                 LOCATE yy, xx
556.                 COLOR c2f, c2b
557.                 PRINT MID$(entry$((yy - vertpos) / yyseparator), xx - startpos + 1, 1)
558.                 dir = dir - 1
559.                 LOCATE yy, xx
560.             ELSE ' unhighlight to left
561.                 xx = xx - 1
562.                 dir = dir - 1
563.                 LOCATE yy, xx
564.                 COLOR c1f, c1b
565.                 PRINT MID$(entry$((yy - vertpos) / yyseparator), xx - startpos + 1, 1)
566.                 IF dir = 0 THEN
567.                     hmrk = 0
568.                     flag = 0
569.                     shift = 0
570.                 END IF
571.                 LOCATE yy, xx
572.             END IF
573.         CASE IS > 0
574.             IF dir >= 0 THEN
575.                 COLOR c2f, c2b
576.                 PRINT MID$(entry$((yy - vertpos) / yyseparator), xx - startpos + 1, 1)
577.                 IF dir = 0 THEN
578.                     hmrk = xx - startpos + 1
579.                     flag = -1
580.                     shift = -2 ' emulated shift key down
581.                 END IF
582.                 xx = xx + 1
583.                 dir = dir + 1
584.                 LOCATE yy, xx
585.             ELSE
586.                 COLOR c1f, c1b
587.                 PRINT MID$(entry$((yy - vertpos) / yyseparator), xx - startpos + 1, 1)
588.                 xx = xx + 1
589.                 dir = dir + 1
590.                 IF dir = 0 THEN
591.                     hmrk = 0
592.                     flag = 0
593.                     shift = 0
594.                 END IF
595.                 LOCATE yy, xx
596.             END IF
597.     END SELECT
598.     RETURN
599. END SUB
600.  

Pete

4

Programs / Re: Lemonade Stand

« Last post by bplus on Yesterday at 10:13:38 PM »

I got tired of selling lemonade at $2000+ and sold the business (and secret to my success) to my assistant for $1M he is thinking of changing the product to coffee and calling it Starbucks.

5

Programs / Re: Lemonade Stand

« Last post by SierraKen on Yesterday at 10:00:00 PM »

Dang you guys been playing a lot of this game. The most I've ever gotten was probably $100. lol :))

6

Programs / Re: Alphabet Invaders

« Last post by SierraKen on Yesterday at 09:58:39 PM »

Thanks B+. :) It's a fun little game, would be good for new programmers to learn. Same with my Lemonade Stand.

7

Programs / Re: Alphabet Invaders

« Last post by bplus on Yesterday at 09:42:32 PM »

Sorry I can not shoot at B nor will I shoot at U. :D

I like how the brackets fly away when letter is shot.

8

Programs / Re: Letter Memory

« Last post by bplus on Yesterday at 09:33:40 PM »

TempodiBasic, that's quite a mod! longer than the original program that took some time!

I did have in mind a mod myself, not quite Sumarian... :)

9

Programs / Re: Lemonade Stand

« Last post by Pete on Yesterday at 09:14:01 PM »

Well, like they all say, "When life hands you lemons, make lemonade." Life handed me a sack of crap once, but it turned out juicy it didn't improve the situation in the least.

I quit at $500. I had 6 glasses of lemonade left. I'll sell them to anyone on the forum for 12,000 a glass, glass included! Don't all line up at once, it pretty freakin' windy out today!

Pete

10

Programs / Re: Lemonade Stand

« Last post by SierraKen on Yesterday at 08:57:12 PM »

LOL awesome Old Moses! Yeah the limit is $10 a glass and the least you can sell is $1.