Sphere

This algorithm processes an image creating the effect of the image being wrapped around a ball.

   



									Public Shared Sub ApplySphere(ByRef bmp As Bitmap)
	Dim bmpWidth As Integer = bmp.Width
	Dim bmpHeight As Integer = bmp.Height
	Dim bmpStride As Integer = 0

	Dim TempBmp As Bitmap = DirectCast(bmp.Clone(), Bitmap)

	Dim bmpData As BitmapData = bmp.LockBits(New Rectangle(0, 0, bmpWidth, bmpHeight), ImageLockMode.ReadWrite, PixelFormat.Format24bppRgb)
	Dim TempBmpData As BitmapData = TempBmp.LockBits(New Rectangle(0, 0, TempBmp.Width, TempBmp.Height), ImageLockMode.[ReadOnly], PixelFormat.Format24bppRgb)

	bmpStride = bmpData.Stride

	Dim ptr As IntPtr = bmpData.Scan0
	Dim TempPtr As IntPtr = TempBmpData.Scan0

	Dim stopAddress As Integer = CInt(ptr) + bmpStride * bmpHeight

	Dim Val As Integer = 0
	Dim MidX As Integer = bmpWidth \ 2
	Dim MidY As Integer = bmpHeight \ 2
	Dim i As Integer = 0, X As Integer = 0, Y As Integer = 0
	Dim TrueX As Integer = 0, TrueY As Integer = 0
	Dim NewX As Integer = 0, NewY As Integer = 0

	Dim NewRadius As Double = 0
	Dim Theta As Double = 0, Radius As Double = 0

	While CInt(ptr) <> stopAddress
		X = i Mod bmpWidth
		Y = i \ bmpWidth

		TrueX = X - MidX
		TrueY = Y - MidY

		Theta = Math.Atan2(TrueY, TrueX)
		Radius = Math.Sqrt(TrueX * TrueX + TrueY * TrueY)
		NewRadius = Radius * Radius / Math.Max(MidX, MidY)

		NewX = CInt(Math.Truncate(MidX + (NewRadius * Math.Cos(Theta))))
		NewY = CInt(Math.Truncate(MidY + (NewRadius * Math.Sin(Theta))))

		If Not (NewY >= 0 AndAlso NewY < bmpHeight AndAlso NewX >= 0 AndAlso NewX < bmpWidth) Then
			NewX = NewY = 0
		End If

		If NewY >= 0 AndAlso NewY < bmpHeight AndAlso NewX >= 0 AndAlso NewX < bmpWidth Then
			Val = (NewY * bmpStride) + (NewX * 3)

			Marshal.WriteByte(ptr + 0, Marshal.ReadByte(TempPtr + Val))
			Marshal.WriteByte(ptr + 1, Marshal.ReadByte(TempPtr + Val + 1))
			Marshal.WriteByte(ptr + 2, Marshal.ReadByte(TempPtr + Val + 2))
		End If

		ptr += 3
		i += 1
	End While

	bmp.UnlockBits(bmpData)
	TempBmp.UnlockBits(TempBmpData)
End Sub
								


Example

									DIm b As Bitmap = CType(Image.FromFile("rose.jpg"), Bitmap)
ApplySphere(b)