|
-
Jan 17th, 2004, 05:46 AM
#1
Thread Starter
PowerPoster
VB6 - Justify text in RichTextBox
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
VB Code:
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
-
Jan 22nd, 2004, 10:44 AM
#2
Frenzied Member
hmm
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 ?
"Lies, sanctions, and cruise missiles have never created a free and just society. Only everyday people can do that."
- Zack de la Rocha
Hear me roar.
-
Jan 23rd, 2004, 03:50 AM
#3
Thread Starter
PowerPoster
hi
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.
-
Jan 31st, 2004, 09:51 PM
#4
Hyperactive Member
Where did you find the info on what messages it accepts?
cjqp
-
Feb 7th, 2004, 02:50 AM
#5
Thread Starter
PowerPoster
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.
-
Aug 12th, 2011, 06:47 AM
#6
New Member
Re: VB6 - Justify text in RichTextBox
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.
-
Jan 9th, 2017, 03:00 AM
#7
Lively Member
Re: VB6 - Justify text in RichTextBox
 Originally Posted by 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.
VB Code:
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):
Code:
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
-
Jan 9th, 2017, 03:12 AM
#8
Lively Member
Re: VB6 - Justify text in RichTextBox
 Originally Posted by 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.
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:
Code:
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
Code:
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
Last edited by Mahdi Jazini; Jan 9th, 2017 at 03:23 AM.
-
Oct 23rd, 2024, 07:30 PM
#9
Addicted Member
Re: VB6 - Justify text in RichTextBox
For me it justifies only the first paragraph, with the Microsoft RichTextBox control 6.0, and that with the initial code, with the second code, nothing at all works for me...
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|