Tampilan Menu yang kereen Abezz...

Membuat program agar tampil lebih menawan dan mempunyai daya jual tinggi adalah harapan semua programmer, nah semua itu terletak bagaimana tingkat kerumitan dari program tersebut dibuat, semakin rumit rumus atau logika yang dibuat semakin mahal harga jualnya, Namun tampilan dari suatu program adalah tolak ukur bagi kaum awam yang membeli program yang kita buat.Jika tampilan program yang kita buat tampil menawan meskipun tidak serumit rumus dan logikanya maka harga jualnya juga bisa jadi tinggi. Nah contoh berikut penulis membuat desain form yang menarik plus animasinya...mungkin bisa dijadikan referensi bagi vbthok mania.

Untuk code scriptnya sperti dibawah ini

'untuk main formnya
Option Explicit
Dim mlaku As String
Dim mulai As Integer


Private Sub MDIForm_Activate()
mulai = 0
mlaku = "S E L A M A T D A T A N G"
End Sub

Private Sub Timer1_Timer()
Dim sent As String
mulai = mulai + 1
If mulai > Len(mlaku) Then
mulai = 1
logo.Caption = ""
End If
sent = sent + Mid(mlaku, mulai, 1)


logo.Caption = logo.Caption + sent
End Sub

Private Sub MDIForm_Load()
With RupaToolbar
.ImageList = ImageList1
.Buttons.Item(1).Image = 4
.Buttons.Item(2).Image = 1
.Buttons.Item(3).Image = 15

.Buttons.Item(5).Image = 3
.Buttons.Item(6).Image = 11
.Buttons.Item(7).Image = 14
.Buttons.Item(8).Image = 13
.Buttons.Item(9).Image = 10

.Buttons.Item(11).Image = 16
.Buttons.Item(12).Image = 7
.Buttons.Item(13).Image = 12
.Buttons.Item(14).Image = 2

.Buttons.Item(16).Image = 8
End With

'set toolbar status
RupaToolbar.Visible = GetSetting("Bar", "MDI", "RupaToolbar.Visible", True)
mnuShowToolbar.Checked = GetSetting("Bar", "MDI", "RupaToolbar.Visible", True)
mnuAgent.Checked = GetSetting("Bar", "MDI", "mnuAgent.Checked", True)

Call Init

'Initialize Agent
MyAgent.Characters.Load "Merlin", "Merlin.Acs"
Set myCharacter = MyAgent.Characters("Merlin")

myCharacter.SoundEffectsOn = True

showMerlin
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
End
End Sub

Private Sub mnuAcct_Click()
frmAccounts.Show 1
End Sub

Private Sub mnuAgent_Click()
mnuAgent.Checked = Not mnuAgent.Checked

SaveSetting "Bar", "MDI", "mnuAgent.Checked", mnuAgent.Checked
showMerlin
End Sub

Private Sub mnuBilling_Click()
frmSales.Show

frmSales.Top = GetSetting("Bar", "frmSales", "Top", (frmMain.Height - frmSales.Height) / 3)
frmSales.Left = GetSetting("Bar", "frmSales", "Left", (frmMain.Width - frmSales.Width) / 2)
End Sub

Private Sub mnuBillingMonitor_Click()
frmBillingMonitor.Show

frmBillingMonitor.Top = GetSetting("Bar", "frmBillingMonitor", "Top", (frmMain.Height - frmBillingMonitor.Height) / 3)
frmBillingMonitor.Left = GetSetting("Bar", "frmBillingMonitor", "Left", (frmMain.Width - frmBillingMonitor.Width) / 2)
End Sub

Private Sub mnuCurrBal_Click()
Dim vAcctName As String
Dim vMsg As String
Dim vAcctNo As Integer
Dim vCurrBal As Single

vAcctNo = frmFind.getKey("Accounts", "AcctName")

If vAcctNo = -1 Then Exit Sub

vAcctName = getAcctDetailsByCode(vAcctNo)!AcctName
vCurrBal = getAcctBalance(vAcctNo)

vMsg = vAcctName & " Has a Balance of Rs : " & IIf(vCurrBal > 0, Format(Abs(vCurrBal), "0.00") & " Dr", Format(Abs(vCurrBal), "0.00") & " Cr")
Merlin vMsg, "Read"
End Sub

Private Sub mnuInward_Click()
ShowInCentre frmInward
End Sub

Private Sub mnuLedger_Click()
ShowInCentre frmLedger
End Sub

Private Sub mnuLoose_Click()
frmLoose.Show 1
End Sub

Private Sub mnuPayment_Click()
frmVoucher.Init ("Payment")
End Sub

Private Sub mnuProduct_Click()
frmProducts.Show 1
End Sub

Private Sub mnuProductUpdate_Click()
ShowInCentre frmProductsUpdate
End Sub

Private Sub mnuQuit_Click()
End
End Sub

Private Sub mnuReceipt_Click()
frmVoucher.Init ("Receipt")
End Sub

Private Sub mnuSalesSummary_Click()
frmDates.Show 1
If datesSelected Then ShowInCentre frmSalesSummary
End Sub

Private Sub mnuShowToolbar_Click()
RupaToolbar.Visible = Not RupaToolbar.Visible
mnuShowToolbar.Checked = Not mnuShowToolbar.Checked

SaveSetting "Bar", "MDI", "RupaToolbar.Visible", RupaToolbar.Visible
End Sub

Private Sub mnuStock_Click()
Call initDtEnv
rptStock.Show
End Sub

Private Sub RupaToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "Accounts"
mnuAcct_Click

Case "Products"
mnuProduct_Click

Case "Update_Products"
mnuProductUpdate_Click

Case "Sales"
mnuBilling_Click

Case "Inward"
mnuInward_Click

Case "Receipt"
mnuReceipt_Click

Case "Payment"
mnuPayment_Click

Case "Loose"
mnuLoose_Click

Case "Ledger"
mnuLedger_Click

Case "Stock"
mnuStock_Click

Case "Sales_Summary"
mnuSalesSummary_Click

Case "Billing_Monitor"
mnuBillingMonitor_Click

Case "Quit"
mnuQuit_Click
End Select
End Sub

' untuk form splash nya
'Software license by www.Vbthok.co.cc
'Programmer by ToMee
'2008

Option Explicit

Private Sub Form_Load()

End Sub

Private Sub Timer1_Timer()
Static count As Integer
count = count + 1

If count = 1 Then
lblDisp = "Software Initialized ..."

ElseIf count = 2 Then
lblDisp = "Menyiapkan Database ..."

ElseIf count = 3 Then
lblDisp = "Menyiapkan Aplikasi..."

ElseIf count = 4 Then
lblDisp = "Wait..."

ElseIf count = 5 Then
Timer1.Enabled = False
Unload Me
frmMain.Show
frmWelcome.Show
End If
End Sub

'untuk form welcome nya
'Software license by www.Vbthok.co.cc
'Programmer by ToMee
'2008

Option Explicit

Private Sub Form_Activate()
lblTime = "Login Time : " & Time
lblDate = Format(Date, "dd-MMM-yyyy")

Call popUp
End Sub

Private Sub Form_Load()
Me.Left = Screen.Width - (Me.Width + 60)
Me.Top = Screen.Height - 600 'assumed height for taskbar
End Sub

Private Sub popUp()
Dim h As Integer

h = Me.Height
Me.Height = 0

While Me.Height < height =" Me.Height" top =" Me.Top"> 0
Me.Height = Me.Height - 1
Me.Top = Me.Top + 1
DoEvents
Wend
Unload Me
End Sub

Private Sub Timer1_Timer()
popDown
End Sub

Silakan dicoba dan silakan lihat hasilnya..keren kan?Untuk fungsi modul2nya silakan diliat sendiri dalam paket sorce code yang bisa didownload disini