VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form TwoPoint
BackColor = &H80000013&
Caption = "CHECKER UPPER CASE"
ClientHeight = 10800
ClientLeft = 120
ClientTop = 450
ClientWidth = 13860
LinkTopic = "Form1"
ScaleHeight = 10800
ScaleWidth = 13860
StartUpPosition = 3 'Windows Default
Begin VB.Frame Frame4
BackColor = &H80000013&
Caption = "VERIFICATION PART"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000E&
Height = 2175
Left = 120
TabIndex = 33
Top = 4800
Width = 13575
Begin VB.Frame Frame6
BackColor = &H80000013&
Caption = "Upper Case"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF00&
Height = 1695
Left = 120
TabIndex = 40
Top = 360
Width = 4335
Begin VB.TextBox AbsAct
Alignment = 2 'Center
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 3600
TabIndex = 46
Top = 1130
Width = 615
End
Begin VB.TextBox IssAct
Alignment = 2 'Center
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 3000
TabIndex = 45
Top = 1130
Width = 615
End
Begin VB.TextBox BatAct
Alignment = 2 'Center
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 2400
TabIndex = 44
Top = 1130
Width = 615
End
Begin VB.TextBox AbsTarget
Alignment = 2 'Center
BackColor = &H00FFFF80&
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 3600
TabIndex = 43
Top = 720
Width = 615
End
Begin VB.TextBox IssTarget
Alignment = 2 'Center
BackColor = &H00FFFF80&
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 3000
TabIndex = 42
Top = 720
Width = 615
End
Begin VB.TextBox BatTarget
Alignment = 2 'Center
BackColor = &H00FFFF80&
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 2400
TabIndex = 41
Top = 720
Width = 615
End
Begin VB.Image ImgGambarUpper
BorderStyle = 1 'Fixed Single
Height = 1215
Left = 120
Stretch = -1 'True
Top = 360
Width = 2055
End
Begin VB.Image Image2
BorderStyle = 1 'Fixed Single
Height = 375
Left = 3000
Picture = "Buat tampilan pesan dengan KeyAscii.frx":0000
Stretch = -1 'True
Top = 360
Width = 615
End
Begin VB.Image Image3
BorderStyle = 1 'Fixed Single
Height = 375
Left = 3600
Picture = "Buat tampilan pesan dengan KeyAscii.frx":119D
Stretch = -1 'True
Top = 360
Width = 615
End
Begin VB.Image Image1
BorderStyle = 1 'Fixed Single
Height = 375
Left = 2400
Picture = "Buat tampilan pesan dengan KeyAscii.frx":2B0D
Stretch = -1 'True
Top = 360
Width = 615
End
End
Begin VB.TextBox inComm
Height = 375
Left = 1560
TabIndex = 55
Top = 1320
Width = 1095
End
Begin VB.Frame Frame8
BackColor = &H80000013&
Caption = "QR ASSY"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF00&
Height = 1695
Left = 9240
TabIndex = 52
Top = 360
Width = 4215
Begin VB.TextBox ActQRAssy
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 600
Left = 2160
TabIndex = 54
Top = 960
Width = 1935
End
Begin VB.TextBox TargetQRAssy
BackColor = &H00FFFF80&
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 2160
TabIndex = 53
Top = 360
Width = 1935
End
Begin VB.Image ImgGambarAssy
BorderStyle = 1 'Fixed Single
Height = 1215
Left = 120
Stretch = -1 'True
Top = 360
Width = 1815
End
End
Begin VB.Frame Frame7
BackColor = &H80000013&
Caption = "QR PCB"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF00&
Height = 1695
Left = 4680
TabIndex = 49
Top = 360
Width = 4335
Begin VB.TextBox ActQRpcb
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 600
Left = 2160
TabIndex = 51
Top = 960
Width = 2055
End
Begin VB.TextBox TargetQRpcb
BackColor = &H00FFFF80&
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 2160
TabIndex = 50
Top = 360
Width = 2055
End
Begin VB.Image ImgGambarpcb
BorderStyle = 1 'Fixed Single
Height = 1215
Left = 120
Stretch = -1 'True
Top = 360
Width = 1815
End
End
Begin VB.TextBox NstepUpper
Height = 285
Left = 1080
TabIndex = 48
Top = 600
Width = 495
End
Begin VB.TextBox NilaiUpper
Height = 285
Left = 480
TabIndex = 47
Top = 600
Width = 495
End
Begin VB.TextBox NilaiAssy
Height = 285
Left = 12360
TabIndex = 39
Top = 960
Width = 495
End
Begin VB.TextBox NstepAssy
Height = 285
Left = 11520
TabIndex = 38
Top = 960
Width = 495
End
Begin VB.TextBox ActQRUpper
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 360
TabIndex = 37
Top = 1560
Width = 1215
End
Begin VB.TextBox NilaiPcb
Height = 285
Left = 7560
TabIndex = 36
Top = 960
Width = 495
End
Begin VB.TextBox NstepPcb
Height = 285
Left = 6840
TabIndex = 35
Top = 960
Width = 495
End
Begin VB.TextBox TargetQRUpper
BackColor = &H00FFFF80&
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 360
TabIndex = 34
Top = 1200
Width = 1215
End
Begin MSCommLib.MSComm MSComm4
Left = 7440
Top = 240
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
CommPort = 2
DTREnable = 0 'False
RThreshold = 3
End
End
Begin VB.Frame Frame5
Caption = "LOG FILE"
ForeColor = &H00000000&
Height = 3615
Left = 120
TabIndex = 14
Top = 7080
Width = 13575
Begin VB.CommandButton Command1
BackColor = &H0000FFFF&
Caption = "Setting"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 11640
Style = 1 'Graphical
TabIndex = 32
Top = 1440
Width = 1695
End
Begin VB.ComboBox cmbHistory
Height = 315
Left = 8520
TabIndex = 29
Top = 3240
Width = 2895
End
Begin MSDataGridLib.DataGrid DataGrid1
Height = 2895
Left = 120
TabIndex = 28
Top = 240
Width = 11295
_ExtentX = 19923
_ExtentY = 5106
_Version = 393216
HeadLines = 1
RowHeight = 15
BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ColumnCount = 2
BeginProperty Column00
DataField = ""
Caption = ""
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1033
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column01
DataField = ""
Caption = ""
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1033
SubFormatType = 0
EndProperty
EndProperty
SplitCount = 1
BeginProperty Split0
BeginProperty Column00
EndProperty
BeginProperty Column01
EndProperty
EndProperty
End
Begin MSAdodcLib.Adodc Adodc1
Height = 330
Left = 120
Top = 3240
Width = 2295
_ExtentX = 4048
_ExtentY = 582
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = ""
OLEDBString = ""
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = ""
Caption = "Adodc1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 12600
Top = 2040
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.TextBox Registrasi1
Alignment = 2 'Center
Height = 285
Left = 11640
TabIndex = 27
Top = 840
Width = 1695
End
Begin VB.Timer Timer1
Interval = 100
Left = 11880
Top = 2040
End
Begin VB.TextBox Tanggal
Alignment = 2 'Center
BackColor = &H0000FF00&
BeginProperty Font
Name = "Arial Narrow"
Size = 14.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 11640
TabIndex = 24
Top = 2520
Width = 1695
End
Begin VB.TextBox Jam
Alignment = 2 'Center
BackColor = &H0000FF00&
BeginProperty Font
Name = "Arial"
Size = 14.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 11640
TabIndex = 23
Top = 3000
Width = 1695
End
Begin VB.CommandButton Registration
BackColor = &H008080FF&
Caption = "Registration"
BeginProperty Font
Name = "Arial Narrow"
Size = 14.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 11640
Style = 1 'Graphical
TabIndex = 22
Top = 240
Width = 1695
End
Begin VB.Label Label10
Caption = "History (log file) >>>"
Height = 255
Left = 6840
TabIndex = 30
Top = 3240
Width = 1575
End
End
Begin VB.Frame Frame3
BackColor = &H80000013&
Caption = "PRODUCTION INFORMATION"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000E&
Height = 1815
Left = 120
TabIndex = 6
Top = 2880
Width = 8535
Begin VB.Timer Timer3
Enabled = 0 'False
Interval = 100
Left = 840
Top = 120
End
Begin VB.Timer Timer2
Enabled = 0 'False
Interval = 700
Left = 120
Top = 120
End
Begin VB.TextBox Scaner
Height = 405
Left = 1440
TabIndex = 19
Top = 1080
Width = 6375
End
Begin VB.TextBox LenText
Height = 405
Left = 7800
TabIndex = 16
Top = 1080
Width = 495
End
Begin VB.TextBox Blc
BackColor = &H00FFFF80&
BeginProperty Font
Name = "Arial"
Size = 21.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 6960
TabIndex = 12
Text = "0"
Top = 360
Width = 1335
End
Begin VB.TextBox Act
BackColor = &H00FFFF80&
BeginProperty Font
Name = "Arial"
Size = 21.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 4200
TabIndex = 10
Text = "0"
Top = 360
Width = 1335
End
Begin VB.TextBox Plan
BackColor = &H00FFFF80&
BeginProperty Font
Name = "Arial"
Size = 21.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1440
TabIndex = 8
Text = "0"
Top = 360
Width = 1335
End
Begin VB.Label lblScaner
Alignment = 2 'Center
BackColor = &H80000013&
BeginProperty Font
Name = "Arial Narrow"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 1080
TabIndex = 20
Top = 1500
Width = 7215
End
Begin VB.Label Label9
BackColor = &H80000013&
Caption = "SCAN >>>"
BeginProperty Font
Name = "Arial Narrow"
Size = 14.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF80&
Height = 375
Left = 120
TabIndex = 15
Top = 1080
Width = 1215
End
Begin VB.Label Label5
BackColor = &H80000013&
Caption = "/ BLC"
BeginProperty Font
Name = "Arial Narrow"
Size = 18
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF80&
Height = 375
Left = 5760
TabIndex = 11
Top = 480
Width = 1095
End
Begin VB.Label Label4
BackColor = &H80000013&
Caption = "/ ACT"
BeginProperty Font
Name = "Arial Narrow"
Size = 18
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF80&
Height = 375
Left = 3000
TabIndex = 9
Top = 480
Width = 1215
End
Begin VB.Label Label3
BackColor = &H80000013&
Caption = "PLAN "
BeginProperty Font
Name = "Arial Narrow"
Size = 18
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF80&
Height = 375
Left = 120
TabIndex = 7
Top = 480
Width = 855
End
Begin VB.Label lblScaner1
BackColor = &H80000013&
Height = 255
Left = 3840
TabIndex = 31
Top = 1080
Width = 2415
End
End
Begin VB.Frame Frame2
BackColor = &H80000013&
Caption = "JUDGEMENT"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000E&
Height = 4575
Left = 8880
TabIndex = 5
Top = 120
Width = 4815
Begin VB.CommandButton Resett
BackColor = &H0000FFFF&
Caption = "RESET"
BeginProperty Font
Name = "Arial"
Size = 15.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1200
MaskColor = &H0000FFFF&
Style = 1 'Graphical
TabIndex = 18
Top = 3960
Width = 2535
End
Begin VB.TextBox Hasil
Height = 315
Left = 1920
TabIndex = 26
Top = 4080
Width = 615
End
Begin VB.TextBox NstepTotal
Height = 375
Left = 1560
TabIndex = 21
Text = "0"
Top = 4080
Width = 615
End
Begin VB.TextBox NilaiTotal
Height = 375
Left = 1320
TabIndex = 17
Text = "0"
Top = 4080
Width = 735
End
Begin VB.Image ImgGambarAll
BorderStyle = 1 'Fixed Single
Height = 3135
Left = 120
Stretch = -1 'True
Top = 600
Width = 4575
End
End
Begin VB.Frame Frame1
BackColor = &H80000013&
Caption = "PROCESS INFORMATION"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000E&
Height = 2655
Left = 120
TabIndex = 0
Top = 120
Width = 8535
Begin VB.ComboBox CmbType
BackColor = &H0000FFFF&
BeginProperty Font
Name = "Arial"
Size = 18
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 2760
TabIndex = 25
Top = 1920
Width = 5535
End
Begin VB.TextBox pic
BackColor = &H00FF0000&
BeginProperty Font
Name = "MS Sans Serif"
Size = 24
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 615
Left = 2760
TabIndex = 3
Top = 1200
Width = 5535
End
Begin VB.TextBox proses
BackColor = &H00FF0000&
BeginProperty Font
Name = "MS Sans Serif"
Size = 24
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 585
Left = 2760
TabIndex = 2
Text = "Checker Upper"
Top = 480
Width = 5535
End
Begin VB.Label Label8
BackColor = &H80000013&
Caption = "TYPE"
BeginProperty Font
Name = "Arial Narrow"
Size = 20.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF80&
Height = 495
Left = 240
TabIndex = 13
Top = 1920
Width = 2535
End
Begin VB.Label Label2
BackColor = &H80000013&
Caption = "PIC"
BeginProperty Font
Name = "Arial Narrow"
Size = 20.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF80&
Height = 495
Left = 240
TabIndex = 4
Top = 1200
Width = 2535
End
Begin VB.Label Label1
BackColor = &H80000013&
Caption = "PROCESS"
BeginProperty Font
Name = "Arial Narrow"
Size = 20.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF80&
Height = 495
Left = 240
TabIndex = 1
Top = 480
Width = 2535
End
End
End
Attribute VB_Name = "TwoPoint"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, _
ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long
Dim Koneksi As New ADODB.Connection
Dim Log As ADODB.Recordset
' Formula insert gambar OK/NG pada kolom verifikasi QR Upper yang mendapat nilai 1 jika kode QR act scan sama dengan standard saat proses scan '
Private Sub ActQRUpper_Change()
BatAct.Text = Mid(ActQRUpper, 1, 1)
IssAct.Text = Mid(ActQRUpper, 2, 1)
AbsAct.Text = Mid(ActQRUpper, 3, 1)
'Tunda (1000)
ImgGambarUpper.Picture = LoadPicture(Clear)
ImgGambarUpper.Picture = LoadPicture(App.Path & "/Gambar1.jpg")
If TargetQRUpper = ActQRUpper Then
NilaiUpper.Text = 1
ImgGambarUpper.Picture = LoadPicture(App.Path & "/Gambar2.jpg")
Scaner.Text = ""
inComm.Text = ""
End If
NstepUpper.Text = 1
Show
Scaner.SetFocus
End Sub
' Formula insert gambar OK/NG pada kolom verifikasi QR Pcb yang mendapat nilai 1 jika kode QR act scan sama dengan standard saat proses scan '
Private Sub ActQRpcb_Change()
ImgGambarpcb.Picture = LoadPicture(Clear)
ImgGambarpcb.Picture = LoadPicture(App.Path & "/Gambar1.jpg")
If TargetQRpcb = ActQRpcb Then
NilaiPcb.Text = 1
ImgGambarpcb.Picture = LoadPicture(App.Path & "/Gambar2.jpg")
Scaner.Text = ""
End If
NstepPcb.Text = 1
End Sub
' Formula insert gambar OK/NG pada kolom verifikasi QR Assy yang mendapat nilai 1 jika kode QR act scan sama dengan standard saat proses scan '
Private Sub ActQRAssy_Change()
ImgGambarAssy.Picture = LoadPicture(Clear)
ImgGambarAssy.Picture = LoadPicture(App.Path & "/Gambar1.jpg")
If TargetQRAssy = ActQRAssy Then
NilaiAssy.Text = 1
ImgGambarAssy.Picture = LoadPicture(App.Path & "/Gambar2.jpg")
Scaner.Text = ""
MSComm4.Output = "Ready$"
End If
NstepAssy.Text = 1
End Sub
' Formula memanggil history log file yang terintegrasi dengan data formula Rs.Fields("Registrasi").Value pada tombol registrasi'
Private Sub cmbHistory_Click()
Set Dba = OpenDatabase(App.Path & "\ListData.mdb")
Set Rsa = Dba.OpenRecordset("Link", dbOpenDynaset)
Call BukaDB2
Adodc1.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source= " & Rsa.Fields("AlamatRecord") & "\" & cmbHistory.Text & ".mdb" & ";"
Adodc1.RecordSource = "log"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
With DataGrid1
.Columns(0).Width = 300
.Columns(1).Width = 800
.Columns(2).Width = 1000
.Columns(3).Width = 1800
.Columns(4).Width = 3300
.Columns(5).Width = 1000
.Columns(6).Width = 1000
.Columns(7).Width = 1000
.Columns(8).Width = 1000
.Columns(9).Width = 600
End With
End Sub
' Perintah untuk memilih type yang akan dimasukan ke kolom QR Assy dan QR PCB sesuai dengan type yang dipilih'
Private Sub CmbType_Click()
Set Db = OpenDatabase(App.Path & "\ListData.mdb")
Set Rs = Db.OpenRecordset("ListModel", dbOpenDynaset)
If Not Rs.EOF Then Rs.MoveFirst
Do Until Rs.EOF
If Rs.Fields("type").Value = CmbType.Text Then
TargetQRUpper.Text = Rs.Fields("Check_Upper").Value
TargetQRpcb.Text = Rs.Fields("QR_pcb").Value
TargetQRAssy.Text = Rs.Fields("QR_Assy").Value
End If
Rs.MoveNext
Loop
Show
Scaner.SetFocus
BatTarget.Text = Mid(TargetQRUpper, 1, 1)
IssTarget.Text = Mid(TargetQRUpper, 2, 1)
AbsTarget.Text = Mid(TargetQRUpper, 3, 1)
End Sub
Private Sub Command1_Click()
Kunci.Show
End Sub
Private Sub inComm_Change()
Tunda (1000)
Scaner = inComm
End Sub
Private Sub MSComm4_OnComm()
If (MSComm4.CommEvent = comEvReceive) Then
inComm = MSComm4.Input
End If
Show
Scaner.SetFocus
End Sub
Private Sub Form_Load()
Dim lagu As String
On Error GoTo ERR
Show
Scaner.SetFocus
Frame1.Visible = False
Frame2.Visible = False
Frame3.Visible = False
Frame4.Visible = False
MsgBox "TEKAN TOMBOL REGISTRASI" & vbCrLf & vbCrLf & "Untuk memulai applikasi two point ini", vbInformation, "PERHATIN !!!!!!!"
Registrasi1.Text = Tanggal.Text
Set Dba = OpenDatabase(App.Path & "\ListData.mdb")
Set Rsa = Dba.OpenRecordset("Link", dbOpenDynaset)
proses.Text = Rsa.Fields("NamaProses").Value
Call filllist
'Comm harus diganti setiap "saving" berdasarkan urutan DVE_WIe
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
MSComm4.CommPort = Rsa.Fields("Comm")
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
If MSComm4.PortOpen = False Then
MSComm4.PortOpen = True
End If
GoTo loncat
ERR:
MsgBox " 'CHECKER UPPER CASE NOT FUNCTION' Check cable konection ", vbInformation, "WARNING"
Tunda (2000)
Unload Me
loncat:
End Sub
'Formula yang digunakan untuk insert data hasil scan QR ke kolom yang ditentukan berdasarkan jumlah len dan posisi '
Private Sub lblScaner_Change()
'Formula untuk pengisisan kolom QR Assy yang telah diganti Check uppercase
If LenText.Text = 3 Then
Hasil.Text = ""
ActQRUpper.Text = ""
NilaiUpper.Text = 0
ActQRUpper.Text = Mid(lblScaner, 1, 3)
End If
If LenText.Text = 63 Then
Hasil.Text = ""
ActQRAssy.Text = ""
NilaiAssy.Text = 0
ActQRAssy.Text = Mid(lblScaner, 2, 9)
lblScaner1 = lblScaner
End If
If LenText.Text = 29 Then
Hasil.Text = ""
ActQRpcb.Text = ""
NilaiPcb.Text = 0
ActQRpcb.Text = Left(lblScaner, 9)
End If
If LenText.Text = 27 Then
pic.Text = Left(lblScaner, 16)
Scaner.Text = ""
End If
NilaiTotal = Val(NilaiUpper.Text) + Val(NilaiPcb.Text) + Val(NilaiAssy.Text)
NstepTotal = Val(NstepUpper.Text) + Val(NstepPcb.Text) + Val(NstepAssy.Text)
'============================================================================================
' Manggil data untuk masuk ke fillGrid pada form display
Set Dba = OpenDatabase(App.Path & "\ListData.mdb")
Set Rsa = Dba.OpenRecordset("Link", dbOpenDynaset)
Call BukaDB
Adodc1.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source= " & Rsa.Fields("AlamatRecord") & "\" & Registrasi1.Text & ".mdb" & ";"
Adodc1.RecordSource = "log"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
With DataGrid1
.Columns(0).Width = 300
.Columns(1).Width = 800
.Columns(2).Width = 1000
.Columns(3).Width = 1800
.Columns(4).Width = 3300
.Columns(5).Width = 1000
.Columns(6).Width = 1000
.Columns(7).Width = 1000
.Columns(8).Width = 1000
.Columns(9).Width = 600
End With
End Sub
'Formula exekusi ketika hasil QR beda proses scaner
Private Sub NstepUpper_Change()
If NstepUpper.Text <> NilaiUpper.Text Then
Timer3 = True
Tunda (200)
MsgBox "PASTIKAN PART TIDAK TERCAMPUR DAN TERKIRIM:" & vbCrLf & vbCrLf & "Beri label NG pada part yang bermasalah dan kembalikan serta informasikan part NG pada pimpinan kerja!", vbInformation, "WARNING !!!!!!!"
End If
End Sub
'Formula exekusi ketika hasil QR beda proseds scaner
Private Sub NstepPcb_Change()
If NstepPcb.Text <> NilaiPcb.Text Then
Timer3 = True
Tunda (200)
MsgBox "PASTIKAN PART TIDAK TERCAMPUR DAN TERKIRIM:" & vbCrLf & vbCrLf & "Beri label NG pada part yang bermasalah dan kembalikan serta informasikan part NG pada pimpinan kerja!", vbInformation, "WARNING !!!!!!!"
End If
End Sub
'Formula exekusi ketika hasil QR beda proseds scaner
Private Sub NstepAssy_Change()
If NstepAssy.Text <> NilaiAssy.Text Then
Timer3 = True
Tunda (200)
MsgBox "PASTIKAN PART TIDAK TERCAMPUR DAN TERKIRIM:" & vbCrLf & vbCrLf & "Beri label NG pada part yang bermasalah dan kembalikan serta informasikan part NG pada pimpinan kerja!", vbInformation, "WARNING !!!!!!!"
End If
End Sub
'Formula exekusi ketika hasil QR beda proseds scaner
Private Sub NstepTotal_Change()
Tunda (100)
If Val(NilaiTotal.Text) + Val(NstepTotal.Text) = 6 Then
ImgGambarAll.Picture = LoadPicture(App.Path & "/Gambar2.jpg")
Hasil.Text = "OK"
inComm = ""
'==============================================================================================================
'Perintah Update data ke file yang telah direcord (berbentuk folder file access)
Set Dba = OpenDatabase(App.Path & "\ListData.mdb")
Set Rsa = Dba.OpenRecordset("Link", dbOpenDynaset)
Set Db = OpenDatabase(Rsa.Fields("AlamatRecord") & "\" & Registrasi1.Text & ".mdb")
Set Rs = Db.OpenRecordset("log", dbOpenDynaset)
Dim X As Long
Do While Not Rs.EOF
X = X + 1
If Not Rs.EOF Then Rs.MoveNext
Loop
Rs.AddNew
Rs.Fields("No").Value = (X + 1)
Rs.Fields("Date").Value = Tanggal.Text & " (" & Jam.Text & ")"
Rs.Fields("PIC").Value = pic.Text
Rs.Fields("Type").Value = CmbType.Text
Rs.Fields("Scaner").Value = lblScaner1.Caption
Rs.Fields("QR_Assy").Value = ActQRAssy.Text
Rs.Fields("QR_Pcb").Value = ActQRpcb.Text
Rs.Fields("Std_Upper").Value = TargetQRUpper.Text
Rs.Fields("Check_Upper").Value = ActQRUpper.Text
Rs.Fields("Hasil").Value = Hasil.Text
Rs.Update
'==============================================================================================================
NilaiTotal.Text = 0
NstepTotal.Text = 0
ActQRUpper.Text = ""
ActQRpcb.Text = ""
ActQRAssy.Text = ""
NilaiUpper.Text = 0
NilaiPcb.Text = 0
NilaiAssy.Text = 0
NstepPcb.Text = 0
NstepUpper.Text = 0
NstepAssy.Text = 0
ImgGambarpcb.Picture = LoadPicture(Clear)
ImgGambarUpper.Picture = LoadPicture(Clear)
ImgGambarAssy.Picture = LoadPicture(Clear)
lblScaner.Caption = ""
Act.Text = Val(Act.Text) + 1
Blc.Text = Val(Plan.Text) - Val(Act.Text)
End If
If Val(NilaiTotal.Text) + Val(NstepTotal.Text) = 5 Then
ImgGambarAll.Picture = LoadPicture(App.Path & "/Gambar1.jpg")
Hasil.Text = "NG"
inComm = ""
'==============================================================================================================
'Perintah Update data ke file yang telah direcord (berbentuk folder file access)
Set Dba = OpenDatabase(App.Path & "\ListData.mdb")
Set Rsa = Dba.OpenRecordset("Link", dbOpenDynaset)
Set Db = OpenDatabase(Rsa.Fields("AlamatRecord") & "\" & Registrasi1.Text & ".mdb")
Set Rs = Db.OpenRecordset("log", dbOpenDynaset)
Dim Xi As Long
Do While Not Rs.EOF
Xi = Xi + 1
If Not Rs.EOF Then Rs.MoveNext
Loop
Rs.AddNew
Rs.Fields("No").Value = (Xi + 1)
Rs.Fields("Date").Value = Tanggal.Text & " (" & Jam.Text & ")"
Rs.Fields("PIC").Value = pic.Text
Rs.Fields("Type").Value = CmbType.Text
Rs.Fields("Scaner").Value = lblScaner1.Caption
Rs.Fields("Std_Upper").Value = TargetQRUpper.Text
Rs.Fields("QR_Assy").Value = ActQRAssy.Text
Rs.Fields("QR_Pcb").Value = ActQRpcb.Text
Rs.Fields("Check_Upper").Value = ActQRUpper.Text
Rs.Fields("Hasil").Value = Hasil.Text
Rs.Update
'===============================================================================================================
NilaiTotal.Text = 0
NstepTotal.Text = 0
ActQRUpper.Text = ""
ActQRpcb.Text = ""
ActQRAssy.Text = ""
NilaiUpper.Text = 0
NilaiPcb.Text = 0
NilaiAssy.Text = 0
NstepPcb.Text = 0
NstepUpper.Text = 0
NstepAssy.Text = 0
ImgGambarpcb.Picture = LoadPicture(Clear)
ImgGambarUpper.Picture = LoadPicture(Clear)
ImgGambarAssy.Picture = LoadPicture(Clear)
lblScaner.Caption = ""
End If
End Sub
Private Sub pic_Change()
CmbType.Enabled = True
End Sub
Private Sub Registration_Click()
Frame1.Visible = True
Frame2.Visible = True
Frame3.Visible = True
Frame4.Visible = True
Registrasi1.Text = Tanggal.Text
Set Db = OpenDatabase(App.Path & "\listData.mdb")
Set Rs = Db.OpenRecordset("Data", dbOpenDynaset)
If Not Rs.EOF Then Rs.MoveFirst
Do Until Rs.EOF
If Registrasi1.Text = Rs.Fields("Registrasi").Value Then
GoTo loncat
End If
Rs.MoveNext
Loop
'==================================================
Dim asal_file As New FileSystemObject
Dim tujuan_file As File
Dim file_name As String
Dim Model_name As String
file_name = Format(Date, "dd mmm yyyy") & ".mdb"
'==================================================
'==========================================================================================================================================
Set Db = OpenDatabase(App.Path & "\ListData.mdb")
Set Rs = Db.OpenRecordset("Link", dbOpenDynaset)
Model_name = CmbType.Text
Set tujuan_file = asal_file.GetFile(App.Path & "\logfile.mdb")
tujuan_file.Copy (Rs.Fields("AlamatRecord") & "\" & Format(Date, "dd mmm yyyy") & ".mdb")
'==========================================================================================================================================
Set Db1 = OpenDatabase(App.Path & "\ListData.mdb")
Set rs1 = Db1.OpenRecordset("Data", dbOpenDynaset)
rs1.AddNew
rs1.Fields("Registrasi").Value = Registrasi1.Text
rs1.Update
loncat:
Show
Scaner.SetFocus
CmbType.Enabled = False
End Sub
Private Sub Resett_Click()
Timer3 = False
inComm = ""
Scaner.Text = ""
ActQRUpper.Text = ""
ActQRpcb.Text = ""
ActQRAssy.Text = ""
NilaiUpper.Text = 0
NilaiPcb.Text = 0
NilaiAssy.Text = 0
ImgGambarUpper.Picture = LoadPicture(Clear)
ImgGambarpcb.Picture = LoadPicture(Clear)
ImgGambarAssy.Picture = LoadPicture(Clear)
ImgGambarAll.Picture = LoadPicture(Clear)
NstepPcb.Text = 0
NstepAssy.Text = 0
NstepUpper.Text = 0
NilaiTotal.Text = 0
NstepTotal.Text = 0
Show
Scaner.SetFocus
End Sub
Private Sub Scaner_Change()
If Scaner.Text = "" Then
Scaner.Text = ""
Else
Timer2.Enabled = True
End If
If pic.Text = "" Then
MsgBox " Lengkapi terlebih dahulu kolom PIC ", vbInformation, "WARNING"
Scaner = ""
GoTo finish
End If
If Plan.Text = 0 Then
MsgBox " Lengkapi terlebih dahulu kolom Plan produksi ", vbInformation, "WARNING"
Scaner = ""
End If
finish:
End Sub
Sub BukaDB()
Set Dbx = OpenDatabase(App.Path & "\ListData.mdb")
Set rsx = Dbx.OpenRecordset("Link", dbOpenDynaset)
Set Koneksi = New ADODB.Connection
Set Log = New ADODB.Recordset
Koneksi.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & rsx.Fields("AlamatRecord") & "\" & Registrasi1.Text & ".mdb"
End Sub
Sub BukaDB2()
Set Dby = OpenDatabase(App.Path & "\ListData.mdb")
Set rsy = Dby.OpenRecordset("Link", dbOpenDynaset)
Set Koneksi = New ADODB.Connection
Set Log = New ADODB.Recordset
Koneksi.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & rsy.Fields("AlamatRecord") & "\" & cmbHistory.Text & ".mdb"
End Sub
Private Sub Timer1_Timer()
Jam.Text = Format(Now, "h:n:s")
Tanggal.Text = Format(Now, "dd mmm yyyy")
End Sub
Private Sub DataGrid1_HeadClick(ByVal ColIndex As Integer)
Adodc1.Recordset.Sort = DataGrid1.Columns(ColIndex).DataField
End Sub
Sub filllist()
Set Dbx = OpenDatabase(App.Path & "\ListData.mdb")
Set rsx = Dbx.OpenRecordset("Link", dbOpenDynaset)
Set Db = OpenDatabase(App.Path & "\ListData.mdb")
Set Rs = Db.OpenRecordset("ListModel", dbOpenDynaset)
Dim X As Long
Rs.MoveFirst
For X = 1 To rsx.Fields("ToType")
CmbType.AddItem Rs.Fields("Type")
Rs.MoveNext
Next X
Set Dba = OpenDatabase(App.Path & "\ListData.mdb")
Set Rsa = Dba.OpenRecordset("Data", dbOpenDynaset)
If Not Rsa.EOF Then Rsa.MoveFirst
Do Until Rsa.EOF
For X = 1 To Rsa.Fields.Count
cmbHistory.AddItem Rsa.Fields("Registrasi")
Rsa.MoveNext
Next X
Loop
End Sub
Private Sub Form_Resize()
Call ResizeForm(Me)
End Sub
Private Sub Timer2_Timer()
Timer2.Enabled = False
ImgGambarAll.Picture = LoadPicture(Clear)
LenText.Text = Len(Scaner.Text)
lblScaner = Scaner
End Sub
Private Sub Timer3_Timer()
lagu = "D:\BuzerNG1.wma"
Call mciSendString("open " & lagu & " type MPEGVideo alias lagu wait", vbNullString, 0&, 0&)
Call mciSendString("play " & lagu, vbNullString, 0&, 0&)
End Sub
Write, Run & Share VB.net code online using OneCompiler's VB.net online compiler for free. It's one of the robust, feature-rich online compilers for VB.net language, running on the latest version 16. Getting started with the OneCompiler's VB.net compiler is simple and pretty fast. The editor shows sample boilerplate code when you choose language as VB.net. OneCompiler also has reference programs, where you can look for the sample code to get started with.
OneCompiler's VB.net online editor supports stdin and users can give inputs to programs using the STDIN textbox under the I/O tab. Following is a sample VB.net program which takes name as input and prints hello message with your name.
Public Module Program
Public Sub Main(args() As string)
Dim name as String = Console.ReadLine() ' Reading input from STDIN
Console.WriteLine("Hello " & name) ' Writing output to STDOUT
End Sub
End Module
Visual Basic is a event driven programming language by Microsoft, first released in the year 1991.
Variable is a name given to the storage area in order to identify them in our programs.
Simple syntax of Variable declaration is as follows
Dim variableName [ As [ New ] dataType ] [ = initializer ]
variableName = value
If condition-expression Then
'code
End If
If(conditional-expression)Then
'code if the conditional-expression is true
Else
'code if the conditional-expression is false
End If
If(conditional-expression)Then
'code if the above conditional-expression is true
Else If(conditional-expression) Then
'code if the above conditional-expression is true
Else
'code if the above conditional-expression is false
End If
If(conditional-expression)Then
'code if the above conditional-expression is true
If(conditional-expression)Then
'code if the above conditional-expression is true
End If
End If
Select [ Case ] expression
[ Case expressionlist
'code ]
[ Case Else
'code ]
End Select
For counter [ As datatype ] = begin To end [ Step step ]
'code
[ Continue For ]
'code
[ Exit For ]
'code
Next [ counter ]
For Each element [ As datatype ] In group
'code
[ Continue For ]
'code
[ Exit For ]
'code
Next [ element ]
While conditional-expression
'Code
[ Continue While ]
'Code
[ Exit While ]
'Code
End While
Do { While | Until } conditional-expression
'Code
[ Continue Do ]
'Code
[ Exit Do ]
'Code
Loop
Do
'Code
[ Continue Do ]
'Code
[ Exit Do ]
'Code
Loop { While | Until } conditional-expression
Procedure is a sub-routine which contains set of statements. Usually Procedures are written when multiple calls are required to same set of statements which increases re-usuability and modularity.
Procedures are of two types.
Functions return a value when they are called.
[accessModifiers] Function functionName [(parameterList)] As returnType
'code
End Function
Sub-procedures are similar to functions but they don't return any value.
Sub ProcedureName (parameterList)
'Code
End Sub