0 Kamis, (17/01/2013)

---

Jangan Lupa Tinggalkan Komentar Kalian Ya...!!!

---

Hari ini saya akan memberi contoh class cetak Struk. . .
Contoh di bawah ini. . .

-----------------------------------------------------------------

Option Explicit
Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Private Declare Function EndDocPrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Private Declare Function EndPagePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, ByVal pDefault As Long) As Long
Private Declare Function StartDocPrinter Lib "winspool.drv" Alias "StartDocPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, pDocInfo As DOCINFO) As Long
Private Declare Function StartPagePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Private Declare Function WritePrinter Lib "winspool.drv" (ByVal hPrinter As Long, pBuf As Any, ByVal cdBuf As Long, pcWritten As Long) As Long
-----------------------------------------------------------------
Private Type DOCINFO
pDocName As String
pOutputFile As String
pDatatype As String
End Type
-----------------------------------------------------------------
Private jumlahstring As Integer
Private kata As String
-----------------------------------------------------------------
Public Sub setJumlahString(jumlah As Integer)
    jumlahstring = jumlah
    kata = ""
End Sub
-----------------------------------------------------------------
Public Sub hapusString()
    kata = ""
End Sub
-----------------------------------------------------------------
Public Function getString() As String
    getString = kata
End Function
-----------------------------------------------------------------
Public Sub tambahString(kata1 As String)
    kata1 = Left(kata1, jumlahstring)
    kata = kata & vbCrLf & kata1
End Sub
-----------------------------------------------------------------
Public Sub tambahString_manual(kata1 As String)
    kata = kata & vbCrLf & kata1
End Sub
-----------------------------------------------------------------
Public Sub tambahString_Tengah(kata1 As String)
    Dim tmljml As Integer
    kata1 = Left(kata1, jumlahstring)
    tmljml = (jumlahstring - Len(kata1)) / 2
    kata = kata & vbCrLf & String(tmljml, " ") & kata1 & String(tmljml, " ")
End Sub
-----------------------------------------------------------------
Public Sub tambahString_Kanan(kata1 As String)
    Dim tmljml As Integer
    kata1 = Left(kata1, jumlahstring)
    tmljml = jumlahstring - Len(kata1)
    kata = kata & vbCrLf & String(tmljml + 1, " ") & kata1
End Sub
-----------------------------------------------------------------
Public Sub tambahString_Kiri_Kanan(kata1 As String, kata2 As String)
    Dim tmljml As Integer
    tmljml = (jumlahstring) / 2
    kata1 = Left(kata1, tmljml)
    kata2 = Left(kata2, tmljml)
    kata = kata & vbCrLf & fungsiStringKiri(kata1, tmljml) & fungsiStringKanan(kata2, tmljml)
End Sub
-----------------------------------------------------------------
Public Sub tambahString_Kiri_Kanan_posisiTengah(kata1 As String, kata2 As String)
    Dim tmljml As Integer
    tmljml = (jumlahstring) / 2
    kata1 = Left(kata1, tmljml)
    kata2 = Left(kata2, tmljml)
    kata = kata & vbCrLf & fungsiStringKanan(kata1, tmljml) & " " & fungsiStringKiri(kata2, tmljml)
End Sub
-----------------------------------------------------------------
Public Sub tambahSparator(kata1 As String)
    kata1 = String(jumlahstring, kata1)
    kata = kata & vbCrLf & kata1
End Sub
-----------------------------------------------------------------
Public Function fungsiStringKanan(kata1, jumlah)
    Dim tmljml As Integer
    tmljml = jumlah - Len(kata1)
    fungsiStringKanan = String(tmljml, " ") & kata1
End Function
-----------------------------------------------------------------
Public Function fungsiStringKiri(kata1, jumlah)
    Dim tmljml As Integer
    tmljml = jumlah - Len(kata1)
    fungsiStringKiri = kata1 & String(tmljml, " ")
End Function
-----------------------------------------------------------------

Public Sub cetakString()
Dim Namafile As String
Dim lhPrinter As Long
Dim lReturn As Long
Dim lpcWritten As Long
Dim lDoc As Long
Dim sWrittenData As String
Dim MyDocInfo As DOCINFO
Namafile = "printer"
Printer.FontSize = 8
lReturn = OpenPrinter(Printer.DeviceName, lhPrinter, 0)
If lReturn = 0 Then
MsgBox "Printer tidak dikenali!", vbCritical, "Error"
Exit Sub
End If
MyDocInfo.pDocName = Namafile
MyDocInfo.pOutputFile = vbNullString
MyDocInfo.pDatatype = "RAW"
lDoc = StartDocPrinter(lhPrinter, 1, MyDocInfo)
Call StartPagePrinter(lhPrinter)
sWrittenData = kata & vbCrLf
lReturn = WritePrinter(lhPrinter, ByVal sWrittenData, Len(sWrittenData), lpcWritten)
lReturn = EndPagePrinter(lhPrinter)
lReturn = EndDocPrinter(lhPrinter)
lReturn = ClosePrinter(lhPrinter)
End Sub

-----------------------------------------------------------------