Archive

Archive for September, 2009

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

combination

September 17, 2009 programmervb Leave a comment

Dim flag As Boolean
Public Sub Engine(char As String, length As Byte)

ReDim ary(length)
Dim depth As Byte
Dim result As String

depth = 1

While Not (flag)
k = DoEvents()
ary(depth) = ary(depth) + 1

If depth = length Then
result = Left(result, length – 1) + Mid(char, ary(depth), 1)
Else
result = result + Mid(char, ary(depth), 1)
End If

If ary(depth) <> Len(char) + 1 Then
If depth <> length Then
depth = depth + 1
Else
List1.AddItem result
If ChSave.Value = 1 Then Print #1, result
End If
Else
If depth = 1 Then
flag = True
Else
ary(depth) = 0
depth = depth – 1
result = Left(result, depth – 1)
End If
End If
Wend
End Sub

Private Sub InitValue(start As Boolean)
flag = start

ChSave.Enabled = start
txtChar.Enabled = start
txtLength.Enabled = start
If start Then
cmdGen.Caption = “Generate”
Else
cmdGen.Caption = “Stop”
End If
End Sub

Private Sub cmdGen_Click()
If Val(txtLength.Text) > Len(txtChar.Text) Then
MsgBox “Jumlah Kombinasi Salah”
Exit Sub
End If

If Len(txtChar.Text) = 0 Or (Val(txtLength.Text) = 0) Then
Exit Sub
End If

If cmdGen.Caption = “Generate” Then
InitValue False
If ChSave.Value = 1 Then
MsgBox “Disimpan pada hasil.txt”
Open App.Path + “\hasil.txt” For Output As #1
End If
Call Engine(txtChar.Text, txtLength.Text)
If ChSave.Value = 1 Then Close #1
InitValue True
Else
InitValue True
End If
End Sub

Private Sub CmdClear_Click()
List1.Clear
End Sub

Private Sub Form_Load()
List1.Clear
End Sub

Categories: forms

Create trigonometry with visual basic

September 8, 2009 programmervb Leave a comment

Code:

Dim th As Double

Dim scal As Integer

Dim op1 As Integer

Dim op2 As Integer

Dim num1 As Double

Dim num2 As Double

Dim x As Double

Dim y As Double

Dim step As Double

Private Sub drawgraph()

GraphCls

For th = -3.2 To 3.2 Step step

Select Case op1

Case 0

x = Sin(num1 * th)

Case 1

x = Cos(num1 * th)

Case 2

x = Tan(num1 * th)

End Select

Select Case op2

Case 0

y = Sin(num2 * th)

Case 1

y = Cos(num2 * th)

Case 2

y = Tan(num2 * th)

End Select

SetPixel graph.hdc, 200 + scal * x, 200 – scal * y, RGB(0, 0, 0)

Next th

graph.Refresh

End Sub

Private Sub cmdnum1d_Click()

If num1 > 1 Then txtnum1 = txtnum1 – 1

End Sub

Private Sub cmdnum1p_Click()

If num1 < 50 Then txtnum1 = txtnum1 + 1

End Sub

Private Sub cmdnum2d_Click()

If num2 > 1 Then txtnum2 = txtnum2 – 1

End Sub

Private Sub cmdnum2p_Click()

If num2 < 20 Then txtnum2 = txtnum2 + 1

End Sub

Private Sub cmdchange_Click()

Form1.Hide

Form2.Top = Form1.Top

Form2.Left = Form1.Left

Form2.Show

End Sub

Private Sub form_load()

GraphCls

step = 0.001

scal = 100

End Sub

Private Sub GraphCls()

graph.Cls

graph.Line (200, 0)-(200, 400), RGB(255, 0, 0)

graph.Line (0, 200)-(400, 200), RGB(255, 0, 0)

End Sub

Private Sub Form_Unload(Cancel As Integer)

End

End Sub

Private Sub menuabout2_Click()

frmAbout.Show

End Sub

Private Sub menuchange_Click()

cmdchange_Click

End Sub

Private Sub menuexit_Click()

End

End Sub

Private Sub optopt1_Click(Index As Integer)

op1 = Index

drawgraph

End Sub

Private Sub optopt2_Click(Index As Integer)

op2 = Index

drawgraph

End Sub

Private Sub sldnum1_Scroll()

txtnum1.Text = sldnum1.Value

End Sub

Private Sub sldnum2_Scroll()

txtnum2.Text = sldnum2.Value

End Sub

Private Sub pull()

num1 = txtnum1.Text

num2 = txtnum2.Text

sldnum1.Value = num1

sldnum2.Value = num2

drawgraph

End Sub

Private Sub sldscale_Scroll()

scal = sldscale.Value * 50

drawgraph

End Sub

Private Sub Timerstart_Timer()

pull

drawgraph

Timerstart.Enabled = False

End Sub

Private Sub txtnum1_Change()

pull

End Sub

Private Sub txtnum2_Change()

pull

End Sub

Module:

Public Declare Function SetPixel Lib “gdi32″ (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal Color As Long) As Long

Upload Document Here

Categories: Application