Edukasi: Maret 2012

Rabu, 14 Maret 2012

Chat Grafik by Vb 6.0

Rancangan form

Code programnya

Dim Conn As New ADODB.Connection

Dim rs As New ADODB.Recordset

Dim Cunt1, Cunt2 As Integer

Dim i As Integer

Dim dt1, dt2, dt3 As Integer

Private Sub Check1_Click()

If Check1.Value = 1 Then

'Show Legends

MSChart1.ShowLegend = True

Check1.Caption = "&Hide Legends"

Else

'Hide Legends

MSChart1.ShowLegend = False

Check1.Caption = "&Show Legends"

End If

End Sub

Private Sub CmdProsesOK_Click()

Dim X(1 To 8, 1 To 3) As Variant

X(1, 2) = ""

MSChart1.ChartData = X

'MSChart1.chartType = 1

MSChart1.RowCount = Adodc1.Recordset.RecordCount

MSChart1.Row = 1

MSChart1.Column = 1

TimerTitle.Interval = 100

i = 1

Adodc1.Recordset.MoveFirst

End Sub

Private Sub Combo1_Click()

'untuk mengubah type chart saat run time.

MSChart1.chartType = Combo1.ListIndex

End Sub

Private Sub Command1_Click()

Dim X(1 To 8, 1 To 3) As Variant

X(1, 2) = ""

MSChart1.ChartData = X

'MSChart1.chartType = 1

MSChart1.RowCount = Adodc1.Recordset.RecordCount

MSChart1.Row = 1

MSChart1.Column = 1

Timer1.Interval = 100

i = 1

Adodc1.Recordset.MoveFirst

End Sub

Private Sub Command2_Click()

FrmAddData.Show

End Sub

Private Sub Command3_Click()

MSChart1.Row = Text3.Text

MSChart1.RowLabel = Text4.Text

End Sub

Private Sub Command4_Click()

MSChart1.RowCount = Text6.Text

MSChart1.ColumnCount = Text5.Text

End Sub

Private Sub Command5_Click()

MSChart1.Data = Text1.Text

MSChart1.Column = Text2.Text

End Sub

Private Sub Form_Load()

'buka koneksi

'Conn.CursorLocation = adUseClient

Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Database.mdb"

Adodc1.RecordSource = "TB_DATA"

Set DataGrid1.DataSource = Adodc1

Adodc1.Caption = "Cunt : " & Adodc1.Recordset.RecordCount

Cunt1 = Adodc1.Recordset.RecordCount

With Combo1

.AddItem "3D Bar"

.AddItem "2D Bar"

.AddItem "3D Line"

.AddItem "2D LIne"

.AddItem "3D Area"

.AddItem "2D Area"

.AddItem "3D Step"

.AddItem "2D Step"

.AddItem "3D Combination"

.AddItem "2D Combination"

End With

End Sub

Private Sub Form_Resize()

On Error Resume Next

MSChart1.Height = Me.Height - 3525

MSChart1.Width = Me.Width - 3420

Combo1.Top = MSChart1.Height + 20

Check1.Top = MSChart1.Height + 40

Command1.Top = MSChart1.Height + 20

Command2.Top = MSChart1.Height + 20

CmdProsesOK.Top = MSChart1.Height + 20

DataGrid1.Top = MSChart1.Height + 600

Adodc1.Top = MSChart1.Height + (DataGrid1.Height + 600)

Frame1.Left = MSChart1.Width + 200

Frame2.Left = MSChart1.Width + 200

Frame3.Left = MSChart1.Width + 200

End Sub

Private Sub Timer1_Timer()

Text3.Text = i

With MSChart1

.RowLabel = Adodc1.Recordset!KELURAHAN

If .Row <= Adodc1.Recordset.RecordCount Then

.Row = .Row + 1

End If

End With

i = i + 1

Adodc1.Recordset.MoveNext

If MSChart1.Row = Adodc1.Recordset.RecordCount Then

Timer1.Interval = 0

MSChart1.RowLabel = Adodc1.Recordset!KELURAHAN

Timer2.Interval = 1500

Adodc1.Recordset.MoveFirst

MSChart1.Row = 1

End If

End Sub

Private Sub Timer2_Timer()

MSChart1.Column = 1

MSChart1.Data = Adodc1.Recordset!datang

MSChart1.ColumnLabel = "DATANG"

MSChart1.Column = 2

MSChart1.Data = Adodc1.Recordset!Meninggal

MSChart1.ColumnLabel = "MENINGGAL"

MSChart1.Column = 3

MSChart1.Data = Adodc1.Recordset!pindah

MSChart1.ColumnLabel = "MUTASI"

Adodc1.Recordset.MoveNext

On Error Resume Next

MSChart1.Row = MSChart1.Row + 1

If Adodc1.Recordset.EOF Then Timer2.Interval = 0

End Sub

Private Sub Timer3_Timer()

TimerC1.Enabled = True

dt1 = 0

dt2 = 0

dt3 = 0

Adodc1.Recordset.MoveNext

On Error Resume Next

MSChart1.Row = MSChart1.Row + 1

Timer3.Interval = 0

If Adodc1.Recordset.EOF Then Timer3.Interval = 0

End Sub

Private Sub TimerC1_Timer()

dt1 = dt1 + 1

MSChart1.Column = 1

MSChart1.Data = dt1

If dt1 >= Val(Adodc1.Recordset!datang) Then

MSChart1.ColumnLabel = "DATANG"

TimerC1.Enabled = False

TimerC2.Enabled = True

dt1 = 0

dt2 = 0

dt3 = 0

End If

End Sub

Private Sub TimerC2_Timer()

dt2 = dt2 + 1

MSChart1.Column = 2

MSChart1.Data = dt2

If dt2 = Val(Adodc1.Recordset!Meninggal) Then

MSChart1.ColumnLabel = "MENIGGAL"

TimerC2.Enabled = False

TimerC3.Enabled = True

dt1 = 0

dt2 = 0

dt3 = 0

End If

End Sub

Private Sub TimerC3_Timer()

dt3 = dt3 + 1

MSChart1.Column = 3

MSChart1.Data = dt3

If dt3 = Val(Adodc1.Recordset!pindah) Then

MSChart1.ColumnLabel = "PINDAH"

TimerC3.Enabled = False

If Not Adodc1.Recordset.AbsolutePosition = Adodc1.Recordset.RecordCount Then

Timer3.Interval = 100

End If

dt1 = 0

dt2 = 0

dt3 = 0

End If

End Sub

Private Sub TimerTitle_Timer()

Text3.Text = i

With MSChart1

.RowLabel = Adodc1.Recordset!KELURAHAN

If .Row <= Adodc1.Recordset.RecordCount Then

.Row = .Row + 1

End If

End With

i = i + 1

Adodc1.Recordset.MoveNext

If MSChart1.Row = Adodc1.Recordset.RecordCount Then

TimerTitle.Interval = 0

MSChart1.RowLabel = Adodc1.Recordset!KELURAHAN

'Timer3.Interval = 1000

Adodc1.Recordset.MoveFirst

MSChart1.Row = 1

TimerC1.Enabled = True

dt1 = 0

dt2 = 0

dt3 = 0

End If

End Sub

Chat grafik.rar

Option Explicit
Private Const pi As Double = 3.14159265358979

Dim strTemp, LenTemp, n
Dim Kalimat As String
Dim x, a, y, l As Integer
Dim jal As Integer
Public Function TulisJalan(hitung As Integer, _
                           strKalimat As String, _
                           Panjang As Integer)
    If hitung = Len(strKalimat) + Panjang Then
        hitung = 0
    ElseIf hitung > Len(strKalimat) Then
        TulisJalan = strKalimat & Space(hitung - Len(strKalimat))
    Else
        TulisJalan = Mid(strKalimat, 1, hitung)
    End If
End Function
Private Sub Form_Load()
Picture1.Top = (Me.Height - Picture1.Height) / 2
Picture1.Left = (Me.Width - Picture1.Width) / 2
x = 0
a = 0
y = 0
l = 0
strTemp = Label4.Caption
    n = 1
End Sub

Private Sub Form_Resize()
Picture1.Top = (Me.Height - Picture1.Height) / 2
Picture1.Left = (Me.Width - Picture1.Width) / 2
End Sub

Private Sub Timer1_Timer()
If a = 1 Then Label1.Caption = "I"
If a = 2 Then Label1.Caption = "In"
If a = 3 Then Label1.Caption = "Ins"
If a = 4 Then Label1.Caption = "Inst"
If a = 5 Then Label1.Caption = "Insta"
If a = 6 Then Label1.Caption = "Instal"
If a = 7 Then Label1.Caption = "Install"
If a = 8 Then Label1.Caption = "Installi"
If a = 9 Then Label1.Caption = "Installin"
If a = 10 Then Label1.Caption = "Installin"
If a = 11 Then Label1.Caption = "Installing System "
If a = 12 Then Label1.Caption = "Installing System.."
If a = 13 Then Label1.Caption = "Installing System1.."
If a = 14 Then Label1.Caption = "Installing System 11.."
If a = 15 Then Label1.Caption = "Installing System 111..."
If a = 25 Then
Timer2.Enabled = True
Label1.Caption = "Loading System . . . . ."
Timer1.Enabled = False
End If
Shape12.Visible = Not Shape12.Visible
a = a + 1
End Sub

Private Sub Timer2_Timer()
Shape12.Visible = False
If x = 1 Then Shape1.Visible = True
If x = 2 Then Shape2.Visible = True
If x = 3 Then Shape3.Visible = True
If x = 4 Then Shape4.Visible = True
If x = 5 Then Shape5.Visible = True
If x = 6 Then Shape6.Visible = True
If x = 7 Then Shape7.Visible = True
If x = 8 Then Shape8.Visible = True
If x = 9 Then Shape9.Visible = True
If x = 10 Then Shape10.Visible = True
If x = 11 Then
Shape11.Visible = True
Timer4.Enabled = True
End If
x = x + 1
End Sub

Private Sub Timer3_Timer()
If y = 1 Then Label2.Caption = "0010"
If y = 3 Then Label2.Caption = "00011"
If y = 4 Then Label2.Caption = "0010"
If y = 5 Then Label2.Caption = "1111"
If y = 6 Then Label2.Caption = "0001"
If y = 7 Then Label2.Caption = "10011"
If y = 8 Then Label2.Caption = "01010"
If y = 9 Then Label2.Caption = "11101"
If y = 10 Then Label2.Caption = "0011"
If y = 11 Then Label2.Caption = "00100"
If y = 12 Then Label2.Caption = "10001"
If y = 13 Then Label2.Caption = "0101"
If y = 14 Then Label2.Caption = "011"
If y = 15 Then Label2.Caption = "01011"
If y = 16 Then y = 0
y = y + 1
End Sub

Private Sub Timer4_Timer()
ShapeSCrol.Visible = True
If ShapeSCrol.Width >= 5295 Then
ShapeSCrol.Width = 5295
Timer4.Enabled = False
Timer5.Enabled = True
Else
ShapeSCrol.Width = ShapeSCrol.Width + 20
Label3.Caption = ShapeSCrol.Width
End If
End Sub

Private Sub Timer5_Timer()
If l = 1 Then ShapeL1.FillColor = &HFF00&
If l = 2 Then ShapeL2.FillColor = &HFF00&
If l = 3 Then ShapeL3.FillColor = &HFF00&
If l = 4 Then
ShapeL4.FillColor = &HFF00&
Timer5.Enabled = False
Timer8.Enabled = True
End If
l = l + 1
End Sub

Private Sub Timer6_Timer()
Dim dblSecond As Double
jal = jal + 5
dblSecond = jal 'Second(Now) * 6 - 90
LineJarum.X2 = 1000 * Cos(dblSecond * pi / 180) + LineJarum.X1
LineJarum.Y2 = 1000 * Sin(dblSecond * pi / 180) + LineJarum.Y1
Label5.Caption = LineJarum.Y2
End Sub

Private Sub Timer7_Timer()
LenTemp = Len(strTemp)
    Dim Form As String
    LenTemp = Len(strTemp)
    Label4.Caption = Left(strTemp, n) + "_"
    n = n + 1
   If n > LenTemp Then
        n = 1
        Timer7.Interval = 0
    End If
End Sub

Private Sub Timer8_Timer()
Unload Me
End Sub
Download Sample Project Loding Splas.rar

Edukasi

Top Navigation Menu

Rabu, 14 Maret 2012

Chat Grafik by Vb 6.0

Splash Loding Into