Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.


Topics - SMcNeill

Pages: 1 2 [3] 4 5 ... 16
31
QB64 Discussion / Bad forum linking
« on: September 13, 2021, 05:28:25 am »
So here’s the rundown for this forum glitch:

Click Profile.
Click Mentions.
Have more than a single page of mentions…. I currently have 3.
Click on the button to go to another page of mentions, besides the first one.
End up at the User Profile Summary page instead.

Currently, it’s impossible to follow a link to any mention page besides the first one.



And unrelated, but how do we erase all these pages of mentions?  I’m not finding a Delete or Trash button anywhere on the page.

32
QB64 Discussion / ON ERROR THEN
« on: September 07, 2021, 09:48:44 pm »
Jaze posted a cryptogram program earlier which the code led me to thinking: Why isn’t there an ON ERROR THEN syntax?

We have both version for IF:

IF X THEN…

IF X GOTO…

Why do we have to have:

ON ERROR GOTO crap
GOTO beginning
crap:
PRINT "Error, Line number"
PRINT ERR, _ERRORLINE
END
beginning:


Why isn’t there a simple:

ON ERROR THEN
    PRINT "Error, Line number"
    PRINT ERR, _ERRORLINE
END ON ERROR

33
Programs / Floating Point Illustrator
« on: July 12, 2021, 02:21:54 pm »
As a few members don't seem to understand the relationship between decimal values and binary representation of them via floating point values, I thought I'd toss together this quick little program so someone could play around with it and see how our values are stored in memory.

Code: QB64: [Select]
  1. _Title "Floating Point Variables"
  2. Screen _NewImage(1024, 720, 32)
  3. _Delay .25
  4.  
  5. m = _Mem(s)
  6.  
  7. For i = 2 To 8: b(i) = 1: Next 'start with a 127 exponent for a value of 0, normalized
  8.  
  9.     Cls
  10.     k = _KeyHit
  11.  
  12.     Select Case k
  13.         Case 19200: p = p - 1: If p < 0 Then p = 31
  14.         Case 19712: p = p + 1: If p > 31 Then p = 1
  15.         Case 43, 61 'plus
  16.             If p > 0 And p < 9 Then
  17.                 For i = 8 To 1 Step -1
  18.                     If b(i) = 1 Then b(i) = 0 Else b(i) = 1: Exit For
  19.                 Next
  20.             End If
  21.         Case 45, 95 'minus
  22.             If p > 0 And p < 9 Then
  23.                 For i = 8 To 1 Step -1
  24.                     If b(i) = 0 Then b(i) = 1 Else b(i) = 0: Exit For
  25.                 Next
  26.             End If
  27.         Case 18432: b(p) = 1
  28.         Case 20480: b(p) = 0
  29.         Case 32: b(p) = Not (b(p))
  30.     End Select
  31.  
  32.  
  33.     l = 0: ex = 0
  34.  
  35.     b$ = "1."
  36.     For i = 1 To 8 'calculate the exponent value
  37.         If b(i) Then ex = ex Or 2 ^ (8 - i)
  38.     Next
  39.     For i = 0 To 31
  40.         Select Case i
  41.             Case 0: Color Green
  42.             Case Is < 9: Color Red
  43.             Case Else: Color White
  44.         End Select
  45.         Print b(i);
  46.         If b(i) <> 0 Then l = l Or 2 ^ (31 - i)
  47.     Next 'print the 32-bit SINGLE
  48.     For i = 9 To 31 'assemble the mantissa into a single string to display
  49.         If b(i) <> 0 Then b$ = b$ + "1" Else b$ = b$ + "0"
  50.     Next
  51.  
  52.     _MemPut m, m.OFFSET, l 'put our 4-byte value into the single variable
  53.     Print " = "; s
  54.     Locate 3, 3 * p + 2: Print "^"
  55.  
  56.     Print
  57.     Print
  58.     Print "Left/Right to move selector"
  59.     Print "Up/Down to select/unselect bit"
  60.     Print "Space to toggle bit"
  61.     Print "+/- to increment whole exponent by 1"
  62.     Print
  63.     Print "Your current sign is:"; b(0)
  64.     Print "Your current exponent is:"; ex - 127
  65.     Print
  66.     Print "The binary value (in formalized format) is: "; b$; "E"; _Trim$(Str$(ex - 127))
  67.     Print Using "Which in decimal value is: #################.###################"; s
  68.     _Display
  69.     _Limit 30

Now, the important things to keep in mind here is:

1) Your binary value is stored in formalized format.  Just as 1,234 is written as 1.234E3, the binary value of 111 (which is 7, in base-10 math) is written and stored as 1.11E2.
2) When looking at how this value is stored in memory, it's stored with:
    the first bit representing the sign.  (+ or -)
    the next 8 bits represent our exponent PLUS 127 (to store negative values)
    the remaining bits represent our formalized format
3) Now note, since formalized format will ALWAYS begin with a 1, storing that value is redundant and as such it isn't done.  We only store those values right of the period.

So, putting this together, The value for 1 would be:
0 --- 01111111 --- 0000000000000000000000

That first 0 represents that there's no negative sign.  (Toggle it and you'll see that our value swaps to become a -1)
The next 8 bits represent the value of 127; which as I mentioned before is an exponent of 0 PLUS 127.  This gives us an exponent of 0.
The rest of the bits are the mantissa, which in this case are just 0.

Put those together, and you have a binary value of: +1.0E0   (Remember, the leading 1 to the left of the period is implied and not stored.)
 

And, the value for 2 would be:
0 --- 10000000 --- 0000000000000000000000

That first 0 represents that there's no negative sign.  (Toggle it and you'll see that our value swaps to become a -1)
The next 8 bits represent the value of 128; which as I mentioned before is an exponent of 1 PLUS 127.  This gives us an exponent of 1.
The rest of the bits are the mantissa, which in this case are just 0.

Put those together, and you have a binary value of: +1.0E1   (Remember, the leading 1 to the left of the period is implied and not stored.)

Shift that to normalized format and the binary value is: 10.   (And, as everyone knows, 10 = 2.)


And, the value for 3 would be:
0 --- 10000000 --- 1000000000000000000000

That first 0 represents that there's no negative sign.  (Toggle it and you'll see that our value swaps to become a -1)
The next 8 bits represent the value of 128; which as I mentioned before is an exponent of 1 PLUS 127.  This gives us an exponent of 1.
The rest of the bits are the mantissa, which in this case are just 1, followed by a ton of zeros.

Put those together, and you have a binary value of: +1.1E1   (Remember, the leading 1 to the left of the period is implied and not stored.)

Shift that to normalized format and the binary value is: 11.   (And, as everyone knows, 11 = 3.)



And since we can now count from 1 to 3 in SINGLE, take a moment to look at how fractional values are stored:

0 --- 01111111 --- 1100000000000000000000

That first 0 represents that there's no negative sign.  (Toggle it and you'll see that our value swaps to become a -1)
The next 8 bits represent the value of 127; which as I mentioned before is an exponent of 0 PLUS 127.  This gives us an exponent of 0.
The rest of the bits are the mantissa, which in this case are two 1's, followed by all 0's.

Put those together, and you have a binary value of: +1.11E0   (Remember, the leading 1 to the left of the period is implied and not stored.)

In normalized format, that'd look like: 1.11 in binary.

In decimal (base-10) values, what we'd have is:
1 in the one's position.  (left of the period.)
1 in the one half's position.  (first one right of the period.)
1 in the one fourth's position.  (furthermost one on the right.)

Added together 1 + 1/2 + 1/4 = 1.75

1,11 binary (base-2) = 1.75 decimal (base-10)




Play around with it.  If nobody believes that our decimal values are stored as base-2 values after this, I don't know what to tell you.  Apparently I'll never be able to illustrate it, or explain it to the point where it makes sense for that person and they can connect the dots and put it all together.  I've tried, so all I can say is if this doesn't sort it out for you, "Find someone else to explain it and teach it to you."

34
QB64 Discussion / Isn't _SETBIT broken?
« on: July 12, 2021, 01:24:12 pm »
Or is it supposed to work the way I'm seeing it work?  Let me show a simple example:

Code: [Select]
A~%% = _SetBit(A~%%, 6) 'set the seventh bit of A~%%
B~%% = _SetBit(A~%%, 2) 'set the second bit of A~%%
? A~%%, B~%%

Now, from my understanding, this should simply set a bit for a variable.   If we print the results, we see that A = 64 and B = 68...

From our results, it shows that what we're doing is copying the value of our internal variable, and then setting a bit over its existing values, and then we're returning that modified value back to our return variable -- which doesn't seem to be what this simple routine was meant to do at all!


Shouldn't this be a simple SUB, which we just call to set a bit?
_SETBIT variable, bit, (optional value for 0 or 1)?

Why is this a FUNCTION that only works when the return variable is the same as our internal variable?  Something with this just seems intrinsically overly complicated and non-intuitive to me.


35
Programs / Multi-Input Popup Box
« on: June 17, 2021, 04:35:46 pm »
(I'd posted this elsewhere, but thought I'd share it here so folks who might not be reading the other topic could locate this and maybe someday reference it, or make use of it, for their own stuff.)

Here's a little something which I tossed together in about 20 minutes this afternoon, which you might be able to use:

Code: QB64: [Select]
  1. Screen _NewImage(1280, 720, 32)
  2. Dim As String prompt(3), results(3)
  3. prompt(0) = "Name": prompt(1) = "Age": prompt(2) = "Sex": prompt(3) = "Phone Number"
  4. For i = 1 To 100 'Draw some stuff on the screen for a background
  5.     Line (Rnd * 1280, Rnd * 720)-(Rnd * 1280, Rnd * 720), _RGB32(Rnd * 255, Rnd * 255, Rnd * 255), BF
  6. Print "SLEEPING SO YOU CAN SEE OUR BACKGROUND"
  7. MultiInput 100, 100, prompt(), results(), 20
  8. Print: Print "As you can see, when finished, our pop up restored our background..."
  9. Print "And your answers were the following:"
  10. For i = 0 To UBound(results): Print results(i): Next
  11. Sub MultiInput (xPos, yPos, prompt() As String, results() As String, maxLength As Integer)
  12.     backupImage = _CopyImage(0) 'copy our screen
  13.     B = _Blend: _DontBlend: A = _AutoDisplay: u = UBound(prompt)
  14.     For i = 0 To u 'get box size
  15.         p = _PrintWidth(prompt(i)): If p > maxWidth Then maxWidth = p
  16.     Next
  17.     boxWidth = maxWidth + maxLength * _FontWidth + 10: boxheight = (u + 1) * (_FontHeight + 3)
  18.     Do
  19.         If Timer > t# + .5 Then blink = Not blink: t# = Timer
  20.         k = _KeyHit 'get input
  21.         Select Case k
  22.             Case 18432: selection = selection - 1: If selection < 0 Then selection = u 'up
  23.             Case 20480, 13: selection = selection + 1: If selection > u Then selection = 0 'down
  24.             Case 27: Exit Do 'esc is the exit/finish code
  25.             Case 8: results(selection) = Left$(results(selection), Len(results(selection)) - 1) 'backspace
  26.             Case 32 TO 255: results(selection) = results(selection) + Chr$(k) 'all else
  27.         End Select
  28.  
  29.         _PutImage , backupImage 'restore background
  30.         Line (xPos, yPos)-Step(boxWidth, boxheight), 0, BF: Line (x + xPos + maxWidth + 1, y + yPos)-Step(0, boxheight), -1 'draw box
  31.         For i = 0 To u
  32.             Line (x + xPos, y + i * (_FontHeight + 3) + yPos)-Step(boxWidth, _FontHeight + 3), -1, B
  33.             _PrintString (x + xPos + 2, y + i * (_FontHeight + 3) + yPos + 2), prompt(i)
  34.             If i = selection And blink Then out$ = results(i) + Chr$(219) Else out$ = results(i)
  35.             _PrintString (x + xPos + maxWidth + 3, y + i * (_FontHeight + 3) + yPos + 2), out$
  36.         Next
  37.         _Limit 30: _Display
  38.     Loop
  39.     _PutImage , backupImage
  40.     If B Then _Blend
  41.     _FreeImage backupImage

45 lines total, and  only 33 lines for our SUB, which does all the real work for us.

And what's this do, you ask?

It creates a simple, stand-alone, multi-line, POP-UP input box which we can use the arrow keys to move up and down between. 

Usage is rather simple:
1) Dim 2 arrays to hold your prompts and the results.
2) Set your prompts.
3) Call the function, get the results.

Can't be much simpler than that!

36
Programs / Rosetta Code: Plasma Effect
« on: May 24, 2021, 08:57:55 pm »
From: https://rosettacode.org/wiki/Plasma_effect

Looking at the code examples for this rosetta code task, FreeBASIC took their program and converted it over from https://lodev.org/cgtutor/plasma.html.  To help showcase how similar the various BASICs are that are out there, I decided to do the same and translate the last demo from that website over into QB64 for everyone. 

Code: QB64: [Select]
  1. 'converted from https://lodev.org/cgtutor/plasma.html, last example
  2. CONST wide = 256, high = 256
  3. SCREEN _NEWIMAGE(wide, high, 32)
  4. _TITLE "Plasma"
  5.  
  6.     FUNCTION timeGetTime ()
  7.  
  8.     t = timeGetTime / 50 't + .99
  9.     FOR y = 0 TO high - 1
  10.         FOR x = 0 TO wide - 1
  11.             v = SIN(Dist(x + t, y, 128, 128) / 8) _
  12.             + SIN(Dist(x, y , 64, 64) / 8) _
  13.             + SIN(Dist(x, y + t / 7, 192, 64) / 7) _
  14.             + SIN(Dist(x, y, 192, 100) / 8)
  15.             c = INT(4 + v) * 32
  16.             PSET (x, y), _RGB32(c, c * 2, 255 - c)
  17.         NEXT
  18.     NEXT
  19.     _DISPLAY
  20.     _DELAY .01
  21.  
  22. FUNCTION Dist## (x1, y1, x2, y2)
  23.     Dist## = _HYPOT(x1 - x2, y1 - y2)
  24.     'Dist = SQR((x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2))
  25.  

For whatever reason, I can generate the same pattern that the website has as their image, but I'm generating a different palette.  They're creating red and blue, mine is creating green and blue.  I imagine the problem is somewhere in their call to ColorRGB, since all the rest of the examples on page use some sort of color palette with that custom function, but I wouldn't swear to it...

Honestly, I don't even see how the BLEEP the final example on the page works at all, the way it's written!

Code: C++: [Select]
  1. #define dist(a, b, c, d) sqrt(double((a - c) * (a - c) + (b - d) * (b - d)))
  2.  
  3. int main(int argc, char *argv[])
  4. {
  5.   screen(256, 256, 0, "Plasma");
  6.   double time;
  7.   while(!done())
  8.   {
  9.     time = getTime() / 50.0;
  10.     for(int y = 0; y < h; y++)
  11.     for(int x = 0; x < w; x++)
  12.     {
  13.       double value = sin(dist(x + time, y, 128.0, 128.0) / 8.0)
  14.              + sin(dist(x, y, 64.0, 64.0) / 8.0)
  15.              + sin(dist(x, y + time / 7, 192.0, 64) / 7.0)
  16.              + sin(dist(x, y, 192.0, 100.0) / 8.0);
  17.       int color = int((4 + value)) * 32;
  18.       pset(x, y, ColorRGB(color, color * 2, 255 - color));
  19.     }
  20.     redraw();
  21.   }
  22.   return(0);
  23. }

Where do we define w and h at?  Or ColorRGB?  What the heck is getTime?  I don't know and can't find reference to any sort of C++ function with that name at all.  The closest I can get is to go with timeGetTime() which gives us seconds since windows started.  (Note that getTime isn't the same thing as gettime.  C is case sensitive.)

If anyone has a clue about how to correct the color palette to match this demo, I'd love to see it.  Otherwise, this is about as close as I can get to what they've posted on their website, with the link here: https://lodev.org/cgtutor/plasma.html

I've never added code to Rosetta Code before, but since I was  looking at Ashish's example earlier, I thought it might be something which somebody might want to add for us.  For anyone who edits and adds code to RC, feel free to add the above (or Ashish's) onto the site so we'll be represented there forever more.  :)

37
Programs / Averaging method of finding square roots
« on: March 09, 2021, 04:27:30 am »
Code: QB64: [Select]
  1. CONST Limit = 10000
  2. DIM SHARED Squares(Limit) AS LONG: FOR i = 0 TO Limit: Squares(i) = i * i: NEXT
  3.     INPUT "What number do you want to find the square root of:"; n
  4.     IF n = 0 THEN EXIT DO
  5.     s = SQRT(n)
  6.     PRINT USING "My quess is ######.######, which squared becomes ######.######"; s; s * s
  7.     PRINT USING "The actual value is ######.######, which squared becomes ######.######"; SQR(n); SQR(n) * SQR(n)
  8.     PRINT "-----------------------------------------------------------"
  9. FOR i = 1 TO 20
  10.     PRINT i, SQRT(i), SQRT(i) * SQRT(i)
  11.  
  12.  
  13.  
  14.  
  15. FUNCTION SQRT (n)
  16.     b = FindBase(n) 'first, find the base, which is the smallest whole number squared that's smaller than our actual number.
  17.     step1 = (n / b + b) / 2 'then take the average of that value and your number divided by that value
  18.     step2 = n / step1 'get the value of your number divided by that number, for greater precision
  19.     SQRT = (step1 + step2) / 2 'and take the average of those two values
  20.  
  21. FUNCTION FindBase (num AS LONG)
  22.     FOR i = 1 TO Limit
  23.         IF Squares(i) > num THEN FindBase = i - 1: EXIT FUNCTION
  24.     NEXT
  25.     FindBase = -1 'not found; value is too large

So as to not keep derailing BSpinoza's topic about Heron's Method to calculate squares, I thought I'd just start a new one here for this example, which STx might want to compare against all his fancy-pancy math formulas which estimate to .1% accuracy.  All we're doing here is some basic averaging to find an estimation which is almost comparable to that .1% accuracy -- no formulas, scribbled notes, or math text books needed!  Just add two numbers together and divide by two for the average!  :P

38
QB64 Discussion / falcon.h and uprint doesn't do extended ASCII characters?
« on: February 19, 2021, 01:52:41 am »
Am I doing something wrong here, or is this just the way uprint is currently set up to work:

Code: QB64: [Select]
  1. DECLARE LIBRARY "falcon"
  2.     SUB uprint_extra (BYVAL x&, BYVAL y&, BYVAL chars%&, BYVAL length%&, BYVAL kern&, BYVAL do_render&, txt_width&, BYVAL charpos%&, charcount&, BYVAL colour~&, BYVAL max_width&)
  3.     FUNCTION uprint (BYVAL x&, BYVAL y&, chars$, BYVAL txt_len&, BYVAL colour~&, BYVAL max_width&)
  4.     FUNCTION uprintwidth (chars$, BYVAL txt_len&, BYVAL max_width&)
  5.     FUNCTION uheight& ()
  6.     FUNCTION uspacing& ()
  7.     FUNCTION uascension& ()
  8.  
  9.  
  10. SCREEN _NEWIMAGE(800, 600, 32)
  11. _FONT _LOADFONT("courbd.ttf", 20, "monospace")
  12.  
  13. FOR i = 1 TO 255
  14.     CLS
  15.     r = uprint(0, 0, CHR$(i), 1, -1, 0)
  16.     LOCATE 1, 20: PRINT CHR$(i), i
  17.     SLEEP

None of the ASCII characters below 32, or above 128 print with uprint.  I see Rho has a way to print unicode characters with uprint in his library collection -- do I need to write a routine to convert extended ascii characters to their unicode counterparts, and then print them character by character to have them render properly, or is there some simple trick which I'm missing here?

39
Programs / QPrint (falcon.h simplified)
« on: February 17, 2021, 10:46:20 am »
There's several programs out there that make use of falcon.h by now, but I wanted to take a shot at tossing in my own personal version of a simplified wrapper for the command -- QPRINT.

Code: QB64: [Select]
  1. DECLARE LIBRARY "falcon"
  2.     SUB uprint_extra (BYVAL x&, BYVAL y&, BYVAL chars%&, BYVAL length%&, BYVAL kern&, BYVAL do_render&, txt_width&, BYVAL charpos%&, charcount&, BYVAL colour~&, BYVAL max_width&)
  3.     FUNCTION uprint (BYVAL x&, BYVAL y&, chars$, BYVAL txt_len&, BYVAL colour~&, BYVAL max_width&)
  4.     FUNCTION uprintwidth (chars$, BYVAL txt_len&, BYVAL max_width&)
  5.     FUNCTION uheight& ()
  6.     FUNCTION uspacing& ()
  7.     FUNCTION uascension& ()
  8.  
  9. SCREEN _NEWIMAGE(640, 480, 32)
  10. _FONT _LOADFONT("cyberbit.ttf", 20)
  11.  
  12. LOCATE 1, 100
  13. QPrint "This is a whole bunch of crap." + CHR$(10) + "What happens to my crap, when there's too much crap to be printed on the screen, as I told it to be?  Will it wrap, or be truncated? Or what the heck will happen to my text when I have a crapload of it to print to the screen?"
  14. SLEEP: QPrint "And what happens if I follow up with another line of crap?  Will it print below the other as it should, or is my positioning all wrong?"
  15. SLEEP: QPrint "This is a whole bunch of crap.  What happens to my crap, when there's too much crap to be printed on the screen, as I told it to be?  Will it wrap, or be truncated? Or what the heck will happen to my text when I have a crapload of it to print to the screen?"
  16. SLEEP: QPrint "And what happens if I follow up with another line of crap?  Will it print below the other as it should, or is my positioning all wrong?"
  17. SLEEP: QPrint "This is a whole bunch of crap.  What happens to my crap, when there's too much crap to be printed on the screen, as I told it to be?  Will it wrap, or be truncated? Or what the heck will happen to my text when I have a crapload of it to print to the screen?"
  18. SLEEP: QPrint "And what happens if I follow up with another line of crap?  Will it print below the other as it should, or is my positioning all wrong?"
  19. SLEEP: QPrint "This is a whole bunch of crap.  What happens to my crap, when there's too much crap to be printed on the screen, as I told it to be?  Will it wrap, or be truncated? Or what the heck will happen to my text when I have a crapload of it to print to the screen?"
  20. SLEEP: QPrint "And what happens if I follow up with another line of crap?  Will it print below the other as it should, or is my positioning all wrong?"
  21.  
  22. QPrint "This is a whole bunch of crap.  What happens to my crap, when there's too much crap to be printed on the screen, as I told it to be?  Will it wrap, or be truncated? Or what the heck will happen to my text when I have a crapload of it to print to the screen?"
  23. QPrint "And what happens if I follow up with another line of crap?  Will it print below the other as it should, or is my positioning all wrong?"
  24.  
  25.  
  26. LOCATE 7, 1
  27. COLOR _RGB32(255, 255, 0), _RGB32(0, 0, 255) 'Yellow on Blue
  28. QPrint "Foo"
  29. COLOR _RGB32(255, 0, 0) 'Red
  30. QPrint "Bar"
  31. COLOR _RGB32(0, 255, 0) ' Green
  32. LOCATE 15, 1: PRINT "(For comparison, a normal PRINT statement)  ";
  33.  
  34. PRINT "This is a whole bunch of crap.  What happens to my crap, when there's too much crap to be printed on the screen, as I told it to be?  Will it wrap, or be truncated? Or what the heck will happen to my text when I have a crapload of it to print to the screen?"
  35.  
  36. COLOR _RGB(255, 0, 0), 0 '_RGB32(0, 0, 0)
  37. FOR i = 1 TO 15
  38.     SLEEP
  39.     LOCATE i, 1
  40.     QPrint STR$(i) + "To showcase locate at work with p's and q's and t's"
  41.  
  42.  
  43. SUB QPrint (temp$)
  44.     STATIC m AS _MEM: m = _MEMIMAGE(0)
  45.     DIM BreakPoint AS STRING
  46.     BreakPoint = ",./- ;:!" 'I consider all these to be valid breakpoints.  If you want something else, change them.
  47.     text$ = _TRIM$(temp$)
  48.     count = -1
  49.     DO
  50.         'first find the natural length of the line
  51.         x = POS(0): IF _FONTWIDTH THEN x = x * _FONTWIDTH
  52.         y = CSRLIN
  53.         wide% = _WIDTH - x - 1
  54.         FOR i = 1 TO LEN(text$)
  55.             IF ASC(text$, i) = 10 OR ASC(text$, i) = 13 THEN i = i - 1: EXIT FOR
  56.             p = uprintwidth(text$, i, 0)
  57.             IF p > wide% THEN EXIT FOR
  58.         NEXT
  59.         'IF i < LEN(text$) THEN lineend = i - 1 ELSE
  60.         lineend = i
  61.  
  62.         t$ = RTRIM$(LEFT$(text$, lineend)) 'at most, our line can't be any longer than what fits the screen.
  63.         FOR i = lineend TO 1 STEP -1
  64.             IF INSTR(BreakPoint, MID$(text$, i, 1)) THEN lineend = i: EXIT FOR
  65.         NEXT
  66.         out$ = RTRIM$(LEFT$(text$, lineend))
  67.         text$ = LTRIM$(MID$(text$, lineend + 1))
  68.         IF LEFT$(text$, 2) = CHR$(13) + CHR$(10) THEN text$ = MID$(text$, 3)
  69.         IF LEFT$(text$, 2) = CHR$(10) + CHR$(13) THEN text$ = MID$(text$, 3)
  70.         IF LEFT$(text$, 1) = CHR$(13) THEN text$ = MID$(text$, 2)
  71.         IF LEFT$(text$, 1) = CHR$(10) THEN text$ = MID$(text$, 2)
  72.         IF _BACKGROUNDCOLOR <> 0 THEN
  73.             LINE (x - 1, (y - 1) * uheight)-STEP(uprintwidth(out$, LEN(out$), 0), uheight), _BACKGROUNDCOLOR, BF
  74.         END IF
  75.         w& = uprint(x - 1, (y - 1) * uheight, out$, LEN(out$), _DEFAULTCOLOR, 0)
  76.         x = 1
  77.         IF y + 1 >= _HEIGHT / uheight THEN 'scroll up
  78.             w = uheight * _WIDTH * 4
  79.             t$ = SPACE$(m.SIZE - w)
  80.             _MEMGET m, m.OFFSET + w, t$
  81.             CLS , 0
  82.             _MEMPUT m, m.OFFSET, t$
  83.             LOCATE y, x
  84.         ELSE
  85.             LOCATE y + 1, x
  86.         END IF
  87.  
  88.     LOOP UNTIL text$ = ""
  89.     clean_exit:
  90.  

Instead of trying to track all sorts of parameters for uprint  -- (x&, y&, chars$, txt_len&, colour~&, max_width&)  -- I've written a wrapper to break it down to one little command QPrint text$.

If you want colors, simply use QB64's normal COLOR command.  If you want to position your text, simply use LOCATE, like you normally would with your code.  It word wraps automatically, as well as scrolls the screen for us if we end up printing down on the bottom line of the screen.   Basically, use it more or less like you would a simplified PRINT statement that can only handle a single string output.

The advantage to this little command?  (And to falcon.h, in general?)

No cutting off parts of your characters.  Some fonts are terrible about having half the letter cut off (I was using a script font the other day that lost the whole top half of my T's and F's, and their flourishes.), and you should be able to see the difference and the problem with the example code, which relies on cyberbit.ttf. 

One thing of note here:  QB64 v1.4 comes with cyberbit.ttf packaged with it.  V1.5 (the latest development build) doesn't.  If you're running the latest development build, you may want to download the file below and toss it in your folder for testing purposes. 

NOTE 2:  QPrint's LOCATE and PRINT's LOCATE are two completely different areas of your screen.  Don't expect the two to match at all for you.   With the example, QPRINT is printing a character 26 pixels high, whereas PRINT cuts off segments of it and only prints a character 20 pixels high... That difference is going to naturally lead to the rows being at different heights, so don't expect to LOCATE y,x and then QPRINT, and then LOCATE y,x and PRINT, and have the numbers match up at all.

40
Programs / Screenmove actual program screen
« on: February 15, 2021, 06:20:48 pm »
I think the demo here speaks for itself:

Code: QB64: [Select]
  1. SCREEN _NEWIMAGE(1020, 780, 32)
  2. ScreenMove_Middle
  3. PRINT "Your desktop dimensions: "; _DESKTOPWIDTH, _DESKTOPHEIGHT
  4. PRINT "Your program dimensions: "; _WIDTH, _HEIGHT
  5. PRINT "Your program borders   : "; glutGet(506)
  6. PRINT "Your program titlebar  : "; glutGet(507)
  7. PRINT "To properly center your program, it should be at:"
  8. PRINT "Using Screenmove_Middle, it is currently at:"
  9. PRINT glutGet(100), glutGet(101)
  10. PRINT "Using _SCREENMOVE _MIDDLE, the screen is placed at:"
  11. PRINT glutGet(100), glutGet(101)
  12. PRINT "Which, as you can see, doesn't account for our borders or titlebar width and height."
  13.  
  14. PRINT "Maybe a better example would be to move the screen to 0,0."
  15. PRINT "Notice how the titlebar and borders are still here?"
  16. PRINT "Our program is actually at: "; glutGet(100), glutGet(101)
  17.  
  18. ScreenMove 0, 0
  19. PRINT "And notice how our program window now starts at 0,0, like we told it to?"
  20. PRINT "And, as you can see, we're now actually at :"; glutGet(100), glutGet(101)
  21.  
  22.  
  23. PRINT "And, best of all, since all these values are calculated manually, you don't need to worry about using a _DELAY with them, at   the beginning of your code, as we're manually setting our X/Y position and not trying to do it automatically."
  24.  
  25. SUB ScreenMove_Middle
  26.     $IF BORDERDEC = UNDEFINED THEN
  27.         $LET BORDERDEC = TRUE
  28.         DECLARE LIBRARY
  29.             FUNCTION glutGet& (BYVAL what&)
  30.         END DECLARE
  31.     $END IF
  32.     BorderWidth = glutGet(506)
  33.     TitleBarHeight = glutGet(507)
  34.     _SCREENMOVE (_DESKTOPWIDTH - _WIDTH - BorderWidth) / 2 + 1, (_DESKTOPHEIGHT - _HEIGHT - BorderWidth) / 2 - TitleBarHeight + 1
  35.  
  36. SUB ScreenMove (x, y)
  37.     $IF BORDERDEC = UNDEFINED THEN
  38.         $LET BORDERDEC = TRUE
  39.         DECLARE LIBRARY
  40.         FUNCTION glutGet& (BYVAL what&)
  41.         END DECLARE
  42.     $END IF
  43.     BorderWidth = glutGet(506)
  44.     TitleBarHeight = glutGet(507)
  45.     _SCREENMOVE x - BorderWidth, y - BorderWidth - TitleBarHeight
  46.  

Note: I found these subtle positioning differences to be vital for me, in another little batch program which tries to interact with my screen in various ways.  Clicks were often not registering as my screen simply wasn't where I expected it to be.  A box from (0,0)-(100,100), wasn't really at those coordinates, as it was instead at (borderwidth, borderwidth + titlebarheight)-STEP(100,100)...

Which was more than enough to throw all my work off and cause all sorts of unintentional glitches.  ;)

41
Programs / Windows drives
« on: February 13, 2021, 02:47:29 am »
Code: QB64: [Select]
  1. SCREEN _NEWIMAGE(800, 600, 32)
  2.  
  3.     FUNCTION GetLogicalDrives&
  4.     'drives that exist are stored in bit position from 0 to 31.   Bit 0 = Drive A, Bit 1 = Drive B, Bit 2 = Drive C, ect
  5.     FUNCTION GetLogicalDriveStringsA& (BYVAL nBufferLength AS LONG, lpBuffer AS STRING)
  6.     FUNCTION GetDriveTypeA& (nDrive AS STRING)
  7.  
  8. 'Drive types will be one of the following:
  9. CONST DRIVE_UNKNOWN = 0
  10. CONST DRIVE_ABSENT = 1
  11. CONST DRIVE_REMOVABLE = 2
  12. CONST DRIVE_FIXED = 3
  13. CONST DRIVE_REMOTE = 4
  14. CONST DRIVE_CDROM = 5
  15. CONST DRIVE_RAMDISK = 6
  16.  
  17.  
  18. PRINT "Drives detected:"
  19.  
  20. FOR i = 0 TO 25 'get all the drives as a bit value array
  21.     IF _READBIT(GetLogicalDrives, i) THEN PRINT CHR$(65 + i)
  22.  
  23. 'Get all the drives in a string
  24. strSave$ = STRING$(255, 0)
  25. ret& = GetLogicalDriveStringsA(255, strSave$)
  26. PRINT strSave$
  27.  
  28. 'Get the drive type for drive C:\ as an example
  29. GDT = GetDriveTypeA("C:\")
  30.     CASE 2
  31.         PRINT "Removable"
  32.     CASE 3
  33.         PRINT "Drive Fixed"
  34.     CASE 4
  35.         PRINT "Remote"
  36.     CASE 5
  37.         PRINT "Cd-Rom"
  38.     CASE 6
  39.         PRINT "Ram disk"
  40.     CASE ELSE
  41.         PRINT "Unrecognized"
  42.  
  43.  
  44.  

Get a list of the available drives on your machine, and some info on what type they are.

42
QB64 Discussion / windows data packing
« on: February 12, 2021, 01:39:07 am »
For a long time now, there's been some difficulty in using windows API functions in QB64x64.  The reason for this is the way that 64-bit data is packed into alignments of 8-bytes, rather than 4-bytes, such as in QB64x32.  After working with it quite a bit, I think I've finally sorted out when and where to put padding into our data types.

TYPE foo
    x as INTEGER
    y as INTEGER
    z as _INTEGER64
END TYPE

Now, the above might be a simple data structure for a windows API call, and yet, it won't work for us in QB64.  WHY?  Because the OS packs the data into 8-byte chunks for ease of loading, unloading, and storage into internal registers.  What we need to do is start at the top of our type and count bytes:

Integer = 2
Integer = 2 (Total 4)
Integer64 = 8 (Total 12)

Now, when we reach, or exceed 8, we need padding between the last two items, of a size of our last total - 8.  In this case, our sum is 12, so 12-8 = 4, leading to us needing 4 bytes of padding between the last two items:

TYPE foo
    x as INTEGER
    y as INTEGER
    Padding1 AS STRING *4 '4 byte of padding to align to 8-byte rules.
    z as _INTEGER64
END TYPE

Now, if we count our bytes, we have a perfect 8-byte alignment from start to finish.

Integer = 2
Integer = 2 (4 total)
String padding = 4 (8 total; here we now need 8 - 8, or 0 more bytes padding.  Reset counter and continue on...)
Integer64 = 8 (8 total.  No padding needed.  Reset counter and continue on...)

And that's basically how 64-bit Windows API data structures are packed and transferred for us.  Once you sort out the trick to it, they're not actually that hard to figure out and manually account for, and the above is your basic method for figuring out where, and how much, padding you need for those 64-bit data structures.



Now, with that said, even 32-bit data structures follow this same rule -- except they pack on 4-byte alignments.  Usually, it seems most windows functions account for this naturally, but you should be aware of this fact just for the odd case where someone forgot to.

For example, if you look at the structure for STARTUPINFO, you'll see this:  https://docs.microsoft.com/en-us/windows/win32/api/processthreadsapi/ns-processthreadsapi-startupinfoa

Code: [Select]
typedef struct _STARTUPINFOA {
  DWORD  cb;
  LPSTR  lpReserved;
  LPSTR  lpDesktop;
  LPSTR  lpTitle;
  DWORD  dwX;
  DWORD  dwY;
  DWORD  dwXSize;
  DWORD  dwYSize;
  DWORD  dwXCountChars;
  DWORD  dwYCountChars;
  DWORD  dwFillAttribute;
  DWORD  dwFlags;
  WORD   wShowWindow;
  WORD   cbReserved2;
  LPBYTE lpReserved2;
  HANDLE hStdInput;
  HANDLE hStdOutput;
  HANDLE hStdError;
} STARTUPINFOA, *LPSTARTUPINFOA;

Start at the top and count down, and you'll see that we always stay on a 4-byte alignment.  At least, we do, until we get down to wShowWindow, which is only 2 bytes -- but immediately following it is another 2 bytes called lpReserved2...  lpReserved2 must always be 0...  Why??  Because Microsoft has inserted it into the data structure to make certain that it aligns to those 4-byte boundaries!

Nearly all (I won't say all because as a programmer I've learned to always expect an edge case somewhere where someone forgot something) Windows API structures are created with this concept built-in.  Most of the time, you shouldn't ever have to add padding to 32-bit data structures, BUT you should at least keep in mind that it MAY be required.

TYPE foo
    x as INTEGER
    y AS LONG
    z AS INTEGER
END TYPE

To stay on those 4-byte alignment boundaries, the above would need to look like this for a 32-bit OS:

TYPE foo
    x as integer
    padding1 as string * 2
    y as long
    z as integer
    padding2 as string * 2
END TYPE

And, the same data structure would look like this for a 64-bit OS, once alignment was taken into consideration:

TYPE foo
    x as integer
    y as long
    padding1 as string * 2
    z as integer
    padding2 as string * 6
END TYPE



Now, as far as I can tell, that's basically all there is to it.  If I'm wrong with something (which Lord knows, I'm NEVER wrong!), then kindly speak up and let us know -- I'd love to correct whatever misconception or flaw there might be in my thinking for this, for certain! 

43
QB64 Discussion / A Trick for Library Makers
« on: February 06, 2021, 11:33:16 pm »
Here's a little trick I just sat down and sorted out, that you guys who write library style code might want to get familiar with.

For your BI file, write it in a simple little $IF Wrapper, like this one:

$IF VKBI = UNDEFINED THEN 

    (put your actual BI file stuff in between the wrapper, here...)

    $LET VKBI = TRUE
$END IF

Then, at the top of your BM file, write something similar to this little snippet:

$IF VKBI = UNDEFINED THEN
    '$INCLUDE:'Virtual Keyboard.BI'
$END IF

Now, you can work in the BM file without getting type errors and such, and having to code blind.  All your references from the BI file are now included in your work, and auto-formatting and the IDE error checking works as intended, and life is good!!



And best of all? 

Once you're finished, you just write your main program like usual to take advantage of those libraries.

'$INCLUDE:'Virtual Keyboard.BI'

(main program code goes here)

'$INCLUDE:'Virtual Keyboard.BM'

Since your manual include of the BI file occurred already in your main program, the precompiler variable is set, and thus no longer UNDEFINED, so you won't include it twice and generate "Name already in use" errors.



I find, for me, this little trick takes a good bit of the hassle out of working with library creation and editing, so I thought I'd share, and maybe others would enjoy taking advantage of it as well.  ;)

44
Programs / Some buttons
« on: February 05, 2021, 06:43:52 am »
I remembered Ken had some real nice looking buttons for his calculator, back when he posted it here: https://www.qb64.org/forum/index.php?topic=2867.msg121306#msg121306

In the spirit of all great coders, I studied his code a bit, and then used it as a reference to help me come up with this little snippet:

Code: QB64: [Select]
  1. SCREEN _NEWIMAGE(640, 480, 32)
  2.  
  3.  
  4. 'Gray buttons
  5. Button 50, 100, 50, 50, 50, 50, 50, 10, 10, 10, "FOO" 'up
  6. Button 100, 100, 50, 50, 150, 150, 150, -5, -5, -5, "FOO" 'down
  7. Button 150, 100, 50, 50, 50, 50, 50, 10, 10, 10, "FOO" 'up
  8.  
  9.  
  10. 'Lavander buttons
  11. Button 250, 100, 50, 50, 50, 50, 50, 10, 10, 20, "FOO" 'up
  12. Button 300, 100, 50, 50, 150, 150, 250, -5, -5, -10, "FOO" 'down
  13. Button 350, 100, 50, 50, 50, 50, 50, 10, 10, 20, "FOO" 'up
  14.  
  15.  
  16. SUB Button (x, y, wide, tall, r, g, b, rc, gc, bc, caption$)
  17.     DIM AS _UNSIGNED LONG k, d, bg
  18.     d = _DEFAULTCOLOR
  19.     bg = _BACKGROUNDCOLOR
  20.     FOR i = 0 TO 10
  21.         rm = rm + rc
  22.         gm = gm + gc
  23.         bm = bm + bc
  24.         k = _RGB32(r + rm, g + gm, b + bm)
  25.         LINE (x + i, y + i)-(x + wide - i, y + tall - i), k, B
  26.     NEXT
  27.     PAINT (x + i, y + i), k
  28.     COLOR _RGB32(r, g, b), 0
  29.     _PRINTSTRING (x + (wide - _PRINTWIDTH(caption$)) / 2, y + (tall - _FONTHEIGHT) / 2), caption$
  30.  
  31.     COLOR d, bg

From my experience playing with the numbers here, you want to pick the base color shade that you want to end up with as a central color for start, and then modify the values from to get to that point.

For example, let's say I want to end up with a Red 100 Green 200 Blue 100 button...

For the up button, you start with small values (say 50, 100, 50), and then increase them so they reach your goal after 10 iterations, which would be 5, 10, 5.  In the end, you end up with the last 6 parameters being (50, 100, 50, 5, 10, 5).

For the down button, you basically just work in reverse, with half the values as your up buttons.  Your decrease would be -2.5, -5, -2.5, so after 10 passes, you'd go 25, 50, 25 from your base, so you'd end up with (125, 250, 125, -2.5, -5, -2.5).

Not the perfect shade you were dreaming of?  Just tweak the values some until you can make it closer to what you're looking for.

45
Programs / Virtual Keyboard
« on: February 05, 2021, 01:11:19 am »
And here's my newest little toy for folks to have fun and play around with -- a virtual keyboard creator!

Code: QB64: [Select]
  1. TYPE Keyboard_Internal_Type
  2.     AS LONG In_Use, Is_Hidden, Handle, Hardware_Handle, Xoffset, Yoffset, Xsize, Ysize
  3. DIM SHARED Virtual_KB(0 TO 10) AS Keyboard_Internal_Type
  4. DIM SHARED Keyboard_Values(0 TO 10, 0 TO 10, 0 TO 255) AS LONG '11 keyboards of up to 11 rows of 256 keys
  5.  
  6. SCREEN _NEWIMAGE(800, 600, 32)
  7.  
  8. DIM My_Keyboard(5) AS STRING
  9. My_Keyboard(0) = CHR$(0) + "27,ESC" + STRING$(2,0) + "15104,F1" + STRING$(2,0) + "15360,F2" + _
  10.     STRING$(2,0) + "15616,F3" + STRING$(2,0) + "15872,F4" + STRING$(2,0) + "16128,F5" + _
  11.     STRING$(2,0) + "16384,F6" + STRING$(2,0) + "16640,F7" + STRING$(2,0) + "16896,F8" + _
  12.     STRING$(2,0) + "17152,F9" + STRING$(2,0) + "17408,F10" + STRING$(2,0) + "34048,F11" + _
  13.     STRING$(2,0) + "34304,F12" + CHR$(0)
  14. My_Keyboard(1) = "`1234567890-=" + CHR$(0) + "19200,BKSP" + CHR$(0)
  15. My_Keyboard(2) = CHR$(0) + "9,TAB" + CHR$(0) + "QWERTYUIOP[]\"
  16. My_Keyboard(3) = CHR$(0) + "100301,TOGGLE" + CHR$(0) + "ASDFGHJKL;'" + CHR$(0) + "13,ENTER" + CHR$(0)
  17. My_Keyboard(4) = CHR$(0) + "100304,SHIFT" + CHR$(0) + "ZXCVBNM,./" + CHR$(0) + "100303,SHIFT" + CHR$(0)
  18. My_Keyboard(5) = CHR$(0) + "100306,CTRL" + STRING$(2,0) + "0,WIN" + STRING$(2,0) + "100308,ALT" + _
  19.     STRING$(2,0) + "32,SPACE" + STRING$(2,0) + "100307,ALT" + STRING$(2,0) + "0,WIN" + STRING$(2,0) + "0,MENU" + _
  20.     STRING$(2,0) + "100305,CTRL" +  CHR$(0)
  21.  
  22.  
  23. FullsizeKB1 = Create_KB(My_Keyboard(), 16, 50, 30)
  24.  
  25.  
  26.  
  27. My_Keyboard(1) = "~!@#$%^&*()_+" + CHR$(0) + "19200,BKSP" + CHR$(0)
  28. My_Keyboard(2) = CHR$(0) + "9,TAB" + CHR$(0) + "qwertyuiop{}|"
  29. My_Keyboard(3) = CHR$(0) + "100301,TOGGLE" + CHR$(0) + "asdfghjkl:" + CHR$(34) + CHR$(0) + "13,ENTER" + CHR$(0)
  30. My_Keyboard(4) = CHR$(0) + "100304,SHIFT" + CHR$(0) + "zxcvbnm<>?" + CHR$(0) + "100303,SHIFT" + CHR$(0)
  31. FullsizeKB2 = Create_KB(My_Keyboard(), 16, 50, 30)
  32.  
  33.  
  34. Keyboard_In_Use = FullsizeKB1
  35.     Display_KB Keyboard_In_Use, 10, 100, 1
  36.     WHILE _MOUSEINPUT: WEND 'must update mouse buffer before reading virtual keyboard
  37.     k = check_KB(Keyboard_In_Use)
  38.     SELECT CASE k
  39.         CASE 100301 'swap keyboards, rather than having a CAPS LOCK key
  40.             IF Keyboard_In_Use = FullsizeKB1 THEN
  41.                 Keyboard_In_Use = FullsizeKB2
  42.             ELSE
  43.                 Keyboard_In_Use = FullsizeKB1
  44.             END IF
  45.             _DELAY .2
  46.         CASE IS <> 0
  47.             PRINT k;
  48.             IF k > 0 AND k < 255 THEN PRINT CHR$(k);
  49.             PRINT ,
  50.             _DELAY .2 'delay is so we don't spam clicks from mousedown events
  51.     END SELECT
  52.  
  53.     _DISPLAY
  54.     _LIMIT 30
  55.  
  56. FUNCTION check_KB& (Which)
  57.     STATIC AS INTEGER x, y 'so as to not interfer with any global variables
  58.     x = _MOUSEX - Virtual_KB(Which).Xoffset
  59.     y = _MOUSEY - Virtual_KB(Which).Yoffset
  60.  
  61.     yon = x \ Virtual_KB(Which).Xsize
  62.     xon = y \ Virtual_KB(Which).Ysize
  63.     IF xon >= 0 AND xon <= 10 AND yon >= 0 AND yon <= 255 THEN
  64.         IF _MOUSEBUTTON(1) THEN check_KB& = Keyboard_Values(Which, xon, yon)
  65.     END IF
  66.  
  67.  
  68.  
  69.  
  70. SUB Display_KB (Which AS INTEGER, Xwhere AS INTEGER, Ywhere AS INTEGER, style AS INTEGER)
  71.     IF Virtual_KB(Which).In_Use = 0 THEN EXIT SUB
  72.     IF Virtual_KB(Which).Is_Hidden THEN EXIT SUB
  73.     Virtual_KB(Which).Xoffset = Xwhere
  74.     Virtual_KB(Which).Yoffset = Ywhere
  75.     IF style THEN 'we want a hardware image
  76.         _PUTIMAGE (Xwhere, Ywhere), Virtual_KB(Which).Hardware_Handle
  77.     ELSE
  78.         _PUTIMAGE (Xwhere, Ywhere), Virtual_KB(Which).Handle
  79.     END IF
  80.  
  81. FUNCTION Create_KB (KB() AS STRING, Font AS LONG, Xsize AS LONG, Ysize AS LONG)
  82.     STATIC AS LONG D, S 'stored as static so as to not interfer with any globals of the same name.
  83.     D = _DEST: S = _SOURCE
  84.  
  85.     FOR i = 0 TO 10
  86.         IF Virtual_KB(i).In_Use = 0 THEN
  87.             Virtual_KB(i).In_Use = -1
  88.             Virtual_KB(i).Xsize = Xsize
  89.             Virtual_KB(i).Ysize = Ysize
  90.  
  91.             Create_KB = i
  92.             EXIT FOR
  93.         END IF
  94.     NEXT
  95.     IF i = 11 THEN
  96.         CLS
  97.         PRINT "Too many keyboards registered in use at the same time!  Can not create a new one."
  98.         END
  99.     END IF
  100.     This_KB = i
  101.  
  102.     keyboard_image = _NEWIMAGE(4096, 4096, 32)
  103.     _DEST keyboard_image: _SOURCE keyboard_image
  104.     _FONT Font
  105.  
  106.     'now build the keyboard
  107.     FOR i = 0 TO UBOUND(KB)
  108.         top = (i - l) * Ysize + Ypos
  109.         count = 0
  110.         FOR j = 1 TO LEN(KB(i))
  111.             left = (count) * Xsize + Xpos
  112.             count = count + 1
  113.             repeat = 1
  114.             c = ASC(KB(i), j): out$ = ""
  115.             IF c = 0 THEN
  116.                 'look for the comma
  117.                 comma_position = INSTR(j, KB(i), ",")
  118.                 IF comma_position THEN 'we have a value, label
  119.                     value$ = MID$(KB(i), j + 1, comma_position - j - 1)
  120.                     c = VAL(value$)
  121.                     j = comma_position + 1
  122.                 ELSE 'cry loud and hard so we can sort it out while programming our keyboard layout
  123.                     scream_and_die:
  124.                     SLEEP
  125.                     CLS
  126.                     PRINT "You have an invalid keyboard layout!"
  127.                     END
  128.                 END IF
  129.  
  130.                 end_position = INSTR(j, KB(i), CHR$(0))
  131.                 IF end_position THEN 'we're extracting the label
  132.                     out$ = MID$(KB(i), j, end_position - j)
  133.                     repeat = ASC(out$, LEN(out$))
  134.                     IF repeat > 0 AND repeat < 9 THEN
  135.                         out$ = LEFT$(out$, LEN(out$) - 1)
  136.                     ELSE
  137.                         repeat = 1
  138.                     END IF
  139.                     j = end_position
  140.                 ELSE
  141.                     GOTO scream_and_die
  142.                 END IF
  143.             END IF
  144.             LINE (left, top)-STEP(Xsize * repeat, Ysize), -1, B
  145.             IF left + Xsize * repeat > max_width THEN max_width = left + Xsize * repeat
  146.             IF top + Ysize > max_height THEN max_height = top + Ysize
  147.             IF c < 256 AND out$ = "" THEN out$ = CHR$(c)
  148.             _PRINTSTRING (left + (Xsize * repeat - _FONTWIDTH * LEN(out$)) / 2, top + (Ysize - _FONTHEIGHT) / 2), out$
  149.  
  150.             DO UNTIL repeat = 1
  151.                 Keyboard_Values(This_KB, i, count - 1) = c
  152.                 count = count + 1
  153.                 repeat = repeat - 1
  154.             LOOP
  155.             Keyboard_Values(This_KB, i, count - 1) = c
  156.         NEXT
  157.     NEXT
  158.  
  159.     'resize to proper size to put upon the screen
  160.     Virtual_KB(This_KB).Handle = _NEWIMAGE(max_width + 1, max_height + 1, 32)
  161.     _PUTIMAGE (0, 0)-(max_width, max_height), keyboard_image, Virtual_KB(This_KB).Handle, (0, 0)-(max_width, max_height)
  162.     Virtual_KB(This_KB).Hardware_Handle = _COPYIMAGE(Virtual_KB(This_KB).Handle, 33)
  163.     _FREEIMAGE keyboard_image
  164.  
  165.     clean_exit:
  166.     _SOURCE S: _DEST D

I'll let the demo speak for itself, but if anyone has questions or ideas, I'd be more than happy to hear them.  ;)

Pages: 1 2 [3] 4 5 ... 16