Option Explicit
Private Const DT_EXTERNALLEADING As Long = &H200
Private Const DT_NOPREFIX As Long = &H800
Private Const DT_RIGHT As Long = &H2
Private Const DT_RTLREADING As Long = &H20000
Private Const DT_TOP As Long = &H0
Private Const DT_WORDBREAK As Long = &H10
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function DrawTextW Lib "user32.dll" (ByVal hDC As Long, ByVal lpStr As Long, ByVal nCount As Long, ByRef lpRect As RECT, ByVal wFormat As Long) As Long
Private Sub Command1_Click()
PrintTextBox Text1, 2
Printer.EndDoc
End Sub
Private Sub Form_Load()
Dim Text As String
Text = GetSampleText
With Text1
.Text = Text
.Alignment = vbRightJustify
.RightToLeft = True
.Font = "Tahoma"
End With
End Sub
Private Sub PrintTextBox(ByRef TextBox As TextBox, ByVal Top As Double)
Dim TextRect As RECT
Dim TextFlags As Long
Dim Text As String
With Printer
.ScaleMode = vbPixels
Set .Font = TextBox.Font
Printer.Line (0, 0)-(1, 1), vbWhite
.ForeColor = vbBlack
TextRect.Left = .ScaleX(2, vbCentimeters, vbPixels)
TextRect.Top = .ScaleY(Top, vbCentimeters, vbPixels)
TextRect.Right = .ScaleWidth - .ScaleX(2, vbCentimeters, vbPixels)
TextRect.Bottom = .ScaleHeight - .ScaleY(2, vbCentimeters, vbPixels)
TextFlags = DT_EXTERNALLEADING Or DT_NOPREFIX Or DT_TOP Or DT_WORDBREAK
If TextBox.RightToLeft Then TextFlags = TextFlags Or DT_RTLREADING
If TextBox.Alignment = vbRightJustify Then TextFlags = TextFlags Or DT_RIGHT
Text = TextBox.Text
DrawTextW .hDC, StrPtr(Text), Len(Text), TextRect, TextFlags
End With
End Sub
Private Function Decode(ByRef Text As String) As String
Dim Pos As Long
For Pos = 1 To Len(Text) Step 2
Decode = Decode & Chr(Val("&H" & Mid(Text, Pos, 2)))
Next
End Function
Private Function GetSampleText() As String
Dim S As String
S = "C7CCD1C720E620DAE3E1ED20D3C7CECAE420C7E190E6D1EDCAE320E5C7ED20C7E4CAD2"
S = S & "C7DAED20E6C7C8D3CAE520C8E520E5E320C8E520E6D3EDE1E520CAE6E1EDCF20ED9820"
S = S & "C8D1E4C7E3E520D1C7EDC7E4E520C7ED20E3D4CED520C8C720C7C8D2C7D120D2C8C7E4"
S = S & "20C8D1E4C7E3E520E4E6EDD3ED20E3E398E420C7D3CA2E2090D18DE520E4D2CFED9820"
S = S & "CAD1EDE420D1C7E520C8D1C7ED20C8C7D2D3C7D2ED20C7EDE420DEE6C7E4EDE420CFD1"
S = S & "20D1C7EDC7E4E52098C7D120D1E6ED20E3CFC7D1E5C7ED20C7E198CAD1E6E4ED98ED20"
S = S & "D3CECA20C7DDD2C7D120C2E420C7D3CA2E20C7E3C720C7EDE42098C7D1ED20D8C7DECA"
S = S & "20DDD1D3C720E620D2E3C7E420C8D120E620CFD1E4CAEDCCE52098E3C7C8EDD420E4C7"
S = S & "E3E398E420C7D3CA2E20E6C7D3D820E5C7EDED20D3C7CECAE520D4CFE4CF20CAC720E3"
S = S & "EDC7E420D3CECA20C7DDD2C7D120E620C7E4D3C7E420DED1C7D12090EDD1CF2E20D8C8"
S = S & "EDDAED20C7D3CA20ED9820E6C7D3D820C8E520D3C7CFE52098D1CFE420E620C7E4CAD2"
S = S & "C7DAED2098D1CFE420D1E6EDCFC7CFE5C7ED20E3E398E420CFD1E6E420D3CECA20C7DD"
S = S & "D2C7D120E3ED2081D1CFC7D2CF2E20C7EDE420C7E4CAD2C7DAED2098D1CFE4A120D3"
S = S & "C7D2E4CFE520D3D8E6CD2090E6E4C790E6E420EDC720E1C7EDE520C8E4CFED20CFD120"
S = S & "E3DAE3C7D1ED20D2EDD1D3C7CECA20C8D1E4C7E3E520E5C720C7D3CA2E20C8E520E5E3"
S = S & "EDE420CAD1CAEDC820D2C8C7E420E5C7ED20C8D1E4C7E3E520E4E6EDD3ED2090E6E4C7"
S = S & "90E6E420E5E320E5D198CFC7E320C8D1C7ED20D3C7CECA20C8D1E4C7E3E520E5C7ED20"
S = S & "ED9820EDC720D4E3C7D1ED20C7E4CF9820C7D220C7EDE420E1C7EDE520E5C720DEC7C8"
S = S & "E120C7D3CADDC7CFE520E5D3CAE4CF2E20C8C720E3CADDC7E6CA20C8E6CFE420C2E48D"
S = S & "E520C8D1E4C7E3E520E4E6EDD320C8D1C7ED20C2D3C7E4ED20C7D3CADDC7CFE520CEE6"
S = S & "CF20C2DDD1EDCFE520C8C720E6D1E6CFED20E6C7DEDAED20D3CECA20C7DDD2C7D120C8"
S = S & "D1C7ED20C7CCD1C7ED20DDD1C7E3EDE4202898E520C8E520D2C8C7E420E3C7D4EDE420"
S = S & "E3DAD1E6DD20C7D3CA2920C8D1E4C7E3E520E6C7D3D820C8C7EDCF20D4EDE6E520CED8"
S = S & "20C8D1E4C7E3E520E4E6EDD320D1C720C8E520D2C8C7E420E3C7D4EDE420C8D190D1CF"
GetSampleText = Decode(S & "C7E4CF2E")
End Function
