You must have seen a picture that is made up of many small pictures.
The program is simple. Just give him a single image at the beginning of the source code! (boss_pic$)
To create such a picture, you need a lot of pictures so that you can work with as many different shades as possible.
Specify where the program should search for images. A drive or folder.
The program will scan your computer and look for image files. Unfortunately, I think this will only work under Windows, because a 'CMD' command generates a list of found images.
After that, the program examines the color shades of all found images and stores them. Peace of mind! The program does not make any changes to any files! You don't put any garbage anywhere!
It took 5,000 pictures in 2 minutes, but I mostly have small pictures on my computer.
After the examination, he creates the mosaic image.
You only check the images once! You don't have to wait every time you start the program. It performs a new test if we change the search location for the images (file_search$) or change the aspect ratio of the mosaic images (ratio_y_start).
The higher the quality of the finished image, the more images the program can work with.
after running the program, the image is automatically saved as "saved.bmp".
during the examination, you select images that are close in shade to another existing image. This prevents the repetition of images.
use the available images proportionately during the work. that's why it randomly creates the mosaics so that there are no more identical images next to each other
Code: (Select All)
'mosaic-picture (MasterGy2022)
'----------------------------------- S E T T I N G S
boss_pic$ = "image1.jpg" 'big picture ! this image will appear large
ratio_resx = 25 'output pictures width number of mosaic
ratio_y_start = 1 / 4 * 3 'mosaic aspect ratio width = 1 ,Height = 1*this
file_search$ = "d:" 'where can I find image files? exapmle: a drive "d:" or directory "d:\pictures"
work_sx = 1200 'output picture width size
cheat_alpha = 100 'color foil alpha value to 1 mosaic
cheat_original = 30 'adding an original image transparent film to the finished work alpha
Open file_ready$ For Input As 1: Line Input #1, temp$: Input #1, ratio_y: If ratio_y <> ratio_y_start Or temp$ <> file_search$ Then Close 1: Kill file_ready$: Run
Open file_ready$ For Input As 1
Line Input #1, temp$
Input #1, ratio_y
Input #1, pic_c
us = Int((ratio_resx * ratio_resy) / pic_c) + 1
Dim pics$(pic_c - 1), pic_dat(pic_c - 1, 5)
For t = 0 To pic_c - 1
Line Input #1, pics$(t)
Input #1, pic_dat(t, 0), pic_dat(t, 1), pic_dat(t, 2)
pic_dat(t, 3) = us
Next t
'fill mosaic
Dim rmap(ratio_resx - 1, ratio_resy - 1)
Do: sum = sum + 1
Do
mx = Int(ratio_resx * Rnd)
my = Int(ratio_resy * Rnd)
Loop While rmap(mx, my)
rmap(mx, my) = 1
x1 = mx * mosx: x2 = x1 + mosx
y1 = my * mosy: y2 = y1 + mosy
'paste picture
_Source read_pic
ReDim c(3)
For tx = x1 To x2
For ty = y1 To y2
c&& = Point(tx, ty)
c(0) = _Red32(c&&) + c(0)
c(1) = _Green32(c&&) + c(1)
c(2) = _Blue32(c&&) + c(2)
c(3) = c(3) + 1
Next ty, tx
For t = 0 To 2: c(t) = c(t) / c(3): Next t
min = 9999999999999
For t = 0 To pic_c - 1: If pic_dat(t, 3) <= 0 Then _Continue
dis = (pic_dat(t, 0) - c(0)) ^ 2 + (pic_dat(t, 1) - c(1)) ^ 2 + (pic_dat(t, 2) - c(2)) ^ 2
If dis < min Then min = dis: ok = t
Next t
End
'files exam ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
files_exam:
ratio_y = ratio_y_start
Locate 1, 1: Print "Waiting ! I will search for the image files in the specified locations ...few minutes"
Shell _Hide "dir /b /s /a:-s " + file_search$ + "\*.bmp " + file_search$ + "\*.jpg " + file_search$ + "\*.jpeg" + " >file_stat.dat"
Open "file_stat.dat" For Input As 1: Do: Line Input #1, s$: pic_c = pic_c + 1: Loop Until EOF(1): Close 1
Locate 3, 1: Print pic_c; " can be used pictures find"
Open "file_stat.dat" For Input As 1
Open "temp.dat" For Output As 2
' Screen ex_pic
ReDim c(3)
For tx = 0 To ex_pic_size - 1
For ty = 0 To ex_pic_size - 1
c&& = Point(tx, ty)
c(0) = _Red32(c&&) + c(0)
c(1) = _Green32(c&&) + c(1)
c(2) = _Blue32(c&&) + c(2)
c(3) = c(3) + 1
Next ty, tx
Print #2, s$
Print #2, Int(c(0) / c(3)), Int(c(1) / c(3)), Int(c(2) / c(3)): cnt = cnt + 1
_FreeImage x
End If
End If
End If
Next t
Close 1, 2
Open "temp.dat" For Input As 1
ReDim pics$(cnt - 1), pic_dat(cnt - 1, 5)
For t = 0 To cnt - 1
Line Input #1, pics$(t)
Input #1, pic_dat(t, 0), pic_dat(t, 1), pic_dat(t, 2)
Next t
Close 1
For t = 0 To cnt - 2: Locate 8, 1: Print "subtraction of identical shades :"; Int(1000 / (pic_c - 1) * t) / 10; "%"
For t2 = t + 1 To cnt - 1
pic_dat(t2, 4) = (pic_dat(t, 0) = pic_dat(t2, 0) And pic_dat(t, 1) = pic_dat(t2, 1) And pic_dat(t, 2) = pic_dat(t2, 2)) Or pic_dat(t2, 4)
Next t2
Next t
For t = 0 To cnt - 1: present = present + Abs(pic_dat(t, 4) = 0): Next t
Locate 9, 1: Print "substractions :"; cnt - present; " pictures"
Open file_ready$ For Output As 1
Print #1, file_search$
Print #1, ratio_y
Print #1, present
For t = 0 To cnt - 1: If pic_dat(t, 4) Then _Continue
Print #1, pics$(t)
Print #1, pic_dat(t, 0), pic_dat(t, 1), pic_dat(t, 2)
Next t
Close 1
_FreeImage ex_pic
On Error GoTo 0
Kill "file_stat.dat"
Kill "temp.dat"
Sleep 2
Run
error1: hiba = 1: Resume Next
Sub SaveImage (image As Long, filename As String)
bytesperpixel& = _PixelSize(image&)
If bytesperpixel& = 0 Then Print "Text modes unsupported!": End
If bytesperpixel& = 1 Then bpp& = 8 Else bpp& = 24
x& = _Width(image&)
y& = _Height(image&)
b$ = "BM????QB64????" + MKL$(40) + MKL$(x&) + MKL$(y&) + MKI$(1) + MKI$(bpp&) + MKL$(0) + "????" + String$(16, 0) 'partial BMP header info(???? to be filled later)
If bytesperpixel& = 1 Then
For c& = 0 To 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
cv& = _PaletteColor(c&, image&) ' color attribute to read.
b$ = b$ + Chr$(_Blue32(cv&)) + Chr$(_Green32(cv&)) + Chr$(_Red32(cv&)) + Chr$(0) 'spacer byte
Next
End If
Mid$(b$, 11, 4) = MKL$(Len(b$)) ' image pixel data offset(BMP header)
lastsource& = _Source
_Source image&
If ((x& * 3) Mod 4) Then padder$ = String$(4 - ((x& * 3) Mod 4), 0)
For py& = y& - 1 To 0 Step -1 ' read JPG image pixel color data
r$ = ""
For px& = 0 To x& - 1
c& = Point(px&, py&) 'POINT 32 bit values are large LONG values
If bytesperpixel& = 1 Then r$ = r$ + Chr$(c&) Else r$ = r$ + Left$(MKL$(c&), 3)
Next px&
d$ = d$ + r$ + padder$
Next py&
_Source lastsource&
Mid$(b$, 35, 4) = MKL$(Len(d$)) ' image size(BMP header)
b$ = b$ + d$ ' total file data bytes to create file
Mid$(b$, 3, 4) = MKL$(Len(b$)) ' size of data file(BMP header)
If LCase$(Right$(filename$, 4)) <> ".bmp" Then ext$ = ".bmp"
f& = FreeFile
Open filename$ + ext$ For Output As #f&: Close #f& ' erases an existing file
Open filename$ + ext$ For Binary As #f&
Put #f&, , b$
Close #f&
End Sub
Sub area (ax1, ay1, ax2, ay2, pic, ratio_y)
x = _Width(pic)
y = _Width(pic) * ratio_y
If y > _Height(pic) Then
y = _Height(pic)
x = _Height(pic) / ratio_y
End If
There's a catch... Of course virtual, not manual and it has to work in Linux and MacOS.
Okay, so in Windows we can use a WinAPI trick to min/restore a Window, which will "Activate" the window. Activate means it is not just in focus, it is also ready to use. With QB64, we can do a _SCREENCLICK to virtually activate it, just as if we clicked it! Oops, problem here is _SCREENCLICK, and other keywords like _SCREENPRINT, etc., are not supported in LInux and MacOC.
So the challenge is to replace the _SCREENCLICK line with something else (number of lines doesn't matter) that will have the same effect to activate the window.
So to try, you need to...
1) Copy and run the first and then the second snippet, in that order. They'll use the CLIPBOARD to message between the two windows.
2) Adjust the windows on your desktop so they don't overlap.
3) Click the first program window to initially activate it.
4) Input a test message (Type and press Enter).
5) Notice the second window "Self-Activates" and displays the message received.
6) Input a reply.
7) The first window self-activates, displays the reply, and you are ready to input another message. It's like a ping-pong effect!
So the challenge is to sub out _SCREENCLICK with any line of code or sub-routine that will work in Linux / Mac OS to do the same effect, "activate" the window so we don't have to click on it.
This is the "SaveImage" routine from the Wiki, changed by me to try to make it faster, but it seems to be a failure with big pictures. For stuff larger than 1920x1080 might have to set even greater string buffers for "d$" and "r$". It was quite fast on my old Toshiba laptop purchased in December 2006 with 1024x768 resolution.
The "DIM" declarations are to ensure it works in "OPTION _EXPLICIT" mode.
!Needs testing!
Code: (Select All)
''from QB64 wiki
''modifications by mnrvovrfc
''this uses MID$() in replacement up to greatly speed up
'' the reading of the screen,
'' it avoids concatenation of strings as much as possible
'' which is notoriously slow when millions of bytes are involved
Sub SaveImage (image As Long, filename As String)
Dim ld As Long, lr As Long, lx As Long
Dim bytesperpixel&, bpp&, lastsource&, px&, py&, cv&, c&, f&, x&, y&, b$, d$, r$, padder$, rrr$, filename2$
bytesperpixel& = _PixelSize(image&)
If bytesperpixel& = 0 Then Print "Text modes unsupported!": End
If bytesperpixel& = 1 Then bpp& = 8 Else bpp& = 24
x& = _Width(image&)
y& = _Height(image&)
b$ = "BM????QB64????" + MKL$(40) + MKL$(x&) + MKL$(y&) + MKI$(1) + MKI$(bpp&) + MKL$(0) + "????" + String$(16, 0) 'partial BMP header info(???? to be filled later)
If bytesperpixel& = 1 Then
For c& = 0 To 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
cv& = _PaletteColor(c&, image&) ' color attribute to read.
b$ = b$ + Chr$(_Blue32(cv&)) + Chr$(_Green32(cv&)) + Chr$(_Red32(cv&)) + Chr$(0) 'spacer byte
Next
End If
Mid$(b$, 11, 4) = MKL$(Len(b$)) ' image pixel data offset(BMP header)
d$ = Space$(50000000)
ld = 1
lastsource& = _Source
_Source image&
If ((x& * 3) Mod 4) Then padder$ = String$(4 - ((x& * 3) Mod 4), 0)
For py& = y& - 1 To 0 Step -1 ' read JPG image pixel color data
r$ = Space$(10000000)
lr = 1
For px& = 0 To x& - 1
c& = Point(px&, py&) 'POINT 32 bit values are large LONG values
If bytesperpixel& = 1 Then
rrr$ = Chr$(c&)
Else
rrr$ = Left$(MKL$(c&), 3)
End If
lx = Len(rrr$)
Mid$(r$, lr, lx) = rrr$
lr = lr + lx
Next px&
r$ = Left$(r$, lr - 1)
rrr$ = r$ + padder$
lx = Len(rrr$)
Mid$(d$, ld, lx) = rrr$
ld = ld + lx
Next py&
_Source lastsource&
d$ = Left$(d$, ld - 1)
Mid$(b$, 35, 4) = MKL$(Len(d$)) ' image size(BMP header)
Mid$(b$, 3, 4) = MKL$(Len(b$) + Len(d$)) ' size of data file(BMP header)
filename2$ = filename$
If LCase$(Right$(filename$, 4)) <> ".bmp" Then filename2$ = filename$ + ".bmp"
f& = FreeFile
Open filename2$ For Output As #f&: Close #f& ' erases an existing file
Open filename2$ For Binary As #f&
Put #f&, , b$
Put #f&, , d$
Close #f&
End Sub
I ain't got nothin' but KEYWORDS, eight days a week...
So let's talk _SCREENPRINT, the little bro to the bigger and better Win32 SENDKEYS function.
SYNTAX: _SCREENPRINT text$
Note: This keyword is not supported in Linux and Mac Operating Systems.
So what does it do?
_SCREENPRINT is acts as a virtual keypress and text transmitter. It is limited in the key combos available, which can be seen in the table, below...
Code: (Select All)
CTRL + A = CHR$(1) ☺ StartHeader (SOH) CTRL + B = CHR$(2) ☻ StartText (STX)
CTRL + C = CHR$(3) ♥ EndText (ETX) CTRL + D = CHR$(4) ♦ EndOfTransmit (EOT)
CTRL + E = CHR$(5) ♣ Enquiry (ENQ) CTRL + F = CHR$(6) ♠ Acknowledge (ACK)
CTRL + G = CHR$(7) • BEEP (BEL) CTRL + H = CHR$(8) ◘ [Backspace] (BS)
CTRL + I = CHR$(9) ○ Horiz.Tab [Tab] CTRL + J = CHR$(10) ◙ LineFeed(printer) (LF)
CTRL + K = CHR$(11) ♂ Vert. Tab (VT) CTRL + L = CHR$(12) ♀ FormFeed(printer) (FF)
CTRL + M = CHR$(13) ♪ [Enter] (CR) CTRL + N = CHR$(14) ♫ ShiftOut (SO)
CTRL + O = CHR$(15) ☼ ShiftIn (SI) CTRL + P = CHR$(16) ► DataLinkEscape (DLE)
CTRL + Q = CHR$(17) ◄ DevControl1 (DC1) CTRL + R = CHR$(18) ↕ DeviceControl2 (DC2)
CTRL + S = CHR$(19) ‼ DevControl3 (DC3) CTRL + T = CHR$(20) ¶ DeviceControl4 (DC4)
CTRL + U = CHR$(21) § NegativeACK (NAK) CTRL + V = CHR$(22) ▬ Synchronous Idle (SYN)
CTRL + W = CHR$(23) ↨ EndTXBlock (ETB) CTRL + X = CHR$(24) ↑ Cancel (CAN)
CTRL + Y = CHR$(25) ↓ EndMedium (EM) CTRL + Z = CHR$(26) → End Of File(SUB) (EOF)
So let's take a look at the first entry, Ctrl+A. This is the key combo we use to highlight text in other apps.
_SCREENPRINT CHR$(1) will therefore highlight all the text on another open and active app.
Wait for it to compile and start. When you see the window open, click back on this browser window...
Code: (Select All)
_DELAY 5 ' Give yourself some time to click another app, like this browser.
_SCREENPRINT CHR$(1)
Cool, right? Well now _SCREENPRINT also works progressively, so if we wanted to copy that text to our clipboard, we would just code...
Code: (Select All)
_DELAY 5 ' Give yourself some time to click another app, like this browser.
_SCREENPRINT CHR$(1)
_SCREENPRINT CHR$(3) ' See the chart. This is Ctrl+C, COPY.
' Now let's see if it worked by reading the clipboard...
PRINT _CLIPBOARD$
If you wanted to paste, it's _SCREENPRINT CHR$(22), btw.
So speaking of pasting, lets try a select all, copy/paste from the QB64 IDE into Notepad...
Windows only example.
Code: (Select All)
_CLIPBOARD$ = ""
_DELAY 1
_SCREENHIDE
DO
_LIMIT 5
LOOP UNTIL LEN(_CLIPBOARD$)
SHELL _HIDE "start Notepad.exe" ' Open Windows Notepad.
_DELAY 1
_SCREENPRINT _CLIPBOARD$
_DELAY 3
_SCREENSHOW
PRINT: PRINT " Cool, right?"
So with _SCREENPRINT we can do things like fill out web forms (Note: _SCREENPRINT CHR$(9) is Tab to change form fields), gather text from other apps, execute commands with _SCREENPRINT CHR$(13) the Enter key, etc.
For some routines like ALT + F to open the QB64 IDE File Menu, you need something more robust like Win32 API SENDKEYS.
DECLARE DYNAMIC LIBRARY "user32"
SUB SENDKEYS ALIAS keybd_event (BYVAL bVk AS LONG, BYVAL bScan AS LONG, BYVAL dwFlags AS LONG, BYVAL dwExtraInfo AS LONG)
END DECLARE
PRINT "Click the QB64 IDE window after I hide!"
_DELAY 5
_SCREENHIDE ' Get the app window the hell out of our way...
_DELAY 5
SENDKEYS VK_ALT, 0, 0, 0 ' Alt
SENDKEYS &H46, 0, 0, 0 ' F open IDE file menu.
_DELAY .1
SENDKEYS &H45, 0, KEYEVENTF_KEYUP, 0 ' Release F key.
SENDKEYS VK_ALT, 0, KEYEVENTF_KEYUP, 0 ' ' Release Alt key.
_DELAY 5
_SCREENSHOW
This is a TCP/IP routine. Windows users will need to Okay it, on the first run, with Windows Defender.
I posted two versions. The first minimizes and restores the chat window to activate it. The second uses QB64 _SCREENCLICK. auto-activation allows us to continuously send messages back and forth without clicking the window each rotation.
Sorry Linux and mac users, I tried, but to return focus to each active chat window requires one Win32 API command to restore the window, and mn pointed out that _SCREENCLICK isn't supported in these operating systems. If anyone can figure out a QB64 way to force a minimized window back to the desktop, please let me know.
So to gives this a try, you need to copy and run both the "host" and client" programs. Since the host starts the client, you will need to name the client as messenger_client.bas and save it as messenger_client.exe before you run the host program.
Min/Restore Version
Host
Code: (Select All)
DECLARE DYNAMIC LIBRARY "user32"
FUNCTION ShowWindow& (BYVAL hWnd AS LONG, BYVAL nCmdShow AS LONG) 'maximize process
END DECLARE
_SCREENMOVE 0, 0 ' Set up this host window to the left of your desktop.
WIDTH 60, 25
PALETTE 0, 8
COLOR 7, 0
CLS
IF NOT _FILEEXISTS("messenger_client.exe") THEN PRINT "Cannot find file: messenger_client.exe. Ending...": END
DIM host_msg AS STRING, client_msg AS STRING
DO
IF initiate = 0 THEN ' This only needs to be performed once, to open the client window.
DO UNTIL x ' Stay in loop until window determines if it is the host or client window.
x = _OPENCLIENT("TCP/IP:1234:localhost") ' Used to establish a TCP/IP routine.
IF x = 0 THEN
x = _OPENHOST("TCP/IP:1234") ' Note the host and clinet must have the same 1234 I.D. number.
a$ = "Opening as host." ' x channel is now open and this window becomes the host.
ELSE
a$ = "Opening as client." ' Should not go here for this demo.
END IF
PRINT a$
LOOP
SHELL _HIDE _DONTWAIT "START messenger_client.exe" ' Open the client window.
initiate = -1 ' Switches this block statement off for all subsequent loops.
END IF
IF z = 0 THEN ' Initiates an open channel number when zero.
DO
z = _OPENCONNECTION(x) ' Checks if host is available to transfer data.
LOOP UNTIL z
PRINT "Connection established."
_DELAY 1
LOCATE 2: PRINT SPACE$(_WIDTH * 2) ' Remove previous text.
LOCATE 3, 1
GOSUB focus
END IF
' Okay, time to input something on the host that will be communicated to the client.
COLOR 7: LINE INPUT "Message to client: "; host_msg: PRINT
PUT #z, , host_msg ' Input is now entered into TCP/IP routine.
IF host_msg = "" THEN SYSTEM
DO
GET #z, , client_msg
LOOP UNTIL LEN(client_msg) ' Exits loop when a return msg is received.
COLOR 6: PRINT "Message from client: "; client_msg: PRINT
host_msg = "": PUT #z, , host_msg$ ' Now put our client value back into the routine. Failure to do so would result in the client not waiting in the GET #x DO/LOOP.
_KEYCLEAR ' Prevents typing before ready.
DIM host_msg AS STRING, client_msg AS STRING
_SCREENMOVE 600, 0 ' Set up this client window next to your host window.
WIDTH 50, 25
PALETTE 0, 8
COLOR 7, 0
CLS
x = _OPENCLIENT("TCP/IP:1234:localhost") ' Used to establish a TCP/IP routine.
PRINT "Opened as client.": PRINT
DO UNTIL x = 0 ' Prevents running if this app is opened without using host.
DO
_LIMIT 30
GET #x, , host_msg ' Waits until it receives message sent from the host.
LOOP UNTIL LEN(host_msg)
COLOR 6: PRINT "Message from host: "; host_msg
PRINT
_KEYCLEAR ' Prevents typing before ready.
GOSUB focus
COLOR 7: LINE INPUT "Message to host: "; client_msg: PRINT
IF client_msg = "" THEN SYSTEM
That one used all Win32 API to find, minimize and restore the window. If you are interested in seeing the extra API stuff, check it out. Also, I play loose and fast with the API type variables. So far I've only been stung once by changing an _OFFSET to a LONG. Most of the time you can get away from convention.
Oh, why bother minimizing and restoring? Well, so far none of us can figure out a way to get a window not just in focus, but active and in focus after another window is made active. Spriggsy and I both came up with the min/restore trick at the same time, which was pretty funny.
Okay, for Linus and Mac fans... (And yes, I made _SCREENCLICK 'smart' so you can move the windows around).
_SCREENCLICK Version: Same App, but uses _SCREENCLICK instead of Win32 API to activate each window.
_SCREENMOVE 0, 0 ' Set up this host window to the left of your desktop.
WIDTH 60, 25
PALETTE 0, 8
COLOR 7, 0
CLS
IF NOT _FILEEXISTS("messenger_client.exe") THEN PRINT "Cannot find file: messenger_client.exe. Ending...": END
DIM host_msg AS STRING, client_msg AS STRING
DO
IF initiate = 0 THEN ' This only needs to be performed once, to open the client window.
DO UNTIL x ' Stay in loop until window determines if it is the host or client window.
x = _OPENCLIENT("TCP/IP:1234:localhost") ' Used to establish a TCP/IP routine.
IF x = 0 THEN
x = _OPENHOST("TCP/IP:1234") ' Note the host and clinet must have the same 1234 I.D. number.
a$ = "Opening as host." ' x channel is now open and this window becomes the host.
ELSE
a$ = "Opening as client." ' Should not go here for this demo.
END IF
PRINT a$
LOOP
SHELL _HIDE _DONTWAIT "START messenger_client.exe" ' Open the client window.
initiate = -1 ' Switches this block statement off for all subsequent loops.
END IF
IF z = 0 THEN ' Initiates an open channel number when zero.
DO
z = _OPENCONNECTION(x) ' Checks if host is available to transfer data.
LOOP UNTIL z
PRINT "Connection established."
_DELAY 1
LOCATE 2: PRINT SPACE$(_WIDTH * 2) ' Remove previous text.
LOCATE 3, 1
GOSUB focus
END IF
' Okay, time to input something on the host that will be communicated to the client.
COLOR 7: LINE INPUT "Message to client: "; host_msg: PRINT
PUT #z, , host_msg ' Input is now entered into TCP/IP routine.
IF host_msg = "" THEN SYSTEM
DO
GET #z, , client_msg
LOOP UNTIL LEN(client_msg) ' Exits loop when a return msg is received.
COLOR 6: PRINT "Message from client: "; client_msg: PRINT
host_msg = "": PUT #z, , host_msg$ ' Now put our client value back into the routine. Failure to do so would result in the client not waiting in the GET #x DO/LOOP.
_KEYCLEAR ' Prevents typing before ready.
DIM host_msg AS STRING, client_msg AS STRING
_SCREENMOVE 600, 0 ' Set up this client window next to your host window.
WIDTH 50, 25
PALETTE 0, 8
COLOR 7, 0
CLS
x = _OPENCLIENT("TCP/IP:1234:localhost") ' Used to establish a TCP/IP routine.
PRINT "Opened as client.": PRINT
DO UNTIL x = 0 ' Prevents running if this app is opened without using host.
DO
_LIMIT 30
GET #x, , host_msg ' Waits until it receives message sent from the host.
LOOP UNTIL LEN(host_msg)
COLOR 6: PRINT "Message from host: "; host_msg
PRINT
_KEYCLEAR ' Prevents typing before ready.
GOSUB focus
COLOR 7: LINE INPUT "Message to host: "; client_msg: PRINT
IF client_msg = "" THEN SYSTEM
Dim As Long connection: connection = OpenClient("HTTP:https://api.kanye.rest/")
If connection <> 0 And StatusCode(connection) = 200 Then
Dim As String buf, outbuf
While Not EOF(connection)
Get connection, , buf
outbuf = outbuf + buf
Wend
outbuf = Mid$(outbuf, 11)
outbuf = Mid$(outbuf, 1, Len(outbuf) - 2)
Print outbuf
Print: Print "-Kanye West"
End If
For folks who want to see how much QB64 has evolved and grown over the last year, I present my little Christmas Program that I was working on and stalled out on last year.
(IF the forum download is too slow, which seems to be a problem for some of our Linux folks, you can also try to get it directly from my OneDrive: https://1drv.ms/u/s!AknUrv8RXVYMm_Uh2wya...A?e=XIKRX8 It may work better for you. )
Last year, I ran into an issue that I simply couldn't work around at all -- it was taking FOREVER and EVER to load my list of holiday music into QB64. No matter how sneakily I tried to sort out a workaround to get past the issue, it still introduced unacceptable levels of lag into the program and made user responses delay by several seconds. Either that, or else I just introduced a nice 10 minute pause at program startup, so that all the sounds could be loaded at first, before actually playing around with the program.
NEITHER of which were actual workable solutions for the program!!
So... come along this year, QB64-PE gets a complete overhaul of the audio system. What took 10 minutes to load, we now load in perhaps 3 seconds! I can once again resume work on my Christmas Project one more time!!
If anyone wants to see the difference in performance for themselves, just download the file above and extract it. It's in its own little XMas folder, so it's easy to clean up and remove the clutter from your drive after extracting, if anyone's worried about something like that.
Compile and run... At the very start, you'll see a series of numbers that pop up and count down the screen -- that's the program loading our music files for us, for the first time. Regardless of if it's incredibly slow or fast for you, once it's finished (or you terminate the process), go into the QB64-PE IDE and navigate to "Options >> Compiler Options" and then toggle the option at the bottom of the list: "use old audio backend".
Compile and run a second time.
The difference here should be as plain as night and day. THAT'S how much QB64-PE has changed under the hood in the last year!!
And if that doesn't put you in a Merry Christmas spirit, then BAH HUMBUG TO YOU, MISTER PETE! Errr... MISTER SCROOGE!!
Space, the final frontier, and when you're sick of space on both sides of your string, use _TRIM$.
_TRIM$ simply removes any leading and/or trailing spaces from any string.
SYNTAX: _TRIM$(mytext$) and can also be used as: _TRIM$(" my text ")
_TRIM$ is the QB64 answer to, "What do you get when you put LTRIM$ + RTRIM$ together?" Well, until _TRIM$ came along it was LTRIM$(RTRM$(mystring$)). Note: LTRIM$ removes leading spaces, spaces to the "left" and RTRIM$ removes trailing space, spaces to the right, and _TRIM$ removes both.
If there are no spaces, _TRIM$ simply does nothing.
_TRIM$ can be combined with STR$(), which converts a number to a string and removes the trailing space. So why do we need _TRIM? The answer is to get rid of the leading space the system uses to reserve space for a possible negative sign in front of a number even after STR$() is used to convert it to a string.
So while PRINT STR$(-1) is "-1", PRINT STR$(1) would be " 1". To get rid of that leading space we can code either: PRINT LTRIM$(STR$(1)) or PRINT _TRIM$(STR$(1)). Of course most of the time a number will be represented by a variable, so we usually code: MyNumber = 1: MyNumber$ = _TRIM$(STR$(a)).
Code: (Select All)
a = -1
PRINT "|"; a; "|" ' Has one trailing space.
PRINT "|"; STR$(a); "|" ' Chops the trailing space when converting to a string.
PRINT "|"; _TRIM$(STR$(a)); "|" ' Actually not needed here because of the negative number value.
PRINT
a = 1
PRINT "|"; a; "|" ' Has one leading space and one trailing space.
PRINT "|"; STR$(a); "|" ' Chops the trailing space when converting to a string.
PRINT "|"; _TRIM$(STR$(a)); "|" ' Chops the remaining leading space.
Another use is when a DIM statement if made to produce a "fixed" string. A fixed string defines the string length and creates trailing spaces if the string is smaller the dim size created.
Example:
Steve's Spreadsheet
Code: (Select All)
DIM a as STRING * 10 ' All strings named a will be 10 bytes long.
FOR i = 1 TO 3 ' (Not 2 B confused with 1, 2, 3.) :D
READ a
PRINT "|";a;"|", LEN(a)
PRINT "|";_TRIM$(a);"|", LEN(_TRIM$(a)) ' Here we combine _TRIM$ with LEN() to output the length of our trimmed string.
NEXT
' Steve's sheet spreaders...
DATA Horse,Pig,Mule
_TRIM$ is often used in parsing routines to compare strings as apples to apples, instead of apples to apples with leading and trailing spaces.
So how about some more use examples? Feel free to post yours...
The Dungeon contains assembly to trap ctrl-break and can be removed from the source by deleting Call Setint/Call Restint.
This program and source are completely 16-bit and won't load in QB64 because it contains arrays in UDTs..
For Dungeon_v12_QB64.zip it contains no assembly.
Attached is:
Dngeon13.zip for VB10.
Dungeon_v12_QB64.zip for QB64.
The readme.txt is:
Code: (Select All)
Program:
Welcome to The Dungeon Adventure Game v12.0 r3.0. These files, documents,
and programs are public domain. Anyone may use, rewrite, or distribute
them without any fee, charge for use, or packaging requirements.
Files:
Separate the .zip file with the PKWare utility into the directory:
c:
cd \
md dngeon12
cd \dngeon12
copy \temp\dngeon12.zip \dngeon12
with the command
pkunzip dngeon12.zip
The .zip file contains the files:
ansi.bas -- opening screen source
ansi.exe -- opening screen program
compile.bat -- compiling batch program
compile.txt -- compile instructions
desc.sdi -- program description
dungeon.bas -- main dungeon source
dungeon.doc -- short documentation
dungeon.exe -- main dungeon program
edit.bas -- edit utility source
edit.exe -- edit utility program
file_id.diz -- program description
features.txt -- list of features
go.bat -- startup batch file
help.bas -- help menu source
help.exe -- help menu program
keytrap.asm -- assembly utility source
list.bat -- lists source to printer
mapedit.bas -- map edit utility source
mapedit.exe -- map edit utility program
page.com -- display utility
print.bat -- prints documentation
program.txt -- description of program
readme.bat -- displays readme file
readme.txt -- readme text file
swapbas.asm -- assembly utility source
util.bas -- display utility
util.exe -- display utility source
Dungeon creates the files:
datafile.00x -- player data file
players.dat -- player data file
ranklist.dat -- ranking list bulletin
Requirements:
The Dungeon is designed to operate on any standard PC, XT, or AT with
minimum of 256K memory, a floppy or fixed disk, and any color graphics
adapter.
The DUNGEON v12.0 r3.0 Documentation Page i
Starting the game:
Enter one of the following commands at the DOS prompt:
go -- read documentation and start the program
print -- print the documentation
readme -- display the readme text file
Instructions:
Playing is done by entry on the numeric keypad. Keys 0, 1, .., 9, and
other symbols like -, +, and = are used for commands. Be sure you have
turned on numlock before game play. The Dungeon also recognizes cursor
keys for moving in the game without numlock.
Program compiling:
This disk contains the compile batch files, BASIC source, and additional
utility for the dungeon v12.0. These files, documents, and programs are
public domain. Anyone may use, rewrite, or distribute them without any
fee, charge for use, or packaging requirements.
Compiling requirements:
The compile program is designed to operate on any standard PC, XT, or AT
with 512K, fixed disk, and any monitor.
Starting the compiler:
Enter one of the following commands at the DOS prompt:
compile -- start the compiling process
list -- print the source
Compiling instructions:
Compiling is done by entering the subprogram name to create with the
compile.bat program. You should have the required compiler and library
listed in the compile.txt file. Example to start: compile dungeon. Also,
the dungeon comes with a makefile containing instructions for nmake.exe
to compile the dungeon programs by date of .exe files.
Maintenance release v12.0 r2.0 Fixed/added:
Alt-Tab to add the globe of power to player inventory.
Clearing monster array between changing dungeon levels.
Dungeon level replenish to avoid placing items in rooms.
Overflow error in info screen for levels greater than 50.
More than eight monsters attacking player at once.
Distance to monsters for evade/approach fixed.
Count loops inside searching for empty dungeon cell.
Timer beyond midnight pause loop corrected.
Bulletin report utility display cleaned.
Added F11/F12 display/clear dungeon symbols.
Fixed page length in util display.
Eat keystrokes in second timer pause routine.
Remove monsters beyond player from attack array.
Update some counting variables during player movement.
Trapped interrupt service error during program shells.
Error with trapped control-break being returned as two-byte null.
Problem restoring current directory during shells.
)![[Image: screen1.jpg]](https://i.ibb.co/NjTH0x4/screen1.jpg)
