A not low quality and speed image resizer

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
Takase
Posts: 13
Joined: Feb 09, 2018 14:12

A not low quality and speed image resizer

Postby Takase » Feb 22, 2018 13:48

Well, I have nothing to do so I created a program to resize images. Somehow it worked but its not good in any aspect. I'll just post the code here for so that somebody might be able to improve it. The resizing mechanism is really simple tho.

Note: the ratio is actually in decimals, not percentage.

resizer.bas

Code: Select all

' a small program to resize pictures
' usage resizer infile outfile ratio
' cannot resize a picture with the ratio >= 6

'macro for getting rgb values from an uinteger
#define returnR( c ) ( CUInt( c ) Shr 16 And 255 )
#define returnG( c ) ( CUInt( c ) Shr  8 And 255 )
#define returnB( c ) ( CUInt( c )        And 255 )

'reads command line args
if (command(1) = "") then
print "No cli option! help: resizer infile outfile ratio" : end
elseif (val(command(3)) >= 6) then
print "Resizer can't resize so big!" : end
end if

screenres 1280, 720, 32, 1, -1

'somehow, this is only used once
union XY
   as long x, y
   declare sub returnFactor(w as long, h as long)
end union

'returns the size of the picture from the file
sub returnWH(filename as string, byref w as long, byref h as long)
   dim as ubyte filenum = freefile()
   open filename for binary access read as #filenum
   get #filenum, 19, w
   get #filenum, 23, h
   close #filenum
end sub

'returns the number of the block drawing that needs to be done
sub XY.returnFactor(w as long, h as long)
   this.x = (w\4) : this.y = (h\4)
end sub

'returns the average of 4 pixels
function returnMedian(img as any ptr, x as long, y as long) as uinteger
   dim as ubyte clrs(12)
   clrs(0) = returnR(point(x, y, img))
   clrs(1) = returnR(point(x+1, y, img))
   clrs(2) = returnR(point(x+1, y+1, img))
   clrs(3) = returnR(point(x, y+1, img))
   clrs(4) = returnG(point(x, y, img))
   clrs(5) = returnG(point(x+1, y, img))
   clrs(6) = returnG(point(x+1, y+1, img))
   clrs(7) = returnG(point(x, y+1, img))
   clrs(8) = returnB(point(x, y, img))
   clrs(9) = returnB(point(x+1, y, img))
   clrs(10) = returnB(point(x+1, y+1, img))
   clrs(11) = returnB(point(x, y+1, img))
   return rgb((clrs(0)+clrs(1)+clrs(2)+clrs(3))/4, (clrs(4)+clrs(5)+clrs(6)+clrs(7))/4, _
   (clrs(8)+clrs(9)+clrs(10)+clrs(11))/4)
end function

dim as XY imgdim
dim as long w, h : returnWH(command(1), w, h)
dim as long i, j
dim as any ptr inimg = imagecreate(w, h)
dim as any ptr outimg = imagecreate((w*(val(command(3)))), (h*(val(command(3)))), &hffffff)

'opens the image file
bload(command(1), inimg)

imgdim.returnFactor(w, h)

'draws to the target image buffer
do until i >= w
   do until j = h
      line outimg, ((i*(val(command(3)))), (j*(val(command(3))))) - ((i*(val(command(3)))+4), (j*(val(command(3)))+4)), returnMedian(inimg, i, j), BF
      j += 1
   loop
   j = 0
   i += 1
loop

open cons for output as #3
print #3, "Done."
close #3

'saves the buffer
bsave(command(2), outimg)

'destroys the buffer
imagedestroy(inimg) : imagedestroy(outimg)
UEZ
Posts: 329
Joined: May 05, 2017 19:59
Location: Germany

Re: A not low quality and speed image resizer

Postby UEZ » Feb 22, 2018 13:55

I have converted https://www.codeproject.com/Articles/33 ... ng-using-C to FB and the result looks good.

Code: Select all

#Define WIN_INCLUDEALL
#Include "fbgfx.bi"
#Include "windows.bi"

Using FB


#Ifndef Floor
   #Define Floor(x) (((x) * 2.0 - 0.5) Shr 1) '' http://www.freebasic.net/forum/viewtopic.php?p=118633
   #Define Ceiling(x) (-((-(x) * 2.0 - 0.5) Shr 1))
   #Define Round(x) ((x * 100 + 0.5) / 100 Shr 0) '2 decimal places 10^2 = 100
#EndIf

#Define Red(colors) ((colors Shr 16) And 255)
#Define Green(colors) ((colors Shr 8) And 255)
#Define Blue(colors) (colors And 255)

declare Function ResizeImage(pImage as any Pointer, iW_new as Ushort, iH_new as uShort) as any Pointer


Dim as UShort iW = 800, iH = 800
Dim as uShort iW_new = iW * 0.45, iH_new = iH * 0.45

ScreenRes(iW_new, iH_new, 32)

Dim As Any Ptr pImage = ImageCreate(iW, iH)
BLoad(CurDir & "\Kapuzineraeffchen.bmp", pImage) '<<<< change here the file you want to load!

Dim as Double fEnd, fStart = Timer
Dim as any Ptr pImage_Resized = ResizeImage(pImage, iW_new, iH_new)
fEnd = Timer - fStart

WindowTitle("Resized to " & iW_new & "x" & iH_new & "px in " & fEnd * 1000 & " ms")

Put (0, 0), pImage_Resized

ImageDestroy pImage
ImageDestroy pImage_Resized

Sleep

'https://www.codeproject.com/Articles/33838/Image-Processing-using-C
Function ResizeImage(pImage as any Pointer, iW_new as Ushort, iH_new as uShort) as any Pointer '24 bit only
   #Define GetPixelRI(_x, _y)          *cptr(ulong ptr, imgData + _y * pitch + _x Shl 2)
   #Define SetPixelRI(_x, _y, _color)  *cptr(ulong ptr, imgData_Resized + _y * pitch_Resized + _x Shl 2) = (_color)

   Dim pImage_Resized As Any Ptr = ImageCreate(iW_new, iH_new, 0, 32)
   Dim As Integer w, h, wr, hr, pitch, pitch_Resized
   Dim As Any Pointer imgData, imgData_Resized
 
   Imageinfo(pImage, w, h, , pitch, imgData)
   Imageinfo(pImage_Resized, wr, hr, , pitch_Resized, imgData_Resized)
   
   Dim as Single fWidthFactor = w / wr, fHeightFactor = h / hr, fx, fy, nx, ny
   Dim as uLong cx, cy, fr_x, fr_y, color1, color2, color3, color4
   Dim as UByte nRed, nGreen, nBlue, bp1, bp2
   
   For x as ushort = 0 to wr - 1
      for y as uSHort = 0 to hr - 1
         
         fr_x = Floor(x * fWidthFactor)
         fr_y = Floor(y * fHeightFactor)
               
         cx = fr_x + 1
         if cx >= w Then cx = fr_x
         cy = fr_y + 1
         if cy >= h Then cy = fr_y
         
         fx = x * fWidthFactor - fr_x
         fy = y * fHeightFactor - fr_y
         
         nx = 1.0 - fx
         ny = 1.0 - fy
         
         color1 = GetPixelRI(fr_x, fr_y)
         color2 = GetPixelRI(cx, fr_y)
         color3 = GetPixelRI(fr_x, cy)
         color4 = GetPixelRI(cx, cy)

         'red
         bp1 = nx * Red(color1) + fx * Red(color2)
         bp2 = nx * Red(color3) + fx * Red(color4)         
         nRed = ny * bp1 + fy * bp2         

         'green
         bp1 = nx * Green(color1) + fx * Green(color2)
         bp2 = nx * Green(color3) + fx * Green(color4)         
         nGreen = ny * bp1 + fy * bp2

         'blue
         bp1 = nx * Blue(color1) + fx * Blue(color2)
         bp2 = nx * Blue(color3) + fx * Blue(color4)
         nBlue = ny * bp1 + fy * bp2
                 
         SetPixelRI(x, y, RGB(nRed, nGreen, nBlue))
      Next
   Next
   Return pImage_Resized
End Function
dodicat
Posts: 5822
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: A not low quality and speed image resizer

Postby dodicat » Feb 22, 2018 14:24

My contribution

Code: Select all



function resizeimage(im As Any Ptr,Wdth As Single,Hght as single,dx as long=0,dy as long=0) as any ptr
     #define putpixel(_x,_y,colour)    *cptr(ulong ptr,rowS+ (_y)*pitchS+ (_x) shl 2)  =(colour)
     #define _getpixel(_x,_y)           *cptr(ulong ptr,row + (_y)*pitch + (_x) shl 2)
     #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))\((b)-(a))+(c)
    static As Integer pitch,pitchs
    static As Any Ptr row,rowS
    static As Ulong Ptr pixel,pixels
    static As Integer ddx,ddy,resultx,resulty
    Imageinfo im,ddx,ddy,,pitch,row
    dim as any ptr im2=imagecreate(Wdth-dx,Hght-dy)
    imageinfo im2,,,,pitchS,rowS
    For y As long=0+dy To Hght-1 -dy
         resulty=map(0,Hght,y,0,ddy)
        For x As long=0+dx To Wdth-1 -dx
            resultx=map(0,Wdth,x,0,ddx)
            putpixel(x,y,_getpixel(resultx,resulty))
        Next x
    Next y
    return im2
End function


Dim as UShort iW = 800, iH = 800
Dim as uShort iW_new = iW * 0.45, iH_new = iH * 0.45

ScreenRes(iW_new, iH_new, 32)

Dim As Any Ptr pImage = ImageCreate(iW, iH)
BLoad(CurDir & "\Kapuzineraeffchen.bmp", pImage) '<<<< change here the file you want to load!

Dim as Double fEnd, fStart = Timer
Dim as any Ptr pImage_Resized = ResizeImage(pImage, iW_new, iH_new)
fEnd = Timer - fStart

WindowTitle("Resized to " & iW_new & "x" & iH_new & "px in " & fEnd * 1000 & " ms")

Put (0, 0), pImage_Resized

ImageDestroy pImage
ImageDestroy pImage_Resized

Sleep
 

Return to “Tips and Tricks”

Who is online

Users browsing this forum: Exabot [Bot] and 4 guests