مشکل با پرینت فارسی

[as987498749874]

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 As String * LF_FACESIZE
End Type

Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) 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 Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long ' or Boolean
' Print rotated text.
Public Sub Print_A(TXT_1 As String, ByVal Degree As Integer, ByVal X As Long, ByVal Y As Long)
Dim t As String


Const FONT_SIZE = 15
'Const FONT_FACE = "Tahoma"
'Const TXT = TXT_1

Dim printer_hdc As Long
Dim log_font As LOGFONT
Dim new_font As Long
Dim old_font As Long


' Initialize the printer.
Printer.Print " "

' Create the rotated font.
printer_hdc = Printer.hdc
With log_font
.lfEscapement = Degree * 10 ''''''''' DEG * 10
.lfHeight = (FONT_SIZE * -20) / Printer.TwipsPerPixelY

' End the font name with a vbNullChar.
' Thanks to Tim Rude (timrude@ hotmail.com) for finding this.
.lfFaceName = "tahoma" & vbNullChar
End With
new_font = CreateFontIndirect(log_font)

' Select the font.
old_font = SelectObject(Printer.hdc, new_font)

' Draw the text.
TextOut printer_hdc, X, Y, TXT_1, Len(TXT_1)

' Restore the original font.
SelectObject printer_hdc, old_font
DeleteObject new_font

' Printer.EndDoc
End Sub


Public Sub Print_B(TXT_1 As String, ByVal Degree As Integer, ByVal X As Long, ByVal Y As Long)
Dim t As String


'Const FONT_SIZE = 150
'Const FONT_FACE = "Tahoma"
'Const TXT = TXT_1

Dim printer_hdc As Long
Dim log_font As LOGFONT
Dim new_font As Long
Dim old_font As Long


' Create the rotated font.
printer_hdc = P1.hdc
With log_font
.lfEscapement = Degree * 10 ''''''''' DEG * 10
.lfHeight = -8.5
' End the font name with a vbNullChar.
' Thanks to Tim Rude (timrude@ hotmail.com) for finding this.
.lfFaceName = "tahoma" & vbNullChar
End With
new_font = CreateFontIndirect(log_font)

' Select the font.
old_font = SelectObject(P1.hdc, new_font)

' Draw the text.
TextOut printer_hdc, X, Y, TXT_1, Len(TXT_1)

' Restore the original font.
SelectObject printer_hdc, old_font
DeleteObject new_font

' Printer.EndDoc
End Sub




سلام دوستان

کدی رو که گذاشتم مربوط به چاپ زاویه دار متن با دستور Printer هست
مشکلی با انگلیسی نداره
با فارسی اصلا کار نمیکنه

کسی نمی تونه تش تغییرات بده تا از فونت فارسی هم پشتیبانی کنه


مر30

[the king]

سلام دوستان

کدی رو که گذاشتم مربوط به چاپ زاویه دار متن با دستور Printer هست
مشکلی با انگلیسی نداره
با فارسی اصلا کار نمیکنه

کسی نمی تونه تش تغییرات بده تا از فونت فارسی هم پشتیبانی کنه


مر30

مرحله اول - بجای TextOutA که ANSI ئه از TextOutW استفاده کنیم که Unicode ئه و مشکلی با فارسی و سایر زبان ها نداره.

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


مرحله دوم - چون رشته Unicode ئه، نحوه فراخوانی TextOutW هم باید طوری باشه که Unicode ارسال بشه، از ()StrPtr استفاده می کنیم :
بجای این :

TextOut printer_hdc, X, Y, TXT_1, Len(TXT_1)

اینطوری باشه :

TextOutW printer_hdc, X, Y, StrPtr(TXT_1), Len(TXT_1)