对齐富文本框中的文本

Question

我知道如何在文本框和 richtextbox 中对齐右中和左对齐，我搜索但没有找到答案是你能像在 word 或所有其他程序中一样对齐文本吗？我尝试使用写字板然后复制它并且效果很好只是当我无法单击命令按钮并调整文本以使所有行都对齐时我停止了，我使用的代码就在这里

    Option Explicit

Private Const WM_USER As Long = &H400&
Private Const EM_GETOLEINTERFACE As Long = WM_USER + 60
Private Const EM_SETTYPOGRAPHYOPTIONS As Long = WM_USER + 202
Private Const TO_ADVANCEDTYPOGRAPHY As Long = 1

Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" ( _
    ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long

Private Document As tom.ITextDocument

Private Sub cmdJustify_Click()
    'Justify the text of the first paragraph:

    'Select first paragraph in the document.
    With Document.Range(0, 0)
        .MoveEnd tomParagraph, 1
        .Para.Alignment = tomAlignJustify 'Apply justification.
        .Collapse tomStart 'Collapse the selection.
    End With
End Sub

Private Sub Form_Load()
    Dim Unknown As Object

    SendMessage rtb.hWnd, EM_GETOLEINTERFACE, 0, VarPtr(Unknown)
    Set Document = Unknown
    SendMessage rtb.hWnd, _
                EM_SETTYPOGRAPHYOPTIONS, _
                TO_ADVANCEDTYPOGRAPHY, _
                TO_ADVANCEDTYPOGRAPHY

    rtb.LoadFile "Resources\Sample1.rtf"
End Sub

Answer 1

您必须向底层 RichEdit 控件发送一个 EM_SETPARAFORMAT 消息，将一个指向 PARAFORMAT2 structure 的指针传递给 wAlignment = PFA_JUSTIFY。

或者使用 TOM 和 ITextPara.Alignment = tomAlignJustify（参见 tomAlignJustify）或其他东西。

否则，查找 RTF 标记并使用 .SelRTF?

好的，您必须先打开 "advanced line breaking and line formatting"。不过在那之后就很顺利了：

Option Explicit

Private Const WM_USER As Long = &H400&
Private Const EM_GETOLEINTERFACE As Long = WM_USER + 60
Private Const EM_SETTYPOGRAPHYOPTIONS As Long = WM_USER + 202
Private Const TO_ADVANCEDTYPOGRAPHY As Long = 1

Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" ( _
    ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long

Private Document As tom.ITextDocument

Private Sub cmdJustify_Click()
    'Justify the text of the first paragraph:

    'Select first paragraph in the document.
    With Document.Range(0, 0)
        .MoveEnd tomParagraph, 1
        .Para.Alignment = tomAlignJustify 'Apply justification.
        .Collapse tomStart 'Collapse the selection.
    End With
End Sub

Private Sub Form_Load()
    Dim Unknown As Object

    SendMessage RTB.hWnd, EM_GETOLEINTERFACE, 0, VarPtr(Unknown)
    Set Document = Unknown
    SendMessage RTB.hWnd, _
                EM_SETTYPOGRAPHYOPTIONS, _
                TO_ADVANCEDTYPOGRAPHY, _
                TO_ADVANCEDTYPOGRAPHY

    RTB.LoadFile "Resources\Sample1.rtf"
End Sub

Answer 2

仅设置一个属性是不可能的。你必须对它做更多的工作并实现你的功能。

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

用法

SetAlignment RichTextBox1.HWND, ercParaJustify

我从 VBForums

的代码库部分选择了这段代码

我在这里发布相同的代码，因为这是一个非常有用的代码。

Answer 3

VB6中的RichText控件只直接支持富文本1.0，不支持对齐。正如 Bob77 所建议的那样，您可以使用 TOM 来执行此操作。本质上，您是在诱使控件直接公开其 iRichTextOLE 接口，这样您就可以访问更高版本的 RTF。这是我使用的代码：

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 Const WM_USER = &H400&
Private Const EM_GETOLEINTERFACE = (WM_USER + 60)

Dim myIUnknown As IUnknown   
Dim tomDoc As ITextDocument  

Sub Form_Load()
    SendMessage(rtcMyControl.hwnd, EM_GETOLEINTERFACE, 0&, myIUnknown)
    tomDoc = myIUnknown
End Sub

这基本上与 Bob77 获取 ITextDocument 引用的代码相同，只是它的另一个版本。我只是为了显示与他答案的 "use TOM" 部分相对应的部分，以防它有助于澄清这一点。就个人而言，如果我需要做任何像你正在做的事情，TOM 就是我的方式。

对齐富文本框中的文本

Justify the text in a richtextbox

textbox

vb6

richtextbox

justify