vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Top-Preis! AP-Access-Tools-CD Volume 1  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2020
 
zurück

 Sie sind aktuell nicht angemeldet.Funktionen: Einloggen  |  Neu registrieren  |  Suchen

VB.NET - Fortgeschrittene
Re: Bild auf Bild einblenden 
Autor: Manfred X
Datum: 23.06.20 16:35

Du deklarierst weiterhin Graphics-Objekte mit Dim und gibst sie nicht frei.
Die Freigabe am Ende des Using-Blockes bezieht sich nur auf Objekte, die
im Using-Statement erstellt worden sind.
Du verwendest immer noch die Picturebox-Graphic zum Zeichnen. Das ist unnötig
und schafft eventuell weitere Rundungen wegen des Zoom.
Die Bidgröße wird bereits in GetPic angepasst. Abhängig vom Seitenverhältnis
entstehen dabei Ränder, wenn das gesamte Bild in der vorgegebene Fläche
angezeigt werden soll.

Deine Rechnungen nützen so nichts.
Bei Reskalierung von Bildern treten Dezimalbrüche auf und es wird
auf ganze Zahlen gerundet. Dabei kann ein Unterschied von einem Pixel auftreten.

Um das zu verhindern, müßtest Du den Code in "GetPic" in zwei Funktionen aufteilen.
Eine Funktion, die jeweils die eingepaßte Bildgröße berechnet und als Parameter zurück
gibt (t,l,w,h). Diese Werte bei beiden Bildern sind zu vergleichen und ggf. anzupassen.
Der zweiten Funktion, sind diese angepaßten Größen als Parameter zu übergeben und
das Bild ist zu zeichnen. Eines der beiden Bilder wird dadurch um einen Pixel
gestreckt.

Windows-Forms-Formular:
Public Class frmFader
 
 
    Dim pic_size As New Size(1920, 1080)
 
    Dim bmp1, bmp2 As Bitmap
 
    Dim pb As New PictureBox With {.Parent = Me, 
        .Size = New Drawing.Size(400, 400),
        .Top = 10, .Left = 10, 
        .SizeMode = PictureBoxSizeMode.Zoom}
 
    Dim WithEvents tm As New Timer With {.Interval = 500, .Enabled = False}
 
 
    Private Sub frmFader_Load(sender As Object, e As EventArgs) Handles _
      MyBase.Load
 
 
        Dim r1 As Rectangle = GetPicRect("G:\daten\x1.jpg", pic_size)
        Dim r2 As Rectangle = GetPicRect("G:\daten\x2.jpg", pic_size)
 
        If Math.Abs(r1.Width - r2.Width) < 3 And 
            Math.Abs(r1.Height - r2.Height) < 3 Then
            r2 = r1
        End If
 
        bmp1 = DrawPic("G:\daten\x1.jpg", pic_size, r1)
        bmp2 = DrawPic("G:\daten\x2.jpg", pic_size, r2)
 
        tm.Enabled = True
    End Sub
 
 
    Private Function GetPicRect(filename As String, picsize As Size) As _
      Rectangle
        Dim w, h, l, t As Integer
        Using bmp As New Bitmap(filename)
            'erforderliche Bildgröße berechnen (Zoomen)
 
            w = CInt(bmp.Width * picsize.Height / bmp.Height)
            h = picsize.Height
            If w > picsize.Width Then
                h = CInt(bmp.Height * picsize.Width / bmp.Width)
                w = picsize.Width
            End If
            'Bild zentrieren
            l = (picsize.Width - w) \ 2
            t = (pic_size.Height - h) \ 2
        End Using
 
        Return New Rectangle(l, t, w, h)
    End Function
 
 
    Private Function DrawPic(filename As String, picsize As Size, 
        picrect As Rectangle) As Bitmap
 
        Dim bmpout As New Bitmap(picsize.Width, pic_size.Height)
 
        Using bmp As New Bitmap(filename)
            'Ausgabebitmap
 
            'Geladenes Bild in erforderlicher Größe neu zeichnen
            Using gout As Graphics = Graphics.FromImage(bmpout)
                gout.InterpolationMode =
                    Drawing2D.InterpolationMode.HighQualityBicubic
                gout.Clear(Color.LightGray)
                gout.DrawImage(bmp,
                            picrect,
                            New Rectangle(0, 0, bmp.Width, bmp.Height),
                            GraphicsUnit.Pixel)
            End Using
        End Using
        Return bmpout
    End Function
 
 
    Private Sub Fade(ByVal Alpha As Single)
        Dim ColMat As New System.Drawing.Imaging.ColorMatrix _
        With {.Matrix33 = Alpha}            ' 
 
        Using bmp As New Bitmap(pic_size.Width, pic_size.Height),
                g As Graphics = Graphics.FromImage(bmp),
                imgAtt As New System.Drawing.Imaging.ImageAttributes
 
            imgAtt.SetColorMatrix(ColMat)
 
            ' Bild deckend in Buffer zeichnen
            g.DrawImage(bmp1, 0, 0)
            ' neues Bild transparent
            ' in Buffer zeichnen
            Dim r As New Rectangle(0, 0, pic_size.Width, pic_size.Height)
            g.DrawImage(bmp2, r, 0, 0, pic_size.Width, pic_size.Height,
                        GraphicsUnit.Pixel, imgAtt)
 
            If pb.Image IsNot Nothing Then pb.Image.Dispose()
            pb.Image = DirectCast(bmp.Clone, Bitmap)
        End Using
 
    End Sub
 
 
    Private Sub tm_Tick(sender As Object, e As EventArgs) Handles tm.Tick
 
        Static alpha As Single = 0
        alpha += CSng(0.1)
        If alpha > 1 Then alpha = 0
        Fade(alpha)
    End Sub
 
End Class
alle Nachrichten anzeigenGesamtübersicht  |  Zum Thema  |  Suchen

 ThemaViews  AutorDatum
Bild auf Bild einblenden138Dikn22.06.20 11:57
Re: Bild auf Bild einblenden68Manfred X22.06.20 13:14
Bild-Datei zentriert in eine vorgegebene Fläche einpassen63Manfred X22.06.20 14:15
Re: Bild auf Bild einblenden29Dikn23.06.20 13:41
Re: Bild auf Bild einblenden48Manfred X23.06.20 16:35
Re: Bild auf Bild einblenden16Dikn25.06.20 12:26
Animation: Bild in Picturebox verschieben29Manfred X25.06.20 13:34
Re: Bild auf Bild einblenden13Dikn26.06.20 08:48
Re: Bild auf Bild einblenden18Manfred X26.06.20 11:40
Animation: Bild über Bild schieben20Manfred X26.06.20 12:26
Re: Bild auf Bild einblenden15Dikn28.06.20 13:50
Re: Bild auf Bild einblenden11Dikn28.06.20 14:04

Sie sind nicht angemeldet!
Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.

Einloggen  |  Neu registrieren

Funktionen:  Zum Thema  |  GesamtübersichtSuchen 

nach obenzurück
 
   

Copyright ©2000-2020 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