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

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)
                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 = 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)
                i = i + 0.001
                LebarAkhir = LebarAkhir / i
                TinggiAkhir = TinggiAkhir / i
                If LebarAkhir = 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:

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

Perihal Novian Agung
Pengangguran

Tinggalkan Balasan

Isikan data di bawah atau klik salah satu ikon untuk log in:

Logo WordPress.com

You are commenting using your WordPress.com account. Logout / Ubah )

Gambar Twitter

You are commenting using your Twitter account. Logout / Ubah )

Foto Facebook

You are commenting using your Facebook account. Logout / Ubah )

Foto Google+

You are commenting using your Google+ account. Logout / Ubah )

Connecting to %s

%d blogger menyukai ini: