Bascom Print out label
$regfile = "89c55wd.dat"
$crystal = 11059200
$baud = 9600
$large
'config LCD
Config Lcd = 16 * 2
Config Lcdpin = Pin , Db4 = P1.5 , Db5 = P1.4 , Db6 = P1.3 , Db7 = P1.2 , E = P1.6 , Rs = P1.7
'config EEprom
Config Scl = P2.5
Config Sda = P2.4
Config Timer0 = Counter0 , Gate = Internal , Mode = 1
Dim F1 As Integer
Dim X(24) As Byte
Dim A1 As Byte
Dim B1 As Byte
Dim C1 As Byte
Dim D1 As Byte
Dim Add_w As Byte
Dim Add_r As Byte
Dim Alamat As Byte
'Dim T3 As Integer
'Dim T3s As Integer
Declare Sub Ambil
Declare Sub Baca
Declare Sub Tulis
Declare Sub Berhenti
Declare Sub Cetak
Declare Sub Waktu
Declare Sub Simpan_waktu
P2.6 = 1
Cursor Off
Enable Int0
Enable Interrupts
On Int0 Menunya
'Cls
'Lcd "ready.."
Do
A1 = Waitkey() ' tunggu sampai ada data masuk
Print Chr(19)
' Counter0 = 0
' Start Counter0
Add_w = 166
Alamat = 0
Tulis
I2cwbyte A1
Alamat = Alamat + 1
C1 = 1
Print Chr(17)
Do
A1 = Waitkey()
If A1 > 0 Then
Print Chr(19)
'' Counter0 = 0
' Start Counter0
I2cwbyte A1
C1 = C1 + 1
If C1 = 16 Then
Alamat = Alamat + 16
Berhenti
Tulis
C1 = 0
End If
End If
' F1 = Counter0
' Waitms 10
' Start Counter0
If F1 > 80000 Then
A1 = "~"
End If
Print Chr(17)
Loop Until A1 = "~"
I2cwbyte A1
Berhenti
'===========================================
'nama PT
Add_w = 160
Alamat = 0
Cetak
'label penimbangan
Add_w = 160
Alamat = 32
Cetak
'timbangan ID
Add_w = 160
Alamat = 64
Cetak
Print "------------------------"
'Tanggal
Print "DATE ";
Add_w = 208
Alamat = 4
Waktu
Print A1 ; "/" ; B1 ; "/" ; C1
Print "TIME ";
'jam
Add_w = 208
Alamat = 0
Waktu
Print C1 ; ":" ; B1 ; ":" ; A1
'nama produk
Print "Produk :";
Add_w = 160
Alamat = 96
Cetak
'no. batch
Print "Batch :";
Add_w = 160
Alamat = 192
Cetak
'nama bahan
Print "Bahan :";
Add_w = 160
Alamat = 128
Cetak
'no analisa
Print "Analisa:";
Add_w = 160
Alamat = 160
Cetak
'spasi
'data penimbangan
Add_w = 166
Alamat = 0
Cetak
'paraf petugas
'paraf pemeriksa
Print " petugas pemeriksa"
' Print "(.........) (.........)"
A1 = Inkey()
A1 = Inkey()
A1 = Inkey()
A1 = Inkey()
Loop
End
'========================
Sub Waktu
Baca
I2crbyte A1 , Ack
I2crbyte B1 , Ack
I2crbyte C1 , Nack
Berhenti
If Alamat = 0 Then
C1 = C1 And &B00011111
End If
A1 = Makedec(a1)
B1 = Makedec(b1)
C1 = Makedec(c1)
End Sub
'================
Sub Simpan_waktu
P2.6 = 0
B1 = 0
D1 = 1
C1 = 0
Do
Bitwait P2.7 , Reset
Waitms 20
Bitwait P2.7 , Set
If B1 = 0 Then
Locate 2 , 1
Lcd " "
Locate 2 , 8
B1 = 1
End If
A1 = P0
If A1 = 27 Then
A1 = "~"
B1 = 2
Else
D1 = 0
D1 = A1 And &B11110000
Shift D1 , Right , 4
If D1 = 3 Then
C1 = C1 + 1
X(c1) = A1 And &B00001111
Lcd X(c1);
If C1 = 2 Or C1 = 4 Then
Lcd ".";
End If
End If
End If
If C1 = 6 Then
'SIMPAN
A1 = "~"
For F1 = 1 To 6
X(f1) = X(f1) And &B00001111
Next
Shift X(1) , Left , 4
X(1) = X(1) Or X(2)
Shift X(3) , Left , 4
X(2) = X(3) Or X(4)
Shift X(5) , Left , 4
X(3) = X(5) Or X(6)
End If
Loop Until A1 = "~"
P2.6 = 1
End Sub
'=======================
Sub Ambil
Add_w = 160
Baca
B1 = 0
For D1 = 1 To 24
If B1 = 0 Then
I2crbyte A1 , Ack
If A1 <> "~" Then
X(d1) = A1
Else
X(d1) = " "
B1 = 1
End If
Else
X(d1) = " "
End If
Next
I2crbyte A1 , Nack
Berhenti
Waitms 80
'masukan ke lcd
For D1 = 1 To 16
Locate 2 , D1
Lcd Chr(x(d1))
Next
P2.6 = 0
B1 = 0
D1 = 1
Do
Bitwait P2.7 , Reset
Waitms 20
Bitwait P2.7 , Set
If B1 = 0 Then
For C1 = 0 To 23
X(c1) = " "
Next
Locate 2 , 1
Lcd " "
B1 = 1
End If
A1 = P0
Select Case A1
Case 13:
Case 27:
A1 = 13
B1 = 2
Case 8 :
D1 = D1 - 1
Locate 2 , D1
Lcd " "
X(d1) = " "
If D1 > 16 Then
A1 = D1 - 16
For C1 = A1 To D1
Add_r = C1 - A1
Locate 2 , Add_r
Lcd Chr(x(c1))
Next
End If
Case Else :
B1 = 5
X(d1) = A1
Locate 2 , D1
Lcd Chr(x(d1))
D1 = D1 + 1
If D1 > 16 Then
A1 = D1 - 16
For C1 = A1 To D1
Add_r = C1 - A1
Locate 2 , Add_r
Lcd Chr(x(c1))
Next
End If
End Select
If D1 > 24 Then
D1 = D1 - 1
End If
Loop Until A1 = 13
If B1 = 5 Then
I2cstart
I2cwbyte 160
I2cwbyte Alamat
D1 = D1 - 1
For C1 = 1 To D1
If C1 = 17 Then
Berhenti
Waitms 40
Alamat = Alamat + 16
Tulis
End If
A1 = X(c1)
I2cwbyte A1
Next
A1 = "~"
I2cwbyte A1
Berhenti
Waitms 40
End If
P2.6 = 1
End Sub
'========================cetak
Sub Cetak
Baca
Do
I2crbyte A1 , Ack
If A1 <> "~" Then
Print Chr(a1);
Else
End If
Loop Until A1 = "~"
I2crbyte A1 , Nack
Berhenti
Waitms 80
End Sub
'==========================
Sub Baca
Tulis
I2cstart
Add_r = Add_w + 1
I2cwbyte Add_r
End Sub
Sub Tulis
I2cstart
I2cwbyte Add_w
I2cwbyte Alamat
End Sub
Sub Berhenti
I2cstop
Waitms 100
End Sub
'=========================
Menunya:
Cls
Select Case P0
Case 129:
Locate 1 , 1
Lcd "Produk : "
Alamat = 96 'f1
Ambil
Case 130:
Locate 1 , 1
Lcd "No Bets : "
Alamat = 192 'f1
Ambil
Case 131:
Locate 1 , 1
Lcd "Bahan : "
Alamat = 128 'f1
Ambil
Case 132:
Locate 1 , 1
Lcd "Analisa : "
Alamat = 160 'f1
Ambil
Case 135:
Cls
Locate 1 , 1
Lcd "DATE :(DD/MM/YY)"
Add_w = 208
Alamat = 4
Waktu
Locate 2 , 8
Lcd A1 ; "/" ; B1 ; "/" ; C1
Simpan_waktu
Tulis
I2cwbyte X(1)
I2cwbyte X(2)
I2cwbyte X(3)
Berhenti
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Case 136:
Cls
Locate 1 , 1
Lcd "TIME :(HH:MM:SS)"
Add_w = 208
Alamat = 0
Waktu
Locate 2 , 8
Lcd C1 ; ":" ; B1 ; ":" ; A1
Simpan_waktu
Tulis
I2cwbyte X(3)
I2cwbyte X(2)
I2cwbyte X(1)
Berhenti
'==============>>>>
Case 137:
Locate 1 , 1
Lcd "Perusahaan "
Alamat = 0 'f1
Ambil
Case 138:
Locate 1 , 1
Lcd "Penimbangan "
Alamat = 32 'f1
Ambil
Case 139:
Locate 1 , 1
Lcd "ID timbangan "
Alamat = 64 'f1
Ambil
Case 13:
Locate 1 , 1
Lcd "Produk : "
Alamat = 96 'f1
Ambil
Locate 1 , 1
Lcd "No Bets : "
Alamat = 192 'f1
Ambil
Locate 1 , 1
Lcd "Bahan : "
Alamat = 128 'f1
Ambil
Locate 1 , 1
Lcd "Analisa : "
Alamat = 160 'f1
Ambil
End Select
Cls
Locate 1 , 1
Lcd "Press key print "
Return