✔ JPEG-Bild an PictureBox anpassen

[Yoah]

Moin,

bin gerade an einem kleinem Projekt und stehe vor einem
Problem, und komme einfach nicht darauf.

Ich möchte ein Bild, mit beliebiger Größe (z.B.: 1200px x 800px) an eine
PictureBox, die eine wesentlich kleinere Größe hat, anpassen.

Hat vielleicht jemand eine Idee, wie ich das programmieren könnte?

 

[Orakel]

Hi Yoah,

da haste Glück, dass ich sowas noch auf meiner Platte hab Wenn Du das in einem Vernünftigen Verhältnis machen möchtest, must Du wohl oder übel das Bild auf Deine Picturebox pinseln (also ich nehm dazu immer sehr weiche Pinsel um den Bildschirm nicht zu beschädigen )

Option Explicit

Private Sub Command1_Click()
    Dim pTempPicture                        As IPictureDisp
    Dim nWidth                              As Integer
    Dim nHeight                             As Integer
    Dim nTop                                As Integer
    Dim nLeft                               As Integer
    Dim dScaleFactor                        As Double

    Rem ===================================================
    Rem == Das Bild in den Speicher holen.               ==
    Rem ===================================================
    Set pTempPicture = LoadPicture("Dein_Bild_auf_der_Platte.jpg")

    Rem ===================================================
    Rem == IPictureDisp gibt die Höhe und Breite in      ==
    Rem == Himetric an. Umwandeln in Pixel.              ==
    Rem ===================================================
    Picture1.ScaleMode = vbPixels
    nWidth = ScaleX(pTempPicture.Width, vbHimetric, vbPixels)
    nHeight = ScaleY(pTempPicture.Height, vbHimetric, vbPixels)

    Rem ===================================================
    Rem == Über welche Achse muss skaliert werden?       ==
    Rem ===================================================
    With Picture1
        If (nWidth - .ScaleWidth) > (nHeight - .ScaleHeight) Then
            dScaleFactor = .ScaleWidth / nWidth
        Else
            dScaleFactor = .ScaleHeight / nHeight
        End If

        Rem ===============================================
        Rem == Das Bild nun auf die Picturebox bringen.  ==
        Rem ===============================================
        .Picture = LoadPicture()
        .Cls
        nWidth = nWidth * dScaleFactor
        nHeight = nHeight * dScaleFactor
        nTop = (.ScaleHeight - nHeight) / 2
        nLeft = (.ScaleWidth - nWidth) / 2
        Picture1.PaintPicture pTempPicture, nLeft, nTop, nWidth, nHeight
    End With

    Rem ===================================================
    Rem == Ein bischen Müll beseitigen.                  ==
    Rem ===================================================
    Set pTempPicture = LoadPicture()
    Set pTempPicture = Nothing
End Sub

Gruß
Das Orakel

 

[Yoah]

ThanX,

die Funktion wirkt auf anhieb!

Nur, dass ich, wenn ich ein neues Bild haben möchte, erst mit Tippex über den Bildschirm muss!

 

[Shakie]

Tippex bekommst du mit:

Picture1.Cls
bzw. mit
Set Picture1.Picture = Nothing

Edit: Evtl. das "Set" weglassen, hab's nur aus dem Kopf hingeschrieben