Public Declare Function GetWindowLong Lib "user32" _ Alias "GetWindowLongA" (ByVal hwnd As Long, _ ByVal nindex As Long) As Long

LISTING PROGRAM mdlProfil Public Public Public Public

Const Const Const Const

LWA_ALPHA = 2 LWA_BOTH = 3 WS_EX_LAYERED = &H80000 GWL_EXSTYLE = -20

Public Declare Function SetLayeredWindowAttributes Lib "user32" _ (ByVal hwnd As Long, ByVal color As Long, _ ByVal X As Byte, ByVal alpha As Long) As Boolean Public Declare Function GetWindowLong Lib "user32" _ Alias "GetWindowLongA" (ByVal hwnd As Long, _ ByVal nIndex As Long) As Long Public Declare Function SetWindowLong Lib "user32" _ Alias "SetWindowLongA" (ByVal hwnd As Long, _ ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Sub SetTranslucent(ThehWnd As Long, nTrans As Integer) On Error GoTo Salah Dim attrib As Long attrib = GetWindowLong(ThehWnd, GWL_EXSTYLE) SetWindowLong ThehWnd, GWL_EXSTYLE, attrib Or WS_EX_LAYERED SetLayeredWindowAttributes ThehWnd, RGB(255, 255, 0), nTrans, LWA_ALPHA Exit Sub Salah: MsgBox Err.Description & "Source: " & Err.Source End Sub

mdlUtama Public Const MaxGrid = 1000 Public Const MaxSegmen = 30 Public Type TipeWarna Red As Long Green As Long Blue As Long End Type Public Type TipeTitik X As Single Y As Single z As Single End Type Public Type TipeKurva BanyakTitik As Integer Tampak As Boolean Titik(MaxGrid) As TipeTitik End Type Public Type TipeParameterFungsi a As Single

Universitas Sumatera Utara

b As Single c As Single d As Single End Type Public Type TipeSurface BanyakTitikD As Integer BanyakTitikL As Integer Tampak As Boolean Titik(MaxSegmen + 2, MaxSegmen + 2) As TipeTitik End Type Public Param(6) As TipeParameterFungsi Public KurvaF(6) As TipeKurva Public SurfaceF(6) As TipeSurface Public Public Public Public Public Public Public Public Public

WDasar As TipeWarna WSumbu As TipeWarna WGMayor As TipeWarna WGMinor As TipeWarna WPembatas As TipeWarna WSumbuO As TipeWarna WGMayorO As TipeWarna WGMinorO As TipeWarna WGrafik(10) As TipeWarna

Public Public Public Public

BBawah As Single BAtas As Single SAwal As Single SAkhir As Single

Public Public Public Public Public Public

ONGrid As Boolean ONSumbu As Boolean ONBatas As Boolean Ox As Single Oy As Single Kanvas3D As Boolean

Public sdtY As Single horizontal/koordinat X+ Public sdtX As Single horizontal/koordinat X+ Public sdtZ As Single horizontal/koordinat X+ Public BSegmenD As Single Public BSegmenL As Single Public BGrid As Integer Public PSkala As Single Public Derajat As Single Public FileBaru As Boolean

'-- sudut sumbu Y terhadap garis '-- sudut sumbu X terhadap garis '-- sudut sumbu Z terhadap garis '-- Banyak Segmen Mendatar '-- Banyak Segmen Melintang

Public Function Warna(W As TipeWarna) As Long Warna = RGB(W.Red, W.Green, W.Blue) End Function Public Function EvalKurvaFungsi(Fungsi As Integer, Par As TipeParameterFungsi) As TipeKurva Dim fx As Single Dim n As Single Dim t As Integer

Universitas Sumatera Utara

Dim Kurva As TipeKurva Dim BS As Integer BS = BGrid \ 2 t = 0 For n = -BS To BS Select Case Fungsi Case 1: fx = Par.a * n + Par.b Case 2: fx = Par.a * n ^ 2 + Par.b Case 3: fx = Par.a * n ^ 3 + Par.b Par.d Case 4: fx = Par.a * Sin(Par.b * n Case 5: fx = Par.a * Cos(Par.b * n Case 6: fx = Par.a * Tan(Par.b * n End Select If (fx <= BS) And (fx >= -BS) Then t = t + 1 Kurva.Titik(t).X = n Kurva.Titik(t).Y = fx Kurva.Titik(t).z = 0 Kurva.BanyakTitik = t End If Next n If (Par.a = 0) And (Par.b = 0) And (Par.c = Then Kurva.BanyakTitik = 0 Kurva.Tampak = False Else Kurva.Tampak = True End If EvalKurvaFungsi = Kurva End Function

* n + Par.c * n ^ 2 + Par.c * n + * Derajat) * Derajat) * Derajat)

0) And (Par.d = 0)

Public Function EvalSurfFungsi(Fungsi As Integer, Par As TipeParameterFungsi) As TipeSurface Dim fx As Single Dim Tx As Single Dim Ty As Single Dim Tz As Single Dim m As Single Dim n As Single Dim SD As Single Dim SL As Single Dim BTL As Integer Dim BTD As Integer Dim Surface As TipeSurface Dim b As Single Dim k As Single SL = (SAkhir - SAwal) / BSegmenL SD = (BAtas - BBawah) / BSegmenD BTL = 0 BTD = 0 'For m = SAwal To SAkhir Step SL For b = 0 To BSegmenL m = SAwal + b * SL BTL = BTL + 1 BTD = 0 'For n = BBawah To BAtas Step SD For k = 0 To BSegmenD n = BBawah + k * SD

Universitas Sumatera Utara

BTD = BTD + Select Case Case 1: Case 2: Case 3:

1 Fungsi fx = Par.a * n + Par.b fx = Par.a * n ^ 2 + Par.b * n + Par.c fx = Par.a * n ^ 3 + Par.b * n ^ 2 + Par.c * n

+ Par.d Case 4: fx = Par.a * Sin(Par.b * n * Derajat) Case 5: fx = Par.a * Cos(Par.b * n * Derajat) Case 6: fx = Par.a * Tan(Par.b * n * Derajat) End Select Tx = n Ty = fx * Cos(m * Derajat) Tz = fx * Sin(m * Derajat) Surface.BanyakTitikD = BTD Surface.BanyakTitikL = BTL Surface.Titik(BTD, BTL).X = Surface.Titik(BTD, BTL).Y = Surface.Titik(BTD, BTL).z = 'Next n Next k 'Next m Next b If (Par.a = 0) And (Par.b = 0) And Then Surface.BanyakTitikD = 0 Surface.BanyakTitikL = 0 Surface.Tampak = False Else Surface.Tampak = True End If EvalSurfFungsi = Surface End Function

Tx Ty Tz

(Par.c = 0) And (Par.d = 0)

Public Sub ResetParameterFungsi() Dim n As Integer For n = 1 To 6 Param(n).a = 0 Param(n).b = 0 Param(n).c = 0 Param(n).d = 0 KurvaF(n).BanyakTitik = 0 KurvaF(n).Tampak = False SurfaceF(n).BanyakTitikD = 0 SurfaceF(n).BanyakTitikL = 0 SurfaceF(n).Tampak = False Next n End Sub Public Sub InisialisasiBatas() BGrid = 60 BAtas = BGrid \ 2 BBawah = -BGrid \ 2 SAwal = 0 SAkhir = 180 BSegmenD = 20 BSegmenL = 18 sdtX = -15 sdtY = 15 sdtZ = 90

Universitas Sumatera Utara

End Sub Public Sub Inisialisasi() Derajat = (22 / 7) / 180 '--- Defenisi Warna WDasar.Red = 255 WDasar.Green = 255 WDasar.Blue = 255 WSumbu.Red = 255 WSumbu.Green = 0 WSumbu.Blue = 0 WSumbuO = WSumbu WGMayor.Red = 168 WGMayor.Green = 168 WGMayor.Blue = 168 WGMayorO = WGMayor WGMinor.Red = 205 WGMinor.Green = 205 WGMinor.Blue = 207 WGMinorO = WGMinor WPembatas.Red = 0 WPembatas.Green = 255 WPembatas.Blue = 0 With WGrafik(1) .Red = 0 .Green = 0 .Blue = 255 End With With WGrafik(2) .Red = 0 .Green = 125 .Blue = 0 End With With WGrafik(3) .Red = 126 .Green = 0 .Blue = 0 End With With WGrafik(4) .Red = 213 .Green = 126 .Blue = 255 End With With WGrafik(5) .Red = 255 .Green = 0 .Blue = 255 End With With WGrafik(6)

Universitas Sumatera Utara

.Red = 255 .Green = 125 .Blue = 47 End With ONGrid = True ONSumbu = True ONBatas = True InisialisasiBatas FileBaru = True End Sub

Sub main() Inisialisasi frmUtama.Show frmSplash.Show End Sub

frmLKerja Dim Dim Dim Dim Dim Dim Dim Dim Dim Dim Dim Dim Dim

LLayar As Single TLayar As Single LKanvas As Single TKanvas As Single BS As Single fx As Single n As Single mX1 As Single mX2 As Single mY1 As Single mY2 As Single NoF As Integer PBelajar As Integer

Private Sub Form_Load() Kanvas3D = False End Sub

Private Dim Dim Dim Dim

Sub Form_Activate() p As Single L As Single f As Integer Warna As Long

frmUtama.txtBBawah = BBawah frmUtama.txtBAtas = BAtas frmUtama.txtSAwal = SAwal frmUtama.txtSAkhir = SAkhir '-- mengukur resolusi layar LLayar = Me.ScaleWidth TLayar = Me.ScaleHeight - 300 picKanvas.Left = 450 picKanvas.Top = 450

Universitas Sumatera Utara

picKanvas.Width = 0.62 * LLayar picKanvas.Height = TLayar picRulerH.Width = picKanvas.Width picRulerV.Height = picKanvas.Height LKanvas = picKanvas.ScaleWidth TKanvas = picKanvas.ScaleHeight '--- Menentukan Titik Pusat 0,0 Ox = LKanvas / 2 Oy = TKanvas / 2 PSkala = LKanvas / 100 BS = BGrid \ 2 Kanvas3D = False SetKanvas2D '-- posisi tampilan sisi kanan p = picKanvas.Width + 50 L = LLayar - p - 550 fraFungsi.Left = p + 500 fraBelajar.Left = fraFungsi.Left txtKet.Left = fraBelajar.Left lblFungsi.Width = L '--- Warna Grafik For f = 1 To 6 Warna = RGB(WGrafik(f).Red, WGrafik(f).Green, WGrafik(f).Blue) picWGrafik(f).BackColor = Warna Next f '--- Set Awal scrollbar pencacah SetNilaiAwalScrollCacah End Sub

Private Sub Form_Resize() With picRulerH .Top = 0 .Left = 450 .Height = 450 .Width = picKanvas.Width End With With picRulerV .Top = 450 .Left = 0 .Height = picKanvas.Height .Width = 450 End With End Sub

Public Sub IsianKosong() chkF(1).Value = Unchecked chkF(2).Value = Unchecked

Universitas Sumatera Utara

chkF(3).Value chkF(4).Value chkF(5).Value chkF(6).Value

= = = =

Unchecked Unchecked Unchecked Unchecked

chkS(1).Value chkS(2).Value chkS(3).Value chkS(4).Value chkS(5).Value chkS(6).Value

= = = = = =

Unchecked Unchecked Unchecked Unchecked Unchecked Unchecked

txtLa.Text = "" txtLb.Text = "" txtKa.Text = "" txtKb.Text = "" txtKc.Text = "" txtPa.Text txtPb.Text txtPc.Text txtPd.Text

= = = =

"" "" "" ""

txtSa.Text = "" txtSb.Text = "" txtCa.Text = "" txtCb.Text = "" txtTa.Text = "" txtTb.Text = "" End Sub

Private Function IsParameter() As Boolean Dim f As Integer Dim paramKosong As Boolean paramKosong = False For f = 1 To 6 If (Param(f).a = 0) And (Param(f).b = 0) And _ (Param(f).c = 0) And (Param(f).d = 0) Then paramKosong = True Else paramKosong = False Exit For End If Next f IsParameter = paramKosong End Function

Public Sub RefreshKanvas() If Kanvas3D = True Then Set3D Else Set2D End If End Sub

Universitas Sumatera Utara

Public Sub Set2D() Dim f As Integer Dim paramKosong As Boolean SetKanvas2D Pembelajaran2D paramKosong = IsParameter If Not FileBaru = True Then If (paramKosong = True) Then MsgBox "Koefisien fungsi belum diisikan.", vbOKOnly + vbExclamation, "Pesan Kesalahan" Exit Sub End If End If For f = 1 To 6 GambarKurva KurvaF(f), f Next f End Sub

Public Sub Set3D() Dim f As Integer Dim paramKosong As Boolean SetKanvas3D Pembelajaran3D paramKosong = IsParameter If Not FileBaru = True Then If (paramKosong = True) Then MsgBox "Koefisien fungsi belum diisikan.", vbOKOnly + vbExclamation, "Pesan Kesalahan" Exit Sub End If End If For f = 1 To 6 GambarSurface SurfaceF(f), f GambarKurva3D KurvaF(f), f Next f End Sub

Private Sub SetKanvas2D() Dim WarnaDasar As Long WarnaDasar = Warna(WDasar) picKanvas.BackColor = WarnaDasar picKanvas.Cls GambarGrid2D GambarRulerH GambarRulerV GambarSumbuXY2D GambarBatas2D End Sub

Private Sub SetKanvas3D() Dim WarnaDasar As Long WarnaDasar = Warna(WDasar) picKanvas.BackColor = WarnaDasar picKanvas.Cls

Universitas Sumatera Utara

GambarGrid3D GambarSumbuXY3D GambarBatas3D End Sub

Private Dim Dim Dim Dim Dim

Sub GambarGrid2D() WarnaGMin As Long WarnaGMay As Long WarnaGrid As Long n As Integer g As Single

If ONGrid = WGMinor WGMayor Else WGMinor WGMayor End If

True Then = WGMinorO = WGMayorO = WDasar = WDasar

WarnaGMin = Warna(WGMinor) WarnaGMay = Warna(WGMayor) BS = BGrid \ 2 For g = 1 To BS n = n + 1 If n = 10 Then n = 0 WarnaGrid = WarnaGMay Else WarnaGrid = WarnaGMin End If Drawline g, BS, g, -BS, WarnaGrid Drawline -g, BS, -g, -BS, WarnaGrid Drawline -BS, g, BS, g, WarnaGrid Drawline -BS, -g, BS, -g, WarnaGrid Next g End Sub

Private Sub GambarSumbuXY2D() Dim WarnaSumbu As Long If ONSumbu = True Then WSumbu = WSumbuO Else WSumbu = WDasar End If WarnaSumbu = Warna(WSumbu) Drawline 0, -BS, 0, BS, WarnaSumbu Drawline -BS, 0, BS, 0, WarnaSumbu End Sub

Public Sub GambarBatas2D() Dim WarnaPembatas As Long Dim pxBB As Integer Dim pxBA As Integer Dim py1 As Integer Dim py2 As Integer

Universitas Sumatera Utara

WarnaPembatas = Warna(WPembatas) pxBB = Ox + BBawah * PSkala pxBA = Ox + BAtas * PSkala py1 = Oy - BS * PSkala py2 = Oy + BS * PSkala linBBawah.x1 linBBawah.x2 linBBawah.y1 linBBawah.y2 linBAtas.x1 linBAtas.x2 linBAtas.y1 linBAtas.y2

= = = =

= = = =

pxBB pxBB py1 py2

pxBA pxBA py1 py2

linBBawah.BorderColor = WarnaPembatas linBAtas.BorderColor = WarnaPembatas linBBawah.Visible = ONBatas linBAtas.Visible = ONBatas End Sub

Private Dim Dim Dim Dim Dim

Sub GambarGrid3D() WarnaGrid As Long WarnaGMin As Long WarnaGMay As Long n As Integer g As Single

If ONGrid = WGMinor WGMayor Else WGMinor WGMayor End If

True Then = WGMinorO = WGMayorO = WDasar = WDasar

WarnaGMin = Warna(WGMinor) WarnaGMay = Warna(WGMayor) For g = 1 To BS n = n + 1 If n = 10 Then n = 0 WarnaGrid = WarnaGMay Else WarnaGrid = WarnaGMin End If drawline3D -BS, g, 0, BS, g, 0, WarnaGrid drawline3D -BS, -g, 0, BS, -g, 0, WarnaGrid drawline3D g, -BS, 0, g, BS, 0, WarnaGrid drawline3D -g, -BS, 0, -g, BS, 0, WarnaGrid Next g End Sub

Private Sub GambarSumbuXY3D() Dim WarnaSumbu As Long If ONSumbu = True Then

Universitas Sumatera Utara

WSumbu Else WSumbu End If WarnaSumbu drawline3D drawline3D End Sub

= WSumbuO = WDasar = Warna(WSumbu) -BS, 0, 0, BS, 0, 0, WarnaSumbu 0, -BS, 0, 0, BS, 0, WarnaSumbu

Public Sub GambarBatas3D() Dim WarnaPembatas As Long Dim BBx1 As Single Dim BBy1 As Single Dim BBx2 As Single Dim BBy2 As Single Dim Dim Dim Dim

BAx1 BAy1 BAx2 BAy2

As As As As

Single Single Single Single

WarnaPembatas = Warna(WPembatas) BBx1 = Tx3D(BBawah, BS, 0) BBy1 = Ty3D(BBawah, BS, 0) BBx2 = Tx3D(BBawah, -BS, 0) BBy2 = Ty3D(BBawah, -BS, 0) BAx1 BAy1 BAx2 BAy2

= = = =

Tx3D(BAtas, Ty3D(BAtas, Tx3D(BAtas, Ty3D(BAtas,

linBBawah.x1 linBBawah.y1 linBBawah.x2 linBBawah.y2 linBAtas.x1 linBAtas.y1 linBAtas.x2 linBAtas.y2

= = = =

= = = =

BS, 0) BS, 0) -BS, 0) -BS, 0)

BBx1 BBy1 BBx2 BBy2

BAx1 BAy1 BAx2 BAy2

linBBawah.BorderColor = WarnaPembatas linBAtas.BorderColor = WarnaPembatas linBBawah.Visible = ONBatas linBAtas.Visible = ONBatas End Sub

Private Dim Dim Dim Dim Dim

Sub GambarRulerH() g As Integer m As Integer SM As Integer Sp As String * 2 Sn As String * 3

picRulerH.Cls '---menggambar garis vertikal di Ruler Horizontal

Universitas Sumatera Utara

picRulerH.Line (Ox, 250)-(Ox, 400), RGB(255, 0, 0) '---memposisikan huruf y berada di titik awal (px -50,150) picRulerH.PSet (Ox - 50, 25), &H8000000F picRulerH.FontName = "Arial" picRulerH.FontSize = 8 picRulerH.Print "Y" m = 0 For g = 1 To BGrid m = m + 1 If m = 5 Then m = 0 SM = 150 'sumbu mayor Sp = CStr(g) Sn = CStr(-g) Else SM = 100 'sumbu minor Sp = "" Sn = "" End If '---menggambar garis skala arah positif picRulerH.Line (Ox + PSkala * g, 400)-(Ox + PSkala * g, 400 SM), RGB(125, 147, 157) picRulerH.PSet (Ox + PSkala * g - 50, 25), &H8000000F picRulerH.Print Sp '---menggambar garis skala arah negatif picRulerH.Line (Ox - PSkala * g, 400)-(Ox - PSkala * g, 400 SM), RGB(125, 147, 157) picRulerH.PSet (Ox - PSkala * g - 50, 25), &H8000000F picRulerH.Print Sn Next g End Sub

Private Dim Dim Dim Dim Dim

Sub GambarRulerV() g As Integer m As Integer SM As Integer Sp As String * 2 Sn As String * 3

picRulerV.Cls picRulerV.Line (400, Oy)-(200, Oy), RGB(255, 0, 0) picRulerV.PSet (25, Oy - 100), &H8000000F picRulerV.FontName = "Arial" picRulerV.FontSize = 8 picRulerV.Print "X" m = 0 For g = 1 To BGrid m = m + 1 If m = 5 Then m = 0 SM = 125 Sp = CStr(g) Sn = CStr(-g) Else

Universitas Sumatera Utara

SM = 80 Sp = "" Sn = "" End If '---menggambar garis skala arah positif picRulerV.Line (400, Oy - PSkala * g)-(400 - SM, Oy - PSkala * g), RGB(125, 147, 157) picRulerV.PSet (25, Oy - PSkala * g - 100), &H8000000F picRulerV.Print Sp '---menggambar garis skala arah negatif picRulerV.Line (400, Oy + PSkala * g)-(400 - SM, Oy + PSkala * g), RGB(125, 147, 157) picRulerV.PSet (25, Oy + PSkala * g - 100), &H8000000F picRulerV.Print Sn Next g End Sub

Private Sub GambarKurva(Kurva As TipeKurva, W As Integer) Dim t As Integer Dim T1 As TipeTitik Dim T2 As TipeTitik Dim WKurva As Long If Kurva.Tampak = True Then WKurva = Warna(WGrafik(W)) T1 = Kurva.Titik(1) For t = 2 To Kurva.BanyakTitik T2 = Kurva.Titik(t) Drawline T1.X, T1.Y, T2.X, T2.Y, WKurva T1 = T2 Next t End If End Sub

Private Sub GambarKurva3D(Kurva As TipeKurva, W As Integer) Dim t As Integer Dim T1 As TipeTitik Dim T2 As TipeTitik Dim WKurva As Long If Kurva.Tampak = True Then WKurva = Warna(WGrafik(W)) T1 = Kurva.Titik(1) For t = 2 To Kurva.BanyakTitik T2 = Kurva.Titik(t) drawline3D T1.X, T1.Y, T1.z, T2.X, T2.Y, T2.z, WKurva T1 = T2 Next t End If End Sub

Private Sub GambarSurface(Surface As TipeSurface, W As Integer) Dim d As Integer Dim L As Integer Dim T1 As TipeTitik Dim T2 As TipeTitik

Universitas Sumatera Utara

Dim WSurf As Long If Surface.Tampak = True Then WSurf = Warna(WGrafik(W)) For L = 1 To Surface.BanyakTitikL + 2 T1 = Surface.Titik(L, 1) For d = 1 To Surface.BanyakTitikD - 2 T2 = Surface.Titik(L, d) drawline3D T1.X, T1.Y, T1.z, T2.X, T2.Y, T2.z, WSurf T1 = T2 Next d Next L For d = 1 To Surface.BanyakTitikD T1 = Surface.Titik(1, d) For L = 1 To Surface.BanyakTitikL + 2 T2 = Surface.Titik(L, d) drawline3D T1.X, T1.Y, T1.z, T2.X, T2.Y, T2.z, WSurf T1 = T2 Next L Next d End If End Sub

Private Sub Drawline(x1 As Single, y1 As Single, x2 As Single, y2 As Single, W As Long) picKanvas.Line (Ox + x1 * PSkala, Oy - y1 * PSkala)- _ (Ox + x2 * PSkala, Oy - y2 * PSkala), W End Sub

Private Sub DrawCircle(X As Single, Y As Single, R As Single, W As Long) picKanvas.Circle (Ox + X * PSkala, Oy - Y * PSkala), R * PSkala, W End Sub

Private Sub DrawPoint(X As Single, Y As Single, W As Long) picKanvas.PSet (Ox + X * PSkala, Oy - Y * PSkala), W End Sub

Private Sub DrawLinePolar(R As Single, sdt As Single, W As Long) Dim Tx As Single Dim Ty As Single Tx = Ox + Int(R * PSkala * Cos(sdt * Derajat)) Ty = Oy - Int(R * PSkala * Sin(sdt * Derajat)) picKanvas.Line -(Tx, Ty), W End Sub

Private Function Tx3D(X As Single Tx3D = Ox + X * PSkala Y * PSkala z * PSkala End Function

Single, Y As Single, z As Single) As * Cos(sdtX * Derajat) + _ * Cos(sdtY * Derajat) + _ * Cos(sdtZ * Derajat)

Universitas Sumatera Utara

Private Function Ty3D(X As Single, Y As Single, z As Single) As Single Ty3D = Oy - (X * PSkala * Sin(sdtX * Derajat) + _ Y * PSkala * Sin(sdtY * Derajat) + _ z * PSkala * Sin(sdtZ * Derajat)) End Function

Private Sub drawline3D(x1 As Single, y1 As Single, z1 As Single, _ x2 As Single, y2 As Single, z2 As Single, W As Long) Dim Tx1 As Single Dim Tx2 As Single Dim Ty1 As Single Dim Ty2 As Single Tx1 = Tx3D(x1, y1, z1) Ty1 = Ty3D(x1, y1, z1) Tx2 = Tx3D(x2, y2, z2) Ty2 = Ty3D(x2, y2, z2) picKanvas.Line (Tx1, Ty1)-(Tx2, Ty2), W End Sub

Private Sub drawPoint3D(X As Single, Y As Single, z As Single, W As Long) Dim Tx As Single Dim Ty As Single Tx = Tx3D(X, Y, z) Ty = Ty3D(X, Y, z) picKanvas.Circle (Tx, Ty), 25, W End Sub

Private Sub picKanvas_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) mX1 = X mY1 = Y End Sub

Private Sub picKanvas_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim dx As Single Dim dy As Single linH.x1 = X linH.x2 = X linV.y1 = Y linV.y2 = Y If Button = 1 Then mX2 = X mY2 = Y Kanvas3D = True dx = mX2 - mX1 dy = mY2 - mY1 sdtX = sdtX + dx / 20 sdtY = sdtY + dy / 20 sdtZ = sdtZ + dx / 20 + dy / 20

Universitas Sumatera Utara

RefreshKanvas End If End Sub

Private Sub picRulerH_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 1 Then linBBawah.x1 = X linBBawah.x2 = X BBawah = (X - Ox) / PSkala frmUtama.txtBBawah = Format(BBawah, "###.#0") ElseIf Button = 2 Then linBAtas.x1 = X linBAtas.x2 = X BAtas = (X - Ox) / PSkala frmUtama.txtBAtas = Format(BAtas, "###.#0") End If End Sub

Private Sub chkF_Click(Index As Integer) Dim f As Integer NoF = Index FileBaru = False '-- Baca Parameter Fungsi For f = 1 To 6 Select Case f Case 1: '-- Parameter Fungsi 1 Param(f).a = Val(txtLa.Text) Param(f).b = Val(txtLb.Text) Param(f).c = 0 Param(f).d = 0 Case 2: '-- Parameter Fungsi 2 Param(f).a = Val(txtKa.Text) Param(f).b = Val(txtKb.Text) Param(f).c = Val(txtKc.Text) Param(f).d = 0 Case 3: '-- Parameter Fungsi 3 Param(f).a = Val(txtPa.Text) Param(f).b = Val(txtPb.Text) Param(f).c = Val(txtPc.Text) Param(f).d = Val(txtPd.Text) Case 4: '-- Parameter Fungsi 4 Param(f).a = Val(txtSa.Text) Param(f).b = Val(txtSb.Text) Param(f).c = 0 Param(f).d = 0 Case 5: '-- Parameter Fungsi 5 Param(f).a = Val(txtCa.Text) Param(f).b = Val(txtCb.Text) Param(f).c = 0 Param(f).d = 0 Case 6: '-- Parameter Fungsi 6 Param(f).a = Val(txtTa.Text) Param(f).b = Val(txtTb.Text) Param(f).c = 0 Param(f).d = 0 End Select

Universitas Sumatera Utara

If (Param(f).a (Param(f).c paramKosong Else paramKosong End If

= 0) And (Param(f).b = 0) And _ = 0) And (Param(f).c = 0) Then = True = False

KurvaF(f) = EvalKurvaFungsi(f, Param(f)) SurfaceF(f) = EvalSurfFungsi(f, Param(f)) Next f If Kanvas3D = False Then SetKanvas2D Else SetKanvas3D End If For f = 1 To 6 If chkF(f).Value = Checked Then KurvaF(f).Tampak = True Else KurvaF(f).Tampak = False End If If Kanvas3D = False Then GambarKurva KurvaF(f), f Else GambarKurva3D KurvaF(f), f GambarSurface SurfaceF(f), f End If Next f End Sub

Private Sub chkS_Click(Index As Integer) Dim f As Integer NoF = Index FileBaru = False '-- Baca Parameter Fungsi For f = 1 To 6 Select Case f Case 1: '-- Parameter Fungsi 1 Param(f).a = Val(txtLa.Text) Param(f).b = Val(txtLb.Text) Param(f).c = 0 Param(f).d = 0 Case 2: '-- Parameter Fungsi 2 Param(f).a = Val(txtKa.Text) Param(f).b = Val(txtKb.Text) Param(f).c = Val(txtKc.Text) Param(f).d = 0 Case 3: '-- Parameter Fungsi 3 Param(f).a = Val(txtPa.Text) Param(f).b = Val(txtPb.Text) Param(f).c = Val(txtPc.Text) Param(f).d = Val(txtPd.Text) Case 4: '-- Parameter Fungsi 4 Param(f).a = Val(txtSa.Text) Param(f).b = Val(txtSb.Text) Param(f).c = 0

Universitas Sumatera Utara

Param(f).d = 0 Case 5: '-- Parameter Fungsi 5 Param(f).a = Val(txtCa.Text) Param(f).b = Val(txtCb.Text) Param(f).c = 0 Param(f).d = 0 Case 6: '-- Parameter Fungsi 6 Param(f).a = Val(txtTa.Text) Param(f).b = Val(txtTb.Text) Param(f).c = 0 Param(f).d = 0 End Select If (Param(f).a (Param(f).c paramKosong Else paramKosong End If

= 0) And (Param(f).b = 0) And _ = 0) And (Param(f).c = 0) Then = True = False

KurvaF(f) = EvalKurvaFungsi(f, Param(f)) SurfaceF(f) = EvalSurfFungsi(f, Param(f)) Next f If Kanvas3D = False Then SetKanvas2D Else SetKanvas3D End If For f = 1 To 6 If chkS(f).Value = Checked Then SurfaceF(f).Tampak = True Else SurfaceF(f).Tampak = False End If If Kanvas3D = False Then GambarKurva KurvaF(f), f Else GambarKurva3D KurvaF(f), f GambarSurface SurfaceF(f), f End If Next f End Sub

Private Sub cboPilih_Click() PBelajar = cboPilih.ListIndex + 1 TampilkanUraian PBelajar End Sub

Private Sub chkBelajar_Click() If (chkBelajar.Value = Checked) Then If Kanvas3D = False Then Pembelajaran2D ElseIf Kanvas3D = True Then Pembelajaran3D End If

Universitas Sumatera Utara

Else fraBelajar.Visible = False txtKet.Visible = False End If End Sub

Private Sub Pembelajaran2D() If (chkBelajar.Value = Checked) Then lblX.Caption = "X :" lblY.Caption = "Y :" fraBelajar.Caption = "Pembelajaran 2D" fraBelajar.Visible = True cboPilih.Visible = True SetNilaiAwalScrollCacah Else fraBelajar.Visible = False txtKet.Visible = False End If End Sub

Private Sub Pembelajaran3D() If (chkBelajar.Value = Checked) Then lblX.Caption = "Sudut Awal:" lblY.Caption = "Sudut Akhir:" fraBelajar.Caption = "Pembelajaran 3D" fraBelajar.Visible = True cboPilih.Visible = True SetNilaiAwalScrollCacah Else fraBelajar.Visible = False txtKet.Visible = False End If End Sub

Private Sub TampilkanUraian(p As Integer) If Kanvas3D = False Then Select Case p Case 1: UraianFLinier2D Case 2: UraianFKuadrat2D Case 3: UraianFPTiga2D Case 4: UraianFSinus2D Case 5: UraianFCosinus2D Case 6: UraianFTangen2D End Select Else Select Case p Case 1: UraianFLinier3D Case 2: UraianFKuadrat3D Case 3: UraianFPTiga3D Case 4: UraianFSinus3D Case 5: UraianFCosinus3D Case 6: UraianFTangen3D End Select End If End Sub

Universitas Sumatera Utara

Private Sub UraianFLinier2D() Dim st As String txtKet.FontName = "Courier New" txtKet.FontSize = 10 txtKet.Visible = True st = "Fungsi Linier dengan persamaan:" st = st & vbCrLf & " y =" & Param(1).a & "x + " & Param(1).b st = st & vbCrLf st = st & vbCrLf & "Cara Menggambar Kurva:" st = st & vbCrLf & "1. Substitusi nilai x ke persamaan" st = st & vbCrLf & " y =" & Param(1).a & "x + " & Param(1).b st = st & vbCrLf & " maka diperoleh nilay y. Kemudian beri " st = st & vbCrLf & " tanda titik (x,y) pada sistim koordinat" st = st & vbCrLf & " Cartesius." st = st & vbCrLf & " Misalnya :" st = st & vbCrLf & " Untuk x = " & KurvaF(1).Titik(1).X & _ " diperoleh y =" & KurvaF(1).Titik(1).Y st = st & vbCrLf & "2. Tandai titik (" & KurvaF(1).Titik(1).X & _ ", " & KurvaF(1).Titik(1).Y & ") pada sistim koordinat." st = st & vbCrLf & " Lakukan hal yang sama untuk titik x lainnya." st = st & vbCrLf & " Nilai x dan y dapat dilihat dengan mengklik" st = st & vbCrLf & " yang scrollbar yang tersedia di atas." st = st & vbCrLf & "3. Hubungkan titik-titik tersebut dengan garis," st = st & vbCrLf & " sehingga diperoleh kurva sesuai dengan persamaan" st = st & vbCrLf & " fungsi yang diberikan." st = st & vbCrLf & " Sambil mengklik scrollbar, perhatikan tampilan" st = st & vbCrLf & " Sistem Koordinat Cartesius di samping." txtKet.Text = st End Sub

Private Sub UraianFKuadrat2D() Dim st As String txtKet.FontName = "Courier New" txtKet.FontSize = 10 txtKet.Visible = True st = "Fungsi Kuadrat dengan persamaan:" st = st & vbCrLf & " y =" & Param(2).a & "x^2 + " & Param(2).b & _ "x + " & Param(2).c st = st & vbCrLf st = st & vbCrLf & "Cara Menggambar Kurva:" st = st & vbCrLf & "1. Substitusi setiap nilai x ke persamaan" st = st & vbCrLf & " y =" & Param(2).a & "x^2 + " & Param(2).b & _ "x + " & Param(2).c st = st & vbCrLf & " maka diperoleh nilay y. Kemudian tandai " st = st & vbCrLf & " titik (x,y) pada sistim koordinat Cartesius." st = st & vbCrLf & " Misalnya :" st = st & vbCrLf & " Untuk x = " & KurvaF(2).Titik(1).X & _ " diperoleh y =" & KurvaF(2).Titik(1).Y st = st & vbCrLf & "2. Tandai titik (" & KurvaF(2).Titik(1).X & _

Universitas Sumatera Utara

", " & KurvaF(2).Titik(1).Y & ") pada sistim koordinat." st = st & vbCrLf lainnya." st = st & vbCrLf mengklik" st = st & vbCrLf st = st & vbCrLf garis," st = st & vbCrLf persamaan" st = st & vbCrLf st = st & vbCrLf tampilan" st = st & vbCrLf txtKet.Text = st End Sub

& "

Lakukan hal yang sama untuk titik x

& "

Nilai x dan y dapat dilihat dengan

& " yang scrollbar yang tersedia di atas." & "3. Hubungkan titik-titik tersebut dengan & "

sehingga diperoleh kurva sesuai dengan

& " fungsi yang diberikan." & " Sambil mengklik scrollbar, perhatikan & " Sistem Koordinat Cartesius di samping."

Private Sub UraianFPTiga2D() Dim st As String txtKet.FontName = "Courier New" txtKet.FontSize = 10 txtKet.Visible = True st = "Fungsi Pangkat Tiga dengan persamaan:" st = st & vbCrLf & " y =" & Param(3).a & "x^3 + " & Param(3).b & _ "x^2 + " & Param(3).c & "x + " & Param(3).d st = st & vbCrLf st = st & vbCrLf & "Cara Menggambar Kurva:" st = st & vbCrLf & "1. Substitusi setiap nilai x ke persamaan" st = st & vbCrLf & " y =" & Param(3).a & "x^3 + " & Param(3).b & _ "x^2 + " & Param(3).c & "x + " & Param(3).d st = st & vbCrLf & " maka diperoleh nilay y. Kemudian tandai " st = st & vbCrLf & " titik (x,y) pada sistim koordinat Cartesius." st = st & vbCrLf & " Misalnya :" st = st & vbCrLf & " Untuk x = " & KurvaF(3).Titik(1).X & _ " diperoleh y =" & KurvaF(3).Titik(1).Y st = st & vbCrLf & "2. Tandai titik (" & KurvaF(3).Titik(1).X & _ ", " & KurvaF(3).Titik(1).Y & ") pada sistim koordinat." st = st & vbCrLf & " Lakukan hal yang sama untuk titik x lainnya." st = st & vbCrLf & " Nilai x dan y dapat dilihat dengan mengklik" st = st & vbCrLf & " yang scrollbar yang tersedia di atas." st = st & vbCrLf & "3. Hubungkan titik-titik tersebut dengan garis," st = st & vbCrLf & " sehingga diperoleh kurva sesuai dengan persamaan" st = st & vbCrLf & " fungsi yang diberikan." st = st & vbCrLf & " Sambil mengklik scrollbar, perhatikan tampilan" st = st & vbCrLf & " Sistem Koordinat Cartesius di samping." txtKet.Text = st End Sub

Universitas Sumatera Utara

Private Sub UraianFSinus2D() Dim st As String txtKet.FontName = "Courier New" txtKet.FontSize = 10 txtKet.Visible = True st = "Fungsi Sinus dengan persamaan:" st = st & vbCrLf & " y =" & Param(4).a & " sin (" & Param(4).b & _ ")" st = st & vbCrLf st = st & vbCrLf & "Cara Menggambar Kurva:" st = st & vbCrLf & "1. Substitusi setiap nilai x ke persamaan" st = st & vbCrLf & " y =" & Param(4).a & " sin (" & Param(4).b & _ ")" st = st & vbCrLf & " maka diperoleh nilay y. Kemudian tandai " st = st & vbCrLf & " titik (x,y) pada sistim koordinat Cartesius." st = st & vbCrLf & " Misalnya :" st = st & vbCrLf & " Untuk x = " & KurvaF(4).Titik(1).X & _ " diperoleh y =" & KurvaF(4).Titik(1).Y st = st & vbCrLf & "2. Tandai titik (" & KurvaF(4).Titik(1).X & _ ", " & KurvaF(4).Titik(1).Y & ") pada sistim koordinat." st = st & vbCrLf & " Lakukan hal yang sama untuk titik x lainnya." st = st & vbCrLf & " Nilai x dan y dapat dilihat dengan mengklik" st = st & vbCrLf & " yang scrollbar yang tersedia di atas." st = st & vbCrLf & "3. Hubungkan titik-titik tersebut dengan garis," st = st & vbCrLf & " sehingga diperoleh kurva sesuai dengan persamaan" st = st & vbCrLf & " fungsi yang diberikan." st = st & vbCrLf & " Sambil mengklik scrollbar, perhatikan tampilan" st = st & vbCrLf & " Sistem Koordinat Cartesius di samping." txtKet.Text = st End Sub

Private Sub UraianFCosinus2D() Dim st As String txtKet.FontName = "Courier New" txtKet.FontSize = 10 txtKet.Visible = True st = "Fungsi Cosinus dengan persamaan:" st = st & vbCrLf & " y =" & Param(5).a & " cos (" & Param(5).b & _ ")" st = st & vbCrLf st = st & vbCrLf & "Cara Menggambar Kurva:" st = st & vbCrLf & "1. Substitusi setiap nilai x ke persamaan" st = st & vbCrLf & " y =" & Param(5).a & " cos (" & Param(5).b & _ ")" st = st & vbCrLf & " maka diperoleh nilay y. Kemudian tandai "

Universitas Sumatera Utara

st = st & vbCrLf & " titik (x,y) pada sistim koordinat Cartesius." st = st & vbCrLf & " Misalnya :" st = st & vbCrLf & " Untuk x = " & KurvaF(5).Titik(1).X & _ " diperoleh y =" & KurvaF(5).Titik(1).Y st = st & vbCrLf & "2. Tandai titik (" & KurvaF(5).Titik(1).X & _ ", " & KurvaF(5).Titik(1).Y & ") pada sistim koordinat." st = st & vbCrLf & " Lakukan hal yang sama untuk titik x lainnya." st = st & vbCrLf & " Nilai x dan y dapat dilihat dengan mengklik" st = st & vbCrLf & " yang scrollbar yang tersedia di atas." st = st & vbCrLf & "3. Hubungkan titik-titik tersebut dengan garis," st = st & vbCrLf & " sehingga diperoleh kurva sesuai dengan persamaan" st = st & vbCrLf & " fungsi yang diberikan." st = st & vbCrLf & " Sambil mengklik scrollbar, perhatikan tampilan" st = st & vbCrLf & " Sistem Koordinat Cartesius di samping." txtKet.Text = st End Sub

Private Sub UraianFTangen2D() Dim st As String txtKet.FontName = "Courier New" txtKet.FontSize = 10 txtKet.Visible = True st = "Fungsi Tangen dengan persamaan:" st = st & vbCrLf & " y =" & Param(6).a & " tan (" & Param(6).b & _ ")" st = st & vbCrLf st = st & vbCrLf & "Cara Menggambar Kurva:" st = st & vbCrLf & "1. Substitusi setiap nilai x ke persamaan" st = st & vbCrLf & " y =" & Param(6).a & " tan (" & Param(6).b & _ ")" st = st & vbCrLf & " maka diperoleh nilay y. Kemudian tandai " st = st & vbCrLf & " titik (x,y) pada sistim koordinat Cartesius." st = st & vbCrLf & " Misalnya :" st = st & vbCrLf & " Untuk x = " & KurvaF(6).Titik(1).X & _ " diperoleh y =" & KurvaF(6).Titik(1).Y st = st & vbCrLf & "2. Tandai titik (" & KurvaF(6).Titik(1).X & _ ", " & KurvaF(6).Titik(1).Y & ") pada sistim koordinat." st = st & vbCrLf & " Lakukan hal yang sama untuk titik x lainnya." st = st & vbCrLf & " Nilai x dan y dapat dilihat dengan mengklik" st = st & vbCrLf & " yang scrollbar yang tersedia di atas." st = st & vbCrLf & "3. Hubungkan titik-titik tersebut dengan garis," st = st & vbCrLf & " sehingga diperoleh kurva sesuai dengan persamaan" st = st & vbCrLf & " fungsi yang diberikan."

Universitas Sumatera Utara

st = st & vbCrLf & " Sambil mengklik scrollbar, perhatikan tampilan" st = st & vbCrLf & " Sistem Koordinat Cartesius di samping." txtKet.Text = st End Sub

Private Sub UraianFLinier3D() Dim st As String Dim sdtPutar As Single txtKet.FontName = "Courier New" txtKet.FontSize = 10 txtKet.Visible = True sdtPutar = Abs(SdtAkhir - SdtAwal) / BSegmenL st = "Fungsi Linier dengan persamaan:" st = st & vbCrLf & " y =" & Param(1).a & "x + " & Param(1).b st = st & vbCrLf st = st & vbCrLf & "Cara Menggambar Benda hasil pemutaran kurva" st = st & vbCrLf & "1. Gambar kurva dengan persamaan" st = st & vbCrLf & " y =" & Param(1).a & "x + " & Param(1).b st = st & vbCrLf & "2. Putar kurva sesuai mulai dari batas bawah" st = st & vbCrLf & " hingga batas atas terhadap sumbu x untuk" st = st & vbCrLf & " setiap kenaikan sudut putar " & sdtPutar & "derajat" st = st & vbCrLf & "3. Hubungkan titik-titik tersebut dengan garis," st = st & vbCrLf & " melintang sehingga diperoleh permukaan benda" st = st & vbCrLf & " hasil pemutaran kurva." st = st & vbCrLf & " Sambil mengklik scrollbar, perhatikan tampilan" st = st & vbCrLf & " Sistem Koordinat Cartesius di samping." txtKet.Text = st End Sub

Private Sub UraianFKuadrat3D() Dim st As String Dim sdtPutar As Single txtKet.FontName = "Courier New" txtKet.FontSize = 10 txtKet.Visible = True sdtPutar = Abs(SdtAkhir - SdtAwal) / BSegmenL st = "Fungsi kwadrat dengan persamaan:" st = st & vbCrLf & " y =" & Param(2).a & "x^2 + " & Param(2).b & "x + " & Param(2).c st = st & vbCrLf st = st & vbCrLf & "Cara Menggambar Benda hasil pemutaran kurva" st = st & vbCrLf & "1. Gambar kurva dengan persamaan" st = st & vbCrLf & " y =" & Param(2).a & "x^2 + " & Param(2).b & "x + " & Param(2).c st = st & vbCrLf & "2. Putar kurva sesuai mulai dari batas bawah" st = st & vbCrLf & " hingga batas atas terhadap sumbu x untuk" st = st & vbCrLf & " setiap kenaikan sudut putar " & sdtPutar & "derajat" st = st & vbCrLf & "3. Hubungkan titik-titik tersebut dengan garis," st = st & vbCrLf & " melintang sehingga diperoleh permukaan benda"

Universitas Sumatera Utara

st = st & vbCrLf & " hasil pemutaran kurva." st = st & vbCrLf & " Sambil mengklik scrollbar, perhatikan tampilan" st = st & vbCrLf & " Sistem Koordinat Cartesius di samping." txtKet.Text = st End Sub

Private Sub UraianFPTiga3D() Dim st As String Dim sdtPutar As Single txtKet.FontName = "Courier New" txtKet.FontSize = 10 txtKet.Visible = True sdtPutar = Abs(SdtAkhir - SdtAwal) / BSegmenL st = "Fungsi Pangkat Tiga dengan persamaan:" st = st & vbCrLf & " y =" & Param(3).a & "x^3 + " & Param(3).b & "x^2 + " & _ Param(3).c & "x + " & Param(3).d st = st & vbCrLf st = st & vbCrLf & "Cara Menggambar Benda hasil pemutaran kurva" st = st & vbCrLf & "1. Gambar kurva dengan persamaan" st = st & vbCrLf & " y =" & Param(3).a & "x^3 + " & Param(3).b & "x^2 + " & _ Param(3).c & "x + " & Param(3).d st = st & vbCrLf & "2. Putar kurva sesuai mulai dari batas bawah" st = st & vbCrLf & " hingga batas atas terhadap sumbu x untuk" st = st & vbCrLf & " setiap kenaikan sudut putar " & sdtPutar & "derajat" st = st & vbCrLf & "3. Hubungkan titik-titik tersebut dengan garis," st = st & vbCrLf & " melintang sehingga diperoleh permukaan benda" st = st & vbCrLf & " hasil pemutaran kurva." st = st & vbCrLf & " Sambil mengklik scrollbar, perhatikan tampilan" st = st & vbCrLf & " Sistem Koordinat Cartesius di samping." txtKet.Text = st End Sub

Private Sub UraianFSinus3D() Dim st As String Dim sdtPutar As Single txtKet.FontName = "Courier New" txtKet.FontSize = 10 txtKet.Visible = True sdtPutar = Abs(SdtAkhir - SdtAwal) / BSegmenL st = "Fungsi Sinus dengan persamaan:" st = st & vbCrLf & " y =" & Param(4).a & " sin (" & Param(4).b & "x)" st = st & vbCrLf st = st & vbCrLf & "Cara Menggambar Benda hasil pemutaran kurva" st = st & vbCrLf & "1. Gambar kurva dengan persamaan" st = st & vbCrLf & " y =" & Param(4).a & " sin (" & Param(4).b & "x)" st = st & vbCrLf & "2. Putar kurva sesuai mulai dari batas bawah" st = st & vbCrLf & " hingga batas atas terhadap sumbu x untuk"

Universitas Sumatera Utara

st = st & vbCrLf "derajat" st = st & vbCrLf garis," st = st & vbCrLf benda" st = st & vbCrLf st = st & vbCrLf tampilan" st = st & vbCrLf txtKet.Text = st End Sub

& "

setiap kenaikan sudut putar " & sdtPutar &

& "3. Hubungkan titik-titik tersebut dengan & "

melintang sehingga diperoleh permukaan

& " hasil pemutaran kurva." & " Sambil mengklik scrollbar, perhatikan & " Sistem Koordinat Cartesius di samping."

Private Sub UraianFCosinus3D() Dim st As String Dim sdtPutar As Single txtKet.FontName = "Courier New" txtKet.FontSize = 10 txtKet.Visible = True sdtPutar = Abs(SdtAkhir - SdtAwal) / BSegmenL st = "Fungsi Cosinus dengan persamaan:" st = st & vbCrLf & " y =" & Param(5).a & " cos (" & Param(5).b & "x)" st = st & vbCrLf st = st & vbCrLf & "Cara Menggambar Benda hasil pemutaran kurva" st = st & vbCrLf & "1. Gambar kurva dengan persamaan" st = st & vbCrLf & " y =" & Param(5).a & " cos (" & Param(5).b & "x)" st = st & vbCrLf & "2. Putar kurva sesuai mulai dari batas bawah" st = st & vbCrLf & " hingga batas atas terhadap sumbu x untuk" st = st & vbCrLf & " setiap kenaikan sudut putar " & sdtPutar & "derajat" st = st & vbCrLf & "3. Hubungkan titik-titik tersebut dengan garis," st = st & vbCrLf & " melintang sehingga diperoleh permukaan benda" st = st & vbCrLf & " hasil pemutaran kurva." st = st & vbCrLf & " Sambil mengklik scrollbar, perhatikan tampilan" st = st & vbCrLf & " Sistem Koordinat Cartesius di samping." txtKet.Text = st End Sub

Private Sub UraianFTangen3D() Dim st As String Dim sdtPutar As Single txtKet.FontName = "Courier New" txtKet.FontSize = 10 txtKet.Visible = True sdtPutar = Abs(SdtAkhir - SdtAwal) / BSegmenL st = "Fungsi Tangen dengan persamaan:" st = st & vbCrLf & " y =" & Param(6).a & " tan (" & Param(6).b & "x)" st = st & vbCrLf st = st & vbCrLf & "Cara Menggambar Benda hasil pemutaran kurva" st = st & vbCrLf & "1. Gambar kurva dengan persamaan"

Universitas Sumatera Utara

st = st & vbCrLf "x)" st = st & vbCrLf st = st & vbCrLf st = st & vbCrLf "derajat" st = st & vbCrLf garis," st = st & vbCrLf benda" st = st & vbCrLf st = st & vbCrLf tampilan" st = st & vbCrLf txtKet.Text = st End Sub

& "

y =" & Param(6).a & " tan (" & Param(6).b &

& "2. Putar kurva sesuai mulai dari batas bawah" & " hingga batas atas terhadap sumbu x untuk" & " setiap kenaikan sudut putar " & sdtPutar & & "3. Hubungkan titik-titik tersebut dengan & "

melintang sehingga diperoleh permukaan

& " hasil pemutaran kurva." & " Sambil mengklik scrollbar, perhatikan & " Sistem Koordinat Cartesius di samping."

Private Sub SetNilaiAwalScrollCacah() If Kanvas3D = True Then hsbCacah.Min = 0 hsbCacah.Max = BSegmenL hsbCacah.LargeChange = 1 hsbCacah.SmallChange = 1 hsbCacah.Value = hsbCacah.Min Else hsbCacah.Min = 0 hsbCacah.Max = KurvaF(NoF).BanyakTitik hsbCacah.SmallChange = 1 hsbCacah.LargeChange = 10 hsbCacah.Value = hsbCacah.Min End If End Sub

Private Sub hsbCacah_Change() Dim T1 As TipeTitik Dim T2 As TipeTitik Dim b As Integer Dim k As Integer Dim g As Integer Dim sdtPutar As Single sdtPutar = (Abs(SAkhir - SAwal) / BSegmenL) * hsbCacah.Value txtY.Text = sdtPutar If Kanvas3D = True Then b = hsbCacah.Value + 1 T1 = SurfaceF(NoF).Titik(1, b) For k = 1 To BSegmenD drawPoint3D SurfaceF(NoF).Titik(k, b).X, _ SurfaceF(NoF).Titik(k, b).Y, _ SurfaceF(NoF).Titik(k, b).z, Warna(WGrafik(NoF)) If k > 1 Then T2 = SurfaceF(NoF).Titik(k, b) drawline3D T1.X, T1.Y, T1.z, T2.X, T2.Y, T2.z, Warna(WGrafik(NoF)) T1 = T2 End If

Universitas Sumatera Utara

Next k Else txtX.Text = KurvaF(NoF).Titik(hsbCacah.Value).X txtY.Text = KurvaF(NoF).Titik(hsbCacah.Value).Y DrawCircle KurvaF(NoF).Titik(hsbCacah.Value).X, _ KurvaF(NoF).Titik(hsbCacah.Value).Y, 0.25, Warna(WGrafik(NoF)) d = KurvaF(NoF).BanyakTitik hsbCacah.Max = d T1 = KurvaF(NoF).Titik(1) For k = 1 To hsbCacah.Value For g = 2 To k T1 = KurvaF(NoF).Titik(g - 1) T2 = KurvaF(NoF).Titik(g) Drawline T1.X, T1.Y, T2.X, T2.Y, Warna(WGrafik(NoF)) Next g Next k End If End Sub

Private Sub hsbL_Change() If Kanvas3D = True Then txtX.Text = SurfaceF(NoF).Titik(hsbCacah.Value, txtY.Text = SurfaceF(NoF).Titik(hsbCacah.Value, txtZ.Text = SurfaceF(NoF).Titik(hsbCacah.Value, drawPoint3D SurfaceF(NoF).Titik(hsbCacah.Value, _ SurfaceF(NoF).Titik(hsbCacah.Value, _ SurfaceF(NoF).Titik(hsbCacah.Value, Warna(WGrafik(NoF)) End If End Sub

hsbL.Value).X hsbL.Value).Y hsbL.Value).z hsbL.Value).X, hsbL.Value).Y, hsbL.Value).z,

frmPenulis Dim Ucapan As String Dim p As Integer Private Sub Form_Activate() Me.Left = (Screen.Width - Me.Width) \ 2 Me.Top = (Screen.Height - Me.Height) \ 2 lblUcapan.Caption = Ucapan picUcapan.Top = 128 End Sub

Private Sub Form_Click() Unload Me End Sub

Private Sub Ucapan = Ucapan = Ucapan = Ucapan = Ucapan =

Form_Load() "Dengan selesainya penulisan tugas akhir ini, penulis " Ucapan & "mengucapkan terima kasih kepada: " & vbCrLf Ucapan & "Orang tua penulis, Bapak Toni Solin, " Ucapan & "ibunda Dameria Sinaga, dan adik saya " Ucapan & "Susi, Okta, Benhat." & vbCrLf & vbCrLf

Universitas Sumatera Utara

Ucapan Ucapan Ucapan vbCrLf Ucapan vbCrLf Ucapan Ucapan Ucapan Ucapan Ucapan semua." & Ucapan Ucapan Ucapan

= Ucapan & "Pembimbing penulis:" & vbCrLf = Ucapan & "Bapak Drs. Suyanto M.Kom dan " & vbCrLf = Ucapan & "Bapak M. Andri B, ST. MCompSc. MEM." & vbCrLf & = Ucapan & "Instruktur Pemrograman Visual BASIC saya" & = Ucapan = Ucapan = Ucapan = Ucapan = Ucapan vbCrLf & = Ucapan = Ucapan = Ucapan

& "di PPK. Bina Potensi - Medan " & vbCrLf & "Bapak Ir. Hendrik Siagian" & vbCrLf & vbCrLf & "Teman saya, Hanna, Esron, Antoni, Basuki, " & "Lenora, Mita, Debora" & vbCrLf & vbCrLf & "Kiranya Tuhan Yesus Kristus memberkati kita vbCrLf & "---ooo))))((((ooo---" & vbCrLf & vbCrLf & "JAMARDI SOLIN" & vbCrLf & "NIM. 051401070"

p = 128 End Sub

Private Sub tmrGulung_Timer() Static u As Integer u = u + 1 p = p - 3 picUcapan.Top = p If u > 280 Then u = 0 p = 128 Me.Picture = LoadPicture(App.Path & "\TPro.jpg") picKanvas.Visible = True ElseIf u > 250 Then Me.Picture = LoadPicture(App.Path & "\TPro2.jpg") ElseIf u > 220 Then picKanvas.Visible = False Me.Picture = LoadPicture(App.Path & "\TPro1.jpg") End If End Sub

frmSplash Dim Dim Dim Dim

Transparan As Integer Ket As String BK As Integer BT As Integer

Private Sub Form_Load() Me.Left = (Screen.Width - Me.Width) \ 2 Me.Top = (Screen.Height - Me.Height) \ 2 Ket = "Program Studi S1 Ilmu Komputer " Ket = Ket & "Departemen Ilmu Komputer " Ket = Ket & "Fakultas Matematika dan Ilmu Pengetahuan Alam " Ket = Ket & "Universitas Sumatera Utara - Medan " BK = Len(Ket) BT = 30 Transparan = 255 lblUsu.Caption = Left(Ket, BT) End Sub

Universitas Sumatera Utara

Private Sub Form_Click() Unload Me End Sub

Private Sub imgSplash_Click() tmrHilang.Enabled = True End Sub

Private Sub tmrHilang_Timer() On Error Resume Next Transparan = Transparan - 5 If Transparan < 0 Then Transparan = 0 tmrHilang.Enabled = False End If SetTranslucent Me.hwnd, Transparan If Transparan <= 0 Then frmUtama.SetFocus Unload Me End If End Sub

Private Sub tmrKurva_Timer() Dim s As Integer Randomize Timer s = Int(Rnd * 100) Mod 5 + 1 Select Case s Case 1: picKurva.Picture = "\splash1.jpg") Case 2: picKurva.Picture = "\splash2.jpg") Case 3: picKurva.Picture = "\splash3.jpg") Case 4: picKurva.Picture = "\splash4.jpg") Case 5: picKurva.Picture = "\splash5.jpg") End Select End Sub

LoadPicture(App.Path & LoadPicture(App.Path & LoadPicture(App.Path & LoadPicture(App.Path & LoadPicture(App.Path &

Private Sub tmrTunda_Timer() tmrHilang.Enabled = True End Sub

Private Sub tmrUsu_Timer() Ket = Mid(Ket, 2, BK - 1) + Left(Ket, 1) lblUsu.Caption = Left(Ket, BT) End Sub frmTPro Private Sub Form_Activate() Dim NamaFile As String Dim noFile As Integer

Universitas Sumatera Utara

rtfTeori.BackColor = RGB(255, 255, 192) rtfTeori.FileName = App.Path & "\teori.rtf" End Sub

Private Sub Form_Resize() rtfTeori.Top = 0 rtfTeori.Left = 0 rtfTeori.Width = frmTPro.ScaleWidth rtfTeori.Height = frmTPro.ScaleHeight End Sub

frmUtama Dim NamaFile As String Dim noFile As Integer Dim AdaData As Boolean Private Sub MDIForm_Load() mnuSimpan.Enabled = False mnuTutup.Enabled = False ToolPasif End Sub

Private Sub ToolPasif() txtBBawah.Enabled = False txtBAtas.Enabled = False txtSAwal.Enabled = False txtSAkhir.Enabled = False chkGrid.Enabled = False chkSumbu.Enabled = False chkBatas.Enabled = False toolStandard.Buttons(3).Enabled toolStandard.Buttons(5).Enabled toolStandard.Buttons(6).Enabled toolStandard.Buttons(7).Enabled toolStandard.Buttons(8).Enabled End Sub

Private Sub ToolAktif() txtBBawah.Enabled = True txtBAtas.Enabled = True txtSAwal.Enabled = True txtSAkhir.Enabled = True chkGrid.Enabled = True chkSumbu.Enabled = True chkBatas.Enabled = True toolStandard.Buttons(3).Enabled toolStandard.Buttons(5).Enabled toolStandard.Buttons(6).Enabled toolStandard.Buttons(7).Enabled toolStandard.Buttons(8).Enabled End Sub

= = = = =

False False False False False

= = = = =

True True True True True

Private Sub mnuBaru_Click() FileBaru = True

Universitas Sumatera Utara

ToolAktif InisialisasiBatas ResetParameterFungsi txtBBawah.Text = BBawah txtBAtas.Text = BAtas txtSAwal.Text = SAwal txtSAkhir.Text = SAkhir chkBatas.Value = Checked chkSumbu.Value = Checked chkGrid.Value = Checked mnuSimpan.Enabled = True mnuTutup.Enabled = True frmLKerja.IsianKosong Kanvas3D = False frmLKerja.RefreshKanvas frmLKerja.chkBelajar.Value = Unchecked End Sub

Private Sub mnuBuka_Click() Dim f As Integer BukaFileData If AdaData = True Then FileBaru = False TampilkanData Kanvas3D = False For f = 1 To 6 KurvaF(f) = EvalKurvaFungsi(f, Param(f)) SurfaceF(f) = EvalSurfFungsi(f, Param(f)) If (KurvaF(f).Tampak = True) And (KurvaF(f).BanyakTitik > 0) Then frmLKerja.chkF(f).Value = Checked End If Next f frmLKerja.RefreshKanvas ToolAktif End If mnuTutup.Enabled = True mnuSimpan.Enabled = True End Sub

Private Sub mnuTutup_Click() mnuTutup.Enabled = False mnuSimpan.Enabled = False Unload frmLKerja ToolPasif End Sub

Private Sub mnuSimpan_Click() SimpanFileData End Sub

Private Sub mnuKeluar_Click() End End Sub

Universitas Sumatera Utara

Private Sub mnuWarna_Click() frmUtama.Enabled = False frmWarna.Show End Sub

Private Sub mnuPenulis_Click() frmPenulis.Show End Sub

Private Sub mnuTProgram_Click() frmTPro.Show End Sub

Private Sub toolStandard_ButtonClick(ByVal Button As MSComctlLib.Button) Select Case Button.Key Case Is = "toolBaru" mnuBaru_Click Case Is = "toolBuka" mnuBuka_Click Case Is = "toolSimpan" mnuSimpan_Click Case Is = "toolPengaturan" frmWarna.Show Case Is = "tool2D" frmLKerja.picRulerH.Visible = True frmLKerja.picRulerV.Visible = True frmLKerja.picKanvas.Left = 450 frmLKerja.picKanvas.Top = 450 Kanvas3D = False frmLKerja.RefreshKanvas Case Is = "tool3D" frmLKerja.picRulerH.Visible = False frmLKerja.picRulerV.Visible = False frmLKerja.picKanvas.Left = 0 frmLKerja.picKanvas.Top = 0 Kanvas3D = True frmLKerja.RefreshKanvas Case Is = "toolZoomO" ZoomOut Case Is = "toolZoomI" ZoomIn End Select End Sub

Private Sub BukaFileData() On Error Resume Next NamaFile = "" cdlFile.Filter = "File Data (*.dfj)|*.dfj|" & _ "Semua File (*.*) |*.*|" cdlFile.ShowOpen NamaFile = cdlFile.FileName noFile = FreeFile AdaData = False If NamaFile = vbNullString Then InisialisasiBatas

Universitas Sumatera Utara

ResetParameterFungsi Exit Sub End If Open NamaFile For Input As noFile If Err.Number = 53 Then MsgBox "Nama File Data Tidak Ditemukan", vbOKOnly + vbCritical, "Pesan Kesalahan" AdaData = False Close #noFile Exit Sub End If '--Baca Data Warna Layar Input #noFile, WDasar.Red, WDasar.Green, WDasar.Blue Input #noFile, WSumbu.Red, WSumbu.Green, WSumbu.Blue Input #noFile, WGMayor.Red, WGMayor.Green, WGMayor.Blue Input #noFile, WGMinor.Red, WGMinor.Green, WGMinor.Blue Input #noFile, WPembatas.Red, WPembatas.Green, WPembatas.Blue '--Baca Data Warna Grafik Input #noFile, WGrafik(1).Red, Input #noFile, WGrafik(2).Red, Input #noFile, WGrafik(3).Red, Input #noFile, WGrafik(4).Red, Input #noFile, WGrafik(5).Red, Input #noFile, WGrafik(6).Red,

WGrafik(1).Green, WGrafik(2).Green, WGrafik(3).Green, WGrafik(4).Green, WGrafik(5).Green, WGrafik(6).Green,

WGrafik(1).Blue WGrafik(2).Blue WGrafik(3).Blue WGrafik(4).Blue WGrafik(5).Blue WGrafik(6).Blue

'--Simpan Data Batas Input #noFile, BBawah, BAtas, SAwal, SAkhir, BSegmenD, BSegmenL, BGrid '--Simpan Parameter Fungsi Input #noFile, Param(1).a, Input #noFile, Param(2).a, Input #noFile, Param(3).a, Input #noFile, Param(4).a, Input #noFile, Param(5).a, Input #noFile, Param(6).a, AdaData = True Close #noFile End Sub

Param(1).b, Param(2).b, Param(3).b, Param(4).b, Param(5).b, Param(6).b,

Param(1).c, Param(2).c, Param(3).c, Param(4).c, Param(5).c, Param(6).c,

Param(1).d Param(2).d Param(3).d Param(4).d Param(5).d Param(6).d

Private Sub TampilkanData() frmUtama.txtBAtas = BAtas frmUtama.txtBBawah = BBawah frmUtama.txtSAwal = SAwal frmUtama.txtSAkhir = SAkhir frmLKerja.txtLa.Text = Replace(Param(1).a, ",", ".") frmLKerja.txtLb.Text = Replace(Param(1).b, ",", ".") frmLKerja.txtKa.Text = Replace(Param(2).a, ",", ".") frmLKerja.txtKb.Text = Replace(Param(2).b, ",", ".") frmLKerja.txtKc.Text = Replace(Param(2).c, ",", ".") frmLKerja.txtPa.Text frmLKerja.txtPb.Text frmLKerja.txtPc.Text frmLKerja.txtPd.Text

= = = =

Replace(Param(3).a, Replace(Param(3).b, Replace(Param(3).c, Replace(Param(3).d,

",", ",", ",", ",",

".") ".") ".") ".")

Universitas Sumatera Utara

frmLKerja.txtSa.Text = Replace(Param(4).a, ",", ".") frmLKerja.txtSb.Text = Replace(Param(4).b, ",", ".") frmLKerja.txtCa.Text = Replace(Param(5).a, ",", ".") frmLKerja.txtCb.Text = Replace(Param(5).b, ",", ".") frmLKerja.txtTa.Text = Replace(Param(6).a, ",", ".") frmLKerja.txtTb.Text = Replace(Param(6).b, ",", ".") End Sub

Private Sub SimpanFileData() NamaFile = "" cdlFile.Filter = "File Data (*.dfj)|*.dfj|" & _ "Semua File (*.*) |*.*|" cdlFile.ShowSave NamaFile = cdlFile.FileName If NamaFile = vbNullString Then Exit Sub End If Me.Caption = NamaFile NamaFile = Trim(NamaFile) & ".dfj" noFile = FreeFile Open NamaFile For Output As noFile '--Simpan Data Print #noFile, ","; Print #noFile, ","; Print #noFile, ","; Print #noFile, ","; Print #noFile, WPembatas.Blue

Warna Layar WDasar.Red; ","; WDasar.Green; ","; WDasar.Blue; WSumbu.Red; ","; WSumbu.Green; ","; WSumbu.Blue; WGMayor.Red; ","; WGMayor.Green; ","; WGMayor.Blue; WGMinor.Red; ","; WGMinor.Green; ","; WGMinor.Blue; WPembatas.Red; ","; WPembatas.Green; ",";

'--Simpan Data Warna Grafik Print #noFile, WGrafik(1).Red; WGrafik(1).Blue; ","; Print #noFile, WGrafik(2).Red; WGrafik(2).Blue; ","; Print #noFile, WGrafik(3).Red; WGrafik(3).Blue; ","; Print #noFile, WGrafik(4).Red; WGrafik(4).Blue; ","; Print #noFile, WGrafik(5).Red; WGrafik(5).Blue; ","; Print #noFile, WGrafik(6).Red; WGrafik(6).Blue

","; WGrafik(1).Green; ","; ","; WGrafik(2).Green; ","; ","; WGrafik(3).Green; ","; ","; WGrafik(4).Green; ","; ","; WGrafik(5).Green; ","; ","; WGrafik(6).Green; ",";

'--Simpan Data Batas Print #noFile, BBawah; ","; BAtas; ","; SAwal; ","; SAkhir; ","; BSegmenD; ","; BSegmenL; ","; BGrid '--Simpan Parameter Fungsi Print #noFile, Replace(Param(1).a, ",", "."); ","; Replace(Param(1).b, ",", "."); ","; Replace(Param(1).c, ",", "."); ","; Replace(Param(1).d, ",", "."); ",";

Universitas Sumatera Utara

Print #noFile, Replace(Param(2).a, ",", "."); ","; Replace(Param(2).b, ",", "."); ","; Replace(Param(2).c, ","; Replace(Param(2).d, ",", "."); ","; Print #noFile, Replace(Param(3).a, ",", "."); ","; Replace(Param(3).b, ",", "."); ","; Replace(Param(3).c, ","; Replace(Param(3).d, ",", "."); ","; Print #noFile, Replace(Param(4).a, ",", "."); ","; Replace(Param(4).b, ",", "."); ","; Replace(Param(4).c, ","; Replace(Param(4).d, ",", "."); ","; Print #noFile, Replace(Param(5).a, ",", "."); ","; Replace(Param(5).b, ",", "."); ","; Replace(Param(5).c, ","; Replace(Param(5).d, ",", "."); ","; Print #noFile, Replace(Param(6).a, ",", "."); ","; Replace(Param(6).b, ",", "."); ","; Replace(Param(6).c, ","; Replace(Param(6).d, ",", ".") Close #noFile End Sub

",", ".");

",", ".");

",", ".");

",", ".");

",", ".");

Public Sub ZoomIn() If PSkala > 50 Then PSkala = PSkala - 25 If Kanvas3D = False Then frmLKerja.Set2D Else frmLKerja.Set3D End If End If End Sub

Private Sub ZoomOut() PSkala = PSkala + 25 If Kanvas3D = False Then frmLKerja.Set2D Else frmLKerja.Set3D End If End Sub

Private Sub txtBAtas_Change() Dim px As Single BAtas = Val(txtBAtas.Text) If Kanvas3D = False Then frmLKerja.GambarBatas2D Else frmLKerja.RefreshKanvas End If End Sub

Private Sub txtBBawah_Change() Dim px As Single BBawah = Val(txtBBawah.Text) If Kanvas3D = False Then frmLKerja.GambarBatas2D Else frmLKerja.RefreshKanvas End If

Universitas Sumatera Utara

End Sub

Private Sub chkBatas_Click() ONBatas = chkBatas.Value frmLKerja.linBAtas.Visible = ONBatas frmLKerja.linBBawah.Visible = ONBatas End Sub

Private Sub chkGrid_Click() ONGrid = chkGrid.Value frmLKerja.RefreshKanvas End Sub

Private Sub chkSumbu_Click() ONSumbu = chkSumbu.Value frmLKerja.RefreshKanvas End Sub

Private Sub txtSAkhir_Change() SAkhir = Val(txtSAkhir.Text) End Sub

Private Sub txtSAwal_Change() SAwal = Val(txtSAwal.Text) End Sub frmWarna Dim WPilih As TipeWarna Dim PPilih As Integer Private Sub Form_Activate() Dim f As Integer Me.Left = (Screen.Width - Me.Width) \ 2 Me.Top = (Screen.Height - Me.Height) \ 2 shpSorot.BorderColor = RGB(255, 0, 0) PPilih = 1 lblVWDasar.BackColor = RGB(WDasar.Red, WDasar.Green, WDasar.Blue) lblVWSumbu.BackColor = RGB(WSumbu.Red, WSumbu.Green, WSumbu.Blue) lblVWGMayor.BackColor = RGB(WGMayor.Red, WGMayor.Green, WGMayor.Blue) lblVWGMinor.BackColor = RGB(WGMinor.Red, WGMinor.Green, WGMinor.Blue) lblVWPembatas.BackColor = RGB(WPembatas.Red, WPembatas.Green, WPembatas.Blue) For f = 1 To 6 lblVWGrafik(f).BackColor = RGB(WGrafik(f).Red, WGrafik(f).Green, WGrafik(f).Blue) Next f txtBSegmenD.Text = BSegmenD txtBSegmenL.Text = BSegmenL txtBGrid.Text = BGrid End Sub

Universitas Sumatera Utara

Private Sub cmdSetWarna_Click() Select Case PPilih Case 1: WDasar.Red = WPilih.Red WDasar.Green = WPilih.Green WDasar.Blue = WPilih.Blue lblVWDasar.BackColor = RGB(WPilih.Red, WPilih.Green, WPilih.Blue) Case 2: WSumbu.Red = WPilih.Red WSumbu.Green = WPilih.Green WSumbu.Blue = WPilih.Blue WSumbuO = WSumbu lblVWSumbu.BackColor = RGB(WPilih.Red, WPilih.Green, WPilih.Blue) Case 3: WGMayor.Red = WPilih.Red WGMayor.Green = WPilih.Green WGMayor.Blue = WPilih.Blue WGMayorO = WGMayor lblVWGMayor.BackColor = RGB(WPilih.Red, WPilih.Green, WPilih.Blue) Case 4: WGMinor.Red = WPilih.Red WGMinor.Green = WPilih.Green WGMinor.Blue = WPilih.Blue WGMinorO = WGMinor lblVWGMinor.BackColor = RGB(WPilih.Red, WPilih.Green, WPilih.Blue) Case 5: WPembatas.Red = WPilih.Red WPembatas.Green = WPilih.Green WPembatas.Blue = WPilih.Blue lblVWPembatas.BackColor = RGB(WPilih.Red, WPilih.Green, WPilih.Blue) Case Else WGrafik(PPilih - 5).Red = WPilih.Red WGrafik(PPilih - 5).Green = WPilih.Green WGrafik(PPilih - 5).Blue = WPilih.Blue lblVWGrafik(PPilih - 5).BackColor = RGB(WPilih.Red, WPilih.Green, WPilih.Blue) End Select End Sub

Private Sub cmdTutup_Click() frmUtama.Enabled = True Unload Me End Sub

Private Sub WarnaPilih() lblWarna.BackColor = RGB(WPilih.Red, WPilih.Green, WPilih.Blue) End Sub

Private Sub hsbBiru_Change() WPilih.Blue = hsbBiru.Value txtBiru.Text = WPilih.Blue End Sub

Universitas Sumatera Utara

Private Sub hsbHijau_Change() WPilih.Green = hsbHijau.Value txtHijau.Text = WPilih.Green End Sub

Private Sub hsbMerah_Change() WPilih.Red = hsbMerah.Value txtMerah.Text = WPilih.Red End Sub

Private Sub lblVWDasar_Click() shpSorot.Top = lblVWDasar.Top - 50 shpSorot.Left = lblVWDasar.Left - 50 shpSorot.Width = lblVWDasar.Width + 100 PPilih = 1 WPilih = WDasar txtMerah.Text = WPilih.Red txtHijau.Text = WPilih.Green txtBiru.Text = WPilih.Blue End Sub

Private Sub lblVWSumbu_Click() shpSorot.Top = lblVWSumbu.Top - 50 shpSorot.Left = lblVWSumbu.Left - 50 shpSorot.Width = lblVWSumbu.Width + 100 PPilih = 2 WPilih = WSumbu txtMerah.Text = WPilih.Red txtHijau.Text = WPilih.Green txtBiru.Text = WPilih.Blue End Sub

Private Sub lblVWGMayor_Click() shpSorot.Top = lblVWGMayor.Top - 50 shpSorot.Left = lblVWGMayor.Left - 50 shpSorot.Width = lblVWGMayor.Width + 100 PPilih = 3 WPilih = WGMayor txtMerah.Text = WPilih.Red txtHijau.Text = WPilih.Green txtBiru.Text = WPilih.Blue End Sub

Private Sub lblVWGMinor_Click() shpSorot.Top = lblVWGMinor.Top - 50 shpSorot.Left = lblVWGMinor.Left - 50 shpSorot.Width = lblVWGMinor.Width + 100 PPilih = 4 WPilih = WGMinor txtMerah.Text = WPilih.Red txtHijau.Text = WPilih.Green txtBiru.Text = WPilih.Blue End Sub

Universitas Sumatera Utara

Private Sub lblVWPembatas_Click() shpSorot.Top = lblVWPembatas.Top - 50 shpSorot.Left = lblVWPembatas.Left - 50 shpSorot.Width = lblVWPembatas.Width + 100 PPilih = 5 WPilih = WPembatas txtMerah.Text = WPilih.Red txtHijau.Text = WPilih.Green txtBiru.Text = WPilih.Blue End Sub

Private Sub lblVWGrafik_Click(Index As Integer) shpSorot.Top = lblVWGrafik(Index).Top - 50 shpSorot.Left = lblVWGrafik(Index).Left - 50 shpSorot.Width = lblVWGrafik(Index).Width + 100 PPilih = 5 + Index WPilih = WGrafik(Index) txtMerah.Text = WPilih.Red txtHijau.Text = WPilih.Green txtBiru.Text = WPilih.Blue End Sub

Private Sub txtBGrid_Change() BGrid = Val(txtBGrid.Text) If BGrid < 2 Then BGrid = 2 txtBGrid.Text = BGrid End If End Sub

Private Sub txtBSegmenD_Change() BSegmenD = Val(txtBSegmenD.Text) If BSegmenD < 1 Then BSegmenD = 1 txtBSegmenD.Text = BSegmenD ElseIf BSegmenD > MaxSegmen Then BSegmenD = MaxSegmen txtBSegmenD.Text = BSegmenD End If End Sub

Private Sub txtBSegmenL_Change() BSegmenL = Val(txtBSegmenL.Text) If BSegmenL < 1 Then BSegmenL = 1 txtBSegmenL.Text = BSegmenL ElseIf BSegmenL > MaxSegmen Then BSegmenL = MaxSegmen txtBSegmenL.Text = BSegmenL End If End Sub

Private Sub txtMerah_Change()

Universitas Sumatera Utara

WPilih.Red = Val(txtMerah.Text) If WPilih.Red > 255 Then WPilih.Red = 255 If WPilih.Red < 0 Then WPilih.Red = 0 txtMerah.Text = WPilih.Red hsbMerah.Value = WPilih.Red WarnaPilih End Sub

Private Sub txtHijau_Change() WPilih.Green = Val(txtHijau.Text) If WPilih.Green > 255 Then WPilih.Green = 255 If WPilih.Green < 0 Then WPilih.Green = 0 txtHijau.Text = WPilih.Green hsbHijau.Value = WPilih.Green WarnaPilih End Sub

Private Sub txtBiru_Change() WPilih.Blue = Val(txtBiru.Text) If WPilih.Blue > 255 Then WPilih.Blue = 255 If WPilih.Blue < 0 Then WPilih.Blue = 0 txtBiru.Text = WPilih.Blue hsbBiru.Value = WPilih.Blue WarnaPilih End Sub

Universitas Sumatera Utara