joshyfrancis / vb6-print-class Goto Github PK
View Code? Open in Web Editor NEWA Featured Class for Printing using API functions in VB
License: MIT License
A Featured Class for Printing using API functions in VB
License: MIT License
Hi there..
great library to use with after a long time..
help me with printing in bold and center the words in a line, unerlining a word
TIA
Kannan
Option Explicit
Private Declare Function TextOutW Lib "gdi32" (ByVal HDc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As Long, ByVal nCount As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal HDc As Long, ByVal nBkMode As Long) As Long
Private Const TRANSPARENT = 1
Private Const OPAQUE = 2
Private Declare Function StretchBlt Lib "gdi32" (ByVal HDc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long
Private Declare Function SetStretchBltMode Lib "gdi32" (ByVal HDc As Long, ByVal nStretchMode As Long) As Long
Private Const HALFTONE = 4
Private Type SIZEAPI
cX As Long
cY As Long
End Type
Private Declare Function GetTextExtentPointW Lib "gdi32" (ByVal HDc As Long, ByVal lpszString As Long, ByVal cbString As Long, lpSize As SIZEAPI) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal HDc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function Ellipse Lib "gdi32" (ByVal HDc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" ( _
ByVal HDc As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal lpPoint As Long) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal HDc As Long, ByVal x As Long, ByVal y As Long) As Long
'wFormat flags:
Private Const DT_BOTTOM As Long = &H8&
Private Const DT_CALCRECT As Long = &H400&
Private Const DT_CENTER As Long = &H1&
Private Const DT_EDITCONTROL As Long = &H2000&
Private Const DT_END_ELLIPSIS As Long = &H8000&
Private Const DT_EXPANDTABS As Long = &H40&
Private Const DT_EXTERNALLEADING As Long = &H200&
Private Const DT_HIDEPREFIX As Long = &H100000
Private Const DT_INTERNAL As Long = &H1000&
Private Const DT_LEFT As Long = &H0&
Private Const DT_MODIFYSTRING As Long = &H10000
Private Const DT_NOCLIP As Long = &H100&
Private Const DT_NOFULLWIDTHCHARBREAK As Long = &H80000
Private Const DT_NOPREFIX As Long = &H800&
Private Const DT_PATH_ELLIPSIS As Long = &H4000&
Private Const DT_PREFIXONLY As Long = &H200000
Private Const DT_RIGHT As Long = &H2&
Private Const DT_SINGLELINE As Long = &H20&
Private Const DT_TABSTOP As Long = &H80&
Private Const DT_TOP As Long = &H0&
Private Const DT_VCENTER As Long = &H4&
Private Const DT_WORDBREAK As Long = &H10&
Private Const DT_WORD_ELLIPSIS As Long = &H40000
Private Declare Function DrawTextW Lib "user32" ( _
ByVal HDc As Long, _
ByVal lpStr As Long, _
ByVal nCount As Long, _
ByRef lpRect As RECT, _
ByVal wFormat As Long) As Long
Private Const LF_FACESIZE = 32
Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName(1 To LF_FACESIZE) As Byte
End Type
Private Const OBJ_FONT = 6
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" _
(lpLogFont As LOGFONT) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" _
(ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetCurrentObject Lib "gdi32" _
(ByVal HDc As Long, ByVal uObjectType As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" _
(ByVal HDc As Long, ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32" _
(ByVal HDc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long
Private Type RGBA
R As Byte
G As Byte
b As Byte
Alpha As Byte
End Type
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Public Sub Print_Route(CN As Object, ByVal PrintRoute As String, ByVal PrintID As Long, json As Object)
Dim sql As String, table As String
Dim rsp As Object 'new ADODB.Recordset
Dim rsd As Object 'new ADODB.Recordset
Dim Heading3 As String
Select Case PrintRoute
Case "bank/bank_payments", "bank/bank_receipts"
If PrintRoute = "bank/bank_payments" Then
Heading3 = "Payment"
table = "bank_payments"
Else
Heading3 = "Receipt"
table = "bank_receipts"
End If
sql = "SELECT a.ScrollNo,a.DocDate,a.Amount,a.principal,a.due_interest,a.overdue_interest"
sql = sql & ",a.other_charges,a.amount_paid,a.principal_paid,a.due_interest_paid"
sql = sql & ",a.overdue_interest_paid,a.other_charges_paid,a.Remarks"
sql = sql & ",b.ACTCODE, b.ACTNAME,b.ACTTYPE"
sql = sql & ",c.CUSID,c.NAME,c.HOUSENAME,c.PLACE"
sql = sql & ",d.MEMBERID,d.MEMBERID,d.member_name,d.address"
sql = sql & ",e.AccountCode,e.AccountName"
sql = sql & ",f.BranchName,f.branch_code"
sql = sql & ",convert(f.address,CHAR(255) CHARACTER SET utf8)COLLATE utf8_unicode_ci AS BranchAddress"
sql = sql & ",f.BranchName"
sql = sql & ",(SELECT DATEDIFF(a.DocDate,aa.DocDate) FROM " & table & " aa WHERE aa.due_interest_paid>0 AND aa.bank_activitiesID=a.bank_activitiesID AND aa.fin_accounts_ledgerID=a.fin_accounts_ledgerID AND aa.DocDate<a.DocDate ORDER BY aa.DocDate desc LIMIT 1) AS interest_days"
sql = sql & ",g.AccountCode as other_charge_AccountCode,g.AccountName AS other_charge_AccountName"
sql = sql & ", IFNULL((select sum(bb.Amount)"
sql = sql & " from fin_balance bb where bb.AccountID=a.fin_accounts_ledgerID AND bb.DocDate < DATE_ADD(a.DocDate,INTERVAL 1 DAY) ) ,0) as Balance_Amount"
sql = sql & ",(SELECT DATEDIFF(date(a.DocDate),aa.APPDATE) FROM bank_intappdates aa WHERE aa.due_interest_paid>0 AND aa.fin_accounts_ledgerID=a.fin_accounts_ledgerID AND aa.APPDATE<date(a.DocDate) ORDER BY aa.APPDATE desc LIMIT 1) AS interest_days2"
sql = sql & " FROM " & table & " a"
sql = sql & " LEFT JOIN bank_activities b ON b.ID=a.bank_activitiesID"
sql = sql & " LEFT JOIN bank_customers c ON c.ID=a.bank_customersID"
sql = sql & " LEFT JOIN bank_members d ON d.ID=a.bank_membersID"
sql = sql & " LEFT JOIN fin_accounts e ON e.ID=a.fin_accounts_ledgerID"
sql = sql & " LEFT JOIN fac_branch f ON f.ID=a.BranchID"
sql = sql & " LEFT JOIN fin_accounts g ON g.ID=a.otherChargeAccountID"
sql = sql & " Where a.ID = " & PrintID
End Select
Set rsp = CN.execute(sql)
If Not (rsp.EOF And rsp.BOF) Then
Else
Exit Sub
End If
Print_ReceiptHEECS rsp, PrintID, Heading3, json
Unload Me
End Sub
Sub Print_ReceiptHEECS(rsp As Object, ByVal PrintID As Long, ByVal Heading3 As String, json As Object)
Const CurrencyFormat As String = "#,##,##,###.#0"
Const mMMPerInch As Single = 25.4
Dim Heading1 As String, Heading2 As String, ScrollNo As Long
Dim DocDate As Date, Particulars1 As String
Dim amount As Currency
Dim cp As New cPrinter
Dim sz As SIZEAPI, rc As RECT
Dim str As String
Dim x As Long, y As Long, pScaleX As Long, pScaleY As Long, tY As Long
Dim halfW As Long, c As Long, b As Boolean, Y2 As Long, y3 As Long, W As Long, H As Long
Dim hFont, hPrevFont As Long, lColor As Long, lPrevColor As Long
Dim tRGBA As RGBA
'a5 w=5.83 in , h=8.27 in
'a4 w=8.27 in , h=11.69 in
' cp.PrinterAddNewForm 4 * mMMPerInch * 1000, 4 * mMMPerInch * 1000, "Small4x4"
'Dim c As Long, NumForms As Long, sNames() As String, cX() As Long, cY() As Long
' NumForms = cp.PrinterGetForms(sNames, cX, cY)
'For c = 0 To NumForms - 1
' cboPaperSize.AddItem sNames(c)
' cboPaperSize.ItemData(cboPaperSize.NewIndex) = c + 1
'' If c + 1 = 11 Then
'' cboPaperSize.ListIndex = c
'' End If
'Next
ScrollNo = val(rsp!ScrollNo)
DocDate = rsp!DocDate
amount = val(rsp!amount_paid)
Heading1 = TrimNull(rsp!BranchName)
Heading2 = TrimNull(rsp!BranchAddress)
Particulars1 = TrimNull(rsp!Name)
If Particulars1 = "" Then
Particulars1 = TrimNull(rsp!member_name)
End If
If Particulars1 = "" Then
Particulars1 = TrimNull(rsp!AccountName)
End If
'If MsgBox("Print " & Heading3 & " - " & ScrollNo & "?", vbQuestion + vbYesNo + vbDefaultButton2) = vbNo Then
' Unload Me
' Exit Sub
'End If
Caption = "Printing " & Heading3 & " - " & PrintID & " - " & ScrollNo & "..."
cp.PaperSize = 11 'A5
cp.Orientation = Landscape
' cp.PrinterSetup
cp.Preview = False 'True
If cp.PrinterStartDoc Then
pScaleX = cp.XScale(1)
pScaleX = cp.YScale(1)
cp.PrinterStartPage
SetBkMode cp.HDc, TRANSPARENT
'cp.PrintText "Hello", 10, 10
Dim F As New StdFont
halfW = cp.WidthPrint \ 2
For c = 0 To 1
x = cp.XScale(10)
y = cp.YScale(10)
If c = 1 Then
x = x + halfW
End If
F.Name = "Times New Roman"
F.Size = 30
F.Bold = True
Set cp.Font = F
rc.Left = x
rc.Top = y
rc.Right = rc.Left + (halfW - cp.XScale(20))
rc.Bottom = rc.Top + (cp.HeightPrint - cp.YScale(20))
'Border
Rectangle cp.HDc, rc.Left, rc.Top, rc.Right, rc.Bottom
y = y + cp.YScale(1)
'Printing Watermark
lColor = RGB(220, 220, 220)
CopyMemory tRGBA, lColor, 4
tRGBA.Alpha = 200
CopyMemory lColor, tRGBA, 4
lPrevColor = SetTextColor(cp.HDc, lColor)
'Create a font for the rotated text
hFont = GetFont(cp.HDc, 90)
'Select the font into the DC
hPrevFont = SelectObject(cp.HDc, hFont)
'Draw the text
str = "W"
GetTextExtentPointW cp.HDc, StrPtr(str), Len(str), sz
W = sz.cX
str = TrimNull(rsp!branch_code) '"Watermark"
GetTextExtentPointW cp.HDc, StrPtr(str), Len(str), sz
H = sz.cX 'because it is rotated
TextOutW cp.HDc, x + (((halfW) - W) / 2), (cp.HeightPrint - (cp.YScale(31) + (W / 2))) - ((H) / 2), StrPtr(str), Len(str)
'Select back the previous font
SelectObject cp.HDc, hPrevFont
'destroy the font object.
DeleteObject hFont
SetTextColor cp.HDc, lPrevColor
F.Size = 10
F.Bold = True
Set cp.Font = F
str = Heading1
rc.Left = x + cp.XScale(1)
rc.Top = y
rc.Right = rc.Left + (halfW - cp.XScale(11))
rc.Bottom = cp.HeightPrint
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_CENTER Or DT_NOPREFIX Or DT_WORDBREAK Or DT_CALCRECT
rc.Right = rc.Left + (halfW - cp.XScale(11))
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_CENTER Or DT_NOPREFIX Or DT_WORDBREAK
y = rc.Bottom + cp.YScale(1)
DrawLine cp.HDc, x, y, x + (halfW - cp.XScale(20)), y
y = y + cp.YScale(1)
F.Bold = False
Set cp.Font = F
str = Heading2
rc.Left = x + cp.XScale(1)
rc.Top = y
rc.Right = rc.Left + (halfW - cp.XScale(11))
rc.Bottom = cp.HeightPrint
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_NOPREFIX Or DT_WORDBREAK Or DT_CALCRECT
rc.Right = rc.Left + (halfW - cp.XScale(11))
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_NOPREFIX Or DT_WORDBREAK
y = rc.Bottom + cp.YScale(1)
DrawLine cp.HDc, x, y, x + (halfW - cp.XScale(20)), y
y = y + cp.YScale(1)
F.Bold = True
Set cp.Font = F
str = Heading3
rc.Left = x + cp.XScale(1)
rc.Top = y
rc.Right = rc.Left + (halfW - cp.XScale(11))
rc.Bottom = cp.HeightPrint
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_CENTER Or DT_SINGLELINE Or DT_NOPREFIX Or DT_CALCRECT
rc.Right = rc.Left + (halfW - cp.XScale(11))
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_CENTER Or DT_SINGLELINE Or DT_NOPREFIX
y = rc.Bottom + cp.YScale(1)
F.Bold = False
Set cp.Font = F
str = "No. " & ScrollNo
rc.Left = x + cp.XScale(1)
rc.Top = y
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
rc.Bottom = cp.HeightPrint
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE Or DT_CALCRECT
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE
str = "Date : " & DocDate
rc.Left = rc.Right
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_RIGHT Or DT_SINGLELINE
y = rc.Bottom + cp.YScale(1)
str = TrimNull(rsp!ACTNAME) & " " & TrimNull(rsp!AccountCode)
rc.Left = x + cp.XScale(1)
rc.Top = y
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
rc.Bottom = cp.HeightPrint
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE Or DT_CALCRECT
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE
y = rc.Bottom + cp.YScale(1)
str = "Name " & Replace$(TrimNull(rsp!AccountName), TrimNull(rsp!AccountCode), "") & ",Cust.ID " & TrimNull(rsp!CUSID) & ",Mem.ID " & TrimNull(rsp!MEMBERID)
rc.Left = x + cp.XScale(1)
rc.Top = y
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
rc.Bottom = cp.HeightPrint
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE Or DT_CALCRECT
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE
y = rc.Bottom + cp.YScale(1)
DrawLine cp.HDc, x, y, x + (halfW - cp.XScale(20)), y
y = y + cp.YScale(1)
F.Size = 9
F.Bold = True
Set cp.Font = F
str = "Particulars"
rc.Left = x + cp.XScale(1)
rc.Top = y
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
rc.Bottom = cp.HeightPrint
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE Or DT_CALCRECT
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE
str = "Amount "
rc.Left = rc.Right
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_RIGHT Or DT_SINGLELINE
y = rc.Bottom + cp.YScale(1)
DrawLine cp.HDc, x + halfW / 2 + cp.XScale(5), rc.Top, x + halfW / 2 + cp.XScale(5), y
DrawLine cp.HDc, x, y, x + (halfW - cp.XScale(20)), y
y = y + cp.YScale(1)
F.Bold = False
Set cp.Font = F
b = False
If val(TrimNull(rsp!principal_paid)) > 0 Then
b = True
str = "Principal"
rc.Left = x + cp.XScale(1)
rc.Top = y
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
rc.Bottom = cp.HeightPrint
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE Or DT_CALCRECT
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE
str = Format2(TrimNull(rsp!principal_paid), CurrencyFormat)
rc.Left = rc.Right
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_RIGHT Or DT_SINGLELINE
y = rc.Bottom + cp.YScale(1)
DrawLine cp.HDc, x + halfW / 2 + cp.XScale(5), rc.Top, x + halfW / 2 + cp.XScale(5), y
End If
If val(TrimNull(rsp!due_interest_paid)) > 0 Then
b = True
str = "Interest(" & val(TrimNull(rsp!interest_days2)) & " Days)"
rc.Left = x + cp.XScale(1)
rc.Top = y
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
rc.Bottom = cp.HeightPrint
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE Or DT_CALCRECT
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE
str = Format2(TrimNull(rsp!due_interest_paid), CurrencyFormat)
rc.Left = rc.Right
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_RIGHT Or DT_SINGLELINE
y = rc.Bottom + cp.YScale(1)
DrawLine cp.HDc, x + halfW / 2 + cp.XScale(5), rc.Top, x + halfW / 2 + cp.XScale(5), y
End If
If val(TrimNull(rsp!overdue_interest_paid)) > 0 Then
b = True
str = "Interest Overdue"
rc.Left = x + cp.XScale(1)
rc.Top = y
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
rc.Bottom = cp.HeightPrint
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE Or DT_CALCRECT
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE
str = Format2(TrimNull(rsp!overdue_interest_paid), CurrencyFormat)
rc.Left = rc.Right
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_RIGHT Or DT_SINGLELINE
y = rc.Bottom + cp.YScale(1)
DrawLine cp.HDc, x + halfW / 2 + cp.XScale(5), rc.Top, x + halfW / 2 + cp.XScale(5), y
End If
If val(TrimNull(rsp!other_charges_paid)) > 0 Then
b = True
str = "Other Charges" ' TrimNull(rsp!other_charge_AccountName)
rc.Left = x + cp.XScale(1)
rc.Top = y
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
rc.Bottom = cp.HeightPrint
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE Or DT_CALCRECT
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE
str = Format2(TrimNull(rsp!other_charges_paid), CurrencyFormat)
rc.Left = rc.Right
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_RIGHT Or DT_SINGLELINE
y = rc.Bottom + cp.YScale(1)
DrawLine cp.HDc, x + halfW / 2 + cp.XScale(5), rc.Top, x + halfW / 2 + cp.XScale(5), y
End If
If b = False Then
str = Replace$(TrimNull(rsp!AccountName), TrimNull(rsp!AccountCode), "")
rc.Left = x + cp.XScale(1)
rc.Top = y
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
rc.Bottom = cp.HeightPrint
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE Or DT_CALCRECT
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE
str = Format2(TrimNull(rsp!amount), CurrencyFormat)
rc.Left = rc.Right
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_RIGHT Or DT_SINGLELINE
y = rc.Bottom + cp.YScale(1)
DrawLine cp.HDc, x + halfW / 2 + cp.XScale(5), rc.Top, x + halfW / 2 + cp.XScale(5), y
End If
tY = y
y = y + cp.YScale(1)
F.Bold = True
Set cp.Font = F
str = "Toal"
rc.Left = x + cp.XScale(1)
rc.Top = y
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
rc.Bottom = cp.HeightPrint
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE Or DT_CALCRECT
Y2 = (rc.Bottom - rc.Top)
rc.Top = (rc.Bottom - rc.Top) * 5
rc.Bottom = cp.HeightPrint - cp.YScale(10)
rc.Top = rc.Bottom - rc.Top
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE
str = Format2(amount, CurrencyFormat)
rc.Left = rc.Right
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_RIGHT Or DT_SINGLELINE
y = rc.Bottom + cp.YScale(1)
Y2 = Y2 + rc.Top + cp.YScale(1)
DrawLine cp.HDc, x, Y2, x + (halfW - cp.XScale(20)), Y2
y3 = Y2
DrawLine cp.HDc, x, rc.Top, x + (halfW - cp.XScale(20)), rc.Top
F.Bold = False
Set cp.Font = F
If b = False Or (Abs(val(TrimNull(rsp!principal)) - val(TrimNull(rsp!principal_paid)))) = 0 Then
str = "Bal." & Format2(Abs(val(TrimNull(rsp!Balance_Amount))), CurrencyFormat)
Else
str = "Bal." & Format2(Abs(val(TrimNull(rsp!principal)) - val(TrimNull(rsp!principal_paid))), CurrencyFormat)
End If
rc.Left = x + cp.XScale(1)
rc.Top = Y2
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
rc.Bottom = cp.HeightPrint
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE Or DT_CALCRECT
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE
Y2 = rc.Bottom + cp.YScale(1)
str = RsPaise(amount)
rc.Left = x + cp.XScale(1)
rc.Top = Y2
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
rc.Bottom = cp.HeightPrint
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE Or DT_CALCRECT
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE
Y2 = rc.Bottom + cp.YScale(1)
DrawLine cp.HDc, x + halfW / 2 + cp.XScale(5), tY, x + halfW / 2 + cp.XScale(5), y3 ' - ((rc.Bottom - rc.Top) / 2)
' DrawLine cp.hdc, x, y, x + (halfW - cp.XScale(20)), y
y = y + cp.YScale(1)
str = "Authorized Signatory"
rc.Left = x + cp.XScale(1)
rc.Top = y
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
rc.Bottom = cp.HeightPrint - cp.YScale(10)
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE Or DT_CALCRECT
rc.Top = rc.Bottom - rc.Top
rc.Bottom = cp.HeightPrint - cp.YScale(10)
rc.Top = rc.Bottom - rc.Top
rc.Right = rc.Left + (halfW / 2 - cp.XScale(11))
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_BOTTOM Or DT_SINGLELINE
' DrawLine cp.hdc, x, rc.Top, x + (halfW - cp.XScale(20)), rc.Top
Next
cp.PrinterEndPage
cp.PrinterEndDoc
End If
cp.Preview = False
Set cp = Nothing
End Sub
Sub Print_ReceiptA5(rsp As Object)
Const mMMPerInch As Single = 25.4
Dim Heading1 As String, Heading2 As String, Heading3 As String, ScrollNo As Long
Dim DocDate As Date, Particulars1 As String
Dim amount As Currency
Dim cp As New cPrinter
Dim sz As SIZEAPI, rc As RECT
Dim x As Long, y As Long, pScaleX As Long, pScaleY As Long, tY As Long
'a5 w=5.83 in , h=8.27 in
'a4 w=8.27 in , h=11.69 in
' cp.PrinterAddNewForm 4 * mMMPerInch * 1000, 4 * mMMPerInch * 1000, "Small4x4"
'Dim c As Long, NumForms As Long, sNames() As String, cX() As Long, cY() As Long
' NumForms = cp.PrinterGetForms(sNames, cX, cY)
'For c = 0 To NumForms - 1
' cboPaperSize.AddItem sNames(c)
' cboPaperSize.ItemData(cboPaperSize.NewIndex) = c + 1
'' If c + 1 = 11 Then
'' cboPaperSize.ListIndex = c
'' End If
'Next
ScrollNo = val(rsp!ScrollNo)
DocDate = rsp!DocDate
amount = val(rsp!amount_paid)
Heading1 = TrimNull(rsp!BranchName)
Heading2 = TrimNull(rsp!BranchAddress)
Particulars1 = TrimNull(rsp!Name)
If Particulars1 = "" Then
Particulars1 = TrimNull(rsp!member_name)
End If
If Particulars1 = "" Then
Particulars1 = TrimNull(rsp!AccountName)
End If
'If MsgBox("Print " & Heading3 & " - " & ScrollNo & "?", vbQuestion + vbYesNo + vbDefaultButton2) = vbNo Then
' Unload Me
' Exit Sub
'End If
Caption = "Printing " & Heading3 & " - " & ScrollNo & "..."
cp.PaperSize = 11 'A5
cp.Orientation = Landscape
' cp.PrinterSetup
cp.Preview = False 'True
If cp.PrinterStartDoc Then
pScaleX = cp.XScale(1)
pScaleX = cp.YScale(1)
cp.PrinterStartPage
SetBkMode cp.HDc, TRANSPARENT
'cp.PrintText "Hello", 10, 10
cp.Rectangle 1, 1, cp.Width - 2, cp.Height - 2
cp.Rectangle 10, 10, cp.Width - 20, cp.Height - 20
' x = 20 * pScaleX
' y = 40 * pScaleY
x = cp.XScale(11)
y = cp.YScale(11)
Dim F As New StdFont
F.Name = "Times New Roman"
F.Size = 25
F.Bold = True
Set cp.Font = F
Dim str As String
str = Heading1
rc.Left = x
rc.Top = y
rc.Right = cp.WidthPrint - cp.XScale(10)
rc.Bottom = cp.HeightPrint
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_CENTER Or DT_NOPREFIX Or DT_WORDBREAK Or DT_CALCRECT
rc.Right = cp.WidthPrint - cp.XScale(10)
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_CENTER Or DT_NOPREFIX Or DT_WORDBREAK
y = rc.Bottom + cp.YScale(1) '(10 * pScaleY)
' DrawLine cp.hDC, x, y, cp.WidthPrint - (40 * pScaleX), y
DrawLine cp.HDc, cp.XScale(10), y, cp.WidthPrint - cp.XScale(10), y
y = y + cp.YScale(1)
F.Size = 20
F.Bold = False
Set cp.Font = F
str = Heading2
rc.Left = x
rc.Top = y
rc.Right = cp.WidthPrint - cp.XScale(10)
rc.Bottom = cp.HeightPrint
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_NOPREFIX Or DT_WORDBREAK Or DT_CALCRECT
rc.Right = cp.WidthPrint - cp.XScale(10)
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_NOPREFIX Or DT_WORDBREAK
y = rc.Bottom + cp.YScale(1)
DrawLine cp.HDc, cp.XScale(10), y, cp.WidthPrint - cp.XScale(10), y
y = y + cp.YScale(1)
F.Size = 16
F.Bold = True
Set cp.Font = F
str = Heading3
rc.Left = x
rc.Top = y
rc.Right = cp.WidthPrint - cp.XScale(10)
rc.Bottom = cp.HeightPrint
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_CENTER Or DT_SINGLELINE Or DT_NOPREFIX Or DT_CALCRECT
rc.Right = cp.WidthPrint - cp.XScale(10)
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_CENTER Or DT_SINGLELINE Or DT_NOPREFIX
y = rc.Bottom + cp.YScale(1)
DrawLine cp.HDc, cp.XScale(10), y, cp.WidthPrint - cp.XScale(10), y
y = y + cp.YScale(1)
F.Size = 13
F.Bold = True
Set cp.Font = F
str = "Particulars"
rc.Left = x
rc.Top = y
rc.Right = cp.WidthPrint - cp.XScale(10)
rc.Bottom = cp.HeightPrint
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE Or DT_CALCRECT
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE
str = "Amount "
rc.Left = cp.WidthPrint / 2 + cp.XScale(10) 'rc.Right + cp.XScale(10)
rc.Right = cp.WidthPrint - cp.XScale(10)
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_RIGHT Or DT_SINGLELINE
y = rc.Bottom + cp.YScale(1)
DrawLine cp.HDc, cp.WidthPrint / 2 + cp.XScale(5), rc.Top, cp.WidthPrint / 2 + cp.XScale(5), y
DrawLine cp.HDc, cp.XScale(10), y, cp.WidthPrint - cp.XScale(10), y
y = y + cp.YScale(1)
F.Bold = False
Set cp.Font = F
str = "Date : " & DocDate
rc.Left = x
rc.Top = y
rc.Right = cp.WidthPrint - cp.XScale(10)
rc.Bottom = cp.HeightPrint
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE Or DT_CALCRECT
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE
y = rc.Bottom + cp.YScale(1)
DrawLine cp.HDc, cp.WidthPrint / 2 + cp.XScale(5), rc.Top, cp.WidthPrint / 2 + cp.XScale(5), y
str = "No : " & ScrollNo
rc.Left = x
rc.Top = y
rc.Right = cp.WidthPrint - cp.XScale(10)
rc.Bottom = cp.HeightPrint
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE Or DT_CALCRECT
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE
y = rc.Bottom + cp.YScale(1)
DrawLine cp.HDc, cp.WidthPrint / 2 + cp.XScale(5), rc.Top, cp.WidthPrint / 2 + cp.XScale(5), y
str = Particulars1
rc.Left = x
rc.Top = y
rc.Right = cp.WidthPrint - cp.XScale(10)
rc.Bottom = cp.HeightPrint
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE Or DT_CALCRECT
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE
str = Format$(amount, "#.00")
rc.Left = cp.WidthPrint / 2 + cp.XScale(10) 'rc.Right + cp.XScale(10)
rc.Right = cp.WidthPrint - cp.XScale(10)
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_RIGHT Or DT_SINGLELINE
y = rc.Bottom + cp.YScale(1)
DrawLine cp.HDc, cp.WidthPrint / 2 + cp.XScale(5), rc.Top, cp.WidthPrint / 2 + cp.XScale(5), y
' DrawLine cp.hDC, cp.XScale(10), y, cp.WidthPrint - cp.XScale(10), y
tY = y
y = y + cp.YScale(1)
F.Bold = True
Set cp.Font = F
str = "Sub-Toal"
rc.Left = x
rc.Top = y
rc.Right = cp.WidthPrint - cp.XScale(10)
rc.Bottom = cp.HeightPrint
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE Or DT_CALCRECT
rc.Top = (rc.Bottom - rc.Top) * 2
rc.Bottom = cp.HeightPrint - cp.YScale(10)
rc.Top = rc.Bottom - rc.Top
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE
str = Format$(amount, "#.00")
rc.Left = cp.WidthPrint / 2 + cp.XScale(10) 'rc.Right + cp.XScale(10)
rc.Right = cp.WidthPrint - cp.XScale(10)
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_RIGHT Or DT_SINGLELINE
y = rc.Bottom + cp.YScale(1)
DrawLine cp.HDc, cp.XScale(10), rc.Top, cp.WidthPrint - cp.XScale(10), rc.Top
DrawLine cp.HDc, cp.WidthPrint / 2 + cp.XScale(5), tY, cp.WidthPrint / 2 + cp.XScale(5), y - ((rc.Bottom - rc.Top) / 2)
DrawLine cp.HDc, cp.XScale(10), y, cp.WidthPrint - cp.XScale(10), y
y = y + cp.YScale(1)
str = "Authorized Signatory"
rc.Left = x
rc.Top = y
rc.Right = cp.WidthPrint - cp.XScale(10)
rc.Bottom = cp.HeightPrint - cp.YScale(10)
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_LEFT Or DT_SINGLELINE Or DT_CALCRECT
rc.Top = rc.Bottom - rc.Top
rc.Bottom = cp.HeightPrint - cp.YScale(10)
rc.Top = rc.Bottom - rc.Top
DrawTextW cp.HDc, StrPtr(str), Len(str), rc, DT_BOTTOM Or DT_SINGLELINE
' DrawLine cp.hDC, cp.WidthPrint / 2 + cp.XScale(5), y, cp.WidthPrint / 2 + cp.XScale(5), rc.Top
DrawLine cp.HDc, cp.XScale(10), rc.Top, cp.WidthPrint - cp.XScale(10), rc.Top
cp.PrinterEndPage
cp.PrinterEndDoc
End If
cp.Preview = False
Set cp = Nothing
End Sub
'Create rotated font handle.
Private Function GetFont(ByVal HDc As Long, ByVal Angle As Double) As Long
Dim hFont As Long
Dim lf As LOGFONT
'Get the current HFONT handle
hFont = GetCurrentObject(HDc, OBJ_FONT)
'Retrieve the LOGFONT structure from the font handle.
GetObject hFont, Len(lf), lf
'Change the font angle
lf.lfEscapement = CInt(Angle * 10)
lf.lfOrientation = lf.lfEscapement
'Create a new font
GetFont = CreateFontIndirect(lf)
End Function
Sub DrawLine(ByVal lHdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long)
MoveToEx lHdc, X1, Y1, 0
LineTo lHdc, X2, Y2
End Sub
Function TrimNull(ByVal v As Variant, Optional ByVal D As Variant = "") As Variant
If IsNull(v) Then
TrimNull = D
Else
TrimNull = v
End If
End Function
A declarative, efficient, and flexible JavaScript library for building user interfaces.
๐ Vue.js is a progressive, incrementally-adoptable JavaScript framework for building UI on the web.
TypeScript is a superset of JavaScript that compiles to clean JavaScript output.
An Open Source Machine Learning Framework for Everyone
The Web framework for perfectionists with deadlines.
A PHP framework for web artisans
Bring data to life with SVG, Canvas and HTML. ๐๐๐
JavaScript (JS) is a lightweight interpreted programming language with first-class functions.
Some thing interesting about web. New door for the world.
A server is a program made to process requests and deliver data to clients.
Machine learning is a way of modeling and interpreting data that allows a piece of software to respond intelligently.
Some thing interesting about visualization, use data art
Some thing interesting about game, make everyone happy.
We are working to build community through open source technology. NB: members must have two-factor auth.
Open source projects and samples from Microsoft.
Google โค๏ธ Open Source for everyone.
Alibaba Open Source for everyone
Data-Driven Documents codes.
China tencent open source team.