vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Mails senden, abrufen und decodieren - ganz easy ;-)  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück

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

VB.NET - Fortgeschrittene
Re: Bilder überblenden - Beispiel 
Autor: Manfred X
Datum: 26.05.20 10:19

Hallo!

Wenn Du Bilder mit unterschiedlichen Seitenverhältnissen durch einen Zoom
in der Größe einander anpasst, erhälst Du entweder oben/unten oderlinks/rechts
einen Rand.
Um das zu vermeiden, mußt Du überstehende Bereiche der Bilder abschneiden.
Das erledigt folgende Routine.

 ''' <summary>Bilddatei in einer vorgegebenen Größe einpassen 
 ''' (Ränder werden ggf. abgeschnitten) 
 ''' </summary>
 ''' <param name="file">Bilddatei</param>
 ''' <param name="sz">Zielgröße (Breite, Höhe in Pixel)</param>
 ''' <param name="pixfmt">Pixelformat des Ausgabe-Bildes</param>
 Public Shared Function LoadPic(ByVal file As String, ByVal sz As Size,
           Optional ByVal CutMode As CutModeEnum = CutModeEnum.center,
           Optional ByVal pixfmt As PixelFormatEnum =
           PixelFormatEnum.Format24bppRgb) As Bitmap
 
     Dim adj_width, adj_height, adj_top, adj_left As Integer
     Dim bmp_out As Bitmap = Nothing
     Try
        If sz.Width < 10 Or sz.Height < 10 Then Return Nothing
        Dim sv As Double = sz.Width / sz.Height
 
        Using bmp_in As New Bitmap(file)
            Dim bsv As Double = bmp_in.Width / bmp_in.Height
            If sv < bsv Then
               'Bild ist für Display-Size zu breit
               adj_width = CInt(bmp_in.Height * sv)
               adj_height = bmp_in.Height
               If CutMode = CutModeEnum.center Then
                   adj_left = (bmp_in.Width - adj_width) \ 2
               ElseIf CutMode = CutModeEnum.topleft Then
                   adj_left = bmp_in.Width - adj_width
               ElseIf CutMode = CutModeEnum.bottomright Then
                   adj_left = 0
               ElseIf cutmode = CutModeEnum.topleft25 Then
                   adj_left = CInt(0.25 * (bmp_in.Width - adj_width))
               ElseIf cutmode = CutModeEnum.bottomright25 Then
                   adj_left = CInt(0.75 * (bmp_in.Width - adj_width))
               End If
            Else
               'Bild ist für Display eventuell zu hoch
               adj_height = CInt(bmp_in.Width / sv)
               adj_width = bmp_in.Width
               If CutMode = CutModeEnum.center Then
                   adj_top = (bmp_in.Height - adj_height) \ 2
               ElseIf CutMode = CutModeEnum.topleft Then
                   adj_top = bmp_in.Height - adj_height
               ElseIf CutMode = CutModeenum.bottomright Then
                   adj_top = 0
               ElseIf CutMode = CutModeEnum.topleft25 Then
                   adj_top = CInt(0.25 * (bmp_in.Height - adj_height))
               ElseIf CutMode = CutModeEnum.bottomright25 Then
                   adj_top = CInt(0.75 * (bmp_in.Height - adj_height))
               End If
           End If
 
           'Ausgabe-Bitmap in gewünschter Größe und Format
           bmp_out = New Bitmap _
            (sz.Width, sz.Height, CType(pixfmt, Imaging.PixelFormat))
           Dim dest_rect As New Rectangle(0, 0, sz.Width, sz.Height)
 
           'erforderlichen Ausschnitt des Bildes definieren
           Dim src_rect As New Rectangle(adj_left, adj_top,
                          adj_width, adj_height)
 
           Using g As Graphics = Graphics.FromImage(bmp_out)
              'qualitative hochwertige Anpassung
              g.InterpolationMode = _
                Drawing2D.InterpolationMode.HighQualityBicubic
              'ggf. Zoomen und Zuschneiden
              g.DrawImage(bmp_in, dest_rect, src_rect, GraphicsUnit.Pixel)
          End Using
 
        End Using
     Catch ex As exception
        If bmp_out IsNot Nothing Then bmp_out.Dispose()
        bmp_out = Nothing
     End Try
 
     Return bmp_out
 
End Function
Benötigte Enumerationen:

    ''' <summary>Position der abgeschnittenen Streifen
    ''' </summary>
    Public Enum CutModeEnum
        center = 0
        topleft = 1
        bottomright = 2
        topleft25 = 3
        bottomright25 = 4
    End Enum
 
    Public Enum PixelFormatEnum
        Format16bppRgb555 = Imaging.PixelFormat.Format16bppRgb555        '
        Format16bppRgb565 = PixelFormat.Format16bppRgb565
        Format24bppRgb = PixelFormat.Format24bppRgb
        Format32bppRgb = PixelFormat.Format32bppRgb
        Format32bppPArgb = PixelFormat.Format32bppPArgb
        Format48bppRgb = PixelFormat.Format48bppRgb
        Format64bppPArgb = PixelFormat.Format64bppPArgb
        Format32bppArgb = PixelFormat.Format32bppArgb
        Format64bppArgb = PixelFormat.Format64bppArgb
    End Enum
alle Nachrichten anzeigenGesamtübersicht  |  Zum Thema  |  Suchen

 ThemaViews  AutorDatum
Bilder überblenden1.158Dikn22.05.20 12:35
Re: Bilder überblenden587Manfred X23.05.20 21:18
Re: Bilder überblenden516Dikn24.05.20 07:48
Bilder überblenden - Beispiel517Manfred X24.05.20 10:09
Re: Bilder überblenden - Beispiel490Dikn26.05.20 09:26
Re: Bilder überblenden - Beispiel513Manfred X26.05.20 10:19
Re: Bilder überblenden667Dikn28.05.20 10:17
Re: Bilder überblenden648Kuno6028.05.20 14:05
Re: Bilder überblenden520Dikn29.05.20 08:23

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-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