vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Erstellen von dynamischen Kontextmen?s - wann immer Sie sie brauchen!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: Grafik und Font · Grafische Effekte   |   VB-Versionen: VB2005, VB200820.04.09
Erzeugen einer Reflexion zu einem gegebenen Bild

Zu einem Bild in einer Picturebox wird das Reflexionsbild mit gradientem Verlauf zum 'Untergrund' ermittelt.

Autor:   Dietrich HerrmannBewertung:     [ Jetzt bewerten ]Views:  10.936 
ohne HomepageSystem:  Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

Dieser Tipp realisiert das Erzeugen einer Reflexion zu einem Bild, das in einer Picturebox auf der Form angezeigt wird. Dabei kann der 'Untergrund' beliebig sein; bspw. könnte die Form ein Hintergrundbild haben.

Das Prinzip ist Folgendes:
Es wird von einem Bild in einer Picturebox ausgegangen. Zu ihm wird am unteren Rand die Reflexion berechnet. Dabei kann man die Höhe der Reflexion in Prozent der Originalbildhöhe angeben.

Die Funktion macht als erstes einen Screenshot der Form und prüft, ob die Reflexion mit der vorgegebenen Höhe noch in der Form anzeigbar ist; eventuell erfolgt eine Höhenanpassuung. Das unter der Picturebox befindliche Rechteck dieser Bitmap wird in der gewünschten Größe aus dem Form-Screenshot ausgeschnitten. Die Auflösung des Origialbildes wird ermittelt und möglicherweise auf die Auflösung 96x96 gesetzt. Dann wird der Auschnitt (in der gleichen Größe) vom Originalbild ermittelt und gekippt.

Die beiden Bitmaps werden nun jeweils mit dem umgekehrten Alphagradienten versehen, d.h., der Untergrund verläuft nach oben zu null, die gekippte Bitmap verläuft nch unten zu null.

Jetzt werden beide Bitmaps "gemischt" in die Ausgabebitmap.

Nun wird nur noch die Ergebnisbitmap in eine neue Picturebox gezeichnet, die im vorgegebenen Absatnd genau unter die Originalpicturebox gesetzt wird. Fertig!

(Die Funktion CropBitmap findest du en detail in meinem Tipp:  Clientarea einer Form abdunkeln bzw. transparent färben)

Also: baue eine Form, gib ihr einen Hintergrund, setze eine Picturebox namens pOriginal in die Form, lade ein Bild in die PB, dann starten...

Imports System
Imports System.Collections.Generic
Imports System.ComponentModel
Imports System.Data
Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Drawing.Drawing2D
 
Public Class Form1
 
  Public Structure ReflectionParams
    ' diese Parameter werden berechnet
    Public alpha As Short
    Public clr As Color
    Public theHeight As Short
    ' diese Parameter müssen vorgegeben werden
    Public theHeightPerc As Single  ' Höhe der Reflexion in Prozent des Originalbilds
    Public theDistance As Short     ' Abstand zwischen Original und Reflexion
  End Structure
 
  Dim myReflection As ReflectionParams
  Private Sub Form1_Load(ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles MyBase.Load
 
    With myReflection
      .theHeightPerc = 0.4
      .theDistance = 2
    End With
    SetReflection(Me, pOriginal, myReflection)
  End Sub
  ' Berechnen des Reflexionsbildes
  Public Sub SetReflection(ByVal fo As Form, ByVal pb As PictureBox, _
    ByVal par As ReflectionParams)
 
    Dim p1 As New PictureBox
    Dim p2 As New PictureBox
 
    ' Höhe der Reflexion berechnen
    par.theHeight = pb.Height * par.theHeightPerc
 
    ' Bitmap für Form-Screenshot
    Dim bm_src1 As Bitmap
    bm_src1 = New Bitmap(fo.ClientSize.Width, fo.ClientSize.Height)
 
    ' Screenshot der Form
    captClient(fo, p1, 0, 0, 0, 0)
 
    ' Prüfen, ob Reflexion noch in Form passt
    If pOriginal.Bottom + par.theHeight + par.theDistance > _
      Me.ClientRectangle.Bottom Then
 
      par.theHeight = fo.ClientRectangle.Bottom - pb.Bottom
    End If
    bm_src1 = CropBitmap(p1.Image, pb.Left, _
      pb.Bottom + par.theDistance, pb.Width, par.theHeight)
 
    ' Prüfen der Auflösung des Originalbildes
    Dim vr As Short = pb.Image.VerticalResolution
    Dim hr As Short = pb.Image.HorizontalResolution
 
    ' Originalbild Ausschnitt für Reflexion ermitteln und kippen
    Dim bm_src2 As Bitmap
    bm_src2 = New Bitmap(pb.Width, pb.Height)
    If vr > 96 OrElse hr > 96 Then
      bm_src2 = pb.Image
      bm_src2.SetResolution(96, 96) ' evtl. neu setzen
      pb.Image = bm_src2
    End If
    bm_src2 = CropBitmap(pb.Image, 0, _
      pb.Height - par.theHeight, pb.Width, par.theHeight)
    bm_src2.RotateFlip(RotateFlipType.RotateNoneFlipY)
 
    ' eine "Mischbitmap" erstellen
    Dim bm_out As New Bitmap(bm_src1.Width, bm_src1.Height)
    Dim gr As Graphics = Graphics.FromImage(bm_out)
 
    ' den Einzelbitmaps jeweils den umgekehrten Alpha-Gradienten geben
    For y As Integer = 0 To bm_src1.Height - 1
      par.alpha = (255 * y) / bm_src1.Height
      For x As Integer = 0 To bm_src1.Width - 1
        par.clr = bm_src1.GetPixel(x, y)
        par.clr = Color.FromArgb(par.alpha, par.clr.R, par.clr.G, par.clr.B)
        bm_src1.SetPixel(x, y, par.clr)
 
        par.clr = bm_src2.GetPixel(x, y)
        par.clr = Color.FromArgb(255 - par.alpha, par.clr.R, par.clr.G, par.clr.B)
        bm_src2.SetPixel(x, y, par.clr)
      Next x
    Next y
 
    ' Zeichnen der Einzel-Bitmaps in die Mischbitmap
    gr.DrawImage(bm_src2, 0, 0)
    gr.DrawImage(bm_src1, 0, 0)
 
    ' Mischbitmap (die Reflection) anzeigen auf der Form
    Dim pr As New PictureBox
    With pr
      .SizeMode = PictureBoxSizeMode.AutoSize
      .Left = pOriginal.Left
      .Top = pOriginal.Bottom + par.theDistance
      .Image = bm_out
      .Visible = True
    End With
    fo.Controls.Add(pr)
  End Sub
  ''' <summary>
  ''' Erstellt einen Screenshot der Client-Area einer Form
  ''' </summary>
  ''' <param name="fo">Form</param>
  ''' <param name="pb">PictureBox für den Screenshot</param>
  ''' <param name="cutTop">Schnitt von oben, wenn von Clientarea noch was
  ''' weggeschnitten werden soll</param>
  ''' <param name="cutBottom">Schnitt von unten</param>
  ''' <param name="cutLeft">Schnitt von links</param>
  ''' <param name="cutRight">Schnitt von rechts</param>
  ''' <param name="doGray">Screenshot als Graustufenbild oder nicht</param>
  Public Function captClient(ByVal fo As Form, ByVal pb As PictureBox, _
    ByVal cutTop As Short, ByVal cutBottom As Short, _
    ByVal cutLeft As Short, ByVal cutRight As Short, _
    Optional ByVal doGray As Boolean = False) As Boolean
 
    Dim w As Integer = fo.Width
    Dim cw As Integer = fo.ClientSize.Width
    Dim h As Integer = fo.Height
    Dim ch As Integer = fo.ClientSize.Height
    Dim dw As Integer = w - cw
    Dim dh As Integer = h - ch
 
    ' Wenn Höhe oder Breite < 1...
    If w < 1 OrElse h < 1 OrElse cw < 1 OrElse ch < 1 Then Return False
 
    Dim bm As New Bitmap(w, h)
 
    ' ganze Form in die Bitmap zeichnen
    fo.DrawToBitmap(bm, New Rectangle(0, 0, w, h))
    Dim bmc As New Bitmap(CInt(dw / 2), ch - cutTop)
 
    ' den Screenshot der Form beschneiden
    bmc = CropBitmap(bm, dw / 2, dh - dw / 2 + cutTop, _
      cw, ch - cutTop - cutBottom)
 
    With pb
      .Left = cutLeft
      .Top = cutTop
      If doGray Then
        ' eventuell Graustufenbild vom Screenshot machen
        .Image = GetGrayScaleImage(bmc)
      Else
        .Image = bmc
      End If
    End With
 
    Return True
  End Function
  ''' <summary>
  ''' Beschneidet ein Bitmap
  ''' </summary>
  ''' <param name="bmp"></param>
  ''' <param name="cropX">X-Koordinate</param>
  ''' <param name="cropY">Y-Koordinate</param>
  ''' <param name="cropWidth">Breite</param>
  ''' <param name="cropHeight">Höhe</param>
  Public Function CropBitmap(ByRef bmp As Bitmap, _
    ByVal cropX As Integer, ByVal cropY As Integer, _
    ByVal cropWidth As Integer, ByVal cropHeight As Integer) As Bitmap
 
    Dim rect As New Rectangle(cropX, cropY, cropWidth, cropHeight)
    Dim cropped As Bitmap = bmp.Clone(rect, bmp.PixelFormat)
    Return cropped
  End Function
  ' This method draws a grayscale image from a given Image-instance
  ' and gives back the Bitmap of it img-  the original bitmap
  Public Function GetGrayScaleImage(ByVal img As Image) As Bitmap
    Dim grayBitmap As New Bitmap(img.Width, img.Height)
    Dim imgAttributes As New ImageAttributes()
    Dim gray As New ColorMatrix(New Single()() { _
      New Single() {0.299F, 0.299F, 0.299F, 0, 0}, _
      New Single() {0.588F, 0.588F, 0.588F, 0, 0}, _
      New Single() {0.111F, 0.111F, 0.111F, 0, 0}, _
      New Single() {0, 0, 0, 1, 0}, _
      New Single() {0, 0, 0, 0, 1}})
 
    imgAttributes.SetColorMatrix(gray)
    Dim g As Graphics = Graphics.FromImage(grayBitmap)
    g.DrawImage(img, New Rectangle(0, 0, img.Width, img.Height), _
      0, 0, img.Width, img.Height, GraphicsUnit.Pixel, imgAttributes)
    Return grayBitmap
  End Function
End Class

Dieser Tipp wurde bereits 10.936 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Aktuelle Diskussion anzeigen (4 Beiträge)

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel