|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (Impressões/Impressoras)
|
|
 |
Título da Dica: Imprimindo um texto justificado
|
 |
|
|
|
Postada em 6/10/2003 por ^HEAVY-METAL^
Option Explicit
Public Sub PrintLine(Text As String, SpaceWidth As Double, Target As
Object)
'Print a justified line to the Target object
Dim i As Integer
Dim cy As Double
Static FontBold As Boolean
Static FuntUnderLine As Boolean
Static FontItalic As Boolean
Target.FontBold = FontBold
Target.FontUnderline = FontUnderline
Target.FontItalic = FontItalic
cy = 0
For i = 1 To Len(Text)
Select Case Mid(Text, i, 1)
Case Chr(1)
Target.FontBold = True
Case Chr(2)
Target.FontBold = False
Case Chr(3)
Target.FontUnderline = True
Case Chr(4)
Target.FontUnderline = False
Case Chr(5)
Target.FontItalic = True
Case Chr(6)
Target.FontItalic = False
Case " "
cy = cy + SpaceWidth
Target.CurrentX = cy
Case Else
Target.Print Mid(Text, i, 1);
cy = cy + Target.TextWidth(Mid(Text, i, 1))
End Select
Next
FontBold = Target.FontBold
FontUnderline = Target.FontUnderline
FontItalic = Target.FontItalic
End Sub
Public Sub PrintJust(Text As String, Target As Object)
'Parse the text string and print justified lines to the Target Object
Dim i As Long
Dim WordWidth As Long
Dim NumWords As Long
Dim LineWidth As Long
Dim StartLine As Long
Dim StopLine As Long
Dim SpaceW As Long
'Verify the type of Target Object : only Printers or Pictures
If Not TypeOf Target Is Printer And Not TypeOf Target Is Picture Then
Exit Sub
End If
If Trim(Text) = "" Then
Target.Print
Exit Sub
End If
Text = Text & " "
Text = Replace(Text, "", Chr(1), 1, -1, vbTextCompare)
Text = Replace(Text, "", Chr(2), 1, -1, vbTextCompare)
Text = Replace(Text, "<u>", Chr(3), 1, -1, vbTextCompare)
Text = Replace(Text, "</u>", Chr(4), 1, -1, vbTextCompare)
Text = Replace(Text, "", Chr(5), 1, -1, vbTextCompare)
Text = Replace(Text, "", Chr(6), 1, -1, vbTextCompare)
Target.FontBold = False
Target.FontItalic = False
Target.FontUnderline = False
LineWidth = 0
WordWidth = 0
NumWords = 0
StartLine = 1
SpaceW = 0
i = 1
Do While i <= Len(Text)
Select Case Mid(Text, i, 1)
Case Chr(1)
Target.FontBold = True
Case Chr(2)
Target.FontBold = False
Case Chr(3)
Target.FontUnderline = True
Case Chr(4)
Target.FontUnderline = False
Case Chr(5)
Target.FontItalic = True
Case Chr(6)
Target.FontItalic = False
Case " "
SpaceW = SpaceW + Target.TextWidth(" ")
If i = Len(Text) Then
StopLine = i - 1
PrintLine Mid(Text, StartLine, StopLine - StartLine + 1),
Target.TextWidth(" "), Target
Target.Print
StartLine = StopLine + 2
LineWidth = 0
NumWords = 0
SpaceW = 0
ElseIf LineWidth + WordWidth + SpaceW > Target.ScaleWidth Then
PrintLine Mid(Text, StartLine, StopLine - StartLine + 1),
(Target.ScaleWidth - LineWidth) / NumWords, Target
Target.Print
StartLine = StopLine + 2
LineWidth = 0
NumWords = 0
SpaceW = 0
End If
StopLine = i - 1
LineWidth = LineWidth + WordWidth
NumWords = NumWords + 1
WordWidth = 0
Case Else
WordWidth = WordWidth + Target.TextWidth(Mid(Text, i, 1))
End Select
i = i + 1
Loop
Target.FontBold = False
Target.FontItalic = False
Target.FontUnderline = False
PrintLine "", 0, Target
End Sub
'Usage: Create a Form with a Picture Box and add this code...
Private Sub Picture1_Click()
Dim Var As String
Picture1.Cls
Var = "This Code allow you to send Justified text to a Printer or a
Picture Box, you can use HTML Tags to speficy Bold Style, Italic
Style or <u>UnderLine Style</u>...Hope you will enjoy with this code!!
Bye Bye."
Call PrintJust(Var, Picture1)
Call PrintJust("", Picture1)
Call PrintJust("Hello,", Picture1)
Call PrintJust(" ", Picture1)
Var = "Yesterday, All my troubles seemed so far away, Now it
looks as though they´re here to stay, Oh I believe in Yesterday.
Suddenly, I´m not half the man I used to be, There´s a shadow hanging
over me, Oh yesterday came suddenly. Why she had to go I don´t know
she wouldn´t say I said something wrong, now I long for yesterday.
Yesterday, Love was such an easy game to play, Now I need a place to
hide away, Oh I believe in vesterday, mm mm mm mm mm"
Call PrintJust(Var, Picture1)
Call PrintJust("", Picture1) 'Put a line to separate
Call PrintJust("Any text put as Sub argument is output justified. To
change the output to printer, just change 'picture1' to
'printer' in 'PrintJust' Sub call argument.", Picture1)
End Sub
|
|
|
|
|
