Hello, Folks!!

    I'm trying to vertically center text within a rich textbox
control.  Since it doesn't have that feature built-in I am trying to
think of a way to do it instead.  After hunting around a number of
tutorial sites the best scheme I can think of is to insert a number of
vbCRLF's ahead of the text something like:

-----
    Private Const EM_GETLINECOUNT = &HBA
    Dim LineCount As Long
    Dim StartY As Integer

    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

    LineCount = SendMessage(RTB.hwnd, EM_GETLINECOUNT, 0&, 0&)

    InsertCRLF = Int((LineCount / 2) * (1 - Me.TextHeight(RTB.Text) /
RTB.Height))

    For i = 0 To InsertCRLF
        RTB.Text = vbCrLf & RTB.Text
    Next
-----

Is there a better way of doing this?

TIA...

On Jun 10, 2:39 pm, Blue Streak <r.lebreto***@gmail.com> wrote:
Show quoteHide quoteSorry, I must have been smoking something when I wrote. This should
make a little more sense but it doesn't center it perfectly.

Ugh!  I need help.

-----
Option Explicit

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 EM_GETLINECOUNT = &HBA

Private Sub CenterVertically(RTB As RichTextBox)
    Dim LineCount, FontHeight As Long
    Dim i, InsertCRLF As Integer

    LineCount = SendMessage(RTB.hwnd, EM_GETLINECOUNT, 0&, 0&)
    FontHeight = RTB.Height / LineCount

    InsertCRLF = Int((RTB.Height - Me.TextHeight(RTB.Text)) /
FontHeight * 2)

    For i = 0 To InsertCRLF
        RTB.Text = vbCrLf & RTB.Text
    Next

End Sub

Private Sub Form_Load()
    RTB.Text = "Hello," & vbCrLf & "World."

    CenterVertically RTB
End Sub

I understand what you're doing, but I guess not why you're doing it. One of
the purposes of a RTB is to allow the user to make the text and formatting
look the way they want it to. But then, despite the number of lines the user
has entered (with or without text in them), you're going to insert, into the
RTB, other lines as necessary to center the text vertically. Plus, might
there not be a possibility that there are too many lines to even center in
this way? It just seems confusing, from the user's standpoint, that while
they have edited/added text, at some point what they're seeing will change.

Now, you really don't say that the purpose of the box is to allow the user
to edit and add formatted text, but of course that is the purpose of a RTB.
Obviously, if you're working with text previously entered into a RTB or
elsewhere, you might be better of simply "drawing" the text in a Picture
box, or on the form directly, where you can not only display the RTB
formatting elements, but also center it any way you like. But I'm assuming
you want the user to be able to enter the text "live", and then at some
interval or command, center it vertically.

Might an alternative be to change the Height and Top properties of the RTB,
to keep the text centered in a given area? I know I'm going off on tangents;
I'm just trying to understand the purpose of doing this, as well as the
possible confusion of the user.

On Jun 10, 2:39 pm, Blue Streak <r.lebreto***@gmail.com> wrote:
Show quoteHide quoteSorry, I must have been smoking something when I wrote. This should
make a little more sense but it doesn't center it perfectly.

Ugh!  I need help.

-----
Option Explicit

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 EM_GETLINECOUNT = &HBA

Private Sub CenterVertically(RTB As RichTextBox)
    Dim LineCount, FontHeight As Long
    Dim i, InsertCRLF As Integer

    LineCount = SendMessage(RTB.hwnd, EM_GETLINECOUNT, 0&, 0&)
    FontHeight = RTB.Height / LineCount

    InsertCRLF = Int((RTB.Height - Me.TextHeight(RTB.Text)) /
FontHeight * 2)

    For i = 0 To InsertCRLF
        RTB.Text = vbCrLf & RTB.Text
    Next

End Sub

Private Sub Form_Load()
    RTB.Text = "Hello," & vbCrLf & "World."

    CenterVertically RTB
End Sub

If you want finer control then you should be able to set SelCharOffset on
the entire first displayed line to any desired number of twips, although
that might cause problems when the user edited the text. Otherwise, how
about setting the RTB to flat borderless and placing it in a VB PictureBox
with a white BackColor (in such a way that the PictureBox is acting as the
RTB's Container), allowing you to position the RTB anywhere you wish within
the PictureBox and giving the impression of any top margin you require. By
the way, in your existing code when you are using Me.TextHeight you need to
ensure that the Form is set to the same font as the RTB and that the RTB
does not contain various different fonts, otherwise perhaps you might be
better off  asking the RTB for the height of its text.

Mike

That's a sticky one. :) I don't know if this
is the best way, but it might provide an
idea:

  Create a hidden RTB of the same size.
Fill it with text of the same font/size.
With that done you can find how many lines
fit into the RTB window. Assuming that you
know how many lines of text you have, or at
least know how to find out, you can use BottomLine
to get total visible lines, subtract your text line
count, divide by two, and add that may returns.

  Actually, you probably don't even need a second
RTB. You could just use LockWindowUpdate for
a moment while you fill the existing RTB, measure
the number of visible lines, and return it to its
previous state.

  The following is quickie code without the declares,
but it should be self-explanatory:

Function BottomLine() As Long
Dim Pt1 As Point
Dim R1 As RECT1
Dim LRet As Long, CPos As Long
    On Error Resume Next
  LRet = SendMessageAny(hRTB, EM_GETRECT, 0&, R1)
    Pt1.X = 1
    Pt1.Y = (R1.Bottom - R1.Top) - 1
  LRet = SendMessageAny(hRTB, EM_CHARFROMPOS, 0&, Pt1)
  BottomLine = SendMessageLong(hRTB, EM_EXLINEFROMCHAR, 0&, LRet)
End Function

Show quoteHide quoteSorry, I must have been smoking something when I wrote. This should
make a little more sense but it doesn't center it perfectly.

Ugh!  I need help.

-----
Option Explicit

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 EM_GETLINECOUNT = &HBA

Private Sub CenterVertically(RTB As RichTextBox)
    Dim LineCount, FontHeight As Long
    Dim i, InsertCRLF As Integer

    LineCount = SendMessage(RTB.hwnd, EM_GETLINECOUNT, 0&, 0&)
    FontHeight = RTB.Height / LineCount

    InsertCRLF = Int((RTB.Height - Me.TextHeight(RTB.Text)) /
FontHeight * 2)

    For i = 0 To InsertCRLF
        RTB.Text = vbCrLf & RTB.Text
    Next

End Sub

Private Sub Form_Load()
    RTB.Text = "Hello," & vbCrLf & "World."

    CenterVertically RTB
End Sub

You can try this:  (You have SendMessage aready defined....)

LFS

Private Sub VCenter(RTB As RichTextBox, Text As String)
Dim rct As RECT, fnt As StdFont
Dim hgt As Long, wid As Long
Const EM_GETRECT = &HB2
Const EM_SETRECT = &HB3

  ' Find width and height of text (in pixels)
  Set fnt = Me.Font
  Set Me.Font = RTB.Font
  hgt = ScaleY(Me.TextHeight(Text), ScaleMode, vbPixels)
  wid = ScaleX(Me.TextWidth(Text), ScaleMode, vbPixels)
  Set Me.Font = fnt

  ' Set top and left margins  (reset to 1 to restore normal usage)
  SendMessage RTB.hWnd, EM_GETRECT, 0, rct
  rct.Top = (rct.Bottom - hgt) \ 2
  rct.Left = (rct.Right - wid) \ 2
  SendMessage RTB.hWnd, EM_SETRECT, 0, rct

  RTB.Text = Text

End Sub

Opps, I forgot RECT also needs to be defined:

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


LFS

Show quote Hide quote Thanks, Larry!

That worked like a charm.

InsertCRLF = Int((RTB.Height - Me.TextHeight(RTB.Text)) / (2 *
FontHeight))

Can you tell I'm having a bad day?...

{Sigh!}

vb memory layout
Re: Multithreading
Multithreading
Vista SP2 Being "offered"
dhRichClient3 Thread Classes Issues
VB6 on Vista Home Premium problem
Excel Execution from VB Fails on 2nd Attempt
Use an Addin to automatically add date/time stamp to each edited line of VB6 code?
Moving .exe somtimes works
In High Density Mode - Looking for previous control counting post