Giter VIP home page Giter VIP logo

vb6-print-class's People

Contributors

joshyfrancis avatar

Stargazers

avatar avatar avatar avatar avatar avatar avatar

Watchers

avatar

Forkers

xxdoc vb6hobbyst7 sabsoft omidpoyan forliny

vb6-print-class's Issues

print in bold, underline.

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

Sample Code

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

Recommend Projects

  • React photo React

    A declarative, efficient, and flexible JavaScript library for building user interfaces.

  • Vue.js photo Vue.js

    🖖 Vue.js is a progressive, incrementally-adoptable JavaScript framework for building UI on the web.

  • Typescript photo Typescript

    TypeScript is a superset of JavaScript that compiles to clean JavaScript output.

  • TensorFlow photo TensorFlow

    An Open Source Machine Learning Framework for Everyone

  • Django photo Django

    The Web framework for perfectionists with deadlines.

  • D3 photo D3

    Bring data to life with SVG, Canvas and HTML. 📊📈🎉

Recommend Topics

  • javascript

    JavaScript (JS) is a lightweight interpreted programming language with first-class functions.

  • web

    Some thing interesting about web. New door for the world.

  • server

    A server is a program made to process requests and deliver data to clients.

  • Machine learning

    Machine learning is a way of modeling and interpreting data that allows a piece of software to respond intelligently.

  • Game

    Some thing interesting about game, make everyone happy.

Recommend Org

  • Facebook photo Facebook

    We are working to build community through open source technology. NB: members must have two-factor auth.

  • Microsoft photo Microsoft

    Open source projects and samples from Microsoft.

  • Google photo Google

    Google ❤️ Open Source for everyone.

  • D3 photo D3

    Data-Driven Documents codes.