VB 5/6-Tipp 0617: Einen Text als Blocksatz ausgeben
von Peter K. Sauer
Beschreibung
Dieser Tipp zeigt, wie man einen Text in einen Blocksatz ausgibt. Dies kann sowohl auf einer Picturebox, als auch auf einem Drucker erfolgen.
Zu diesem Tipp existieren im Tippupload die folgende(n) Aktualisierung(en):
[VB 5/6 Tippvorschlag 0381] Korrektur VB 617
Schwierigkeitsgrad: | Verwendete API-Aufrufe: | Download: |
'Dieser Quellcode stammt von http://www.activevb.de 'und kann frei verwendet werden. Für eventuelle Schäden 'wird nicht gehaftet. 'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum. 'Ansonsten viel Spaß und Erfolg mit diesem Source! '---------- Anfang Projektdatei PrintBlockSatz.vbp ---------- '--- Anfang Formular "frmBlocksatz" alias frmBlocksatz.frm --- ' Steuerelement: Schaltfläche "Command3" ' Steuerelement: Kontrollkästchen-Steuerelement "Check1" ' Steuerelement: Kombinationsliste "Combo2" ' Steuerelement: Kombinationsliste "Combo1" ' Steuerelement: Schaltfläche "Command2" ' Steuerelement: Schaltfläche "Command1" ' Steuerelement: Textfeld "Text1" ' Steuerelement: Bildfeld-Steuerelement "Picture1" ' Steuerelement: Beschriftungsfeld "Label1" Option Explicit Private BlockSatzFile As String Private Sub Check1_Click() Text1.FontBold = Check1.Value * -1 End Sub Private Sub Combo1_Click() Text1.FontName = Combo1.List(Combo1.ListIndex) End Sub Private Sub Combo2_Click() Text1.FontSize = Val(Combo2.List(Combo2.ListIndex)) End Sub Private Sub Command1_Click() Dim FNr As Integer FNr = FreeFile Open BlockSatzFile For Output As #FNr Print #FNr, Text1.Text; Close #FNr End Sub Private Sub DoPrint(prnObj As Object) Dim s() As String Dim i As Long, j As Long Dim w As Single Dim x As Single Dim aTime As Single aTime = Timer 'zur Messung auf For j = 1 To 100 For j = 1 To 1 'Textbox auslesen in Array s() = TextboxLinesToArray(Text1) 'benötigte Breite für Blocksatz ermitteln w = BlockSatzWidth(prnObj, s(), Text1.FontName, Text1.FontSize, Text1.FontBold) x = prnObj.CurrentX For i = LBound(s) To UBound(s) BlocksatzZeilePrint prnObj, s(), i, x, w Next Next j Label1.Caption = Format(Timer - aTime, "0.00000") End Sub Private Sub Command2_Click() With Picture1 .Cls .CurrentX = 600 .CurrentY = 150 End With DoPrint Picture1 End Sub Private Sub Command3_Click() Printer.CurrentX = 1000 Printer.CurrentY = 2000 DoPrint Printer Printer.EndDoc End Sub Private Sub Form_Load() Dim FNr As Integer Dim s As String Dim i As Long BlockSatzFile = App.Path If Right(App.Path, 1) <> "\" Then BlockSatzFile = BlockSatzFile & "\" BlockSatzFile = BlockSatzFile & "blocksatz.txt" If Len(Dir(BlockSatzFile)) > 0 Then FNr = FreeFile Open BlockSatzFile For Binary As #FNr s = Space$(LOF(FNr)) Get #FNr, , s Close #FNr End If Text1.Text = s Command1.Caption = "SaveFile" Command2.Caption = "Picturebox" Command3.Caption = "Printer" Label1.Caption = "" Check1.Caption = "Bold" For i = 0 To Printer.FontCount - 1 Combo1.AddItem Printer.Fonts(i) Next i Combo1.ListIndex = 0 For i = 0 To Combo1.ListCount - 1 If LCase(Combo1.List(i)) = "arial" Then Combo1.ListIndex = i Exit For End If Next i Combo2.AddItem 8 Combo2.AddItem 10 Combo2.AddItem 12 Combo2.AddItem 14 Combo2.AddItem 16 Combo2.AddItem 20 Combo2.AddItem 24 Combo2.ListIndex = 1 End Sub '--- Ende Formular "frmBlocksatz" alias frmBlocksatz.frm --- '---- Anfang Modul "modBlockSatz" alias modBlockSatz.bas ---- '################################################################### ' ' modBlockSatz.bas ' ' Funktionen für Blocksatz Print ' ' (c) peter.k.sauer@web.de 07.2003 ' nur für den persönlichen nicht gewerblichen Gebrauch '------------------------------------------------------------------- Option Explicit Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hWnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, lParam As Any) As Long Private Const EM_GETLINE = &HC4 Private Const EM_GETLINECOUNT = &HBA Private Const EM_SCROLLCARET = &HB7 Private Const EM_LINELENGTH = &HC1 Private Const EM_LINEINDEX = &HBB Private Type PrnFormatType Top As Single Left As Single Width As Single Height As Single End Type Private PrnFormat As PrnFormatType 'Anzahl der Zeilen einer Textbox ausgeben Public Function TextBoxLineCount(ByRef Tbox As Control) As Long TextBoxLineCount = SendMessage(Tbox.hWnd, EM_GETLINECOUNT, 0, 0&) End Function 'einzelne Line einer (Rich) Textbox ausgeben (Line 0 to n) Public Function TextBoxLine(ByRef Tbox As Control, _ ByVal LineNr As Long) As String Dim LineLength As Long Dim LineStart As Long 'ermitteln Beginn Zeile und Länge LineStart = SendMessage(Tbox.hWnd, EM_LINEINDEX, LineNr, ByVal 0&) LineLength = SendMessage(Tbox.hWnd, EM_LINELENGTH, LineStart, ByVal 0&) 'aus Textbox separieren TextBoxLine = Mid$(Tbox, LineStart + 1, LineLength) End Function 'Position einer Zeile im Text Public Function TextboxLineStart(ByRef Tbox As Control, LineNr As Long) As Long TextboxLineStart = SendMessage(Tbox.hWnd, EM_LINEINDEX, LineNr, ByVal 0&) End Function 'Länge einer Zeile Public Function TextboxLineLength(ByRef Tbox As Control, LineNr As Long) As Long Dim LineChar As Long LineChar = SendMessage(Tbox.hWnd, EM_LINEINDEX, LineNr, ByVal 0&) TextboxLineLength = SendMessage(Tbox.hWnd, EM_LINELENGTH, LineChar, ByVal 0&) End Function 'Textbox in ein Array ausgeben Public Function TextboxLinesToArray(Tbox As Control) As String() Dim s() As String Dim i As Long i = TextBoxLineCount(Tbox) If i = 0 Then ReDim s(0) Else ReDim s(i - 1) For i = 0 To UBound(s) s(i) = TextBoxLine(Tbox, i) Next i End If TextboxLinesToArray = s() End Function 'Breite für einen Blocksatz aus einem Array ermitteln Public Function BlockSatzWidth(prnObj As Object, sString() As String, _ FontName As String, FontSize As Long, _ FontBold As Boolean) As Single Dim MaxWidth As Single, w As Single Dim i As Long Dim s As String 'Schrift einrichten prnObj.FontName = FontName prnObj.FontSize = FontSize prnObj.FontBold = FontBold 'maximale Breite einer Zeile feststellen For i = LBound(sString) To UBound(sString) sString(i) = RTrim(sString(i)) w = prnObj.TextWidth(sString(i)) If w > MaxWidth Then MaxWidth = w End If Next i BlockSatzWidth = MaxWidth End Function 'Zeile auf Blocksatzlänge ausdrucken Public Function BlocksatzZeilePrint(prnObj As Object, sString() As String, _ Zeile As Long, StartPosX As Single, _ MaxWidth As Single) As Boolean Dim s() As String Dim tb() As Single Dim AnzWorte As Long, AnzPixel As Long Dim AnzProWort As Single Dim i As Long, j As Long Dim w As Single Dim x As Single Dim PrintDirect As Boolean 'linker Rand prnObj.CurrentX = StartPosX If Len(Trim(sString(Zeile))) = 0 Then 'nix bei Leerzeile PrintDirect = True ElseIf Zeile = UBound(sString) Then 'nix bei letzter Zeile PrintDirect = True ElseIf Len(Trim(sString(Zeile + 1))) = 0 Then 'nix wenn Leerzeile folgt PrintDirect = True End If w = prnObj.TextWidth(sString(Zeile)) If w = MaxWidth Then 'ist breiteste Zeile, drucken und weg PrintDirect = True End If If PrintDirect Then prnObj.Print sString(Zeile) BlocksatzZeilePrint = True Exit Function End If 'Zeile auf Wörter aufsplitten s() = Split(sString(Zeile), Space(1)) 'wieviele Wörter insgesamt ohne letztes Wort For i = LBound(s) To UBound(s) - 1 If RTrim(s(i)) > 0 Then AnzWorte = AnzWorte + 1 End If Next i 'Breite ohne Optimierung feststellen w = prnObj.TextWidth(sString(Zeile)) 'Breite eines Pixels auf Scalemode der Ausgabe x = prnObj.ScaleX(1, vbPixels, prnObj.ScaleMode) 'benötigte Pixel AnzPixel = (MaxWidth - w) \ x 'für Verteilung ReDim tb(UBound(s)) 'LeerPixel pro Wort ermitteln Do For i = UBound(s) - 1 To LBound(s) Step -1 If Len(s(i)) > 0 Then tb(i) = tb(i) + 1 AnzPixel = AnzPixel - 1 End If If AnzPixel = 0 Then Exit Do End If Next i Loop 'Ausgabe der einzelnen Wörter For i = LBound(s) To UBound(s) 'Wort mit folgendem Space prnObj.Print s(i) & Space(1); 'verschieben um x Pixel prnObj.CurrentX = prnObj.CurrentX + (tb(i) * x) Next i 'Rücklauf mit Zeilenvorschub prnObj.Print "" BlocksatzZeilePrint = True End Function '----- Ende Modul "modBlockSatz" alias modBlockSatz.bas ----- '----------- Ende Projektdatei PrintBlockSatz.vbp -----------
Tipp-Kompatibilität:
Windows/VB-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
VB4 | |||||||
VB5 | |||||||
VB6 |
Ihre Meinung
Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.
Archivierte Nutzerkommentare
Klicken Sie diesen Text an, wenn Sie die 3 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.
Kommentar von Peter Siepe am 11.02.2008 um 09:48
Hallo, gibt es noch ne möglichkeit für nen blocksatz,
ausser so fett und .. hmm, umständlich ?
Gruß
P. siepe
Kommentar von C.Stricker am 19.07.2005 um 13:04
Ist es wirklich nur möglich über eine Picturebox den Blocksatz hinzukriegen. Mir würde es besser gefallen , wenn es so wie in Word funktionieren würde.
Kommentar von Patrick Hegemann am 22.02.2004 um 12:27
bei mir funktioniert das Programm nicht weil ich keinen Drucker habe deswegen bringt er die fehlermeldung
Lufzeitfehler'482':
Druckerfehler
bei der folgenden Zeile:
For i = 0 To Printer.FontCount - 1