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,032
|
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
|
|
|
Problem starting BC.Exe in DOS 5.02 |
Posted by: eoredson - 06-08-2023, 04:55 AM - Forum: Help Me!
- Replies (14)
|
|
We are trying to run certain .exe programs on a IBM 486 running DOS 5.02 to make sure they are backwards compatible. When attempting to compile an QBasic 4.5 program with BC.EXE we get the following error and would like to know how to solve it.:
Code: (Select All) runtime error R6002
- floating point not loaded
Note: This is not a Windows error and we have all the necessary drivers loaded.
|
|
|
CPU Type and Speed |
Posted by: TerryRitchie - 06-07-2023, 08:26 PM - Forum: General Discussion
- Replies (11)
|
|
A while back I could have sworn I saw someone post code that identified the CPU and speed using a Declare Library but I can't find it. Furthermore, I would have saved something like that in my box of goodies but I can't find that either?? Is my age finally messing with my brain or did I in fact see this code recently?
|
|
|
Testing QBJS tags |
Posted by: bplus - 06-05-2023, 06:21 PM - Forum: QBJS, BAM, and Other BASICs
- Replies (10)
|
|
[qbjs]'Option _Explicit
'_Title "Tessellation 4" ' b+ 2023-05-19
' Inspired by Charlie's BAM example
' https(colon)//staging.qb64phoenix.com/showthread.php?tid=1646&pid=15772#pid15772
' b+ 2023-05-09 - Tiling with a pattern
' Tessellation 2 will try color filled with more background black.
' Tessellation 3 Charlie mentions a mirror image for interesting tessellating,
' lets try mirroring both x and y axis.
'
' Tessellation 4
' Use b key to toggle between
' 1. 3 color tessellation
' 2. 4 color tessellation
' and use c key to toggle between
' 1. a random set of colors
' 2. contrast (a red, a green, a blue and 4th is white)
'
'DefLng A-Z
Randomize Timer
Screen _NewImage(800, 600, 32) ' full rgb range here
_ScreenMove 250, 50
Dim Shared Pix ' Pix is number of pixels to Tile side
Dim Shared Scale ' Change a pixel to a bigger square block for not so subtle patterns
Dim Shared Tile ' Handle that stores Tile Image in memory to call up with _PutImage
Dim Shared B ' Toggle color mode from 3 to 4 and back
Dim Shared C ' Toggle Contrast set and Random set of colors
ReDim Shared Pal(1 To 4) As _Unsigned Long ' palette to hold 3 or 4 colors
Dim K$, t$
Do
K$ = InKey$
If K$ = "b" Then B = 1 - B ' toggle coloring mode on a b keypress
If K$ = "c" Then C = 1 - C ' toggle coloring mode on a b keypress
' update the title according current b and c toggles
If B Then t$ = "4" Else t$ = "3"
If C Then t$ = t$ + " Contrasted Colors" Else t$ = t$ + " Random Colors"
_Title t$ + ">>> use b to toggle 3|4 colors, c to toggle random|contrast, any other for next screen"
MakePalette ' 3 or 4 random colors according to b
MakeTile ' create a new random tiling pattern
Tessellate ' tile the screen with it
_PrintString (740, 580), "ZZZ..." ' Show user we are sleeping awaiting a key press
Sleep
Loop Until _KeyDown(27) ' quit when detect escape key on sleep
Sub MakePalette
Dim As Long n, i
If B Then n = 4 Else n = 3
ReDim Pal(1 To n) As _Unsigned Long
For i = 1 To n
If C Then
If B Then
If i = 4 Then Pal(i) = C3~&(999) Else Pal(i) = C3~&(10 ^ (i - 1) * Int(Rnd * 10))
Else
Pal(i) = C3~&(10 ^ (i - 1) * Int(Rnd * 10))
End If
Else
Pal(i) = C3~&(Int(Rnd * 1000))
End If
Next
End Sub
Sub MakeTile ' make a random tile to Tesselate according to B Mode coloring
Pix = Int(Rnd * 9) + 4 ' sets tile size pix X pix or a 4X4 to 12X12 Tile coloring
Scale = Int(Rnd * 6) + 4 ' to change pixels to square blocks
If Tile Then _FreeImage Tile ' throw old image away
Tile = _NewImage(2 * Scale * Pix - 1, 2 * Scale * Pix - 1) ' make new one
_Dest Tile ' draw in the memory area Tile not on screen
Dim As Long y, x, q
For y = 0 To Scale * Pix Step Scale
For x = 0 To Scale * Pix Step Scale
If B Then q = Int(Rnd * 4) + 1 Else q = Int(Rnd * 3) + 1
Line (x, y)-Step(Scale, Scale), Pal(q), BF ' this should be integer since Tile is
Line (2 * Scale * Pix - x - 1, y)-Step(Scale, Scale), Pal(q), BF
Line (x, 2 * Scale * Pix - y - 1)-Step(Scale, Scale), Pal(q), BF
Line (2 * Scale * Pix - x - 1, 2 * Scale * Pix - y - 1)-Step(Scale, Scale), Pal(q), BF
Next
Next
_Dest 0
End Sub
Sub Tessellate ' just covering the screen with our Tile
Dim As Long y, x
For y = 0 To _Height Step 2 * Scale * Pix
For x = 0 To _Width Step 2 * Scale * Pix
_PutImage (x, y)-Step(2 * Scale * Pix, 2 * Scale * Pix), Tile, 0
Next
Next
End Sub
Function C3~& (n) ' New (even less typing!) New Color System 1000 colors with up to 3 digits
Dim s3$, r As Long, g As Long, b As Long
s3$ = Right$("000" + LTrim$(Str$(n)), 3)
r = Val(Mid$(s3$, 1, 1))
If r Then r = 28 * r + 3
g = Val(Mid$(s3$, 2, 1))
If g Then g = 28 * g + 3
b = Val(Mid$(s3$, 3, 1))
If b Then b = 28 * b + 3
C3~& = _RGB32(r, g, b)
End Function[/qbjs]
So what am I doing wrong?
|
|
|
Developing the next generation |
Posted by: NasaCow - 06-05-2023, 11:33 AM - Forum: General Discussion
- Replies (7)
|
|
So, I have a nearly 7 year old daughter and she seems interested in daddy pounding on the keyboard when I am programming. I know scratch is a language for kids as well. Anyone have experince of it and can point me in a direction to have enough resources to teach it? Or should I just download it and it is all in the langauge already? Thanks!
|
|
|
CreateFile library error |
Posted by: eoredson - 06-05-2023, 05:42 AM - Forum: Help Me!
- Replies (20)
|
|
I have been using this code for awhile. It is a CreateFile library function call.
Problem it work in Qb64pe-32 bit but in 64-bit throws a GNU C++ compilation error and I wanted to know why!?
Erik.
Code: (Select All) Rem $Dynamic
DefLng A-Z
Declare Dynamic Library "kernel32"
Function CloseHandle& (ByVal hfile As _Offset)
End Declare
Rem hfind = CreateFileA(ASCIIZ, &H180, &H3, 0, 3, 0, 0)
' parameters:
' (1) pointer to filename
' (2) access:
' x80(128) - read
' x100(256) - write
' (3) sharing
' (4) security attributes
' (5) create file flag
' (6) flags (standard OSHA)
' (7) pointer to template file
' paramater 5
' 0 DEFAULT_OPEN_EXISTING = open only if exists
' 1 CREATE_NEW = create only if not exist
' 2 CREATE_ALWAYS = always create new file
' 3 OPEN_EXISTING = open only if exists
' 4 OPEN_ALWAYS = open file always
' 5 TRUNCATE_EXISTING = open/truncate to 0 only if exists
' 6 OPEN_DIRECTORY = open if directory exists
Declare Library
Function CreateFileA& (filename$, Byval access&, Byval sharing&, Byval sec_attr%&, Byval create&, Byval flags&, Byval template%&)
End Declare
Dim hfind As _Offset
' detect file
Print "Enter filename";
Input f$
If Len(f$) Then
f$ = f$ + Chr$(0)
hfind = CreateFileA(f$, &H180, 0, 0, 3, 0, 0)
If hfind Then
Print "File exists."
r = CloseHandle(hfind)
End If
End If
End
|
|
|
Simple SpriteSheet Editor step by step in QB64pe |
Posted by: TempodiBasic - 06-04-2023, 05:04 PM - Forum: Works in Progress
- Replies (5)
|
|
Hi
this is a first version of a SpriteSheet editor: a program that loads a SpriteSheet and let you modify it painting with simple tools or/and lets to select an area as a single sprite into the sheet. After selected the sprites, you can save their cohordinates into a DATA file to use into your code with the original SpriteSheet and you can see the selected sprite shown on the screen.
It is a project step by step:
this first step brings a program with a main window that will be adapted to the spritesheet loaded and on this the user can define the 2 points to select an area of the picture to do a single sprite. You can accept/store or cancel each point selected before, after stored point 1 and 2 you get the sprite that is highlighted by a red square.
You can stop the selecting function pressing spacebar into the main loop or mousebutton2 while you are selecting the point 2.
the selected sprites will be displayed at the end of the procedure of selection.
This program uses a second area /canvas to give output to the user as messages or warnings or instructions.
I have posted some screenshots.
It is really incomplete but it can grow up if I use Option _explicit avoiding to waste so much time with bugs going out from my typo errors!
Code: (Select All) Option _Explicit
Rem SPRITE SHEET EDITOR
Rem this software has the purpouse to load an image of a sprite sheet
Rem and in SELECT MODE it allows to the user to select an area,
Rem or in EDIT MODE to paint changing the images into the sprite sheet
_Title "SpriteSheet Editor"
Const W = 1200, H = 800
'global varables
Dim Shared Main&, Sprite&, NameFile$, SSheet&, HelpS&
ReDim Sprites&(1 To 1)
Dim Shared As Integer Xm(1 To 2), Ym(1 To 2), SprC(1 To 4, 1 To 100)
' main variables
Dim Mg As Integer, a As Integer, Mb1 As Integer, Mb2 As Integer, kb As Integer, spr As Integer
Main& = _NewImage(W, H, 32)
HelpS& = _NewImage(W, H / 4, 32)
Screen Main&
_PrintString ((W / 2) - (10 * 8), H / 2), "SPRITES SHEET EDITOR" ' the title is 20 characters
_Delay 3
_SetAlpha 125, HelpS& ' area of output is half transparent
LoadI
Mg = 13: a = 0 'Mg pixel between 2 lines of the reticulus, a is a counter
While kb <> 32 ' while user does not press spacebar, he can define area on the screen delimiting sprites to capture into single area/canvas
Helping " Press spacebar to end", 1
If MouseData(Mb1, Mb2) = -1 Then 'it evaluates mouseinput
If Mb1 Then 'did mouse button 1 trigger?
' it starts the procedure for storing X an Y of points 1 (topleft) and 2 (bottomright)
If StoreMouseData(1) = -1 Then ' it stores mouse data for topleft point of sprite
While 1
Helping " Press spacebar to end", 1
Helping Str$(_MouseX) + Str$(_MouseY) + Space$(8), 0
'_Dest HelpS&: Locate 4, 26: Print kb; Space$(10);
'Locate 5, 1: Print _MouseX, _MouseY; Space$(8);: _Dest 0
'_PutImage (0, 2 * (_Height(0))), HelpS&,
If MouseData(Mb1, Mb2) = -1 Then ' it evaluates mouse input
Helping " Press spacebar to end", 1
Helping Str$(_MouseX) + Str$(_MouseY) + Space$(8), 0
' it adjourns the keyboard and mouse information
'_Dest HelpS&: Locate 4, 26: Print kb; Space$(10);
'Locate 5, 1: Print _MouseX, _MouseY; Space$(8);: _Dest 0
'_PutImage (0, 2 * (_Height(0))), HelpS&,
If Mb1 Then 'did mousebutton 1 trigger?
If StoreMouseData(2) = -1 Then ' yes, it stores mouse data bottomright
' after confirming the two points of the sprite it memorizes their cohordinates into SprC array
spr = spr + 1 ' sprite counter
SprC(1, spr) = Xm(1): Xm(1) = 0 'X1
SprC(2, spr) = Ym(1): Ym(1) = 0 'Y1
SprC(3, spr) = Xm(2): Xm(2) = 0 'X2
SprC(4, spr) = Ym(2): Ym(2) = 0 'Y2
Line (SprC(1, spr), SprC(2, spr))-(SprC(3, spr), SprC(4, spr)), _RGB32(233, 0, 6), B
Helping Str$(spr) + "/" + Str$(SprC(1, spr)) + "+" + Str$(SprC(2, spr)) + "--" + Str$(SprC(3, spr)) + "+" + Str$(SprC(4, spr)), 0
_Delay 1
Exit While ' after storing point 2 of sprite it returns to external loop
Else
Helping "To exit press mouse button 2", 0
_Delay 2
End If
End If
If Mb2 = -1 Then Exit While
End If
Wend
End If
' if no data stored for point 1 topleft it runs again the loop
End If
End If
kb = _KeyHit
' escaping way
If kb = 13 Then Grid
Helping Str$(kb), 0
Helping Str$(_MouseX) + Str$(_MouseY), 0
While _MouseInput: Wend ' it voids the mouse buffer
_Limit 10
Wend
Screen Main&
Helping "Save data of sprites into a DATA code file (Y/N)?", 1
kb = 0
While kb = 0
kb = _KeyHit
If kb = 89 Or kb = 121 Then SaveDATAtoFile: Exit While 'Y or y
If kb = 78 Or kb = 110 Then Exit While ' N or n
kb = 0
Wend
' getting single sprites with newimage
ReDim Sprites&(1 To spr), x As Integer, y As Integer
For a = 1 To spr
Sprites&(a) = _NewImage(Abs(SprC(1, a) - SprC(3, a)), Abs(SprC(2, a) - SprC(4, a)), 32)
_PutImage , Sprite&, Sprites&(a), (SprC(1, a), SprC(2, a))-(SprC(3, a), SprC(4, a)) 'it copies area of spritesheet to single area/canvas
x = x + _Width(Sprites&(a)) ' it adjourns the cohordinates X for showing sprites in sequence
y = _Height(Sprites&(a))
_PutImage (x, y), Sprites&(a), 0 ' showing sprites from 1 to top
Next a
End
Sub SaveDATAtoFile
Rem Saveto DATA file
Rem save to file in DATA format the array SprC
Dim n As Integer
Open "Datafile.txt" For Output As #1
Helping "Saving data...", 0
Print #1, "Data";
For n = 1 To 100 Step 1
If SprC(1, n) = 0 Then _Continue ' if it finds a wrong value it exits from FOR loop
If (n Mod 9) = 0 Then Print #1,: Print #1, "Data"; Else If n > 1 Then Print #1, ",";
Print #1, SprC(1, n), ",", SprC(2, n), ",", SprC(3, n), ",", SprC(4, n);
Next
Close #1
Helping "Saved data!", 1
End Sub
Function MouseData (Mb1 As Integer, Mb2 As Integer)
MouseData = 0
While _MouseInput: Wend ' it waits that mouse input ends
Mb1 = _MouseButton(1)
Mb2 = _MouseButton(2)
If Mb1 <> 0 Or Mb2 <> 0 Then MouseData = -1 ' if no mousebutton then function returns failure
End Function
Function StoreMouseData (Index As Integer)
Dim kb As Integer, OldC As Long
StoreMouseData = 0
If _MouseX > 0 Then Xm(Index) = _MouseX Else Xm(Index) = 1 ' it corrects wrong 0 values
If _MouseY > 0 Then Ym(Index) = _MouseY Else Ym(Index) = 1
If Xm(Index) > 0 And Ym(Index) > 0 Then
' both cohordinates are good?
Helping "Storing point " + Str$(Index) + Str$(Xm(Index)) + "-" + Str$(Ym(Index)) + " Cancel/Store?", 0
OldC = Point(Xm(Index), Ym(Index))
PSet (Xm(Index), Ym(Index)), _RGB32(211, 255, 6)
While 1 'kb <> 83 Or kb <> 115
' here the loop to take cancel/store data
kb = _KeyHit
If kb = 67 Or kb = 99 Then
PSet (Xm(Index), Ym(Index)), OldC
Exit Function ' if key is c or C then exit function returning the failure
End If
If kb = 83 Or kb = 115 Then Exit While
Wend
Helping "Stored", 0
_Delay 1
StoreMouseData = -1
Else
Exit Function
End If
End Function
Sub Grid
Shared Mg As Integer, a As Integer
For a = 1 To W Step Mg
Line (a, 1)-(a, W), Mg
Next
For a = 1 To H Step Mg
Line (1, a)-(H, a), Mg
Next
End Sub
Sub LoadI
NameFile$ = ".\defendersprites.jpg" '<----- coming soon Open option to type name of file and better an Opendialog box
If _FileExists(NameFile$) Then
Helping "File founded", 1
Sprite& = _LoadImage(NameFile$)
Else
Helping "Error: image not loaded", 1
Sprite& = -1000 ' sprite& brings the failure flag
_Delay 2
Exit Sub
End If
_Delay 1
SSheet& = _NewImage(_Width(Sprite&), _Height(Sprite&), 32)
Screen SSheet&
_PutImage , Sprite&, 0
End Sub
Sub PaletteS
Dim n As Integer
For n = 1 To 256
'pset (n,1),n
Line (n, 1)-(n, 256), n, BF
Next n
Sleep 2
End Sub
Sub Helping (Msg As String, M As Integer)
_Dest HelpS&
If M = 1 Then Cls
Print Msg
_Dest 0
_PutImage (0, 2 * (_Height(0) / 3)), HelpS&,
End Sub
Welcome feedbacks and propositive criticisms.
I'm thinking to add a third way to select the area with a dragging of mouse like in the graphic editor in which you draw a square/rectangle.
Moreover I need an OpenDialog box to choose the file of the Spritesheet to modify. I think that the created/selected sprites must be managed like in a list box with a single/multiple selection for doing specific actions (Save, Cancel, Edit...).
I have never used a SpriteSheet Editor but I'm doing it from zero with poor plan... this will cause so much modifications! Sob. Better measures twice and cut ones.
this is the spritesheet that I have used as file, but use whatever do you want
|
|
|
|