USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  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
 


CyberWEB Network Ltda.    © Copyright 2000-2022   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página