Memposisikan Gambar

Pernah mencoba menampilkan gambar pada PictureBox? Anda pasti pernah menemukan masalah, ketika ingin menampilkan gambar dengan ukuran melebihi ukuran PictureBox atau ukuran form. Ini solusinya.

Buat project baru (biar gampang, pakai pola VBEnterprise Edition Controls), tambahkan sebuah module.

Buka form, sisipkan sebuah PictureBox, namai dengan "picTarget", ubah properti "AutoRedraw" menjadi "True". Tambahkan kontrol CommonDialog, ganti namanya dengan "cDlg". Terakhir tambahkan kontrol CommandButton, namai dengan "cmdBuka".

Ketik kode ini di Module

Code:


Sub PosisikanGambar(NamaFile$, picSumber As Object, _
picTarget As Object)
    Dim MaxWidth As Double
    Dim MaxHeight As Double
 
    Dim LebarAwal As Long
    Dim TinggiAwal As Long
    Dim LebarAkhir As Long
    Dim TinggiAkhir As Long
   
    Dim i As Double
   
    picSumber.Width = 50
    picSumber.Height = 50
    picSumber.AutoSize = True
    picTarget.AutoRedraw = True
   
    'Mengkosongkan Picture
    Set picSumber.Picture = Nothing
    Set picTarget.Picture = Nothing
   
    'Membersihkan PictureBox
    picSumber.Cls
    picTarget.Cls
   
    'Menampilkan gambar terpilih
    picSumber.Picture = LoadPicture(NamaFile$)
    picSumber.AutoSize = True
   
    'Pembatasan ukuran
    MaxWidth = picTarget.Width
    MaxHeight = picTarget.Height
   
    'Tentukan ukuran awal gambar
    LebarAwal = picSumber.Width
    TinggiAwal = picSumber.Height
   
    'Tentukan ukuran akhir gambar
    LebarAkhir = LebarAwal
    TinggiAkhir = TinggiAwal
       
    i = 1
   
    picTarget.ScaleMode = 1
   
    'Jika lebar gambar lebih besar
    'dari atau sama dengan tinggi gambar
    If LebarAwal >= TinggiAwal Then
       
        'Jika lebar akhir lebih kecil dari
        'atau sama dengan batas lebar
        If LebarAkhir <= MaxWidth Then
           
            'Jika tinggi akhir lebih kecil dari
            'atau sama dengan batas tinggi
            If TinggiAkhir <= MaxHeight Then
           
                'Gambarkan di tengah-tengah PictureBox
                picTarget.PaintPicture picSumber.Picture, _
                    (MaxWidth - LebarAkhir) / 2, _
                    (MaxHeight - TinggiAkhir) / 2, _
                    LebarAkhir, TinggiAkhir
                Set picTarget.Picture = picTarget.Image
            Else
                'Lakukan pengulangan
                'tinggi awal gambar tidak
                'melampaui bats tinggi
               
                Do While (TinggiAwal >= MaxHeight)
                i = i + 0.001
               
                'Memperkecil tinggi dan lebar gambar
                TinggiAkhir = TinggiAkhir / i
                LebarAkhir = LebarAkhir / i
               
                'Jika tinggi akhir kurang dari
                'atau sama dengan batas tinggi
                If TinggiAkhir <= MaxHeight Then
                   
                    'Gambarkan di tengah-tengah PictureBox
                    picTarget.PaintPicture picSumber.Picture, _
                    (MaxWidth - LebarAkhir) / 2, _
                    (MaxHeight - TinggiAkhir) / 2, _
                    LebarAkhir, TinggiAkhir
                   
                    'Set nilai properti Picture
                    Set picTarget.Picture = picTarget.Image
                   
                    'Hentikan pengulangan
                    Exit Do
                End If
               
                    DoEvents
                Loop
            End If
        'Jika lebar akhir lebih besar dari
        'batas lebar
        Else
            Do While (LebarAkhir >= MaxWidth)
                i = i + 0.001
                LebarAkhir = LebarAkhir / i
                TinggiAkhir = TinggiAkhir / i
                If LebarAkhir <= MaxWidth Then
                    picTarget.PaintPicture picSumber.Picture, _
                    (MaxWidth - LebarAkhir) / 2, _
                    (MaxHeight - TinggiAkhir) / 2, _
                    LebarAkhir, TinggiAkhir
                    Set picTarget.Picture = picTarget.Image
                    Exit Do
                End If
               
                DoEvents
            Loop
        End If
   
    'Jika lebar gambar lebih kecil
    'dari tinggi gambar
    Else
        If TinggiAkhir <= MaxHeight Then
            If LebarAkhir <= MaxWidth Then
                picTarget.PaintPicture picSumber.Picture, _
                    (MaxWidth - LebarAkhir) / 2, _
                    (MaxHeight - TinggiAkhir) / 2, _
                    LebarAkhir, TinggiAkhir
                    Set picTarget.Picture = picTarget.Image
            Else
                Do While (LebarAkhir >= MaxWidth)
                i = i + 0.001
                LebarAkhir = LebarAkhir / i
                TinggiAkhir = TinggiAkhir / i
                If LebarAkhir <= MaxWidth Then
                    picTarget.PaintPicture picSumber.Picture, _
                    (MaxWidth - LebarAkhir) / 2, _
                    (MaxHeight - TinggiAkhir) / 2, _
                    LebarAkhir, TinggiAkhir
                    Set picTarget.Picture = picTarget.Image
                    Exit Do
                End If
                DoEvents
            Loop
            End If
        Else
            Do While (TinggiAwal >= MaxHeight)
                i = i + 0.001
               
                TinggiAkhir = TinggiAkhir / i
                LebarAkhir = LebarAkhir / i
               
                If TinggiAkhir <= MaxHeight Then
                    picTarget.PaintPicture picSumber.Picture, _
                    (MaxWidth - LebarAkhir) / 2, _
                    (MaxHeight - TinggiAkhir) / 2, _
                    LebarAkhir, TinggiAkhir
                    Set picTarget.Picture = picTarget.Image
                    Exit Do
                End If
               
                DoEvents
            Loop
        End If
    End If
   
    picTarget.Width = MaxWidth
    picTarget.Height = MaxHeight
End Sub


Yang ini di form:

Code:


Option Explicit

Dim NamaFile As String
Dim ctl As Control

Private Sub cmdGambar_Click()
    With Me.cDlg
        .DialogTitle = "Buka Gambar"
        .FileName = NamaFile
        .Filter = "Semua Gambar|*.jpg;*.bmp;*.gif;*.ico;"
        NamaFile = .FileName
        .ShowOpen
        If .FileName <> "" Then
            NamaFile = .FileName
            PosisikanGambar NamaFile, ctl, Me.picTarget
        End If
    End With
End Sub

Private Sub Form_Load()
    'Buat PictureBox bayangan
    Set ctl = Me.Controls.Add("VB.PictureBox", "picSumber")
    Set ctl = Me.Controls("picSumber")
End Sub

Private Sub Form_Resize()
    If Me.WindowState <> vbMinimized Then
        Me.picTarget.Width = Me.ScaleWidth - 2 * Me.picTarget.Left
        Me.picTarget.Height = Me.ScaleHeight - Me.picTarget.Top - 60
        If NamaFile <> "" Then
            PosisikanGambar NamaFile, ctl, Me.picTarget
        End If
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    'Hapus PictureBox bayangan
    Set ctl = Nothing
End Sub