Tipp-Upload: VB.NET 0108: Mit ColorMatrix Farbwerte transformieren

Hinweis zum Tippvorschlag  

Dieser Vorschlag wurde noch nicht auf Sinn und Inhalt überprüft und die Zip-Datei wurde noch nicht auf schädlichen Inhalt hin untersucht.
Bitte haben Sie ein wenig Geduld, bis die Freigabe erfolgt.

Über den Tipp  

Dieser Tippvorschlag ist noch unbewertet.

Der Vorschlag ist in den folgenden Kategorien zu finden:

• Grafik

Dem Tippvorschlag wurden folgende Schlüsselwörter zugeordnet:
ColorMatrix

Der Vorschlag wurde erstellt am: 17.09.2007 21:05.
Die letzte Aktualisierung erfolgte am 04.03.2008 20:51.

Zurück zur Übersicht

Beschreibung  

Mit der Colormatrix kann für jeden Farbwert einer Bitmap ein Transformations-Wert festgelegt werden, der sich aus allen Farbkomponenten zusammensetzen kann, incl. Farbsättigung.
Colormatrix stellt also ein mächtiges Instrument für Farbverfremdungen dar.

Anmerkung: Der eigentliche Tipp besteht aus zwei Zeilen in frmColorMatrix.ApplyColormatrix(). Das weitere ist "nur" eine komfortable Eingabe für die 25 Elemente einer Colormatrix bereitzustellen.

Schwierigkeitsgrad

Verwendete API-Aufrufe:

Download: Download des Beispielprojektes [44,73 KB]

' Dieser Source stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.

' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
' Ansonsten viel Spaß und Erfolg mit diesem Source!
'
' Beachten Sie, das vom Designer generierter Code hier ausgeblendet wird.
' In den Zip-Dateien ist er jedoch zu finden.

' ----------- Anfang Projektgruppe ColorMatrix.sln -----------
' ---------- Anfang Projektdatei ColorMatrix.vbproj ----------
' -------------- Anfang Datei frmColorMatrix.vb --------------
' Projekt-Einstellungen:
' Option Strict On
' Option Explicit On
' Imports System.Windows.Forms
' Imports System.Drawing
' Imports Microsoft.VisualBasic.ControlChars

Imports System.Drawing.Imaging
Imports System.IO

Public Class frmColorMatrix

    Private _GDest As Graphics ' Graphics des zu aktualisierenden Images
    Private _DrawAttr As New Imaging.ImageAttributes()

    Private Sub frmColorMatrix_Load( _
                ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Load

        Using Bmp As New Bitmap("Colors.jpg")
            Me.picSrc.BackgroundImage = CreateArgbCopy(Bmp)
        End Using

        ' Eine Überlagerung zweier Bilder wird implementiert, indem der Ziel-Picturebox
        ' sowohl ein BackgroundImage als auch ein Image zugewiesen wird
        Me.picDest.BackgroundImage = New Bitmap("Colgate-Pig.jpeg")

        Me.picDest.Image = New Bitmap(picDest.Width - 50, picDest.Height - 30, _
            PixelFormat.Format32bppArgb)

        _GDest = Graphics.FromImage(Me.picDest.Image)
        ApplyColormatrix()

    End Sub

    ''' <summary>
    ''' konvertiert eine RGB-Bitmap ins ARGB-Format (Alpha-Komponente:
    ''' Farbsättigung)
    ''' </summary>
    Private Function CreateArgbCopy(ByVal Img As Image) As Bitmap

        CreateArgbCopy = New Bitmap(Img.Width, Img.Height, PixelFormat.Format32bppArgb)

        Using G As Graphics = Graphics.FromImage(CreateArgbCopy)

            Dim Rct As New Rectangle(Point.Empty, Img.Size)

            G.DrawImage(Img, Rct, Rct, GraphicsUnit.Pixel)
        End Using

    End Function

    Private Sub UclColormatrix1_ColorMatrixChanged( _
                ByVal sender As Object, ByVal e As EventArgs) _
                Handles UclColormatrix1.ColorMatrixChanged

        ApplyColormatrix()

    End Sub

    Private Sub ApplyColormatrix()

        _GDest.Clear(Color.Transparent)
        _DrawAttr.SetColorMatrix(UclColormatrix1.ColorMatrix)

        Dim Src As Image = Me.picSrc.BackgroundImage

        _GDest.DrawImage(Src, Rectangle.Round(_GDest.VisibleClipBounds), 0, 0, Src.Width, _
            Src.Height, GraphicsUnit.Pixel, _DrawAttr)

        picDest.Invalidate()

    End Sub

    Private Sub frmColorMatrix_Disposed( _
                ByVal sender As Object, ByVal e As EventArgs) Handles Me.Disposed

        For Each D As IDisposable In New IDisposable() { _GDest, _DrawAttr, _
            picSrc.BackgroundImage, picDest.BackgroundImage, picDest.Image}

            D.Dispose()
        Next

    End Sub

End Class

' --------------- Ende Datei frmColorMatrix.vb ---------------
' ---------------- Anfang Datei modHelpers.vb ----------------
Imports System
Imports System.Diagnostics

Public Module modHelpers

    ''' <summary>
    ''' Normiert ScrollBar.Value auf einen Wert zw. 0 und 1
    ''' </summary>
    Public Property NormedScrollValue(ByVal Scrollbar As ScrollBar) As Double
        Get

            With Scrollbar
                Return .Value / (.Maximum - (.LargeChange - 1))
            End With

        End Get

        Set(ByVal value As Double)

            If Not IsBetween(0.0, value, 1.0) Then Throw New Exception(String.Concat( _
                "Value '", value, "' liegt nicht zwischen 0 und 1."))

            With Scrollbar

                Dim Val As Integer = CInt(value * (.Maximum - (.LargeChange - 1)))

                If Val = .Value Then Return
                .Value = Val
            End With

        End Set

    End Property

    ''' <summary>
    ''' Normiert ScrollBar.Value auf einen Wert zw. ScaleMin und ScaleMax 
    ''' </summary>
    Public Property NormedScrollValue(ByVal ScrollBar As ScrollBar, ByVal ScaleMin As Double, _
        ByVal ScaleMax As Double) As Double

        Get
            Return NormedScrollValue(ScrollBar) * (ScaleMax - ScaleMin) + ScaleMin

        End Get

        Set(ByVal value As Double)
            NormedScrollValue(ScrollBar) = (value - ScaleMin) / (ScaleMax - ScaleMin)

        End Set

    End Property

    Public Function IsBetween(Of T As IComparable)( _
              ByVal Bord0 As T, _
              ByVal ToTest As T, _
              ByVal Bord1 As T, _
              Optional ByVal AutoSort As Boolean = False) As Boolean

        If AutoSort Then

            Dim C0 As Integer = Bord0.CompareTo(ToTest)
            Dim C1 As Integer = ToTest.CompareTo(Bord1)

            Return C0 = 0 OrElse C1 = 0 OrElse (C0 < 0) = (C1 < 0)

        Else

            Return Bord0.CompareTo(ToTest) <= 0 AndAlso ToTest.CompareTo(Bord1) <= 0
        End If

    End Function

End Module

' ----------------- Ende Datei modHelpers.vb -----------------
' -------------- Anfang Datei uclColormatrix.vb --------------
Imports System.Drawing.Imaging

'''<summary>
''' UserControl, kombiniert eine Scrollbar mit einem Grid, welches die 
''' 5*5 Elemente einer ColorMatrix anzeigt: Das Grid wählt das gewünschte 
''' Matrix-Element an,die Scrollbar stellt den Wert ein
''' </summary>
Public Class uclColormatrix

    Public ReadOnly ColorMatrix As New ColorMatrix

    Public Event ColorMatrixChanged As EventHandler

    Private Sub uclColormatrix_Load( _
                ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Load

        Me.MatrixGrid.RowCount = 5

        For Y As Integer = 0 To 4
            For X As Integer = 0 To 4
                Me.MatrixGrid(X, Y).Value = ColorMatrix(Y, X)
            Next
        Next

        UpdateScroll()

    End Sub

    Private Sub UpdateScroll()

        NormedScrollValue(HScrollBar1) = CSng(MatrixGrid.CurrentCell.Value)

    End Sub

    Private Sub MatrixGrid_CurrentCellChanged( _
                ByVal sender As Object, ByVal e As EventArgs) _
                Handles MatrixGrid.CurrentCellChanged

        UpdateScroll()

    End Sub

    ' Zeilenbeschriftung anbringen - entsprechend den ColumnHeaderTexten
    Private Sub MatrixGrid_CellPainting( _
                ByVal sender As Object, ByVal e As DataGridViewCellPaintingEventArgs) _
                Handles MatrixGrid.CellPainting

        ' Die Zeilenköpfe werden mit ColumnIndex=-1 angesprochen
        If e.ColumnIndex < 0 AndAlso e.RowIndex >= 0 Then
            e.PaintBackground(e.CellBounds, False)

            With MatrixGrid

                TextRenderer.DrawText(e.Graphics, .Columns(e.RowIndex).HeaderText, .Font, _
                    e.CellBounds, .ForeColor)

            End With

            e.Handled = True
        End If

    End Sub

    ' Scroll-Wert in Grid und Colormatrix eintragen, dann Event raisen
    Private Sub HScrollBar1_ValueChanged(ByVal sender As Object, ByVal e As EventArgs) _
              Handles HScrollBar1.ValueChanged

        Dim ScrollVal As Single = CSng(NormedScrollValue(HScrollBar1))

        With MatrixGrid.CurrentCell

            If ScrollVal.Equals(.Value) Then Return
            .Value = ScrollVal
            ColorMatrix(.RowIndex, .ColumnIndex) = ScrollVal
        End With

        RaiseEvent ColorMatrixChanged(Me, EventArgs.Empty)

    End Sub

End Class

' --------------- Ende Datei uclColormatrix.vb ---------------
' ----------- Ende Projektdatei ColorMatrix.vbproj -----------
' ------------ Ende Projektgruppe ColorMatrix.sln ------------

	

Diskussion  

Diese Funktion ermöglicht es, Fragen, die die Veröffentlichung des Tipps betreffen, zu klären, oder Anregungen und Verbesserungsvorschläge einzubringen. Nach der Veröffentlichung des Tipps werden diese Beiträge nicht weiter verlinkt. Allgemeine Fragen zum Inhalt sollten daher hier nicht geklärt werden.

Um eine Diskussion eröffnen zu können, müssen sie angemeldet sein.