| Welcome, Guest |
You have to register before you can post on our site.
|
|
|
| Fast filled circle |
|
Posted by: mdijkens - 11-26-2022, 03:20 PM - Forum: Utilities
- Replies (9)
|
 |
I ran into issues with Paint and transparency; they don't get along very well.
So I created my own filled circle routine:
Code: (Select All) Sub fCircle (x%, y%, r%, c~&)
'Filled Circle: Transparency OK & >4x faster then Paint
r2& = r% * r%
xx% = Sqr(r2& - y2&): Line (x% - xx%, y%)-(x% + xx%, y%), c~&
For yy% = 1 To r%
y2& = yy% * yy%: xx% = Sqr(r2& - y2&)
Line (x% - xx%, y% - yy%)-(x% + xx%, y% - yy%), c~&
Line (x% - xx%, y% + yy%)-(x% + xx%, y% + yy%), c~&
Next yy%
End Sub
It runs a lot faster then Circle & Paint and also works well with transparent colors!
|
|
|
| _MOUSEHIDE / _MOUSESHOW |
|
Posted by: Pete - 11-25-2022, 07:32 PM - Forum: General Discussion
- Replies (7)
|
 |
Here are some interesting observations about _MOUSEHIDE and _MOUSESHOW
See the remark statements at the top of the code.
Code: (Select All) ' _MOUSEHIDE _MOUSE SHOW DEMO
' Note: _MOUSEHIDE WILL BE DISENGAGED WHEN A MOUSE BUTTON IS HELD DOWN.
' A MOUSE TRIGGER EVENT LIKE _MOUSEMOVE IS NEEDED TO HIDE/SHOW MOUSE WHEN MOUSE IS IDLE.
REM PRESS ESC TO END. <==================================================
WHILE _MOUSEINPUT: WEND
DO UNTIL my
my = _MOUSEY
mx = _MOUSEX
LOOP
PALETTE 8, 0
DO
_LIMIT 30
COLOR 1, 0
_MOUSESHOW
WHILE _MOUSEINPUT: WEND: my = _MOUSEY: mx = _MOUSEX
_MOUSEMOVE mx, my
PALETTE 0, 63
FOR i = 1 TO 10
_DELAY .2
PRINT i
IF INKEY$ = CHR$(27) THEN EXIT DO
NEXT
COLOR 8, 0
myhide = my: mxhide = mx
_MOUSEHIDE
PRINT "_MOUSEMOVEX ="; mxhide, "_MOUSEMOVEY ="; myhide
WHILE _MOUSEINPUT: WEND: myhide = _MOUSEY: mxhide = _MOUSEX
_MOUSEMOVE mxhide, myhide
PALETTE 0, 4
FOR i = 10 TO 1 STEP -1
_DELAY .2
PRINT i
IF INKEY$ = CHR$(27) THEN EXIT DO
NEXT
oldmy = my: oldmy = mx
LOOP
So curious that if you continuously move the mouse with no button held, the pointer hides on the red screen and shows on the white, as expected, but... if you initiate and hold any mouse button down WHILE ON THE WHITE SCREEN, it shows up all the time, even on the red screen. Personally, I wish it would continue to show and hide regardless of mouse button status, but unless this is a "glitch" I wonder what was the thought process to have it coded this way?
Pete
|
|
|
|
| Think you can do better??? Moving a Borderless Window |
|
Posted by: Pete - 11-25-2022, 07:10 PM - Forum: Works in Progress
- Replies (9)
|
|
This is a mix of WIN32 API and QB64 code. I would have posted it all in Win API, but I haven't looked into controlling the mouse cursor, only locating it. So what it does is produce a borderless window with a fake blank top strip you can drag around the screen. The limits placed on the cursor, to keep it from racing away from the window, are a bit choppy. Maybe that could be improved with a different approach. If anyone has a pure Win API example to compare it to, that would be nice.
Code: (Select All) DIM WinMse AS POINTAPI
TYPE POINTAPI
X_Pos AS LONG
Y_Pos AS LONG
END TYPE
DECLARE DYNAMIC LIBRARY "User32"
FUNCTION GetWindowLongA& (BYVAL hwnd AS LONG, BYVAL nIndex AS LONG)
FUNCTION SetWindowLongA& (BYVAL hwnd AS LONG, BYVAL nIndex AS LONG, BYVAL dwNewLong AS LONG)
FUNCTION SetWindowPos& (BYVAL hwnd AS LONG, BYVAL hWndInsertAfter AS LONG, BYVAL x AS LONG, BYVAL y AS LONG, BYVAL cx AS LONG, BYVAL cy AS LONG, BYVAL wFlags AS LONG)
FUNCTION GetAsyncKeyState% (BYVAL vkey AS LONG)
FUNCTION GetCursorPos (lpPoint AS POINTAPI)
END DECLARE
WIDTH 50, 25
DO: LOOP UNTIL _SCREENEXISTS
GWL_STYLE = -16
ws_border = &H800000
WS_VISIBLE = &H10000000
_TITLE "No Border"
hwnd& = _WINDOWHANDLE
winstyle& = GetWindowLongA&(hwnd&, GWL_STYLE)
_DELAY .25
a& = SetWindowLongA&(hwnd&, GWL_STYLE, winstyle& AND WS_VISIBLE)
a& = SetWindowPos&(hwnd&, 0, 0, 200, 400, 0, 39)
LOCATE 1, 1
COLOR 0, 7
PRINT SPACE$(_WIDTH);
fw = _FONTWIDTH
fh = _FONTHEIGHT
x = _SCREENX: y = _SCREENY
DO
_LIMIT 60
IF GetAsyncKeyState(1) < 0 THEN
IF lb = 0 THEN lb = 1
ELSE
IF lb THEN lb = 0: dragpt = 0
END IF
z = GetCursorPos(WinMse)
IF lb THEN
IF dragpt THEN
IF WinMse.X_Pos <> oldxpos THEN
j = SGN(WinMse.X_Pos - oldxpos) ' This will be multiplied in statements to speed things up.
DO
x = x + j * 8
_SCREENMOVE x, y
_MOUSEMOVE dragpt, 1
IF j > 0 THEN
IF x + dragpt * fw >= WinMse.X_Pos THEN EXIT DO
ELSE
IF x + dragpt * fw <= WinMse.X_Pos THEN EXIT DO
END IF
LOOP
END IF
IF WinMse.Y_Pos <> oldypos THEN
j = SGN(WinMse.Y_Pos - oldypos)
DO
IF j > 0 THEN
y = y + j * 3
_SCREENMOVE x, y
_MOUSEMOVE dragpt, 1
IF y >= WinMse.Y_Pos THEN EXIT DO
ELSE
y = y + j * 8
_SCREENMOVE x, y
_MOUSEMOVE dragpt, 1
IF y <= WinMse.Y_Pos THEN EXIT DO
END IF
LOOP
END IF
z = GetCursorPos(WinMse)
ELSE
IF WinMse.Y_Pos >= _SCREENY AND WinMse.Y_Pos <= _SCREENY + fh THEN
x = _SCREENX: y = _SCREENY
dragpt = (WinMse.X_Pos - x) \ fw
END IF
END IF
END IF
IF LEN(INKEY$) THEN SYSTEM
oldypos = WinMse.Y_Pos
oldxpos = WinMse.X_Pos
LOOP
Pete
|
|
|
|
| DAY 019: EQV |
|
Posted by: SMcNeill - 11-25-2022, 05:59 PM - Forum: Keyword of the Day!
- Replies (5)
|
 |
Just like IMP, this is one of those keywords that does binary comparisons on values, that you never see anyone using.
WHY?
Because everyone seems to be under a misconception about what EQV actually does!
From our wiki page -- EQV - QB64 Phoenix Edition Wiki -- we learn that this does bitwise comparisons. When both bits are the same (both are 0, or both are 1), then EQV reports that it's TRUE, they're equivalent to each other. If the two bits are different, EQV reports to us that it's FALSE, and they're not equivalent to each other.
Most people see that, or read that, and think, "Hey! That's simple enough. If they're the same, it's true. If they're different, it's false. This is just like equals!"
BZZZZZTTTTZZZ!! That's completely WRONG!
And let me tell you why:
0 EQV 0 = 1
1 EQV 1 = 1
0 EQV 1 = 0
1 EQV 0 = 0
^ Those are the basic rules of evaluating our bits. Now, let's apply it to two real world numbers!
4 = &B00000100
2 = &B00000010
EQV ----------
&B11111001
All those 0's that compare to 0's become 1. All the 1's that compare to 1's become 1. When a 0 compares to a 1, the result is 0. <<-- All just like the rules for EQV tell us.
Now, is 2 EQUAL TO 4?? (2 = 4)??
Of course not!!
But is 2 EQV 4??
Absolutely! It's 249! (Just count and add the bits in the result above... 11111001 = 249.)
Remember, in BASIC, *ONLY* zero is FALSE. Anything else is TRUE.
2 is not equal to 4, but it *is* EQV to 4.
Now, I know what some of you guys are going to say, after you think on this for a bit: "Then in BASIC, EQV is just about useless as all mixed numbers are going to give TRUE results."
1 EQV 0 = TRUE
1 EQV 1 = TRUE
1 EQV 2 = TRUE
1 EQV 3 = TRUE
Try it for yourself:
Code: (Select All) Dim As _Unsigned _Byte a, b, c
a = 1
For i = 0 To 10
b = i
c = a Eqv b
Print c
Next
11 non-zero numbers on the screen.. 11 TRUE values! They're *ALL* True!!
"Now hold on one moment there, Stevey-boy!" (I'm channeling my inner Pete here, as I can hear him already.) "Just how the hell did 1 and 0 end up being TRUE? By our definition from the wiki, they have to be FALSE!! Somethings fishy here, and it isn't the tuna I had for supper last night!"
BZZZZZZZZTTTZZZZ!! Sorry, Imaginary @Pete. The result is exactly what you'd expect to see, if you think about it for just a moment.
What is 1? What is 0??
1 = &B00000001
0 = &B00000000
Now, that 0 and 1 might EQV out to become 0, but what happens to all those 0's and 0's when they're compared against each other??
11111110.
1 AND 0 = 254 (as unsigned bytes). It's definitely true!
"Then how the hell do you ever generate a FALSE with EQV? That's impossible, for tarnation's sake!"
BZZZZZZZZTTTZZZZ!! Sorry again, Imaginary @Pete.
You get FALSE back, if -- and only if -- EVERY bit is the opposite of the other!
&B10101010
&B01010101
EQV========
&B00000000
&B11111111
&B00000000
EQV========
&B00000000
&B00000001
&B11111110
EQV========
&B00000000
When EVERY bit is the opposite of the other, the result is FALSE. Otherwise it's TRUE.
So 1 EQV 254 is FALSE. 0 EQV 255 is FALSE. 127 EQV 128 is FALSE.
.
.
.
"Ha! Ha! You're a goober! That's wrong! I just tried it! Nanner! Nanner!"
Shut up, Imaginary @Pete!
It's only wrong because you didn't pay attention to what I just stressed in bold, italic, underline above!
When EVERY bit is the opposite of the other, the result is FALSE. Otherwise it's TRUE.
What variable type did you use, when you tested those values for 1 EQV 254? 0 EQV 255?
"Umm... Whatever QB64-PE defaults to. I just typed them in as numbers!"
Then let me ask.. What is 254 as an INTEGER value? What is 1 as an INTEGER value??
254 = &B0000000011111110
1 = &B0000000000000001
See the problem already? There's a whole bunch of leading 0's which match for both values!
It's only when one is dealing with BYTE values, that 1 EQV 254 is FALSE. If they're a different variable type, they're both padded with zeros which are going to match up, and 0 EQV 0 = 1...
When EVERY bit is the opposite of the other, the result is FALSE. Otherwise it's TRUE.
I can't stress the above enough. EQV is not a form of equal. It's a bitwise comparison, and...
When EVERY bit is the opposite of the other, the result is FALSE. Otherwise it's TRUE.
|
|
|
|
| I for the life of me can not remember the program name. |
|
Posted by: doppler - 11-25-2022, 01:36 PM - Forum: General Discussion
- Replies (8)
|
 |
Hello, Following on from the subject line....
I while back, in some other forum likely. I saw and used a program (dumb me never saved it). That would allow revision changes to take the original program and files. And update it to a new release. This would serve two purposes. The program changes need only be downloaded (much smaller), and the updated program is verified/changed as needed. By doing it this way, I don't have to migrate or integrate my stuff to a new release.
The real take away is. The change file is much smaller, faster download and less space of hard drive (like that a real problem still. Sorry I am old school ie: $100 for 5MB mfm drive).
Thanks.
|
|
|
|
| Color Fetch Tool |
|
Posted by: SMcNeill - 11-25-2022, 11:31 AM - Forum: SMcNeill
- No Replies
|
|
Now one thing that I think we're all happy about (or at least I'm happy about it), was the addition of all the color names to QB64. Personally, I find it quite nice to be able to do things like Color Red, Blue and such. My one personal gripe, however, is that it's impossible to remember all the color names and what they actually look like. Do I want Wheat, or Peach, or GoldenRod? Is it LightGray, or LightGrey? Uggh! If I just had a handy little tool to help me quickly find and make use of these colors!!
And, lo and behold, now I do!
Code: (Select All) Screen _NewImage(800, 600, 32)
$Color:32
Do
GetColor cn$, cv&&
Color cv&&
Print cn$, cv&&, _Red32(cv&&), _Green32(cv&&), _Blue32(cv&&)
Loop
Sub GetColor (KolorName$, KolorValue&&)
Static clip$
file$ = ".\internal\support\color\color32.bi"
If _FileExists(file$) = 0 Then Exit Sub 'bad path, bad file... some glitch... we can't work
Open file$ For Binary As #1
ReDim Kolor(1000) As String
ReDim Value(1000) As _Integer64
Dim Alphabet(25) As Integer
Do Until EOF(1)
Line Input #1, text$
If UCase$(Left$(text$, 5)) = "CONST" Then
count = count + 1
text$ = Mid$(text$, 7) 'strip off the CONST and space
l = InStr(text$, "=")
Kolor(count) = Left$(text$, l - 4)
Value(count) = Val(Mid$(text$, l + 2))
If Alphabet(Asc(Kolor(count), 1) - 65) = 0 Then Alphabet(Asc(Kolor(count), 1) - 65) = count
End If
Loop
Close
ReDim _Preserve Kolor(count) As String
ReDim _Preserve Value(count) As _Integer64
w = _Width: h = _Height
xPos = (w - 320) \ 2: yPos = (h - 240) \ 2
PCopy 0, 1
selected = 1
Do
Line (xPos, yPos)-Step(320, 240), LightGray, BF
fPosx = (w - _PrintWidth(Kolor(selected))) \ 2
_PrintString (fPosx, yPos + 5), Kolor(selected)
Line (xPos + 30, yPos + 30)-Step(260, 180), Value(selected), BF
Line (xPos + 30, yPos + 30)-Step(260, 180), Black, B
k = _KeyHit
z = k And Not 32
Select Case z
Case 18432: selected = selected - 1: If selected < 1 Then selected = count
Case 20480: selected = selected + 1: If selected > count Then selected = 1
Case 13: KolorName$ = Kolor(selected): KolorValue&& = Value(selected)
Case 65 To 90:
If Alphabet(z - 65) Then selected = Alphabet(z - 65)
If z = 81 Then selected = Alphabet(82 - 65) 'there is no Q colors, so show R
If z = 90 Then selected = count 'there is no Z colors, so last one
End Select
_Display
Loop Until k = 13 Or k = 27
_AutoDisplay
PCopy 1, 0
If k = 27 Then _Clipboard$ = clip$: System
clip$ = clip$ + KolorName$ + "~& =" + Str$(KolorValue&&) + Chr$(13)
End Sub
Compile and run. Use arrow keys to change colors one color at a time, or A - Z keys to jump to that corresponding point in the color name index. Hit ENTER to select several colors that you like, and ESC to exit the program.
The program saves your selected color names and values to the clipboard, and you can simply post them into your program wherever you desire afterwards. (CTRL-V is shortcut key to post into the IDE.)
Makes for a quick little tool to help you remember what the names are, how to actually spell them, and maybe add a little bit more of the rainbow into your programs. 
Example colors quickly copied:
Code: (Select All) AntiqueBrass~& = 4291663221
CrayolaGold~& = 4293379735
Gold~& = 4294956800
|
|
|
|
Dirwalker - Simplistic and Ergonomic Directory Browser |
|
Posted by: Sanmayce - 11-25-2022, 06:44 AM - Forum: Utilities
- Replies (35)
|
 |
First, glad that today I found the new forum, hi to all fellow members.
These days I am playing with my new GUI tool - Dirwalker - The QB64 Simplistic-n-Ergonomic Directory Browser.
Screenshot #1, showing the initial window with all the quick help:
Screenshot #2, showing the search panel filtering only the specified files/lines:
Screenshot #3, showing the four columns (fileTYPE, fileSIZE, fileMODIFIEDtime, fileNAME), sortable respectively with F1/F2/F3/F4:
The main idea is to have one cross-platform tool allowing bypassing of ls/dir commands, most of the time, anyway.
Currently, I have written revision 5++++, which has some original ideas/functionalities, wanna develop it steadily in next months.
Two main goals/features are EASYNESS of navigation and VISIBILITY-n-CRISPNESS, targeting the 4K monitors (3K as well) while allowing 1600x900 modes too.
In next posts hope to share more...
As always, the full source code and the Linux/Windows binaries are in the attached package.
Dirwalker_r5++++_Sourcecode_Binaries.zip (Size: 2.6 MB / Downloads: 123)
|
|
|
|
| EVMS -- Easy Versatile Menu System |
|
Posted by: SMcNeill - 11-24-2022, 10:55 PM - Forum: Works in Progress
- Replies (8)
|
|
Something I'm playing around with:
Code: (Select All) Screen _NewImage(800, 600, 32)
$Color:32
Type Menu_Entries
Name As String
HighLight As Integer
Active As Integer
xOffset As Integer
yOffset As Integer
width As Integer
height As Integer
End Type
Type Menu_Metadata
inUse As Integer
totalChoices As Integer
xPos As Integer
yPos As Integer
width As Integer
height As Integer
layout As Integer '0 for left-right, anything else for up-down
Active As Integer
Visible As Integer
End Type
Dim Shared Menu(1 To 100) As Menu_Metadata, MenuChoice(1 To 100, 20) As Menu_Entries
mainmenu = DefineMenu("#File" + Chr$(0) + "#Edit" + Chr$(0) + "#Help, Help me, Rhonda!" + Chr$(0) + "Qui#t" + Chr$(0), 0)
Do
Cls
While _MouseInput: Wend
If _MouseButton(2) And Not omb2 Then
showIt = Not showIt
ShowMenu mainmenu, showIt
If showIt = 0 Then
style = Not style
Menu(1).inUse = 0 'a hack so we can watch the menu change styles
mainmenu = DefineMenu("#File" + Chr$(0) + "#Edit" + Chr$(0) + "#Help, Help me, Rhonda!" + Chr$(0) + "Qui#t" + Chr$(0), style)
End If
SetMenuPos mainmenu, _MouseX, _MouseY
End If
Drawmenus
omb2 = _MouseButton(2)
_Limit 30
_Display
Loop
Sub Drawmenus
DC&& = _DefaultColor: BG&& = _BackgroundColor
Color Black, 0
For i = 1 To 100
If Menu(i).inUse And Menu(i).Visible Then
xp = Menu(i).xPos: yp = Menu(i).yPos
Line (xp, yp)-Step(Menu(i).width, Menu(i).height), DarkGray, BF
For j = 1 To Menu(i).totalChoices
Color Black, 0
_PrintString (xp + MenuChoice(i, j).xOffset, yp + MenuChoice(i, j).yOffset), MenuChoice(i, j).Name
h = MenuChoice(i, j).HighLight
If h Then
Color White, 0
_PrintString (xp + MenuChoice(i, j).xOffset + (h - 1) * _FontWidth, yp + MenuChoice(i, j).yOffset), Mid$(MenuChoice(i, j).Name, MenuChoice(i, j).HighLight, 1)
End If
Next
End If
Next
Color DC&&, BG&&
End Sub
Sub SetMenuPos (whichMenu, xPos, yPos)
Menu(whichMenu).xPos = xPos
Menu(whichMenu).yPos = yPos
End Sub
Sub ShowMenu (whichMenu, visible)
Menu(whichMenu).Visible = visible
End Sub
Function DefineMenu (choices$, layout) 'layout 0 for left-right, anything else for up-down
'first, check for a free menu handle
For i = 1 To 100
If Menu(i).inUse = 0 Then Exit For
Next
If i > 100 Then Exit Function 'return a value of 0 as we have no available menus
MIU = i 'Menu in Use
'parse choices$
Dim item(1000) As String
c$ = choices$
maxWidth = 0
Do
count = count + 1
i = InStr(c$, Chr$(0))
If i Then
item(count) = " " + Left$(c$, i - 1) + " "
c$ = Mid$(c$, i + 1)
Else
item(count) = " " + c$ + " "
End If
L = Len(item(count))
If InStr(item(count), "#") Then L = L - 1
If L > maxWidth Then maxWidth = L
Loop Until i = 0 Or c$ = ""
Menu(MIU).inUse = -1
Menu(MIU).totalChoices = count
Menu(MIU).xPos = 0 'can set these later
Menu(MIU).yPos = 0
If layout Then 'vertical menu
Menu(MIU).layout = -1
Menu(MIU).width = maxWidth * _FontWidth
Menu(MIU).height = count * _FontHeight
Else 'hortizontal menu
Menu(MIU).layout = 0
Menu(MIU).height = _FontHeight
End If
Menu(MIU).Active = 0
Menu(MIU).Visible = 0
For i = 1 To count
L = InStr(item(i), "#")
If L Then
MenuChoice(MIU, i).HighLight = L
item(i) = Left$(item(i), L - 1) + Mid$(item(i), L + 1)
End If
MenuChoice(MIU, i).Name = item(i)
MenuChoice(MIU, i).Active = -1
If layout Then 'vertical
MenuChoice(MIU, i).xOffset = 0
MenuChoice(MIU, i).yOffset = (i - 1) * _FontHeight
MenuChoice(MIU, i).width = Len(item(i)) * _FontWidth
Else 'hortizontal
MenuChoice(MIU, i).xOffset = wide
MenuChoice(MIU, i).yOffset = 0
wide = wide + Len(item(i)) * _FontWidth
MenuChoice(MIU, i).width = Len(item(i)) * _FontWidth
Menu(MIU).width = wide
End If
MenuChoice(MIU, i).height = _FontHeight
Next
DefineMenu = MIU
End Function
At the moment, this just demos defining a menu, clicking a button, and popping it onto the screen. There's no actual "select a choice" function in this yet (hence why it's in the Works in Progress area), so don't think you can actually use this for much yet.
To test this out so far, just run it and right click your mouse a few times. It should pop up our little menu wherever the mouse is at (or hide the menu on a second click). Multiple clicks will cycle through the two options which we can set for our menus.
Does this look more-or-less presentable to everyone? Is there some secret menu layout that I'm missing with this simple set up? Test it out. Offer a suggestion or opinion. And remember -- this is a work in progress and is liable to be changed (or even dropped) without any notice.
|
|
|
|
| Sharing an entire BAM project |
|
Posted by: CharlieJV - 11-24-2022, 06:07 PM - Forum: QBJS, BAM, and Other BASICs
- Replies (3)
|
 |
Say you want to share your entire BAM project (i.e. not just your programs, but everything in your BASIC Anywhere Machine instance: BAM itself, your programs, tasks, etc.).
BASIC Anywhere Machine is a single-html-file and it is easy to share in various ways: - upload it to your web server so your file can be shared for download via your website
- upload it to a file hosting service on the web
- (for both options above, just share the URL with your audience)
- attach the file to a post in a forum (most forums have a limit on file size, so that may not be an option)
- email it as an attachment
One of the top features I wanted in BAM: easily share not just programs, but your entire BAM instance (the interpreter, the IDE, the tools, the programs, the libraries, the tasks, etc. etc.; everything). And have just the one file to think about.
And make it easy to have multiple instances of BAM, one for every project if you want.
Because most forums like this one have a max file size limit too low for the size of a BAM instance, I've shared my "Calculator Project BAM instance" via a Google Groups post: https://groups.google.com/g/basic-anywhe...PRTwQ0fOr4
|
|
|
|
|
![[Image: Quelltext-drucken.jpg]](https://i.ibb.co/khVv5k2/Quelltext-drucken.jpg)
