Feedback

VB - Let your image glow - Bild glühen lassen

Veröffentlicht von am 12/7/2009
(1 Bewertungen)
In vielen Anwendungen ist man mit eigenen Bildern unterwegs. Dabei möchte man sich gerne um die Programmierung kümmern und ggf. erst später um die Grafiken. Mit dieser Funktion kann man eine Bildkopie erstellen, welche eine Art Glüheffekt erstellt. Damit kann man Bilder erstellen für EIN / AUS Modi.
   ''' <summary>
            ''' Let any source image glow.
            ''' Copyright by Timo Boehme, www.goldengel.ch
            ''' </summary>
            ''' <param name="bmSrc">An bitmap with image. Example 64x64 Pixel icon.</param>
            ''' <returns>A brighten sourceimage with some glowing like effekt.</returns>
            ''' <remarks>'*1) Variant: Check out to let some channels at zero. For example only take
            ''' the green channel to change the luminance.</remarks>
            Public Function CreateGlowingImage(ByVal bmSrc As Bitmap) As Bitmap
                Dim i As Integer                'Helper
                Dim m As Integer                'Bytes per Pixel to work with
                Dim R1, G1, B1 As Integer       'Source Red, Green, Blue
                Dim R2, G2, B2 As Integer       'Result Red, Green, Blue
                Dim D As Integer                'luminance to add
                Dim L As New List(Of Point)     'List to store areas to widen
                Dim Pt As Point                 'point helper

                'if no image is available, we can not do anything
                If bmSrc Is Nothing Then Return Nothing

                Dim bm As Bitmap = bmSrc.Clone 'Lets us make a copy. Not nessesary but will keep away support questions.

                'convert any image indexed image into an RGB24 image
                If bm.PixelFormat <> Drawing.Imaging.PixelFormat.Format32bppArgb And bm.PixelFormat <> Drawing.Imaging.PixelFormat.Format24bppRgb Then
                    Dim Bm2 As New Bitmap(bm.Width, bm.Height, Drawing.Imaging.PixelFormat.Format24bppRgb)
                    Using gr As Graphics = Graphics.FromImage(Bm2)
                        gr.DrawImage(bm, New Point(0, 0))
                    End Using
                    bm = Bm2
                End If

                'unlock the image data for reading and writing
                Dim bts As Drawing.Imaging.BitmapData
                bts = bm.LockBits(New Rectangle(0, 0, bm.Width, _
                    bm.Height), Drawing.Imaging.ImageLockMode.ReadWrite, bm.PixelFormat)

                'bytes per pixel (default = 3 for 24BPP images)
                m = 3
                If bm.PixelFormat = Drawing.Imaging.PixelFormat.Format32bppArgb Then m = 4

                'change the luminance for each pixel
                Dim X, Y As Integer
                For Y = 0 To bm.Height - 1
                    For X = 0 To bm.Width - 1
                        Pt = New Point(X, Y)
                        i = ((Y * bts.Stride) + (X * m))

                        R1 = System.Runtime.InteropServices.Marshal.ReadByte(bts.Scan0, i + 2) 'Red
                        G1 = System.Runtime.InteropServices.Marshal.ReadByte(bts.Scan0, i + 1) 'Green
                        B1 = System.Runtime.InteropServices.Marshal.ReadByte(bts.Scan0, i + 0) 'Blue
                        D = 50
                        If L.Contains(Pt) Then
                            D = 80
                            L.Remove(Pt)
                        End If
                        'brighten up the image
                        R2 = Global.System.Math.Min(255, R1 + D) '*1
                        G2 = Global.System.Math.Min(255, G1 + D) '*1
                        B2 = Global.System.Math.Min(255, B1 + D) '*1
                        System.Runtime.InteropServices.Marshal.WriteByte(bts.Scan0, i + 2, CByte(R2))
                        System.Runtime.InteropServices.Marshal.WriteByte(bts.Scan0, i + 1, CByte(G2))
                        System.Runtime.InteropServices.Marshal.WriteByte(bts.Scan0, i + 0, CByte(B2))

                        If (R1 + G1 + B1) > (200 + 200 + 200) Then
                            L.Add(New Point(X, Y + 1))
                            L.Add(New Point(X + 1, Y))
                            L.Add(New Point(X + 1, Y + 1))
                        End If
                    Next
                Next

                bm.UnlockBits(bts)
                Return bm
            End Function
Abgelegt unter image, bitmap, luminance, helligkeit, glühen.

Kommentare zum Snippet

 

Logge dich ein, um hier zu kommentieren!