Recent Posts

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

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.
Pages: [1] 2 3 ... 10