Results 1 to 4 of 4
  1. #1
    Join Date
    Jan 2004
    Location
    California, USA
    Posts
    25

    Unanswered: WYSIWYG with an arranging text box

    Here's some useful code for rich text. Can anyone translate German?

    http://www.activevb.de/tipps/vb6tipps/tipp0221.html

    'Dieser Source 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 Projekt1.vbp -------------
    ' Die Komponente 'Microsoft Rich Textbox Control 6.0 (SP4)
    ' (RICHTX32.OCX)' wird ben�tigt.
    ' Die Komponente 'Microsoft Common Dialog Control 6.0 (SP3)
    ' (COMDLG32.OCX)' wird ben�tigt.
    '--------- Anfang Formular "Form1" alias Form1.frm ---------
    ' Steuerelement: Standarddialog-Steuerelement "CommonDialog1"
    ' Steuerelement: RichTextBox "RichTextBox1"
    ' Steuerelement: Men� "Menu" (Index von 0 bis 20)
    ' Steuerelement: Men� "menuDatei" (Index von 0 bis 99) auf Menu

    Option Explicit

    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal _
    hDC As Long, ByVal nIndex As Long) As Long

    Private 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 Declare Function CreateDC Lib "gdi32" Alias _
    "CreateDCA" (ByVal lpDriverName As String, ByVal _
    lpDeviceName As String, ByVal lpOutput As Long, _
    ByVal lpInitData As Long) As Long

    Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC _
    As Long) As Long

    Private Const PHYSICALOFFSETX As Long = 112
    Private Const PHYSICALOFFSETY As Long = 113
    Private Const WM_USER As Long = &H400
    Private Const EM_GETLINECOUNT As Long = &HBA
    Private Const EM_LINEFROMCHAR As Long = &HC9
    Private Const EM_FORMATRANGE As Long = WM_USER + 57
    Private Const EM_SETTARGETDEVICE As Long = WM_USER + 72
    Private Const EM_SCROLLCARET As Long = &HB7
    Private Const EM_SCROLL As Long = &HB5
    Private Const EM_LINESCROLL As Long = &HB6
    Private Const EM_GETFIRSTVISIBLELINE As Long = &HCE
    Private Const EM_LINELENGTH As Long = &HC1
    Private Const EM_LINEINDEX As Long = &HBB

    Private Type Rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
    End Type

    Private Type CharRange
    cpMin As Long
    cpMax As Long
    End Type

    Private Type FormatRange
    hDC As Long
    hdcTarget As Long
    rc As Rect
    rcPage As Rect
    chrg As CharRange
    End Type

    Dim PrtDC As Long
    Dim ObererRand As Long
    Dim LinkerRand As Long
    Dim RechterRand As Long
    Dim UntererRand As Long


    Private Sub Form_Load()
    Dim BW&, BH&, r&
    Dim TopOffSet As Long
    Dim LeftOffSet As Long

    ' Randeinstellungen
    ' Angaben in Twips
    ObererRand = 1000
    LinkerRand = 1200
    RechterRand = 1000
    UntererRand = 1000

    ' Druckerr�nder
    ' Linken Offset auslesen
    LeftOffSet = Printer.ScaleX(GetDeviceCaps(Printer.hDC, _
    PHYSICALOFFSETX), vbPixels, vbTwips)

    Dim LeftMargin As Long
    Dim RightMargin As Long
    Dim LineWidth As Long

    ' Eingestellter Druckbereich
    LeftMargin = LinkerRand - LeftOffSet
    RightMargin = (Printer.Width - RechterRand) - LeftOffSet

    ' Wird ben�tigt um der RTB die exacte Breite zu �bergeben
    LineWidth = RightMargin - LeftMargin

    ' Einen hDC vom Drucker erstellen f�r die RTB in WYSIWYG
    PrtDC = CreateDC(Printer.DriverName, Printer.DeviceName, 0, 0)

    ' Der RTF sagen das sie sich dem Druckbild anpassen soll (WYSIWYG)
    r = SendMessage(RichTextBox1.hwnd, EM_SETTARGETDEVICE, PrtDC, _
    ByVal LineWidth)

    End Sub

    Private Sub Form_Unload(Cancel As Integer)
    DeleteDC PrtDC

    End Sub

    Private Sub Menu_Click(Index As Integer)
    If Index = 10 Then
    On Error Resume Next
    CommonDialog1.CancelError = True
    CommonDialog1.Flags = cdlCFBoth Or cdlCFTTOnly Or cdlCFEffects
    CommonDialog1.ShowFont
    If Err = 0 Then
    With RichTextBox1
    .SelFontName = CommonDialog1.FontName
    .SelFontSize = CommonDialog1.FontSize
    .SelBold = CommonDialog1.FontBold
    .SelItalic = CommonDialog1.FontItalic
    .SelStrikeThru = CommonDialog1.FontStrikethru
    .SelUnderline = CommonDialog1.FontUnderline
    .SelColor = CommonDialog1.Color
    End With
    End If
    End If
    If Index = 20 Then
    Call MsgBox("WYSIWYG RichTextbox Editor" & vbCrLf & _
    "(c) Dirk Lietzow, ActiveVB 2000", _
    vbInformation, "WYSIWYG - RTB")
    End If

    End Sub

    Private Sub menuDatei_Click(Index As Integer)
    On Error Resume Next
    Select Case Index
    Case 0
    RichTextBox1.TextRTF = ""
    Case 10
    CommonDialog1.CancelError = True
    CommonDialog1.ShowOpen
    If Err = 0 Then
    RichTextBox1.LoadFile CommonDialog1.filename
    Me.Caption = "WYSIWYG RichTextBox - " _
    & CommonDialog1.filename
    End If
    Case 15
    CommonDialog1.CancelError = True
    CommonDialog1.ShowSave
    If Err = 0 Then
    RichTextBox1.SaveFile CommonDialog1.filename
    End If
    Case 18
    CommonDialog1.CancelError = True
    CommonDialog1.Flags = 0
    CommonDialog1.ShowPrinter
    If Err = 0 Then
    Call PrintRTB(RichTextBox1, LinkerRand, _
    ObererRand, RechterRand, UntererRand)
    End If
    Case 99
    Unload Me
    End Select

    End Sub

    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 As String
    Dim strFooter As String

    ' Kopf- und Fusszeile
    strHeader = "ActiveVB " & Now
    strFooter = Mid$(Me.Caption, 23)

    'Initialisierung des Printers
    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
    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 = 11

    '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)
    'Kopfzeile ausdrucken
    Printer.CurrentX = (Printer.ScaleWidth - _
    Printer.TextWidth(strHeader)) / 2

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

    Printer.Print strHeader
    'Fusszeile ausdrucken
    Printer.CurrentX = (Printer.ScaleWidth - _
    Printer.TextWidth(strFooter)) / 2

    Printer.CurrentY = BottomMargin + (Printer.ScaleHeight _
    - BottomMargin - Printer.TextHeight("x")) _
    / 2

    Printer.Print strFooter
    'Seitennummer ausdrucken
    Printer.CurrentX = Printer.ScaleWidth - _
    Printer.TextWidth("Seite " & i)

    Printer.CurrentY = BottomMargin + (Printer.ScaleHeight - _
    BottomMargin - Printer.TextHeight("x")) _
    / 2

    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

  2. #2
    Join Date
    Nov 2003
    Posts
    1,487
    I had run the web page through translation software and here is what it come up with (see Attached File):

    Hope this helps
    Attached Files Attached Files

  3. #3
    Join Date
    Jan 2004
    Location
    California, USA
    Posts
    25
    Thanks for the translation. I found a few VB websites that have Rich Text editing codes in English. I tried the codes, but I'm new to VB and can't get them to work. Can anyone get these to work in MS Access 2000 and leave a sample in reply?

    See these webpages.
    http://www.freevbcode.com/ShowCode.asp?ID=1028

    http://www.developerfusion.com/show/244/

    Thanks,
    PC

  4. #4
    Join Date
    Jan 2004
    Location
    California, USA
    Posts
    25
    I've been tinkering with this rich text editing code and I have some of it working. If someone else wants to work on it further, see the attached.

    PC
    Attached Files Attached Files

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •