Image=ImageScale(SrcImage,width,height) (8,15,16,24,32 bpp)

[D.J.Peters]

In 2008 FreeBASIC was 32-bit only :-)
But I posted many working PutResize stuff.

PutResize(dst,src) viewtopic.php?f=7&t=24420&p=216249

PutResize(dst,src,x,y,w,h) viewtopic.php?f=7&t=24422&p=216257

PutResize(dst,x,y,w,h,src,x,y,w,h) viewtopic.php?f=7&t=24423&p=21625
...

Joshy

[UEZ]

Thanks Joshy but for me it doesn't work or I'm unable to use it properly.

Code: Select all

' PutResize(dst,src,x,y,w,h) fast but no filter
union FP field=1
  as ulong  v32
  type
  as ushort l16
  as ushort h16
  end type
end union

sub PutResize(byval dst  as any ptr, _
              byval src  as any ptr, _
              byval dstX as integer, _
              byval dstY as integer, _
              byval dstW as uinteger, _
              byval dstH as uinteger, _
              byval autoLock as boolean=false)
#macro copyloop
d+=dstY*dpitch+dstX
sy.v32=srcY*&H10000
for y as integer=0 to dstH-1
  sr = @s[sy.h16*spitch] : sx.v32=srcX*&H10000
  for x as integer=0 to dstW-1
    d[x] = sr[sx.h16] : sx.v32+=xStep.v32
  next
  sy.v32+=yStep.v32 : d+=dpitch
next
#endmacro

  ' target = source ?
  if dst=src then return
  ' if source or destination are the screen
  ' a video mode must be active also
  if (dst=0 or src=0) andalso (screenptr()=0) then return
  dim as integer sw,sh,spitch,sbytes
  dim as integer dw,dh,dpitch,dbytes
  dim as any ptr spixels,dpixels
  dim as boolean blnLock
  if dst=0 then     ' destination is screen
    if autoLock then blnLock=true
    screeninfo       dw,dh,,dbytes,dpitch:dpixels=screenptr()
    if imageinfo(src,sw,sh, sbytes,spitch,spixels) then return
  elseif src=0 then ' source is screen
    if autoLock then blnLock=true
    screeninfo       sw,sh,,sbytes,spitch:spixels=screenptr()
    if imageinfo(dst,dw,dh, dbytes,dpitch,dpixels) then return
  else              ' both are images
    if imageinfo(dst,dw,dh,dbytes,dpitch,dpixels) then return
    if imageinfo(src,sw,sh,sbytes,spitch,spixels) then return
  end if
  ' bytes per pixel must be equal
  if sbytes<>dbytes then return

  if dstW<1 then return
  if dstH<1 then return
  if dstX>=dw then return
  if dstY>=dh then return

  dim as integer srcX,srcY,srcW=sw,srcH=sh

  dim as single off
  if dstX<0 then
     off = srcW * abs(dstX)/dstW
     dstW+=dstX
     if dstW<1 then return
     srcW-=off
     if srcW<1 then return
     srcX+=off
     dstX=0
  elseif (dstX+dstW)>dw then
     off = srcW * ((dstX+dstW)-dw)/dstW
     srcW-=off
     if srcW<1 then return
     dstW=dw-dstX
  end if

  if dstY<0 then
     off = srcH * abs(dstY)/dstH
     dstH+=dstY
     if dstH<1 then return
     srcH-=off
     if srcH<1 then return
     srcY+=off
     dstY=0
  elseif (dstY+dstH)>dh then
     off = srcH * ((dstY+dstH)-dh)/dstH
     srcH-=off
     if srcH<1 then return
     dstH=dh-dstY
     if dstH<1 then return
  end if
  dim as FP sx,xStep : xStep.v32 = (srcW*&H10000)/dstW
  dim as FP sy,yStep : yStep.v32 = (srcH*&H10000)/dstH
  if blnLock then screenlock
  dpitch shr=(sbytes shr 1) : spitch shr=(sbytes shr 1)
  select case as const dbytes
  case 1 ' 8 bit palette
    dim as ubyte ptr sr,s=spixels,d=dpixels
    copyloop
  case 2 ' 15/16 bit
    dim as ushort ptr sr,s=spixels,d=dpixels
    copyloop
  case 4 ' 24/32 bit
    dim as ulong ptr sr,s=spixels,d=dpixels
    copyloop
  end select
  if blnLock then screenunlock
#undef copyloop
end Sub


screenres 1280, 720, 32
Dim As Any Ptr img = Imagecreate(1280, 720, 0, 32)
For y As Long = 0 To 719
	For x As Long = 0 To 1279
		Pset (x, y), Rgba(x Xor y, 255, x Or Y, 255)
	Next
Next

PutResize 0,img,0,0,640,360
Sleep
Imagedestroy img

Any hint?

[D.J.Peters]

you used PSET not on the image you created !

Joshy

Code: Select all

screenres 1280, 720, 32
Dim As Any Ptr img = Imagecreate(1280, 720, 0, 32)
For y As Long = 0 To 719
   For x As Long = 0 To 1279
      Pset img,(x, y), Rgba(x Xor y, 255, x Or Y, 255)
   Next
Next

PutResize 0,img,0,0,640,360,true
Sleep
Imagedestroy img