Bordered Box

[kevin]

 Make Bordered Box

 This example makes a shaded box with blurred edges.


 PB V1.64j

PlayBASIC Code: [Select]

      BackDropColour=rgb(255,0,0)
      C1=rgb(100,130,200)
      C2=rgb(50,70,900)
      shadebox 0,0,800,300,c1,c1,c2,c2
      shadebox 0,300,800,600,c2,c2,c1,c1
      

   t=timer()
      ThisImage1=MakeBorderedBox(700,400,16,RndRgb(),RndRgb())
      ThisImage2=MakeBorderedBox(325,100,10,RndRgb(),RndRgb())
      ThisImage3=MakeBorderedBox(325,100,10,RndRgb(),RndRgb())
      print timer()-t

      DrawImage ThisImage1,50,20,true
      DrawImage ThisImage2,50,450,true
      DrawImage ThisImage3,420,450,true


   
      Sync
      waitkey
      waitnokey
      

Function MakeBorderedBox(Width,Height,CornerSize,ForeColourTop,ForeColourBot)

   if Width>0 and Height>0 and cornerSize>0
         oldSurface=Getsurface()         

         ThisImage=GetFreeimage()
         CreateFXIMageEx ThisImage,Width,Height,32
      
         rendertoimage ThisIMage
   
         CornerWidth=CornerSize
         CornerHeight=CornerSize
         Dim PhongMap(CornerWidth,CornerHeight)

         if CornerWidth<CornerHeight
            Dist#=CornerHeight/2
         else
            Dist#=CornerWidth/2
         endif
         Scaler#=250/Dist#

         MakePhongMap(PhongMap(),CornerWidth,CornerHeight,Scaler#,CornerWidth/2,CornerHeight/2)

         DrawArray(PhongMap(),0,0,ForeColour)

         if CornerSize<Height
            StripImage=GetFreeImage()
            GetImage StripIMage,0,CornerHeight/2,CornerWidth,CornerHeight
            for ylp=CornerHeight/2 to Height-CornerHeight/2
               DrawImage StripImage,0,ylp,false
            next
            Deleteimage StripImage
         endif

         StripImage=GetFreeImage()
         getimage StripIMage,CornerWidth/2,0,CornerWidth,Height
   
         EndImage=GetFreeImage()
         getimage EndIMage,CornerWidth/2,0,CornerWidth/2+1,Height


         for Xlp=CornerWidth/2 to Width-(CornerWidth/2)
               drawimage StripImage,Xlp,0,false
         next
         drawimage EndImage,Xlp,0,false

         inkmode 1+64
         ShadeBox 0,0,width,height,ForeColourTop,ForeColourTop,ForeColourBot,ForeColourBot
         inkmode 1

         deleteimage StripImage
         DEleteImage EndImage
         RenderToImage OldSurface
         prepareafximage ThisImage
   endif
EndFunction   ThisImage
   


   // Phong table
Function MakePhongMap(PhongMap(),Width,Height,Scaler#,CenterX,CenterY)
   Dim PhongMap(Width,Height)
   For y = 0 To Height
      For x = 0 To Width
         Level#=GetDistance2D(CenterX,CenterY,x,y)*Scaler#
         PhongMap(x, y) =cliprange(255-level#,0,255)
      Next 
   Next 
   PhongMap(CenterX,CenterY) = 255
EndFunction


Function DrawArray(Pixels(),Xpos,Ypos,ThisColour)
   lockbuffer
      nullpixel=point(0,0)
      inkmode 1+512
      for y=0 to getarrayelements(Pixels(),2)-1
         for x=0 to getarrayelements(Pixels(),1)-1
               Dotc Xpos+X,Ypos+Y,ARgb(Pixels(X,y),0,0,0)
         next
      next
      inkmode 1
   unlockbuffer
EndFunction

Related To

  Create Mirrored Image
  Create Shadowed Image
  Make Shadowed Thumbnail

[kevin]

 Make Tube Image

 This example makes a rounded tube styled texture.   The texture is then drawn in a ring using TextureQuad.


 PB V1.64j

PlayBASIC Code: [Select]

      Screen=NewFxImage(800,600)
      
      Width=128
      Height=128

      ThisIMage=MakeTubeIMage(Width,height,RGB(200,255,200))

      OverLAy=MakeTubeIMage(Width,height,RGB(255,155,100))
      
      setfps 50
      Do

         RendertoImage Screen
         C1=rgb(200,80,20)
         C2=rgb(50,20,20)
         shadebox 0,0,800,300,c1,c1,c2,c2
         shadebox 0,300,800,600,c2,c2,c1,c1

         DrawRotatedImage  OverLay, 400+CosRadius(Angle#,500), 200,0,5,1,Width/-2,0,true

         TextureRing(ThisImage,400,300,300+Sin(Angle#)*100,120,20,Angle#)

         Angle#=wrapangle(Angle#,2)

         rendertoscreen
         Drawimage Screen,0,0,0

         Sync
      loop
   



Function MakeTubeIMage(Width,height,Colour)
   Colour=Colour and $00ffffff
   oldsurface=GetSurface()

   ThisImage=GetFreeImage()
   CreateFXImageEX ThisImage,Width,Height,32

   rendertoimage ThisIMage

   lockbuffer
      Scaler#=250/(Height/2)
      PhongStrip(Height,Scaler#,Height/2,Colour)
      TempImage=GetFreeImage()
      GetImage TempImage,0,0,1,Height
      tileimage Tempimage,0,0,false
      deleteimage TempImage
   unlockbuffer      
   rendertoimage oldsurface
   prepareAFXimage ThisIMage
EndFunction ThisImage



Function PhongStrip(Height,Scaler#,CenterY,Colour)
   For y = 0 To Height
      if Y<>CenterY
         Level#=GetDistance2D(0,CenterY,0,y)*Scaler#
         Alpha=cliprange(level#,0,255) * $ff000000
      else
         Alpha=$ff000000
      endif
      Dotc 0,y,   Alpha or Colour
   Next 
EndFunction







psub TextureRing(Texture,Xpos,Ypos,RAdius,Width,Verts,Angle#)

      S#=360.0/Verts

      COlour=RgbFade(COlour,20)
      RAdiusI=Radius-Width
      RAdiusO=Radius+Width

      ColourI=RgbFade(Colour,20)
      ColourO=RgbFade(Colour,20)

      
      u1=GetImageWidth(Texture)
      v1=0

      u2=GetImageWidth(Texture)
      v2=GetImageHeight(Texture)

      u3=0
      v3=GetImageHeight(Texture)

      u4=GetImageWIdth(Texture)
      v4=0


lockbuffer         
      For V=0 to Verts
         A#=wrapangle(Angle#,V*S#)

         // outter points
         xi=cosnewvalue(Xpos,A#,RadiusI)
         yi=sinnewvalue(Ypos,A#,RadiusI)

         // Center Points   
         xc=cosnewvalue(Xpos,A#,Radius)
         yc=sinnewvalue(Ypos,A#,Radius)
      
         // outter points
         xo=cosnewvalue(Xpos,A#,RadiusO)
         yo=sinnewvalue(Ypos,A#,RadiusO)

         if V   
            TextureQuad Texture,oldxi,oldyi,u1,v1,oldxc,oldyc,u2,v2,xc,yc,u3,v3,xi,yi,u4,v4,true
            TextureQuad Texture,oldxc,oldyc,u1,v1,oldxo,oldyo,u2,v2,xo,yo,u3,v3,xc,yc,u4,v4,true
         endif


         //
         oldxi=xi
         oldyi=yi

         oldxc=xc
         oldyc=yc

         oldxo=xo
         oldyo=yo

      next

unlockbuffer         



Endpsub

[kevin]

Rounded Box


  This is another variation of the box routine above, the only difference is that this version has black edges and different shading inside the box area.  Which creates a type of shadowed effect you see in many current website designs.   The routine is used in the Musical Note Head Editor

PlayBASIC Code: [Select]

   Cls $8888a8

   IMage= MakeBorderedBox(600,180,20,$334455,$886655)
   
   drawimage IMage,100,200,true
   
   Sync
   waitkey
   



Function MakeBorderedBox(Width,Height,CornerSize,ForeColourTop,ForeColourBot)

   if Width>0 and Height>0 and cornerSize>0
         oldSurface=Getsurface()         

         ThisImage=GetFreeimage()
         CreateFXIMageEx ThisImage,Width,Height,32
      
         rendertoimage ThisIMage
   
         CornerWidth=CornerSize
         CornerHeight=CornerSize
         Dim PhongMap(CornerWidth,CornerHeight)

         if CornerWidth<CornerHeight
            Dist#=CornerHeight/2
         else
            Dist#=CornerWidth/2
         endif
         Scaler#=250/Dist#

         MakePhongMap(PhongMap(),CornerWidth,CornerHeight,Scaler#,CornerWidth/2,CornerHeight/2)

         DrawArray(PhongMap(),0,0,ForeColour)

         if CornerSize<Height
            StripImage=GetFreeImage()
            GetImage StripIMage,0,CornerHeight/2,CornerWidth,CornerHeight
            for ylp=CornerHeight/2 to Height-CornerHeight/2
               DrawImage StripImage,0,ylp,false
            next
            Deleteimage StripImage
         endif

         StripImage=GetFreeImage()
         getimage StripIMage,CornerWidth/2,0,CornerWidth,Height
   
         EndImage=GetFreeImage()
         getimage EndIMage,CornerWidth/2,0,CornerWidth/2+1,Height


         for Xlp=CornerWidth/2 to Width-(CornerWidth/2)
               drawimage StripImage,Xlp,0,false
         next
         drawimage EndImage,Xlp,0,false

         inkmode 1+64
         c2=CornerWidth/2
         boxc 0,0,width,height,true,$444444         

         midy=height/2
         ShadeBox c2,C2,width-C2,midy,ForeColourTop,ForeColourTop,ForeColourBot,ForeColourBot
         ShadeBox c2,midy,width-C2,height-C2,ForeColourBot,ForeColourBot,ForeColourTop,ForeColourTop
         
         inkmode 1

         deleteimage StripImage
         DEleteImage EndImage
         RenderToImage OldSurface
         prepareafximage ThisImage
   endif
EndFunction   ThisImage
   


   // Phong table
Function MakePhongMap(PhongMap(),Width,Height,Scaler#,CenterX,CenterY)
   Dim PhongMap(Width,Height)
   For y = 0 To Height
      For x = 0 To Width
         Level#=GetDistance2D(CenterX,CenterY,x,y)*Scaler#
         PhongMap(x, y) =cliprange(255-level#,0,255)
      Next 
   Next 
   PhongMap(CenterX,CenterY) = 255
EndFunction


Function DrawArray(Pixels(),Xpos,Ypos,ThisColour)
   lockbuffer
      nullpixel=point(0,0)
      inkmode 1+512
      for y=0 to getarrayelements(Pixels(),2)-1
         for x=0 to getarrayelements(Pixels(),1)-1
               Dotc Xpos+X,Ypos+Y,ARgb(Pixels(X,y),0,0,0)
         next
      next
      inkmode 1
   unlockbuffer
EndFunction