Zum Inhalt springen

Bild in PictureBox angepasst


Empfohlene Beiträge

Geschrieben

Guten Morgen allerseits,

meinereiner codet seit ca3Wochen bischen an einem kleines Progi, aber an einem Problemchen komm ich nicht weiter...

Ich will ein Bild (egal ob jpg, bmp ...) in einer PictureBox anzeigen. Problem das Bild ist wesentlich größer als die Picturebox, soll aber komplett in der PictureBox angezeigt werden ohne das die Größe der PictureBox sich verändert. Also so ähnlich wie ein Thumbnail.

Ich bekomm´s einfach nicht auf die Reihe. :(

Würde mich über Tips/Hilfe/Beispiele freuen!!!:)

Geschrieben

Nur mal ne Frage: Kannst Du kein Image-Element nehmen? Dieses hätte die Eigenschaft "streched", das Du auf true setzen könntest. Die gängigen Bildformate (jpg, gif, bmp) kannst Du auch in diesem laden.

Geschrieben

Das Imageobjekt hat eine Eigenschaft Picture. AFAIK kann man bmp-, emf-, gif-, ico-, jpg- und wmf-Dateien damit anzeigen. (Wobei man sagen muss, das man die bewegten gif-Dateien, also mit mehreren Layern, nicht so ohne weiteres anzeigen lassen kann, bzw. nur den ersten Layer/das erste Frame)

Geschrieben
Original geschrieben von LoneGunman

Nur mal ne Frage: Kannst Du kein Image-Element nehmen? Dieses hätte die Eigenschaft "streched", das Du auf true setzen könntest. Die gängigen Bildformate (jpg, gif, bmp) kannst Du auch in diesem laden.

nur wäre dann noch das Problem, dass nicht alle bilder gleich hoch und breit sind, bzw. das selbe seitenlängenverhältnis haben, desswegen werden einige bilder verzerrt werden... da müsste man noch ne zusatzfunktion schreiben

Geschrieben

Hier mal ein Quick & Dirty Programm, das ich mal zu Übungszwecken geschrieben habe.


'frmMain.frm mit einer FileListBox 'fileEasyView', CommonDialog 'cdEasyView', einem Image 'imgAnzeige' und ein paar Menueinträgen

Option Explicit


Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

    If KeyCode = 33 Then Call modEasyView.give_prev_file(arrFileList, strDateinameVar)

    If KeyCode = 34 Then Call modEasyView.give_next_file(arrFileList, strDateinameVar)

End Sub


Private Sub Form_KeyPress(KeyAscii As Integer)

    'EasyView beenden

    If KeyAscii = vbKeyEscape Then Call mmEasyViewBeenden_Click

    'nächstes Bild laden

    If KeyAscii = vbKeySpace Then Call modEasyView.give_next_file(arrFileList, strDateinameVar)

    If KeyAscii = 43 Then

        'Bild vergrössern

        frmMain.imgAnzeige.Width = frmMain.imgAnzeige.Width * 1.2

        frmMain.imgAnzeige.Height = frmMain.imgAnzeige.Height * 1.2

        Call modEasyView.set_full_size(frmMain)

        Call modEasyView.keep_min_size(frmMain)

        Call modEasyView.set_in_middle_screen(frmMain)

    End If

    If KeyAscii = 45 Then

        'Bild verkleinern

        frmMain.imgAnzeige.Width = frmMain.imgAnzeige.Width / 1.2

        frmMain.imgAnzeige.Height = frmMain.imgAnzeige.Height / 1.2

        Call modEasyView.set_full_size(frmMain)

        Call modEasyView.keep_min_size(frmMain)

        Call modEasyView.set_in_middle_screen(frmMain)

    End If

    If KeyAscii = 42 Then

        frmMain.imgAnzeige.Width = modEasyView.longWidth

        frmMain.imgAnzeige.Height = modEasyView.longHeight

        Call modEasyView.set_full_size(Me)

        Call modEasyView.set_in_middle_screen(Me)

    End If

    If KeyAscii = 118 Then

        frmMain.imgAnzeige.Height = Screen.Height

        frmMain.imgAnzeige.Width = frmMain.imgAnzeige.Height / modEasyView.singRatio

        modEasyView.set_full_size (Me)

    End If

    If KeyAscii = 115 Then

        Me.imgAnzeige.Stretch = Not Me.imgAnzeige.Stretch

        Me.Refresh

    End If

End Sub


Private Sub Form_Load()

    'Falls das Programm über die Bilddatei gestartet wurde steht im Command$ der Name der Datei als Parameter

    If Trim(Command$) <> "" Then

        Call modEasyView.lade_bild(Me, Command$)

    End If

End Sub


Private Sub imgAnzeige_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

    If Button = 1 Then frmMain.MousePointer = 99

End Sub


Private Sub Form_Resize()

    If Trim(modEasyView.strDateinameVar) <> "" Then

        If Me.WindowState <> 1 Then

            'Call modEasyView.keep_min_size(Me)

            'Call modEasyView.set_full_size(Me)

        End If

    End If

End Sub


Private Sub imgAnzeige_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

    If Button = 1 Then frmMain.MousePointer = 0

End Sub


Private Sub mmEasyViewBeenden_Click()

    Unload Me

    End

End Sub


Private Sub mmEasyViewBildLaden_Click()

    cdEasyView.FileName = ""

    cdEasyView.Filter = "Alle Bilddateien |*.bmp;*.ico;*.wmf;*.emf;*.jpg;*.jpe;*.jpeg;*.gif|Bitmapdateien (*.bmp)|*.bmp|Symboldateien (*.ico)|*.ico|Windows Metafile (*.wmf)|*.wmf|erweitertes Metafile (*.emf)|*.emf|JPEG - Bilddateien (*.jpg;*.jpeg;*.jpe)|*.jpg;*.jpeg;*.jpe|GIF - Bilddateien (*.gif)|*.gif"

    cdEasyView.InitDir = App.Path

    cdEasyView.ShowOpen

    If modEasyView.datei_vorhanden(cdEasyView.FileName) Then

        fileEasyView.Path = get_path(cdEasyView.FileName)

        Call modEasyView.lade_bild(Me, cdEasyView.FileName)

    End If

End Sub


Private Sub mmInfoUeberEasyView_Click()

    MsgBox App.Title & " V" & App.Major & "." & App.Minor & "." & App.Revision & vbNewLine & vbNewLine & Chr(169) & " by Alexander Köhn", vbInformation, "Über EasyView"

End Sub


'modEasyView.bas'

Option Explicit

Public arrFileList() As String 'Liste aller Bilddateien im aktuellen Verzeichnis

Public strDateinameVar As String 'Name des aktuellen Bildes

Private fsoEasyView As New FileSystemObject

Public longHeight As Long

Public longWidth As Long

Public singRatio As Single


Public Sub lade_bild(ByRef frmMain As Form, ByVal strDateiname As String)

Dim strDateinameKurz As String

Dim arrTemp() As String

    frmMain.imgAnzeige.Stretch = False

    'Aufbereiten des relativen Dateinamens

    arrTemp = Split(strDateiname, "\")

    strDateinameKurz = arrTemp(UBound(arrTemp))

    'Laden des Bildes und anpassen

    Set frmMain.imgAnzeige = LoadPicture(strDateiname)

    'Passe das Fenster an die Bildgröße an

    Call set_full_size(frmMain)

    'Behalte jedoch eine Mindestgröße

    'Call keep_min_size(frmMain)

    'Setze das Fenster in die Mitte des Bildschirms

    Call set_in_middle_screen(frmMain)

    'Evtl. Scrollbars

    'Call config_picture(frmMain)

    'Erstelle eine Liste mit allen Bilddateien im aktuellen Verzeichnis

    Call generate_filelist(arrFileList, strDateiname)

    'Anzeige des relativen Dateinamens

    frmMain.Caption = "EasyView - " & strDateinameKurz

    strDateinameVar = strDateiname

    longHeight = frmMain.imgAnzeige.Height

    longWidth = frmMain.imgAnzeige.Width

    singRatio = longHeight / longWidth

End Sub


Public Sub keep_in_middle(ByRef frmMain As Form)

    'Setzen des Imageobjektes in die Mitte der Form

    frmMain.imgAnzeige.Left = frmMain.Width \ 2 - frmMain.imgAnzeige.Width \ 2 - 50

    frmMain.imgAnzeige.Top = frmMain.Height \ 2 - frmMain.imgAnzeige.Height \ 2 - 350

End Sub


Public Sub set_full_size(ByRef frmMain As Form)

    'Anpassen der Formbreite und -höhe an das Bild

    frmMain.Width = frmMain.imgAnzeige.Width + 60

    frmMain.Height = frmMain.imgAnzeige.Height + 690

    'frmMain.imgAnzeige.Width = frmMain.Width - 60

    'frmMain.imgAnzeige.Height = frmMain.Height - 690

    frmMain.imgAnzeige.Stretch = True

    frmMain.Refresh

End Sub


Public Sub set_in_middle_screen(ByRef frmMain As Form)

    'Setzen der Form in die Mitte des Bildschirms

    frmMain.Left = Screen.Width \ 2 - frmMain.Width \ 2

    frmMain.Top = Screen.Height \ 2 - frmMain.Height \ 2

End Sub


Public Sub keep_min_size(ByRef frmMain As Form)

    'Behalten einer Mindestgröße

    If frmMain.Width < 2450 Then frmMain.Width = 2450

    If frmMain.Height < 2880 Then frmMain.Height = 2880

End Sub


Public Sub generate_filelist(ByRef arrFileListIntern() As String, ByVal strDateiname As String)

'Generierung eines Array mit allen Bilddateien im aktuellen Verzeichnis

Dim strDirName As String

Dim strDateinameKurz As String

Dim arrTemp() As String

Dim intLauf As Integer

    ReDim arrFileListIntern(0)

    arrTemp = Split(strDateiname, "\")

    strDateinameKurz = arrTemp(UBound(arrTemp))

    strDirName = Left(strDateiname, Len(strDateiname) - Len(strDateinameKurz))

    For intLauf = 0 To frmMain.fileEasyView.ListCount - 1

        If LCase(Right(frmMain.fileEasyView.List(intLauf), 4)) = ".bmp" Or _

            LCase(Right(frmMain.fileEasyView.List(intLauf), 4)) = ".ico" Or _

            LCase(Right(frmMain.fileEasyView.List(intLauf), 4)) = ".wmf" Or _

            LCase(Right(frmMain.fileEasyView.List(intLauf), 4)) = ".emf" Or _

            LCase(Right(frmMain.fileEasyView.List(intLauf), 4)) = ".jpg" Or _

            LCase(Right(frmMain.fileEasyView.List(intLauf), 4)) = ".jpe" Or _

            LCase(Right(frmMain.fileEasyView.List(intLauf), 5)) = ".jpeg" Or _

            LCase(Right(frmMain.fileEasyView.List(intLauf), 4)) = ".gif" Then

            arrFileListIntern(UBound(arrFileListIntern)) = frmMain.fileEasyView.List(intLauf)

            ReDim Preserve arrFileListIntern(UBound(arrFileListIntern) + 1)

        End If

    Next intLauf

On Error Resume Next

    ReDim Preserve arrFileListIntern(UBound(arrFileListIntern) - 1)

On Error GoTo 0

    arrFileList = arrFileListIntern

End Sub


Public Sub give_next_file(ByRef arrFileListIntern() As String, ByVal strDateiname As String)

'Laden des nächsten Bildes im Verzeichnis

Dim intPos As Integer

Dim arrTemp() As String

Dim strDateinameKurz As String

    arrTemp = Split(strDateiname, "\")

    strDateinameKurz = arrTemp(UBound(arrTemp))

    intPos = 0

    While (strDateinameKurz <> arrFileListIntern(intPos)) And Not (intPos = UBound(arrFileListIntern))

        intPos = intPos + 1

    Wend

    If intPos > UBound(arrFileListIntern) Then intPos = UBound(arrFileListIntern)

    intPos = intPos + 1

    If intPos > UBound(arrFileListIntern) Then intPos = 0

    Call lade_bild(frmMain, Replace(strDateiname, strDateinameKurz, arrFileListIntern(intPos)))

End Sub


Public Sub give_prev_file(ByRef arrFileListIntern() As String, ByVal strDateiname As String)

'Laden des nächsten Bildes im Verzeichnis

Dim intPos As Integer

Dim arrTemp() As String

Dim strDateinameKurz As String

    arrTemp = Split(strDateiname, "\")

    strDateinameKurz = arrTemp(UBound(arrTemp))

    intPos = UBound(arrFileListIntern)

    While (strDateinameKurz <> arrFileListIntern(intPos)) And Not (intPos = LBound(arrFileListIntern))

        intPos = intPos - 1

    Wend

    If intPos < LBound(arrFileListIntern) Then intPos = LBound(arrFileListIntern)

    intPos = intPos - 1

    If intPos < LBound(arrFileListIntern) Then intPos = UBound(arrFileListIntern)

    Call lade_bild(frmMain, Replace(strDateiname, strDateinameKurz, arrFileListIntern(intPos)))

End Sub


Public Function datei_vorhanden(ByVal strDateiname As String) As Boolean

    datei_vorhanden = fsoEasyView.FileExists(strDateiname)

End Function


Public Function get_path(ByVal strDateiname) As String

'Liefert nur den Pfad zu einem absoluten Dateinamen

Dim arrTemp() As String

Dim strDateinameKurz As String

    arrTemp = Split(strDateiname, "\")

    strDateinameKurz = arrTemp(UBound(arrTemp))

    get_path = Replace(strDateiname, strDateinameKurz, "")

End Function

Dein Kommentar

Du kannst jetzt schreiben und Dich später registrieren. Wenn Du ein Konto hast, melde Dich jetzt an, um unter Deinem Benutzernamen zu schreiben.

Gast
Auf dieses Thema antworten...

×   Du hast formatierten Text eingefügt.   Formatierung wiederherstellen

  Nur 75 Emojis sind erlaubt.

×   Dein Link wurde automatisch eingebettet.   Einbetten rückgängig machen und als Link darstellen

×   Dein vorheriger Inhalt wurde wiederhergestellt.   Editor leeren

×   Du kannst Bilder nicht direkt einfügen. Lade Bilder hoch oder lade sie von einer URL.

Fachinformatiker.de, 2024 by SE Internet Services

fidelogo_small.png

Schicke uns eine Nachricht!

Fachinformatiker.de ist die größte IT-Community
rund um Ausbildung, Job, Weiterbildung für IT-Fachkräfte.

Fachinformatiker.de App

Download on the App Store
Get it on Google Play

Kontakt

Hier werben?
Oder sende eine E-Mail an

Social media u. feeds

Jobboard für Fachinformatiker und IT-Fachkräfte

×
×
  • Neu erstellen...