3D Text

October 20, 2009 programmervb 1 comment

‘Code

Static Sub FormLabelCaptionEmbossed(L1 As Label, L2 As Label, L3 As Label, _
label_text As String, label_effect As Integer, label_forecolor As Long, _
label_depth As Integer)
Dim lt As String
Dim savesm As Integer
Dim f As Form
Set f = L1.Parent
L1.Visible = False
L2.Visible = False
L3.Visible = False
savesm = f.ScaleMode
f.ScaleMode = 3
If label_text = “” Then
lt = L1
Else
lt = label_text
End If
L1 = lt
L2 = lt
L3 = lt
L1.BackStyle = 0
L1.ForeColor = label_forecolor
L2.Width = L1.Width
L2.Height = L1.Height
L2.BackStyle = L1.BackStyle
L2.ForeColor = BOX_DARKGRAY&
L3.Width = L1.Width
L3.Height = L1.Height
L3.BackStyle = L1.BackStyle
L3.ForeColor = BOX_WHITE&
Select Case label_effect
Case GFM_SUNKEN
L2.Left = L1.Left – label_depth
L2.Top = L1.Top – label_depth
L3.Left = L1.Left + label_depth
L3.Top = L1.Top + label_depth
Case GFM_RAISED
L2.Left = L1.Left + label_depth
L2.Top = L1.Top + label_depth
L3.Left = L1.Left – label_depth
L3.Top = L1.Top – label_depth
End Select
f.ScaleMode = savesm
L1.Visible = True
L2.Visible = True
L3.Visible = True
L1.ZOrder
End Sub

Private Sub Form_Load()
FormLabelCaptionEmbossed Label1, Label2, Label3, “DIMENSI”, 2, vbBlue, 1
End Sub

‘Modules

Global Const GFM_STANDARD = 0
Global Const GFM_RAISED = 1
Global Const GFM_SUNKEN = 2
Global Const GFM_BACKSHADOW = 1
Global Const GFM_DROPSHADOW = 2
Global Const BOX_WHITE& = &HFFFFFF
Global Const BOX_LIGHTGRAY& = &HC0C0C0
Global Const BOX_DARKGRAY& = &H808080
Global Const BOX_BLACK& = &H0

Download Here

Bandwidth Monitor

Categories: Grafis

Perbaikan

October 8, 2009 programmervb Leave a comment

Sedang Dalam Perbaikan dan Update Document

Categories: Uncategorized

Show and hide assistant

October 7, 2009 programmervb Leave a comment

Private Sub CommandButton1_Click()
With Assistant
    .Visible = True
    .Animation = msoAnimationGreeting
End With
End Sub

Private Sub CommandButton2_Click()
With Assistant
    .Visible = False
    .Animation = msoAnimationGreeting
End With

End Sub

Private Sub CommandButton3_Click()
With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = “Tips for Saving Information.”
    .Labels(1).Text = “Save your work often.”
    .Labels(2).Text = “Install a surge protector.”
    .Labels(3).Text = “Exit your application properly.”
    .Show
End With

End Sub

Categories: control

Convert Text To Number

September 25, 2009 programmervb 1 comment

‘2 texts, 2 labels and 2 commands
Private Sub cmdConvert_Click()
txtResult = NumToText(Val(txtNumber))
txtNumber.SelStart = 0
txtNumber.SelLength = Len(txtNumber)
txtNumber.SetFocus
End Sub

Private Sub cmdExit_Click()
Unload Me
End Sub

Private Function NumToText(dblVal As Double) As String
Static Ones(0 To 9) As String
Static Teens(0 To 9) As String
Static Tens(0 To 9) As String
Static Thousands(0 To 4) As String
Static bInit As Boolean
Dim i As Integer, bAllZeros As Boolean, bShowThousands As Boolean
Dim strVal As String, strBuff As String, strTemp As String
Dim nCol As Integer, nChar As Integer

‘Only handles positive values
Debug.Assert dblVal >= 0

If bInit = False Then
‘Initialize array
bInit = True
Ones(0) = “zero”
Ones(1) = “one”
Ones(2) = “two”
Ones(3) = “three”
Ones(4) = “four”
Ones(5) = “five”
Ones(6) = “six”
Ones(7) = “seven”
Ones(8) = “eight”
Ones(9) = “nine”
Teens(0) = “ten”
Teens(1) = “eleven”
Teens(2) = “twelve”
Teens(3) = “thirteen”
Teens(4) = “fourteen”
Teens(5) = “fifteen”
Teens(6) = “sixteen”
Teens(7) = “seventeen”
Teens(8) = “eighteen”
Teens(9) = “nineteen”
Tens(0) = “”
Tens(1) = “ten”
Tens(2) = “twenty”
Tens(3) = “thirty”
Tens(4) = “forty”
Tens(5) = “fifty”
Tens(6) = “sixty”
Tens(7) = “seventy”
Tens(8) = “eighty”
Tens(9) = “ninety”
Thousands(0) = “”
Thousands(1) = “thousand”   ‘US numbering
Thousands(2) = “million”
Thousands(3) = “billion”
Thousands(4) = “trillion”
End If
‘Trap errors
On Error GoTo NumToTextError
‘Get fractional part
strBuff = “and ” & Format((dblVal – Int(dblVal)) * 100, “00″) & “/100″
‘Convert rest to string and process each digit
strVal = CStr(Int(dblVal))
‘Non-zero digit not yet encountered
bAllZeros = True
‘Iterate through string
For i = Len(strVal) To 1 Step -1
‘Get value of this digit
nChar = Val(Mid$(strVal, i, 1))
‘Get column position
nCol = (Len(strVal) – i) + 1
‘Action depends on 1’s, 10’s or 100’s column
Select Case (nCol Mod 3)
Case 1  ‘1’s position
bShowThousands = True
If i = 1 Then
‘First digit in number (last in loop)
strTemp = Ones(nChar) & ” “
ElseIf Mid$(strVal, i – 1, 1) = “1″ Then
‘This digit is part of “teen” number
strTemp = Teens(nChar) & ” “
i = i – 1   ‘Skip tens position
ElseIf nChar > 0 Then
‘Any non-zero digit
strTemp = Ones(nChar) & ” “
Else
‘This digit is zero. If digit in tens and hundreds column
‘are also zero, don’t show “thousands”
bShowThousands = False
‘Test for non-zero digit in this grouping
If Mid$(strVal, i – 1, 1) <> “0″ Then
bShowThousands = True
ElseIf i > 2 Then
If Mid$(strVal, i – 2, 1) <> “0″ Then
bShowThousands = True
End If
End If
strTemp = “”
End If
‘Show “thousands” if non-zero in grouping
If bShowThousands Then
If nCol > 1 Then
strTemp = strTemp & Thousands(nCol \ 3)
If bAllZeros Then
strTemp = strTemp & ” “
Else
strTemp = strTemp & “, “
End If
End If
‘Indicate non-zero digit encountered
bAllZeros = False
End If
strBuff = strTemp & strBuff
Case 2  ’10’s position
If nChar > 0 Then
If Mid$(strVal, i + 1, 1) <> “0″ Then
strBuff = Tens(nChar) & “-” & strBuff
Else
strBuff = Tens(nChar) & ” ” & strBuff
End If
End If
Case 0  ‘100’s position
If nChar > 0 Then
strBuff = Ones(nChar) & ” hundred ” & strBuff
End If
End Select
Next i
‘Convert first letter to upper case
strBuff = UCase$(Left$(strBuff, 1)) & Mid$(strBuff, 2)
EndNumToText:
‘Return result
NumToText = strBuff
Exit Function
NumToTextError:
strBuff = “#Error#”
Resume EndNumToText
End Function

Private Sub Form_Load()

End Sub

Categories: Application