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
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
'--------------------------------------------------------------------------------------------------------------------------------------------------------------------
If _FileExists(boss_pic$) = 0 Then Print "boss-picture not found !": End
file_ready$ = "pics_ready.dat"
monx = 800
mony = 600
mon = _NewImage(monx, mony, 32)
Screen mon
_Dest mon
If _FileExists(file_ready$) = 0 Then GoSub files_exam
boss_pic = _LoadImage(boss_pic$, 32)
work_sy = Int(work_sx / _Width(boss_pic) * _Height(boss_pic))
mosx = Int(work_sx / ratio_resx)
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
Close 1
ratio_resy = Int(work_sy / (mosx * ratio_y))
mosy = Int(work_sy / ratio_resy)
read_pic = _NewImage(work_sx, work_sy, 32): _Dest read_pic: _Source boss_pic: _PutImage
work_pic = _NewImage(work_sx, work_sy, 32)
_FullScreen _SquarePixels: Screen work_pic: _Dest work_pic
'database load
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)
sum_mosaic = ratio_resx * ratio_resy
_Source read_pic
_Dest work_pic 'mon
_PutImage
temp = _NewImage(1, 1, 32): _Dest temp: Cls , _RGB32(0, 0, 0, 200)
_Source temp
_Dest work_pic
_PutImage
_FreeImage temp
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
temp = _LoadImage(pics$(ok), 32)
'Print #5, pics$(ok), ok
_Source temp
_Dest work_pic
area ax1, ay1, ax2, ay2, temp, ratio_y
_PutImage (x1, y1)-(x2, y2), , , (ax1, ay1)-(ax2, ay2)
_FreeImage temp
'shadow
temp = _NewImage(1, 1, 32): _Dest temp: Cls , _RGB32(c(0), c(1), c(2), cheat_alpha)
_Source temp
_Dest work_pic
_PutImage (x1, y1)-(x2, y2)
_Source work_pic
_FreeImage temp
pic_dat(ok, 3) = pic_dat(ok, 3) - 1
Loop Until sum_mosaic = sum
'add original picture shadow
_Dest read_pic
_SetAlpha cheat_original
_Dest work_pic
_Source read_pic
_PutImage
'saving
SaveImage work_pic, "saved.bmp"
End
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
ex_pic_size = 200
ex_pic = _NewImage(ex_pic_size, ex_pic_size * ratio_y, 32)
For t = 0 To pic_c - 1
_Dest mon
Locate 5, 1: Print "Examine the color depth of the image files ..."; Int(1000 / (pic_c - 1) * t) / 10; "% ready ("; pic_c; "/"; (t + 1); ")"
Line Input #1, s$
Locate 6, 1: Print s$ + Space$(40)
' End
If _FileExists(s$) And Mid$(s$, Len(file_search$) + 2, 1) <> "$" Then
x = _LoadImage(s$, 32)
If x Then
hiba = 0
On Error GoTo error1
_Source x
On Error GoTo 0
If hiba = 0 Then
_Dest ex_pic
area ax1, ay1, ax2, ay2, x, ratio_y
_PutImage , , , (ax1, ay1)-(ax2, ay2)
_Dest mon
psize = monx / 3
_Source ex_pic
_PutImage (0, Int(mony / 2))-(psize, Int(mony / 2 + psize * ratio_y))
' 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
ax1 = (_Width(pic) - x) / 2
ax2 = ax1 + x
ay1 = 0 '(_Height(pic) - y) / 2
ay2 = ay1 + y
End Sub
