Code archives/Graphics/Emboss
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
Hi! Hmmm yes a little emboss-effect cu olli | |||||
; ------------------------------------------------------------ Graphics 640,480,32,2 SetBuffer BackBuffer() ; ------------------------------------------------------------ ; ------------------------------------------------------------ Image = CreateImage(400,300) Dim Buffer(ImageWidth(Image),ImageHeight(Image)) Dim Picture(ImageWidth(Image),ImageHeight(Image)) ; ------------------------------------------------------------ ; ------------------------------------------------------------ SetBuffer ImageBuffer(Image) Font = LoadFont("Verdana",70,1,0,0) SetFont Font Text 200,150,"BlitzBASIC",1,1 ; ------------------------------------------------------------ ; ------------------------------------------------------------ LockBuffer ImageBuffer(Image) For X = 0 To ImageWidth(Image) For Y = 0 To ImageHeight(Image) Buffer(X,Y) = ReadPixelFast(X,Y) Next Next For X = 0 To ImageWidth(Image) - 3 For Y = 0 To ImageHeight(Image) - 1 BufferR1 = GetR(Buffer(X,Y)) BufferG1 = GetG(Buffer(X,Y)) BufferB1 = GetB(Buffer(X,Y)) BufferR2 = GetR(Buffer(X + 3,Y + 1)) BufferG2 = GetG(Buffer(X + 3,Y + 1)) BufferB2 = GetB(Buffer(X + 3,Y + 1)) TempR = Abs(BufferR1) - BufferR2 + 128 If TempR > 255 Then TempR = 255 If TempR < 0 Then TempR = 0 TempG = Abs(BufferG1) - BufferG2 + 128 If TempG > 255 Then TempG = 255 If TempG < 0 Then TempG = 0 TempB = Abs(BufferB1) - BufferB2 + 128 If TempB > 255 Then TempB = 255 If TempB < 0 Then TempB = 0 Picture(X,Y) = GetRGB(TempR,TempG,TempB) Next Next For X = 0 To ImageWidth(Image) - 3 For Y = 0 To ImageHeight(Image) - 1 WritePixelFast X,Y,Picture(X,Y) Next Next For X = ImageWidth(Image) - 3 To ImageWidth(Image) For Y = ImageHeight(Image) - 1 To ImageHeight(Image) WritePixelFast X,Y,Buffer(X,Y) Next Next UnlockBuffer ImageBuffer(Image) ; ------------------------------------------------------------ ; ------------------------------------------------------------ Dim Buffer(0,0) Dim Picture(0,0) ; ------------------------------------------------------------ ; ------------------------------------------------------------ SetBuffer BackBuffer() DrawImage Image,0,0 : Flip ; ------------------------------------------------------------ ; ------------------------------------------------------------ WaitKey : FreeImage Image : End ; ------------------------------------------------------------ ; ------------------------------------------------------------ Function GetR(RGB) Return (RGB And $FF0000) / $10000 End Function Function GetG(RGB) Return (RGB And $FF00) / $100 End Function Function GetB(RGB) Return RGB And $FF End Function Function GetRGB(R,G,B) Return R * $10000 + G * $100 + B End Function ; ------------------------------------------------------------ |
Comments
None.
Code Archives Forum