Función para imprimir texto justificado en impresora.

Sub justifica_printer(x0, xf, y0, txt)
' x0, xf = posicion de los margenes izquierdo y derecho
' y0 = posicion vertical donde se desea empezar a escribir
' txt = texto a escribir

Dim x, y, k, ancho
Dim s As String, ss As String
Dim x_spc

s = txt
x = x0
y = y0
ancho = (xf - x0)

While s <> ""

  ss = ""
  While (s <> "") And (Printer.TextWidth(ss) <= ancho)
    ss = ss & Left$(s, 1)
    s = Right$(s, Len(s) - 1)
  Wend
  If (Printer.TextWidth(ss) > ancho) Then
    s = Right$(ss, 1) & s
    ss = Left$(ss, Len(ss) - 1)
  End If
  ' aqui tenemos en ss lo maximo que cabe en una linea
  If Right$(ss, 1) = " " Then
     ss = Left$(ss, Len(ss) - 1)
  Else
     If (InStr(ss, " ") > 0) And (Left$(s & " ", 1) <> " ") Then
      While Right$(ss, 1) <> " "
        s = Right$(ss, 1) & s
        ss = Left$(ss, Len(ss) - 1)
      Wend
      ss = Left$(ss, Len(ss) - 1)
     End If
  End If
  x_spc = 0
  x = x0
  If (Len(ss) > 1) And (s & "" <> "") Then
    x_spc = (ancho - Printer.TextWidth(ss)) / (Len(ss) - 1)
  End If
  Printer.CurrentX = x
  Printer.CurrentY = y

  If x_spc = 0 Then
    Printer.Print ss;
  Else
    For k = 1 To Len(ss)
     Printer.CurrentX = x
     Printer.Print Mid$(ss, k, 1);
     x = x + Printer.TextWidth("*" & Mid$(ss, k, 1) & "*") - Printer.TextWidth("**")
     x = x + x_spc
    Next
  End If

  y = y + Printer.TextHeight(ss)
  While Left$(s, 1) = " "
    s = Right$(s, Len(s) - 1)
  Wend
Wend

End Sub


Daniel Castillo Martinez, dacasma@servitel.es

Función para imprimir texto justificado en un PictureBox.

Sub justifica_picture(p As PictureBox, x0, xf, y0, txt)
' Muestra un texto justificado dentro del picture "p"
' x0, xf = posicion de los margenes izquierdo y derecho
' y0 = posicion vertical donde se desea empezar a escribir
' txt = texto a escribir

Dim x, y, k, ancho
Dim s As String, ss As String
Dim x_spc

s = txt
x = x0
y = y0
ancho = (xf - x0)

While s <> ""

  ss = ""
  While (s <> "") And (p.TextWidth(ss) <= ancho)
    ss = ss & Left$(s, 1)
    s = Right$(s, Len(s) - 1)
  Wend
  If (p.TextWidth(ss) > ancho) Then
    s = Right$(ss, 1) & s
    ss = Left$(ss, Len(ss) - 1)
  End If
  ' aqui tenemos en ss lo maximo que cabe en una linea
  If Right$(ss, 1) = " " Then
     ss = Left$(ss, Len(ss) - 1)
  Else
     If (InStr(ss, " ") > 0) And (Left$(s & " ", 1) <> " ") Then
      While Right$(ss, 1) <> " "
        s = Right$(ss, 1) & s
        ss = Left$(ss, Len(ss) - 1)
      Wend
      ss = Left$(ss, Len(ss) - 1)
     End If
  End If
  x_spc = 0
  x = x0
  If (Len(ss) > 1) And (s & "" <> "") Then
    x_spc = (ancho - p.TextWidth(ss)) / (Len(ss) - 1)
  End If
  p.CurrentX = x
  p.CurrentY = y

  If x_spc = 0 Then
    p.Print ss;
  Else
    For k = 1 To Len(ss)
     p.CurrentX = x
     p.Print Mid$(ss, k, 1);
     x = x + p.TextWidth("*" & Mid$(ss, k, 1) & "*") - p.TextWidth("**")
     x = x + x_spc
    Next
  End If

  y = y + p.TextHeight(ss)
  While Left$(s, 1) = " "
    s = Right$(s, Len(s) - 1)
  Wend
Wend
End Sub

Daniel Castillo Martinez, dacasma@servitel.es