PutResize.bi

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:
Contact D.J.Peters

PutResize.bi

Post by D.J.Peters »

Scale and Put:
Image to Screen
Screen to Image
Image to Image

part of Image [scaled] to Screen
part of Screen [scaled] to Image

part of Screen [scaled] to part of [scaled] Image
part of Image [scaled] to part of [scaled] image

sub PutResize (byval dst as any ptr, byval src as any ptr, byval transparent as boolean=false, byval autoLock as boolean=false)

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 transparent as boolean=false, byval autoLock as boolean=false)

sub PutResize (byval dst as any ptr, _
byval dstX as integer, byval dstY as integer, byval dstW as uinteger, byval dstH as uinteger, _
byval src as any ptr, _
byval srcX as integer, byval srcY as integer, byval srcW as uinteger, byval srcH as uinteger, _
byval transparent as boolean=false, byval autoLock as boolean=false)

file: "PutResize.bi"

Code: Select all

#ifndef __PUT_RESIZE_BI__
#define __PUT_RESIZE_BI__

union FP field=1
  as ulong  v32
  type
  as ushort l16
  as ushort h16
  end type
end union

sub PutResize overload(byval dst as any ptr, _
                       byval src as any ptr, _
                       byval transparent as boolean=false, _
                       byval autoLock as boolean=false)
#macro copyloop
if transparent=false then
  for y as integer=0 to dh-1
    sr = @s[sy.h16*spitch] : sx.v32=0
    for x as integer=0 to dw-1
      d[x] = sr[sx.h16] : sx.v32+=xStep.v32
    next
    sy.v32+=yStep.v32 : d+=dpitch
  next
else
  for y as integer=0 to dh-1
    sr = @s[sy.h16*spitch] : sx.v32=0
    for x as integer=0 to dw-1
      c = sr[sx.h16] : if c<>mask then d[x] = c
      sx.v32+=xStep.v32
    next
    sy.v32+=yStep.v32 : d+=dpitch
  next
end if  
#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=any
  if dst=0 then     ' destination is screen
    blnLock=autoLock
    screeninfo       dw,dh,,dbytes,dpitch:dpixels=screenptr()
    if imageinfo(src,sw,sh, sbytes,spitch,spixels) then return
  elseif src=0 then ' source is screen
    blnLock=autoLock
    screeninfo       sw,sh,,sbytes,spitch:spixels=screenptr()
    if imageinfo(dst,dw,dh, dbytes,dpitch,dpixels) then return
  else              ' both are images
    blnLock=false
    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
  dim as FP sx,xStep : xStep.v32 = (sw*&H10000)/dw
  dim as FP sy,yStep : yStep.v32 = (sh*&H10000)/dh

  if blnLock then screenlock

  dpitch shr=(sbytes shr 1) : spitch shr=(sbytes shr 1)
  select case as const dbytes
  case 1 ' palette
    dim as ubyte ptr sr,s=spixels,d=dpixels
    dim as ubyte c,mask=0
    copyloop
  case 2 ' 15/16 bit
    dim as ushort ptr sr,s=spixels,d=dpixels
    dim as ushort c,mask=&HF81F
    copyloop
  case 4 ' 24/32 bit
    dim as ulong ptr sr,s=spixels,d=dpixels
    dim as ulong c,mask=&HFFFF00FF
    copyloop
  end select

  if blnLock then screenunlock
#undef copyloop
end sub

sub PutResize overload(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 transparent as boolean=false, _
                       byval autoLock as boolean=false)
#macro copyloop
d+=dstY*dpitch+dstX
sy.v32=srcY*&H10000
if transparent=false then
  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
else
  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
      c = sr[sx.h16] : if  c<>mask then d[x] = c
      sx.v32+=xStep.v32
    next
    sy.v32+=yStep.v32 : d+=dpitch
  next


end if
#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=any
  if dst=0 then     ' destination is screen
    blnLock = autoLock
    screeninfo       dw,dh,,dbytes,dpitch:dpixels=screenptr()
    if imageinfo(src,sw,sh, sbytes,spitch,spixels) then return
  elseif src=0 then ' source is screen
    blnLock = autoLock
    screeninfo       sw,sh,,sbytes,spitch:spixels=screenptr()
    if imageinfo(dst,dw,dh, dbytes,dpitch,dpixels) then return
  else              ' both are images
    blnLock = false
    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 ' palette
    dim as ubyte ptr sr,s=spixels,d=dpixels
    dim as ubyte c,mask=0
    copyloop
  case 2 ' 15/16 bit
    dim as ushort ptr sr,s=spixels,d=dpixels
    dim as ushort c,mask=&HF81F
    copyloop
  case 4 ' 24/32 bit
    dim as ulong ptr sr,s=spixels,d=dpixels
    dim as ulong c,mask=&HFFFF00FF
    copyloop
  end select

  if blnLock then screenunlock
#undef copyloop
end sub

sub PutResize overload (byval dst  as any ptr, _
                        byval dstX as integer, _
                        byval dstY as integer, _
                        byval dstW as uinteger, _
                        byval dstH as uinteger, _
                        byval src  as any ptr, _
                        byval srcX as integer, _
                        byval srcY as integer, _
                        byval srcW as uinteger, _
                        byval srcH as uinteger, _
                        byval transparent as boolean=false, _
                        byval autoLock as boolean=false)
#macro copyloop
d+=dstY*dpitch+dstX
sy.v32=srcY*&H10000
if transparent=false then
  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
else
  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
      c = sr[sx.h16] : if c<>mask then d[x] = c 
      sx.v32+=xStep.v32
    next
    sy.v32+=yStep.v32 : d+=dpitch
  next
end if
#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
    blnLock = autoLock
    screeninfo       dw,dh,,dbytes,dpitch:dpixels=screenptr()
    if imageinfo(src,sw,sh, sbytes,spitch,spixels) then return
  elseif src=0 then ' source is screen
    blnLock = autoLock
    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

 
  if srcX>=sw then return
  if srcY>=sh then return
  if srcX<0 then srcX=0
  if srcY<0 then srcY=0
  if (srcX+srcW)>sw then srcW=sw-srcX
  if srcW<1   then return
  if (srcY+srcH)>sh then srcH=sh-srcY
  if srcH<1   then return

  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 ' palette
    dim as ubyte ptr sr,s=spixels,d=dpixels
    dim as ubyte c,mask=0
    copyloop
  case 2 ' 15/16 bit
    dim as ushort ptr sr,s=spixels,d=dpixels
    dim as ushort c,mask=&HF81F
    copyloop
  case 4 ' 24/32 bit
    dim as ulong ptr sr,s=spixels,d=dpixels
    dim as ulong c,mask=&HFFFF00FF
    copyloop
  end select

  if blnLock then screenunlock
#undef copyloop
end sub

#endif ' __PUT_RESIZE_BI__
Last edited by D.J.Peters on May 05, 2018 22:15, edited 3 times in total.
Top
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:
Contact D.J.Peters

Re: PutResize.bi

Post by D.J.Peters »

Code: Select all

#include once "PutResize.bi"

screenres 512,512,16  '8,16,24,32
dim as single ws
dim as any ptr img = imagecreate(128,128)
circle img,(64,64),63,RGB(128,128,128),,,,f

while inkey=""
  screenlock
  cls
  put (0,0),img,TRANS
  dim as integer x = 256+cos(ws)*256
  dim as integer y = 256+sin(ws*2)*256
  dim as integer w = 110+cos(ws*2)*100
  dim as integer h = 110+sin(ws)*100
   ' put and scale the half of the image to the screen
   ' and ignore transparent pixels = true
  PutResize 0,x,y,w,h,img,0,0,64,128,true
  screenunlock
  sleep 10
  ws+=0.01
wend
sleep
Top
srvaldez
Posts: 3379
Joined: Sep 25, 2005 21:54

Re: PutResize.bi

Post by srvaldez »

thanks D.J.Peters :-)
Top
Post Reply

Return to “Sources, Examples, Tips and Tricks”