Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0801: Gauß'scher Filterkernel

VB 5/6-Tipp 0801: Gauß'scher Filterkernel

 von BAGZZlash

Schwierigkeitsgrad:

Verwendete API-Aufrufe: keine

Download: Download des Beispielprojektes [2,41 KB]

'Dieser Quellcode 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!

'------------- Anfang Projektdatei Projekt1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Textfeld "Text3"
' Steuerelement: Textfeld "Text2"
' Steuerelement: Textfeld "Text1"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Bildfeld-Steuerelement "Picture1"
' Steuerelement: Beschriftungsfeld "Label3"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label1"
Option Explicit

Private Const Pi As Double = 3.14159265358979

Private Function GetGaussianFilterKernel(SizeX As Integer, SizeY As Integer, Sigma As Single) As Double()

Dim X As Integer
Dim Y As Integer
Dim HalfSizeX  As Integer
Dim HalfSizeY  As Integer
Dim Kernel() As Double

ReDim Kernel(0 To SizeX, 0 To SizeY) As Double

HalfSizeX = SizeX \ 2
HalfSizeY = SizeY \ 2

For X = 0 To SizeX
    For Y = 0 To SizeY
        Kernel(X, Y) = (1 / (2 * Pi * (Sigma * Sigma))) * Exp(-((((X - HalfSizeX) * (X - HalfSizeX)) + ((Y - HalfSizeY) * (Y - HalfSizeY))) / (2 * (Sigma * Sigma))))
    Next
Next

GetGaussianFilterKernel = Kernel

End Function

Private Sub Command1_Click()

Dim UseKernel() As Double
Dim X As Long
Dim Y As Long
Dim PosX As Integer
Dim PosY As Integer
Dim MySizeX As Integer
Dim MySizeY As Integer
Dim MySigma As Single
Dim MyHalfSizeX As Integer
Dim MyHalfSizeY As Integer
Dim MaxKernel As Double

MySizeX = Val(Form1.Text1)
MySizeY = Val(Form1.Text2)
MySigma = Val(Form1.Text3)

MyHalfSizeX = MySizeX \ 2
MyHalfSizeY = MySizeY \ 2

UseKernel = GetGaussianFilterKernel(MySizeX, MySizeY, MySigma)
MaxKernel = UseKernel(MyHalfSizeX, MyHalfSizeY)

For X = 0 To MySizeX 'Normalize kernel for more convenience
    For Y = 0 To MySizeY
        UseKernel(X, Y) = UseKernel(X, Y) / MaxKernel
    Next
Next

For X = 0 To Form1.Picture1.ScaleWidth
    For Y = 0 To Form1.Picture1.ScaleHeight
        PosX = Int((X / Form1.Picture1.ScaleWidth) * MySizeX)
        PosY = Int((Y / Form1.Picture1.ScaleHeight) * MySizeY)
        Form1.Picture1.PSet (X, Y), RGB(255 * UseKernel(PosX, PosY), 255 * UseKernel(PosX, PosY), 255 * UseKernel(PosX, PosY))
    Next
Next

End Sub

Private Sub Command2_Click()

Unload Me

End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------