VB6 - Justify text in RichTextBox

[veryjonny]

hi, I was looking for this for sometime, and finally found it.

Though I now search in the forum, then I do find it posted in one two threads. I posted it here in this Code-Bank section, because I think this one is really handy.

Usage:
SetAlignment RichTextBox1.HWND, ercParaJustify

Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal HWND As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam 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
Const WM_USER = &H400
Const EM_SETTYPOGRAPHYOPTIONS = WM_USER + 202
Const TO_ADVANCEDTYPOGRAPHY = 1
Const EM_SETPARAFORMAT = WM_USER + 71
Private Const PFA_LEFT = 1
Private Const PFA_RIGHT = 2
Private Const PFA_CENTER = 3
Private Const PFA_JUSTIFY = &H4
Const MAX_TAB_STOPS = 32
Private Type PARAFORMAT2
    cbSize                     As Long
    dwMask                     As Long
    wNumbering                 As Integer
    wEffects                   As Integer
    dxStartIndent              As Long
    dxRightIndent              As Long
    dxOffset                   As Long
    wAlignment                 As Integer
    cTabCount                  As Integer
    rgxTabs(MAX_TAB_STOPS - 1) As Long
    dySpaceBefore              As Long
    dySpaceAfter               As Long
    dyLineSpacing              As Long
    sStyle                     As Integer
    bLineSpacingRule           As Byte
    bOutlineLevel              As Byte
    wShadingWeight             As Integer
    wShadingStyle              As Integer
    wNumberingStart            As Integer
    wNumberingStyle            As Integer
    wNumberingTab              As Integer
    wBorderSpace               As Integer
    wBorderWidth               As Integer
    wBorders                   As Integer
End Type
Public Enum ERECParagraphAlignmentConstants
   ercParaLeft = PFA_LEFT
   ercParaCentre = PFA_CENTER
   ercParaRight = PFA_RIGHT
   ercParaJustify = PFA_JUSTIFY
End Enum
Private Const PFM_ALIGNMENT = &H8&
 
Private Function SetAlignment(lHwnd As Long, ByVal eAlign As ERECParagraphAlignmentConstants)
    Dim tP2 As PARAFORMAT2
    Dim lR As Long
    tP2.dwMask = PFM_ALIGNMENT
    tP2.cbSize = Len(tP2)
    tP2.wAlignment = eAlign
    lR = SendMessageLong(lHwnd, EM_SETTYPOGRAPHYOPTIONS, TO_ADVANCEDTYPOGRAPHY, TO_ADVANCEDTYPOGRAPHY)
    lR = SendMessage(lHwnd, EM_SETPARAFORMAT, 0, tP2)
End Function

[vbNeo]

I makes me wonder why this isn't included in the properties of the normal rich text box, if it's done with sendmessage, it obviouslt most hold the information already, or ?

[veryjonny]

Actually not just this property, but also making wavy lines( the ones which ms word uses to mark a spell error), hiding some text in a rtfbox, have not being exposed to VB programmers.

[cjqp]

Where did you find the info on what messages it accepts?

cjqp

[veryjonny]

Well, frankly speaking I dont remember.

From some time, I have being looking in rtf control and searching various sites. I may have got it from some site.

[nicebasic]

First of all, I'd like to thank "veryjonny" for sharing this valuable code with us, but it needs some modifications.

This code can correctly "justify" the text in a RichTextBox, but it does not work on a Right-To-Left paragraph.

For languages such as "Persian, Arabic, Hebrew" that have a Right-To-Left paragraph direction, it changes the paragraphy direction to Left-To-Right.

Can anyone change the code to make it applicable to Right-To-Left paragraphs?

By the way, How can we use "dySpaceBefore" & "dySpaceAfter" for a paragraph with this code?

Thank you again.

[Mahdi Jazini]

hi, I was looking for this for sometime, and finally found it.

Though I now search in the forum, then I do find it posted in one two threads. I posted it here in this Code-Bank section, because I think this one is really handy.

Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal HWND As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam 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
Const WM_USER = &H400
Const EM_SETTYPOGRAPHYOPTIONS = WM_USER + 202
Const TO_ADVANCEDTYPOGRAPHY = 1
Const EM_SETPARAFORMAT = WM_USER + 71
Private Const PFA_LEFT = 1
Private Const PFA_RIGHT = 2
Private Const PFA_CENTER = 3
Private Const PFA_JUSTIFY = &H4
Const MAX_TAB_STOPS = 32
Private Type PARAFORMAT2
    cbSize                     As Long
    dwMask                     As Long
    wNumbering                 As Integer
    wEffects                   As Integer
    dxStartIndent              As Long
    dxRightIndent              As Long
    dxOffset                   As Long
    wAlignment                 As Integer
    cTabCount                  As Integer
    rgxTabs(MAX_TAB_STOPS - 1) As Long
    dySpaceBefore              As Long
    dySpaceAfter               As Long
    dyLineSpacing              As Long
    sStyle                     As Integer
    bLineSpacingRule           As Byte
    bOutlineLevel              As Byte
    wShadingWeight             As Integer
    wShadingStyle              As Integer
    wNumberingStart            As Integer
    wNumberingStyle            As Integer
    wNumberingTab              As Integer
    wBorderSpace               As Integer
    wBorderWidth               As Integer
    wBorders                   As Integer
End Type
Public Enum ERECParagraphAlignmentConstants
   ercParaLeft = PFA_LEFT
   ercParaCentre = PFA_CENTER
   ercParaRight = PFA_RIGHT
   ercParaJustify = PFA_JUSTIFY
End Enum
Private Const PFM_ALIGNMENT = &H8&
 
Private Function SetAlignment(lHwnd As Long, ByVal eAlign As ERECParagraphAlignmentConstants)
    Dim tP2 As PARAFORMAT2
    Dim lR As Long
    tP2.dwMask = PFM_ALIGNMENT
    tP2.cbSize = Len(tP2)
    tP2.wAlignment = eAlign
    lR = SendMessageLong(lHwnd, EM_SETTYPOGRAPHYOPTIONS, TO_ADVANCEDTYPOGRAPHY, TO_ADVANCEDTYPOGRAPHY)
    lR = SendMessage(lHwnd, EM_SETPARAFORMAT, 0, tP2)
End Function

Hi

I have tested your API code, It worked very well... Thank you for sharing it

But, I have found another way without using API (based on TextRTF Property):

Private Sub RichTextBox1_Change()

    'Guide: True is Right To Left And False OR Default is Left To Right

    Call RichTextSetAlignment(RichTextBox1, True)

End Sub

Public Sub RichTextSetAlignment(TheControl As Control, Optional RightToLeftSupport As Boolean)

    Select Case RightToLeftSupport
    
    Case False
    
        ' For Left To Right Justify Support
        With TheControl
            
            Select Case InStr(.TextRTF, "\ql\")
                Case Is <= 0
                    'If there is not ql in the codes
                    .TextRTF = Replace(.TextRTF, "\ltrpar\", "\ltrpar\qj\")
                Case Else
                    'If there is at least 1 ql in the code
                    .TextRTF = Replace(.TextRTF, "\ltrpar\ql\", "\ltrpar\qj\")
            End Select
            
        End With
        
    Case True
    
        ' For Right To Left Justify Support
        With TheControl
            
            Select Case InStr(.TextRTF, "\ql\")
                Case Is <= 0
                    'If there is not ql in the codes
                    .TextRTF = Replace(.TextRTF, "\ltrpar\", "\rtlpar\qj\")
                Case Else
                    'If there is at least 1 ql in the code
                    .TextRTF = Replace(.TextRTF, "\ltrpar\ql\", "\rtlpar\qj\")
            End Select
          
        End With
        
    End Select
    
End Sub

[Mahdi Jazini]

First of all, I'd like to thank "veryjonny" for sharing this valuable code with us, but it needs some modifications.

This code can correctly "justify" the text in a RichTextBox, but it does not work on a Right-To-Left paragraph.

For languages such as "Persian, Arabic, Hebrew" that have a Right-To-Left paragraph direction, it changes the paragraphy direction to Left-To-Right.

Can anyone change the code to make it applicable to Right-To-Left paragraphs?

By the way, How can we use "dySpaceBefore" & "dySpaceAfter" for a paragraph with this code?

Thank you again.

Hi

Unfortunately, The Classic RichTextBox doesn't support it

It's impossible even with my function

But If you use (my function) + ( @Krool OCX ) it's possible (i have tested it)

1) Go to http://www.vbforums.com/showthread.p...mmon-controls)

2) Download ComCtlsDemo.zip.docx

3) Rename to .zip

4) Unzip it

5) Read the readme file and do the steps

6) Open the standard exe file

7) Add a new Form and then add a RichTextBox to it and set its RightToLeft Property to True

8) Add my function (that you can see in the last post)

9) Replace:

    Case True
    
        ' For Right To Left Justify Support
        With TheControl
            
            Select Case InStr(.TextRTF, "\ql\")
                Case Is <= 0
                    'If there is not ql in the codes
                    .TextRTF = Replace(.TextRTF, "\ltrpar\", "\rtlpar\qj\")
                Case Else
                    'If there is at least 1 ql in the code
                    .TextRTF = Replace(.TextRTF, "\ltrpar\ql\", "\rtlpar\qj\")
            End Select
          
        End With
        
    End Select

With

    Case True
    
        ' For Right To Left Justify Support
        With TheControl
            
            Select Case InStr(.TextRTF, "\ql\")
                Case Is <= 0
                    'If there is not ql in the codes
                    .TextRTF = Replace(.TextRTF, "\ltrpar\", "\rtlpar\qj\")
                Case Else
                    'If there is at least 1 ql in the code
                    .TextRTF = Replace(.TextRTF, "\ltrpar\ql\", "\rtlpar\qj\")
            End Select

            .TextRTF = Replace(.TextRTF, "\rtlpar\qr\", "\rtlpar\qj\")
          
        End With
        
    End Select

10) Enjoy Full Support

Good news: The New RichTextBox Also Supports Unicode

Thank you @Krool