PutResize
Два примера изменения размеров изображения для FBGFXLIB с разной функциональностью.
Платформы: Windows, Linux
Автор: D.J.Peters
' 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
' PutResize(dst,x,y,w,h,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 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 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 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 ' 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 512,512,16 '8,16,24,32 Dim As Single WS Dim As Any Ptr img = Imagecreate(128,128,0) Circle img,(64,64),63,Rgb(128,128,0),,,,f While Inkey="" Screenlock Cls 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 PutResize 0,x,y,w,h,img,0,0,64,128 Screenunlock Sleep 10 WS+=0.01 Wend Sleep
