| Welcome, Guest |
You have to register before you can post on our site.
|
| Latest Threads |
The QB64 IDE shell
Forum: Utilities
Last Post: JasonPag
09-16-2024, 05:37 PM
» Replies: 9
» Views: 762
|
Importance regarding Ches...
Forum: Utilities
Last Post: JasonPag
09-01-2024, 06:34 PM
» Replies: 0
» Views: 31
|
Chess and Analysis and En...
Forum: Utilities
Last Post: JasonPag
08-28-2024, 02:37 PM
» Replies: 0
» Views: 32
|
DAY 009:_PutImage
Forum: Keyword of the Day!
Last Post: grymmjack
09-02-2023, 02:57 PM
» Replies: 54
» Views: 2,034
|
Fall Banner Contest?
Forum: Site Suggestions
Last Post: grymmjack
08-31-2023, 11:50 PM
» Replies: 36
» Views: 1,261
|
ColorPicker - Function th...
Forum: Dav
Last Post: Dav
08-31-2023, 11:04 PM
» Replies: 3
» Views: 315
|
Goals(1) = New Tile()
Forum: Works in Progress
Last Post: RhoSigma
08-31-2023, 09:45 PM
» Replies: 3
» Views: 127
|
micro(A)v11
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:14 PM
» Replies: 90
» Views: 3,589
|
Updating The Single Most ...
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:13 PM
» Replies: 7
» Views: 254
|
QBJS Image Question
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 05:49 PM
» Replies: 5
» Views: 155
|
|
|
| Custom Title Bar with Win32 API |
|
Posted by: Pete - 11-27-2022, 07:11 AM - Forum: General Discussion
- Replies (8)
|
 |
So if anyone ever wants to avoid the Windows title bar and create a custom title bar with functions, here's a little demo I whipped up...
It's all SCREEN 0, but you could just as easily make one with a graphics screen.
To drag the window, simply place the mouse pointer on the title bar and hold the left mouse button down, just as you always do for any windows title bar.
The various buttons are clickable. The menu functions are just for show, except for quit.
Code: (Select All) DIM SHARED 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 ShowWindow& (BYVAL hwnd AS LONG, BYVAL nCmdShow AS LONG)
FUNCTION GetAsyncKeyState% (BYVAL vkey AS LONG)
FUNCTION GetCursorPos (lpPoint AS POINTAPI)
FUNCTION SetCursorPos& (BYVAL x AS INTEGER, BYVAL y AS INTEGER)
END DECLARE
DIM AS INTEGER setxy
WIDTH 50, 25
DO: LOOP UNTIL _SCREENEXISTS
GWL_STYLE = -16
ws_border = &H800000
WS_VISIBLE = &H10000000
_TITLE "No Border"
hwnd& = _WINDOWHANDLE
DO
winstyle& = GetWindowLongA&(hwnd&, GWL_STYLE)
LOOP UNTIL winstyle&
DO
a& = SetWindowLongA&(hwnd&, GWL_STYLE, winstyle& AND WS_VISIBLE)
LOOP UNTIL a&
REDIM SHARED p1(8), p2(5)
p1(1) = 0 ' Background reg and snooze.
p1(2) = 1 ' Highlight background.
p1(3) = 3 ' Open menu shadow.
p1(4) = 4 ' Show collapsed entries background.
p1(5) = 5 ' Tabs background.
p1(6) = 6 ' Strip between tabs and title bar.
p1(7) = 7 ' Open menu background.
p1(8) = 14 ' Highlight foreground text.
p2(1) = 0 ' Strip between tabs and title bar.
p2(2) = 8 ' Background all pages.
p2(3) = 56 ' Background snooze.
p2(4) = 62 ' Highlight Background.
p2(5) = 63 ' Tabs background.
rt.mrgn = 2: lt.mrgn = 3: tp.mrgn = 4: bt.mrgn = 2
IF lt.mrgn = 0 THEN lt.mrgn = 1 ' Default.
IF tp.mrgn = 0 THEN tp.mrgn = 1 ' Default.
LOCATE 1, 1
PALETTE 5, 63
PALETTE 6, 8
PALETTE 9, 7
PALETTE 7, 7
CALL sam_titlebar
COLOR 15, 6
VIEW PRINT 2 TO _HEIGHT
CLS 2
VIEW PRINT
fw = _FONTWIDTH
fh = _FONTHEIGHT
x = _SCREENX: y = _SCREENY
DO
_LIMIT 60
WHILE _MOUSEINPUT: WEND
mx = _MOUSEX
my = _MOUSEY
' Check pseudo-title bar.
IF my = 1 THEN
' ID by screen character.
IF mx <> tmp% THEN
SELECT CASE CHR$(SCREEN(my, mx))
CASE "X", "þ", "Ä"
IF tmp% THEN COLOR 8, 5: LOCATE my, tmp% - 1: PRINT tmp$;
tmp$ = SPACE$(3): MID$(tmp$, 2, 1) = CHR$(SCREEN(my, mx))
IF MID$(tmp$, 2, 1) = "X" THEN: COLOR 15, 12 ELSE COLOR 15, 7
tmp% = mx: LOCATE my, mx - 1: PRINT tmp$;
CASE "ð", "M", "e", "n", "u" ' Menu.
IF tmp% THEN COLOR 8, 5: LOCATE my, tmp% - 1: PRINT tmp$;
' Exception.
tmp$ = SPACE$(3): MID$(tmp$, 2, 1) = "ð"
tmp% = 2: COLOR 15, 7: LOCATE my, 1: PRINT tmp$;
CASE ELSE
IF tmp% THEN COLOR 8, 5: LOCATE my, tmp% - 1: PRINT tmp$;
tmp% = 0
END SELECT
END IF
ELSE
IF tmp% THEN CALL sam_titlebar: tmp% = 0
END IF
IF GetAsyncKeyState(1) < 0 THEN
IF lb = 0 THEN lb = 1
ELSE
IF lb THEN lb = 0: dragx = 0: dragy = 0
END IF
z& = GetCursorPos(WinMse)
IF lb THEN
IF tmp% THEN
COLOR 8, 5: LOCATE my, tmp% - 1: PRINT tmp$;: tmp% = 0
DO: LOOP UNTIL GetAsyncKeyState(1) = 0: lb = 0
_DELAY .1
SELECT CASE MID$(tmp$, 2, 1)
CASE "X"
SYSTEM
CASE "þ"
IF _FULLSCREEN THEN
_FULLSCREEN OFF
ELSE
_FULLSCREEN
END IF
CASE "Ä"
x& = ShowWindow&(hwnd&, 2)
DO: _LIMIT 1: LOOP UNTIL _SCREENICON = 0
CALL sam_titlebar
CASE "ð"
CALL sam_menu
END SELECT
tmp$ = ""
ELSEIF dragx THEN
IF WinMse.X_Pos <> oldxpos OR WinMse.Y_Pos <> oldypos THEN
j1 = (WinMse.X_Pos - oldxpos)
j2 = (WinMse.Y_Pos - oldypos)
x = x + j1: y = y + j2
_SCREENMOVE x, y
setxy = SetCursorPos(x + dragx, y + dragy)
END IF
z& = GetCursorPos(WinMse)
ELSEIF WinMse.Y_Pos >= _SCREENY AND WinMse.Y_Pos <= _SCREENY + fh THEN
x = _SCREENX: y = _SCREENY
dragx = (WinMse.X_Pos - x)
dragy = fw \ 2 ' Set to middle of the title bar vertical height.
END IF
END IF
IF LEN(INKEY$) THEN SYSTEM
oldypos = WinMse.Y_Pos: oldxpos = WinMse.X_Pos
oldmx = mx: oldmy = my
LOOP
END
SUB sam_titlebar
LOCATE 1, 1
COLOR 0, 5
PRINT SPACE$(_WIDTH);
LOCATE 1, 2: PRINT CHR$(240);
LOCATE , 4: PRINT "Menu";
msg$ = "Sam-Clip"
LOCATE , _WIDTH / 2 - LEN(msg$) / 2 + 1: PRINT msg$;
LOCATE , _WIDTH - 7: PRINT "Ä þ X";
END SUB
SUB sam_menu ' Self-contained subroutine.
y = CSRLIN: x = POS(0)
LOCATE , , 0 ' Hide cursor
clipinsert.var = 0
DIM atmp AS STRING
noi = 6 ' Number of menu items
REDIM menu$(noi)
menu$(1) = "Open"
menu$(2) = "Settings"
menu$(3) = "Recycled"
menu$(4) = "Help"
menu$(5) = "Close"
menu$(6) = "Quit"
h = 5 ' Variable to determine margin spaces from the right of menu.
FOR i = 1 TO noi
j = LEN(menu$(i))
IF j > k THEN k = j
NEXT
mwidth = k + h
mheight = noi * 2 + 1 ' Add one for the separate border element.
MenuT = 1: MenuL = 1: MenuR = MenuL + mwidth: MenuB = MenuT + mheight
DO
_LIMIT 30
z = GetCursorPos(WinMse)
SELECT CASE menu.var
CASE -1
WHILE _MOUSEINPUT: WEND
my = _MOUSEY
mx = _MOUSEX
IF my > MenuT AND my < MenuB AND mx > MenuL AND mx < MenuR THEN
IF my \ 2 = my / 2 AND my AND my <> oldmy THEN
IF MenuHL THEN
atmp = SPACE$(mwidth - 2)
LOCATE MenuHL, MenuL + 2 - 1
COLOR 0, 7
MID$(atmp, 2, LEN(menu$((MenuHL - MenuT) \ 2 + 1))) = menu$((MenuHL - MenuT) \ 2 + 1)
PRINT atmp;
END IF
atmp = SPACE$(mwidth - 2)
LOCATE my, MenuL + 2 - 1
COLOR 7, 0
MID$(atmp, 2, LEN(menu$((my - MenuT) \ 2 + 1))) = menu$((my - MenuT) \ 2 + 1)
PRINT atmp;
COLOR 0, 7
MenuHL = my
END IF
IF _MOUSEBUTTON(1) THEN
menu.var = (my - MenuT) \ 2 + 1
EXIT DO
END IF
ELSE
' Toggle close menu.
IF GetAsyncKeyState(1) < 0 THEN
IF WinMse.Y_Pos >= _SCREENY AND WinMse.Y_Pos <= _SCREENY + 24 AND WinMse.X_Pos >= _SCREENX + 36 AND WinMse.X_Pos <= _SCREENX + 48 THEN
menu.var = 0: EXIT DO ' Close menu.
ELSE
IF WinMse.Y_Pos >= _SCREENY AND WinMse.Y_Pos <= _SCREENY + _FONTHEIGHT * (_HEIGHT + 1) AND WinMse.X_Pos >= _SCREENX AND WinMse.X_Pos <= _SCREENX + _FONTWIDTH * _WIDTH THEN
ELSE ' Outside of app window.
menu.var = 0: EXIT DO ' Close menu.
END IF
END IF
END IF
IF _MOUSEBUTTON(1) THEN ' Outside of menu closes menu.
menu.var = 0 ' Close.
EXIT DO
END IF
END IF
oldmy = my
CASE 0
menu.var = -1 ' Menu open.
PCOPY 0, 1
PALETTE p1(7), p2(5)
PALETTE p1(3), p2(3)
COLOR 0, 7
LOCATE MenuT, MenuL
PRINT CHR$(218) + STRING$(mwidth - 2, 196) + CHR$(191)
FOR i = 1 TO mheight - 2
COLOR 0, 7
PRINT CHR$(179); SPACE$(mwidth - 2) + CHR$(179);
COLOR 7, 3: PRINT CHR$(SCREEN(CSRLIN, POS(0))) + CHR$(SCREEN(CSRLIN, POS(0) + 1)): COLOR 1, 7
NEXT
COLOR 0, 7
PRINT CHR$(192) + STRING$(mwidth - 2, 196) + CHR$(217);: COLOR 7, 3: PRINT CHR$(SCREEN(CSRLIN, POS(0))) + CHR$(SCREEN(CSRLIN, POS(0) + 1))
LOCATE , MenuL + 2
FOR i = 1 TO mheight
PRINT CHR$(SCREEN(CSRLIN, POS(0)));
NEXT
COLOR 0, 7
LOCATE MenuT + 2, MenuL + 2
FOR i = 0 TO noi - 1
LOCATE MenuT + 1 + i * 2, 3
PRINT menu$(i + 1)
LOCATE , MenuL
IF i + 1 < noi THEN PRINT "Ã" + STRING$(mwidth - 2, CHR$(196)) + "´";
NEXT
DO: _LIMIT 10: LOOP UNTIL GetAsyncKeyState(1) = 0 ' Wait for button release to avoid continuous toggle event.
END SELECT
LOOP
PCOPY 1, 0
LOCATE y, x
_KEYCLEAR
IF menu.var = 6 THEN SYSTEM
DO: _LIMIT 10: LOOP UNTIL GetAsyncKeyState(1) = 0
PALETTE 7, 7
END SUB
Pete
|
|
|
| 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
|
|
|
|
| Version 2.0.2 compatibility |
|
Posted by: krovit - 11-25-2022, 09:22 AM - Forum: Programs
- Replies (28)
|
|
Hello! I hope you are all well.
It's been a while since I came here for certain commitments that I could not neglect but today I see that you have gone a long way: good!
I tried to compile my project with version 3.4.1 and I get an error while the same project with version 2.0.2 comes to fruition.
Evidently there is a compatibility problem but I can not figure out where it is because I do not see informative messages. I attach the log of the compilation in the hope that someone can tell me where it is i find the error.
Thank you!
___
internal\c\c_compiler\bin\c++.exe -w -std=gnu++11 -DGLEW_STATIC -DFREEGLUT_STATIC -Iinternal\c\libqb/include -DDEPENDENCY_IMAGE_CODEC -DDEPENDENCY_NO_SOCKETS -DDEPENDENCY_NO_PRINTER -DDEPENDENCY_ICON -DDEPENDENCY_NO_SCREENIMAGE -DDEPENDENCY_LOADFONT -DDEPENDENCY_DEVICEINPUT -DDEPENDENCY_AUDIO_MINIAUDIO internal\c/qbx.cpp -c -o internal\c/qbx.o
internal\c\c_compiler\bin\windres.exe -i internal\temp\icon.rc -o internal\temp\icon.o
internal\c\c_compiler\bin\objcopy.exe -Ibinary -Oelf32-i386 -Bi386 internal\temp/data.bin internal\temp/data.o
internal\c\c_compiler\bin\c++.exe -w -std=gnu++11 -DGLEW_STATIC -DFREEGLUT_STATIC -Iinternal\c\libqb/include -DDEPENDENCY_IMAGE_CODEC -DDEPENDENCY_NO_SOCKETS -DDEPENDENCY_NO_PRINTER -DDEPENDENCY_ICON -DDEPENDENCY_NO_SCREENIMAGE -DDEPENDENCY_LOADFONT -DDEPENDENCY_DEVICEINPUT -DDEPENDENCY_AUDIO_MINIAUDIO internal\c/libqb_make_01000101110000.o internal\c/qbx.o internal\temp\icon.o internal\temp/data.o -o "D:\161\NC_07-phoenix.exe" internal\c\libqb/src/threading.o internal\c\libqb/src/buffer.o internal\c\libqb/src/filepath.o internal\c\libqb/src/threading-windows.o internal\c/parts/video/image/image.o internal\c/parts/gui/tinyfiledialogs.o internal\c/parts/gui/gui.o internal\c/parts/video/font/ttf/src.a internal\c/parts/input/game_controller/src.a internal\c/parts/audio/audio.o internal\c/parts/audio/miniaudio_impl.o internal\c/parts/audio/extras/mod_ma_vtable.o internal\c/parts/audio/extras/radv2_ma_vtable.o internal\c/parts/audio/extras/libxmp-lite.a internal\c/parts/audio/extras/midi_ma_vtable_stub.o internal\c/parts/core/src.a -static-libgcc -static-libstdc++ -lcomdlg32 -lole32 -mwindows -lopengl32 -lglu32 -lwinmm -lwinmm -lwinmm -lksguid -ldxguid -lole32 -lgdi32
d:/qb64/internal/c/c_compiler/bin/../lib/gcc/x86_64-w64-mingw32/12.2.0/../../../../x86_64-w64-mingw32/bin/ld.exe: i386 architecture of input file `internal\temp/data.o' is incompatible with i386:x86-64 output
collect2.exe: error: ld returned 1 exit status
mingw32-make: *** [Makefile:430: D:\161\NC_07-phoenix.exe] Error 1
|
|
|
|
|
![[Image: Quelltext-drucken.jpg]](https://i.ibb.co/khVv5k2/Quelltext-drucken.jpg)
