title image


Smiley VB6 Drucken RTF
Einen guten Morgen an alle Coder;

ich muß schnell ein Problem lösen...

Wenn ich dein Inhalt meiner RichtText Box ausdrucke,

wird nur auf der ersten Seite die Schrift

der Kopf und Fusszeile Blau ausgedruckt,auf

den anderen Seiten wieder Schwarz,so soll dass natürlich

nicht sein!Deshalb habe ich schon überall Printer.ForeColor = QBColor(9)

hingeschmissen,da es schnell gehen muss,aber leider

wird die "1." Seite perfekt ausgedruckt,wie gesagt ab der zweiten

nicht mehr!!!Warum?????????





Sub PrintRTB(RTF As RichTextBox, LeftMarginWidth As Long, _

TopMarginHeight As Long, RightMarginWidth As Long, _

BottomMarginHeight As Long)



Dim LeftOffSet As Long, TopOffSet As Long

Dim LeftMargin As Long, TopMargin As Long

Dim RightMargin As Long, BottomMargin As Long

Dim fr As FormatRange

Dim rcDrawTo As Rect

Dim rcPage As Rect

Dim TextLength As Long

Dim NextCharPosition As Long

Dim r As Long

Dim strHeader, strHeader2, strHeader3 As String

Dim strFooter As String

Dim wsh As Object

Dim a, b, c

Set wsh = CreateObject("WScript.shell")

a = wsh.regread("HKEY_LOCAL_MACHINE\Software\WEITENDORF\USER\Firma")

b = wsh.regread("HKEY_LOCAL_MACHINE\Software\WEITENDORF\USER\NName")

c = wsh.regread("HKEY_LOCAL_MACHINE\Software\WEITENDORF\USER\VName")

If Me.Text2 = "" Then

strHeader = "Position: " & Me.Text3 & " Beschreibung: " & Me.Text8 & vbCrLf & " HTSWeb 2006 - " & " Datum: " & Me.DTPicker1.Value

ElseIf Me.Text2 "" Then



strHeader = " Projekt: " & Me.Text2 & " Beschreibung: " & Me.Text6

strHeader2 = " Position: " & Me.Text3 & " Beschreibung: " & Me.Text8

strHeader3 = " Programm: HTSweb 2006 " & "Version: " & App.Major & "." & App.Minor & "." & App.Revision & " Datum: " & Me.DTPicker1.Value



End If



'MsgBox Printer.ScaleHeight

'Initialisierung des Printers

If Me.Text4 = "" And Me.Text7 = "" Then

strFooter = " Firma: " & Me.Text5

ElseIf Me.Text4 "" And Me.Text7 = "" Then

strFooter = " Firma: " & Me.Text5 & " Tel.: " & Me.Text4

ElseIf Me.Text4 = "" And Me.Text7 "" Then

strFooter = " Firma: " & Me.Text5 & " Fax: " & Me.Text7

ElseIf Me.Text4 "" And Me.Text7 "" Then

strFooter = " Firma: " & Me.Text5 & " Tel.: " & Me.Text4 & " Fax: " & Me.Text7

End If

Printer.Print ""

Printer.ScaleMode = vbTwips



'Linken und Oberen Offset auslesen

LeftOffSet = Printer.ScaleX(GetDeviceCaps(Printer.hDC, _

PHYSICALOFFSETX), vbPixels, _

vbTwips)



TopOffSet = Printer.ScaleY(GetDeviceCaps(Printer.hDC, _

PHYSICALOFFSETY), vbPixels, _

vbTwips)



'Ränder berechnen

LeftMargin = LeftMarginWidth - LeftOffSet

TopMargin = TopMarginHeight - TopOffSet

RightMargin = (Printer.ScaleWidth - RightMarginWidth) _

+ LeftOffSet



BottomMargin = (Printer.ScaleHeight - BottomMarginHeight) _

+ TopOffSet



'Druckbarer Bereich in einer Variable speichern

rcPage.Left = 0

rcPage.Top = 0

rcPage.Right = Printer.ScaleWidth

rcPage.Bottom = Printer.ScaleHeight



'Bereich in einer Veriable speichern, in dem gedruckt

'werden soll

rcDrawTo.Left = LeftMargin

rcDrawTo.Top = TopMargin + 1000

rcDrawTo.Right = RightMargin

rcDrawTo.Bottom = BottomMargin



'Druckerinstruktionen festlegen

fr.hDC = Printer.hDC

fr.hdcTarget = Printer.hDC

fr.rc = rcDrawTo

fr.rcPage = rcPage

fr.chrg.cpMin = 0

fr.chrg.cpMax = -1



'Textlänge bestimmen

TextLength = Len(RTF.text)



'Schriftgrösse/-art für Kopf-/Fusszeilen

Printer.Font = "Courier New" '"Arial"

Printer.FontSize = 9



'Loop der alle Seiten ausdruckt

Dim i As Integer: i = 1

Do

'Text mit EM_FORMATRANGE ausdrucken

NextCharPosition = SendMessage(RTF.hWnd, EM_FORMATRANGE, _

1, fr)

'Kopfzeile1 ausdrucken

Printer.ForeColor = QBColor(9)



Printer.CurrentX = (Printer.ScaleWidth - _

Printer.TextWidth(strHeader)) / 4

Printer.CurrentY = (TopMargin - Printer.TextHeight("x")) _

/ 2

Printer.ForeColor = QBColor(9)

Printer.Print strHeader

Printer.CurrentX = (Printer.ScaleWidth - _

Printer.TextWidth(strHeader)) / 4

Printer.CurrentY = (TopMargin + 700 - Printer.TextHeight("x")) _

/ 2

Printer.ForeColor = QBColor(9)

Printer.Print strHeader2

Printer.CurrentX = (Printer.ScaleWidth - _

Printer.TextWidth(strHeader)) / 4

Printer.CurrentY = (TopMargin + 1400 - Printer.TextHeight("x")) _

/ 2



Printer.Print strHeader3

Printer.Line (1500, 150)-(10000, 150)

Printer.Line (1500, 150)-(1501, 1200)

Printer.Line (10000, 150)-(10001, 1200)

Printer.Line (1500, 1200)-(10000, 1200)

Printer.ForeColor = QBColor(9)

'Fusszeile ausdrucken

Printer.CurrentX = (Printer.ScaleWidth - _

Printer.TextWidth(strFooter)) / 4



Printer.CurrentY = BottomMargin + (Printer.ScaleHeight _

- BottomMargin - Printer.TextHeight("x")) _

/ 2



Printer.Print strFooter

Printer.ForeColor = QBColor(9)





Printer.Line (1500, 16150)-(10000, 16150)

Printer.Line (1500, 15750)-(1501, 16150)

Printer.Line (10000, 15750)-(10001, 16150)

Printer.Line (1500, 15750)-(10000, 15750)



'Seitennummer ausdrucken

Printer.CurrentX = Printer.ScaleWidth - _

Printer.TextWidth("Seite " & i)



Printer.CurrentY = BottomMargin + (Printer.ScaleHeight - _

BottomMargin - Printer.TextHeight("x")) _

/ 2

Printer.ForeColor = QBColor(9)

Printer.Print "Seite " & i

'Falls alles ausgedruckt ist, Schleife verlassen

If NextCharPosition >= TextLength Then Exit Do



'Startposition für die nächste Seite

fr.chrg.cpMin = NextCharPosition

'Neue Seite beginnen

Printer.NewPage

Printer.Print ""

fr.hDC = Printer.hDC

fr.hdcTarget = Printer.hDC

i = i + 1

Loop



'Druckauftrag abschliessen

Printer.EndDoc



'Control zurücksetzten

r = SendMessage(RTF.hWnd, EM_FORMATRANGE, 0, ByVal CLng(0))

End Sub
Wenn das Universum endlich ist, muss es einen Rand geben. Und wenn man kurz vor diesem Rand steht und einen Speer wirft – was würde mit dem passieren, wenn er über den Rand hinausfliegt?

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: