Menghias MDIForm dengan Logo

Agar MDIForm Anda tidak terlihat membosankan atau biasa saja. Anda bisa saja memberinya sedikit hiasan logo pada MDIForm ini. Bagaimana caranya? Sementara kita tahu kalau MDIForm itu salah satu form yang “rewel”. Kenapa dikatakan demikian? Karena tidak sembarang kontrol yang bisa diletakkan di dalam MDIForm, hanya kontrol-kontrol yang invisible (tidak ditampilkan ketika runtime, seperti Timer, ImageList, dsb) atau kontrol yang memiliki properti Alignment, seperti (TextBox, ComboBox, dsb). Kontrol Image tidak akan dapat Anda letakkan di dalam MDIForm, lalu bagaimana cara menambahkan logo pada MDIForm? Dengan mengubah properti Picture-nya? Ya, bisa saja dengan cara seperti itu, cuma kurang menarik tampaknya, kita tidak dapat memodifikasi tampilan logo (seperti agar selalu berada di tengah-tengah, atau luas nya mengikuti ukuran MDIForm tersebut)

Bagaimana pemecahannya? Ada satu trik menarik, yaitu dengan menambahkan form anak, dimana form anak ini yang akan dimodifikasi. Untuk lebih jelasnya, ikuti panduan berikut ini.

Buatlah project baru, tambahkan MDIForm ke dalam project, tambahkan form baru, pada dialog yang ditampilkan, pilih “Splash Screen”, ubah properti MDIChild menjadi True. Modifikasi tata letak kontrol pada frmSplash sesuai keinginan Anda!

Tambahkan sebuah PictureBox, namai dengan “picMe”, ubah properti AutoRedraw menjadi True. Di dalam picMe, gambarkan sebuah PictureBox (klik tombol PictureBox pada ToolBox, lakukan dragging di dalam picMe. Namai PictureBox baru tersebut dengan nama picAdo ubah properti AutoRedraw menjadi True

Tambahkan Timer, ubah nama menjadi “tmrJam”, set Interval menjadi 500.

Tampilan akhir, kurang lebih seperti ini:

Online  Free Image Share Hosting

Ketik kode di bawah ini di frmSplash:

Option Explicit
DefSng A-Z
Dim Waktu As Date
Dim Jno, Mno, Dno
Dim Jwarna, Mwarna, DWarna
Dim Jlen, Mlen, DLen
Const PI = 3.14159265358979
Const Pi2 = PI + PI
Const PiSt = PI / 2

Private Sub Form_Activate()
    Me.ZOrder 1
End Sub

Private Sub Form_Load()
    On Error Resume Next
    lblVersion.Caption = "Versi " & _
    App.Major & "." & App.Minor & "." & App.Revision
    lblProductName.Caption = App.Title
    Me.lblCopyright.Caption = "Copyright " & App.LegalCopyright
    Me.lblCompanyProduct.Caption = App.CompanyName
    Me.lblCompany.Caption = App.FileDescription
    Me.lblWarning.Caption = App.Comments
    'Me.lblLicenseTo.Caption = "Lisensi untuk: "
    'Me.imgLogo.Picture = frmInduk.Icon
    Me.picMe.BorderStyle = 0
        Jlen = 0.8
    Mlen = 1.5
    DLen = 1.7
    '
    Me.picAdo.BorderStyle = 0
    With Me.picAdo
        .AutoRedraw = True
            .PaintPicture Me.Image, 0, 0, _
            .Width, .Height, .Left, _
            .Top, .Width, .Height
    End With
    picAdo.Scale (-2.2, -2.2)-(2.2, 2.2)
End Sub

 Sub Form_Resize()
    On Error Resume Next
    With MDIForm1
        Me.Frame1.Move (Me.ScaleWidth - Me.Frame1.Width) / 2, _
        (Me.ScaleHeight - Me.Frame1.Height) / 2
    End With
End Sub

Private Sub tmrJam_Timer()
    Dim Jsud, Msud, Dsud
    Dim DetikAkhir
    Dim Jx, Jy, Mx, My, Dx, Dy
    '
    picAdo.Cls
    '
    CetakBackGround
    '
    Me.CetakAngka
    '
    Waktu = Time
    If Second(Waktu) = DetikAkhir Then
        Exit Sub
    Else
        DetikAkhir = Second(Waktu)
    End If
    '
    Jno = Hour(Waktu)
    Mno = Minute(Waktu)
    Dno = Second(Waktu)
    '
    Jsud = Pi2 * (Jno + Mno / 60) / 12 - PiSt
    Msud = Pi2 * (Mno + Dno / 60) / 60 - PiSt
    Dsud = Pi2 * Dno / 60 - PiSt
    '
    Jx = Jlen * Cos(Jsud)
    Jy = Jlen * Sin(Jsud)
    Mx = Mlen * Cos(Msud)
    My = Mlen * Sin(Msud)
    Dx = DLen * Cos(Dsud)
    Dy = DLen * Sin(Dsud)
    '
    With Me.picAdo
        .DrawWidth = 6
        '
        picAdo.Line (0, 0)-(Jx, Jy), vbYellow
        .DrawWidth = 6
        picAdo.Line (0, 0)-(Mx, My), vbYellow
        .DrawWidth = 4
        picAdo.Line (0, 0)-(Dx, Dy), vbYellow
        '
        .DrawWidth = 4
        picAdo.Line (0, 0)-(Jx, Jy), RGB(0, 0, 180)
        .DrawWidth = 4
        picAdo.Line (0, 0)-(Mx, My), RGB(0, 180, 0)
        .DrawWidth = 2
        picAdo.Line (0, 0)-(Dx, Dy), RGB(180, 0, 0)
        '
        Jx = (0.2 + Jlen) * Cos(Jsud)
        Jy = (0.2 + Jlen) * Sin(Jsud)
        Mx = (0.2 + Mlen) * Cos(Msud)
        My = (0.2 + Mlen) * Sin(Msud)
        Dx = (0.2 + DLen) * Cos(Dsud)
        Dy = (0.2 + DLen) * Sin(Dsud)
        '
        .DrawWidth = 4
        picAdo.Line (0, 0)-(Jx, Jy), RGB(0, 0, 180)
        Me.picAdo.DrawWidth = 4
        picAdo.Line (0, 0)-(Mx, My), RGB(0, 180, 0)
        '
        .DrawWidth = 2
        picAdo.Line (0, 0)-(Dx, Dy), RGB(180, 0, 0)

        .FillStyle = vbFSSolid
        .FillColor = RGB(0, 0, 150)
        Me.picAdo.Circle (0, 0), 0.15, vbYellow
    End With
End Sub

Sub CetakBackGround()
    With Me.picAdo
        .ScaleMode = 1
        .PaintPicture picMe.Image, 0, 0, _
        .Width, .Height, .Left, _
        .Top, .Width, .Height
        .ScaleMode = 3
        picAdo.Scale (-2.2, -2.2)-(2.2, 2.2)
    End With
End Sub

Sub CetakAngka()
    With Me.picAdo
        .FontSize = 6
        .CurrentX = (0 - .TextWidth("INOCHI")) / 2
        .CurrentY = 2.4 - (.TextHeight("I") * 3)
        Me.picAdo.Print "INOCHI"
        .FontSize = 10
        .CurrentX = (0 - .TextWidth("6")) / 2
        .CurrentY = 2 - .TextHeight("6")
        Me.picAdo.Print "6"
        .CurrentX = (0 - .TextWidth("12")) / 2
        .CurrentY = -3.3 + .TextHeight("12")
        Me.picAdo.Print "12"
        .CurrentX = -2
        .CurrentY = (0 - .TextHeight("9")) / 2
        Me.picAdo.Print "9"
        .CurrentX = 1.5
        .CurrentY = (0 - .TextHeight("3")) / 2
        Me.picAdo.Print "3"
    End With
End Sub

Ketik kode di bawah ini di MDIForm1:

Option Explicit

Private Sub MDIForm_Resize()
    On Error Resume Next
    frmSplash.Move (Me.ScaleWidth - frmSplash.Width) / 2, _
    (Me.ScaleHeight - frmSplash.Height) / 2
End Sub

Tampilan runtime akan terlihat seperti ini:

Online  Free Image Share Hosting

Contoh, bisa Anda unduh di sini:
http://www.4shared.com/file/71597687/6f7228ba/MDI.html

Tentang Novian Agung
Pengangguran

Tinggalkan komentar