Link to home
Start Free TrialLog in
Avatar of abulka
abulka

asked on

DrawText 3 sentences within a rect

Given a node / rectangular region and a DC, I have 3 text sentences that I want to display

thus:

--------------------
| 102.  This is the
| second sentence,
| the number was the
| first.  This is the
| third sentence.
--------------------

The first sentence is the node 'number' which should be shown in a red italic font.  The second sentence is in bold (and a slightly larger font).  The third sentence is in normal font.  It all has to word wrap and the node should grow in size to accomodate all the text.

The ::DrawText API function relies on a single rectangular area, whereas I have three potentially irregularly shaped areas (because I want to draw each sentence appended to each previous sentence, rather than beginning each sentence on a new line).

Some advice I got was that I probably need to use the more primitive CDC:TextOut method, together with CDC:SetTextAlign method. The TextOut method allows to draw a string starting at a specific position with the current font of the DC. However, TextOut does not automatically do wordwrap, so I may have to do wordwrap manually.

Can someone give me the Delphi code to achieve this?  The code has to run in a DLL that is callable by my VC++ activeX - so I hope that doesn't complicate things too much.
Avatar of ZifNab
ZifNab

Hi abulka,

have a look at the GetTextExtentExPoint and GetTextExtentPoint32 function

Regards, Zif.
here is an example (of course you don't work with a memo canvas):

{Gets the TextWidth in pixels of a string if it was in the memo}
function TForm1.MemoTextWidth(Memo : TMemo; s : string) : integer;
 var
   p : pChar;
   dc : hDc;
   r : TRect;
   sz : TSize;
   OldFont : THandle;
begin
   Result := 0;
   if Length(s) = 0 then exit; {Exit if we have an empty string}
  {Copy the stirng to a pChar}
   GetMem(p, Length(s) + 1);
   StrPCopy(p, s);
   {Get the canvas of the memo}
    dc := GetDc(Memo.Handle);
   {Select the font into the canvas}
     OldFont := SelectObject(dc, Memo.Font.Handle);
   {Get the text width}
     GetTextExtentPoint(dc, p, length(s), sz);
   {Select the old font back into the canvas}
     SelectObject(dc, OldFont);
   {Release the memo's canvas}
     ReleaseDc(Memo1.Handle, dc);
   {Clean up and return the text width}
     FreeMem(p, Length(s) + 1);
     Result := sz.cx;
end;
another way for determing the text-width is

                              function GetTextWidth(Font: TFont; S: string): integer;
                               var
                                 Canvas: TCanvas;
                                 DC: HDC;
                               begin
                                 // create canvas
                                 Canvas := TCanvas.Create;
                                 // get DC for screen device
                                 DC := GetDC(0);
                                 try
                                   // make canvas use it
                                   Canvas.Handle := DC;
                                 
                                   // assign font to canvas
                                   Canvas.Font.Assign(Font);
                               
                                   // get textwidth from canvas
                                   Result := Canvas.TextWidth(S);
                                 finally
                                   // release DC again
                                   ReleaseDC(0, DC);
                                   Canvas.Handle := 0;
                                 end;
                                 // free resources
                                 Canvas.Free;
                               end;
Abulka,

Try this routine. Setup the thre text strings (or as many as you need), setup the fonts, and the rectangle size, and off it should go. This will do the word wrapping and everything taht you need.

procedure TForm1.Button1Click(Sender: TObject);

  FUNCTION TextExt(DC : THandle; Text : STRING): TSize;
  begin
    Result.cX := 0;
    Result.cY := 0;
    Windows.GetTextExtentPoint32(DC, PChar(Text), Length(Text), Result);
  END;

VAR
  x          : LONGINT;
  y          : LONGINT;
  tx         : LONGINT;
  n          : LONGINT;
  m          : LONGINT;
  LineHeight : LONGINT;
  RectWidth  : LONGINT;
  RectLeft   : LONGINT;
  RectTop    : LONGINT;
  curWord    : STRING;
  curSent    : STRING;
  str        : ARRAY [1..3] OF STRING;
  Fonts      : ARRAY [1..3] OF TFont;
  stlStrings : TStringList;
  bmpTemp    : TBitmap;
  dc         : THandle;
BEGIN
  bmpTemp := TBitmap.Create;
  bmpTemp.Width := 200;
  bmpTemp.Height := 200;

  RectWidth := 200;
  RectLeft  := 100;
  RectTop   := 0;

  Str[1] := '102.';
  Str[2] := 'This is the second sentence, the number was the first.';
  Str[3] := 'This is the third sentence.';

  Fonts[1] := TFont.Create;
  Fonts[2] := TFont.Create;
  Fonts[3] := TFont.Create;
  Fonts[1].Name  := 'Arial';
  Fonts[1].Size  := 8;
  Fonts[1].Color := clBlack;
  Fonts[2].Assign(Fonts[1]);
  Fonts[3].Assign(Fonts[1]);

  Fonts[2].Color := clRed;

  dc := bmpTemp.Canvas.Handle;

  bmpTemp.Canvas.Font := Fonts[1];
  lineHeight := TextExt(dc, 'Aj').cy;
  bmpTemp.Canvas.Font := Fonts[2];
  IF TextExt(dc, 'Aj').cy > lineHeight
  THEN
    lineHeight := TextExt(dc, 'Aj').cy;
  bmpTemp.Canvas.Font := Fonts[3];
  IF TextExt(dc, 'Aj').cy > lineHeight
  THEN
    lineHeight := TextExt(dc, 'Aj').cy;

  stlStrings := TStringList.Create;
  x := 0;
  y := 0;
  FOR n := 1 TO 3
  DO
  BEGIN
    bmpTemp.Canvas.Font := Fonts[n];
    dc := bmpTemp.Canvas.Handle;

    IF TRIM(Str[n]) <> ''
    THEN
    BEGIN
      tx := x;
      curWord := '';
      curSent := '';
      stlStrings.Clear;
      FOR m := 1 TO Length(Str[n])
      DO
      BEGIN
        IF Str[n][m] = ' '
        THEN
        BEGIN
          IF (TextExt(dc, curSent + ' ' + curWord).cx + tx) > RectWidth
          THEN
          BEGIN
            stlStrings.Add(curSent);
            curSent := curword;
            tx := 0;
          END
          ELSE
            curSent := curSent + ' ' + curWord;
          curWord := '';
        END
        ELSE
          curWord := curWord + Str[n][m];
      END;

      IF curWord <> ''
      THEN
      BEGIN
        IF (TextExt(dc, curSent + ' ' + curWord).cx + tx) > RectWidth
        THEN
        BEGIN
          stlStrings.Add(curSent);
          curSent := curword;
        END
        ELSE
          curSent := curSent + ' ' + curWord;
        curWord := '';
      END;

      IF curSent <> ''
      THEN
        stlStrings.Add(curSent);

      FOR m := 0 TO (stlStrings.Count - 1)
      DO
      BEGIN
        TextOut(dc, RectLeft + x, RectTop + y, PCHAR(stlStrings[m]), Length(stlStrings[m]));

        x := 0;
        y := y + lineHeight;
      END;
      y := y - lineHeight;
      x := TextExt(dc, stlStrings[stlStrings.Count - 1]).cx
    END;
  END;

  stlStrings.Free;
  Image1.Canvas.Draw(0, 0, bmpTemp);
  bmpTemp.Free;

  Fonts[1].Free;
  Fonts[2].Free;
  Fonts[3].Free;
end;

The Neil
Avatar of abulka

ASKER

The Neil - thanks for the comprehensive code.  I pasted it in to Delphi 4 and plonked down an Timage component (which you seem to need) and it SORT OF WORKS.  Instead of

--------------------
| 102.  This is the
| second sentence,
| the number was the
| first.  This is the
| third sentence.
--------------------

I am getting

--------------------
| 102.  This is the seco
| number was the first
| sentence.
--------------------

??

Also - any thoughts on wrapping this delphi code in a dll and calling it from C++, passing in a DC and the 3 strings?  What happens to the delphi code's dependency on TImage?

-Andy
Andy,

I know exactly wjhat is happening and the code is working fine. The initialising of the rectangle to draw the thing in in wrong.

  bmpTemp.Width := 200;
  bmpTemp.Height := 200;

  RectWidth := 200;
  RectLeft  := 100;

It's defined a drawing area 200 wide and a rectangle 200 wide BUT it's drawing the rectangle at 100 pixels in instead of 0. Either increase the width of the drawing area (bmpTemp.Width :=...) or move the position where the rectangle is being drawn (RectLeft := ...)

Believe me, this DOES work

The Neil
Avatar of abulka

ASKER

Adjusted points to 250
Avatar of abulka

ASKER

The Neil - I fiddled with RectLeft := and the code seems to work!  Thanks.

1. When I increase the font to 12/14 point the sentences start clipping and looking horrible.  Is there a fix for this?

2. Also, as mentioned in my original question, I am wanting to put your function in a DLL and call it from VC++.  I will pass in a DC and some strings.  So what happens to the current delphi code's dependency on TImage?  All I will have is a DC.

3. Finally, is there a way of getting the bounds of the resulting rect that was used to format the text?  The initial area I would want to pass to your function should 'autosize' the rect area and return the finished rect.
Avatar of abulka

ASKER

The Neil - I fiddled with RectLeft := and the code seems to work!  Thanks.

1. When I increase the font to 12/14 point the sentences start clipping and looking horrible.  Is there a fix for this?

2. Also, as mentioned in my original question, I am wanting to put your function in a DLL and call it from VC++.  I will pass in a DC and some strings.  So what happens to the current delphi code's dependency on TImage?  All I will have is a DC.

3. Finally, is there a way of getting the bounds of the resulting rect that was used to format the text?  The initial area I would want to pass to your function should 'autosize' the rect area and return the finished rect.
I deliberately coded the routine to use device contexts. In my example code I'm outputting to a TImage but I only ever deal with the device context when manipulating the image, measuring text, outputting text etc. Close to the start of the routine I get the device context (placed in dc) and use that all the way through until I output the results to the display.

As for returning the final size of the rectangle then it should be possible. The width will never change so obviously you only need to return the new height. It's actually very easy to do, just insert the following line before the stringlist is destroyed:

Final_Height := y + line_height;

Your question about increasing the point size DOES create problems. The code can handle different font sizes easily but the problem comes in the way it text wraps. If a word is too long to fit on a line, it adds it to the NEXT line. If however it is too long for that line then it leaves it there and DOESN'T split it any further. What you need to do is make the rectangle wide enough to fit the longest word in. I know it's not an ideal solution but the alternative is to start splitting words and that's very tricky

The Neil
Listening
Avatar of abulka

ASKER

Thanks for your comments.  

> Your question about increasing the point size DOES create problems...What you need to do is make the rectangle wide enough to fit the longest word in.<<

I'm not sure this is going to work.  I mean - no matter how wide I define the rectangular output area to be, at around 14 pt I get clipping on BOTH the RHS margin and on the bottom of EACH letter.

1. Regarding the clipping occuring on the RHS - you say this will require more fancy word wrapping to be implemented. Surely we can calculate the space remaining and the space that will be needed by the particular word and output the word that will not fit on the next line instead? Isn't this what the algorithm is supposed to be basically doing anyway?

2. What worries me more is the clipping that occurs on the bottom of EACH CHARACTER (at 14pt and above).  It's like the vertical line spacing is being calculated wrongly, so each subsequent line is drawn slightly on top of the previous line.  

I haven't studied your algorithm in detail yet, but perhaps the vertical height of the characters is not being accurately calculated, or the spacing between lines is not being added into the equation?
The problem with word wrapping is not in my code and you have reached the same point as my code - if it finds a word that won't fit onto the end of the current line then it outputs it to the nect line...but what if that single word is too long for the next line? The code at the moment will just output it and it will get cut. To get around this you have to start splitting the text into letters not words.

Ok, as for clipping the text at the bottom, the code is supposed to be caculating the tallest piece of text (based on the 3 fonts), and use that height as the line height for ALL the text. Therefore it should have a gap if anything. I can't see what's up with it but if you want me to investigate it then I can (if I get a few spare minutes)

The Neil
Avatar of abulka

ASKER

Adjusted points to 300
Avatar of abulka

ASKER

>> ... if it finds a word that won't fit onto the end of the current line then it outputs it to the next line...<<

Mostly this works ok, but not always.  For example, short words like "all" and "me" at the RHS are clipped into "al" and "me" with half the "e" missing.  Try 14pt and 18 pt (I just change the one point in the code & re-run).

>> if that single word is too long for the next line? The code at the moment will just output it and it will get cut. <<

fair enough, I accept this limitation to the code.  It's the fragments of the little words being cut off that is worrying (see my first point).

>> Ok, as for clipping the text at the bottom, the code is supposed to be caculating the tallest piece of text <<

Again, if you could look at this glitch, I would appreciat it.

Ok, I've checked the code and fixed the second problem. The first problem (word clipping) I can't reproduce. Can you tell me which sentences you're using, the rectangle dimensions etc.

Here's the code with the fixed line height calculation

procedure TForm1.Button1Click(Sender: TObject);

  FUNCTION TextExt(DC : THandle; Text : STRING): TSize;
  begin
    Result.cX := 0;
    Result.cY := 0;
    Windows.GetTextExtentPoint32(DC, PChar(Text), Length(Text), Result);
  END;

VAR
  x          : LONGINT;
  y          : LONGINT;
  tx         : LONGINT;
  n          : LONGINT;
  m          : LONGINT;
  LineHeight : LONGINT;
  RectWidth  : LONGINT;
  RectLeft   : LONGINT;
  RectTop    : LONGINT;
  curWord    : STRING;
  curSent    : STRING;
  str        : ARRAY [1..3] OF STRING;
  Fonts      : ARRAY [1..3] OF TFont;
  stlStrings : TStringList;
  bmpTemp    : TBitmap;
  dc         : THandle;
BEGIN
  bmpTemp := TBitmap.Create;
  bmpTemp.Width := 200;
  bmpTemp.Height := 400;

  RectWidth := 150;
  RectLeft  := 0;
  RectTop   := 0;

  Str[1] := '102.';
  Str[2] := 'This is the second sentence, the number was the first. Me I am.';
  Str[3] := 'This is the third sentence. Tiny be it.';

  Fonts[1] := TFont.Create;
  Fonts[2] := TFont.Create;
  Fonts[3] := TFont.Create;
  Fonts[1].Name  := 'Arial';
  Fonts[1].Size  := 18;
  Fonts[1].Color := clBlack;
  Fonts[2].Assign(Fonts[1]);
  Fonts[3].Assign(Fonts[1]);

  Fonts[2].Color := clRed;
  Fonts[2].Size  := 14;
  Fonts[3].Size  := 8;

  bmpTemp.Canvas.Font := Fonts[1];
  dc := bmpTemp.Canvas.Handle;
  lineHeight := TextExt(dc, 'Aj').cy;

  bmpTemp.Canvas.Font := Fonts[2];
  dc := bmpTemp.Canvas.Handle;
  IF TextExt(dc, 'Aj').cy > lineHeight
  THEN
    lineHeight := TextExt(dc, 'Aj').cy;

  bmpTemp.Canvas.Font := Fonts[3];
  dc := bmpTemp.Canvas.Handle;
  IF TextExt(dc, 'Aj').cy > lineHeight
  THEN
    lineHeight := TextExt(dc, 'Aj').cy;

  stlStrings := TStringList.Create;
  x := 0;
  y := 0;
  FOR n := 1 TO 3
  DO
  BEGIN
    bmpTemp.Canvas.Font := Fonts[n];
    dc := bmpTemp.Canvas.Handle;

    IF TRIM(Str[n]) <> ''
    THEN
    BEGIN
      tx := x;
      curWord := '';
      curSent := '';
      stlStrings.Clear;
      FOR m := 1 TO Length(Str[n])
      DO
      BEGIN
        IF Str[n][m] = ' '
        THEN
        BEGIN
          IF (TextExt(dc, curSent + ' ' + curWord).cx + tx) > RectWidth
          THEN
          BEGIN
            stlStrings.Add(curSent);
            curSent := curword;
            tx := 0;
          END
          ELSE
            curSent := curSent + ' ' + curWord;
          curWord := '';
        END
        ELSE
          curWord := curWord + Str[n][m];
      END;

      IF curWord <> ''
      THEN
      BEGIN
        IF (TextExt(dc, curSent + ' ' + curWord).cx + tx) > RectWidth
        THEN
        BEGIN
          stlStrings.Add(curSent);
          curSent := curword;
        END
        ELSE
          curSent := curSent + ' ' + curWord;
        curWord := '';
      END;

      IF curSent <> ''
      THEN
        stlStrings.Add(curSent);

      FOR m := 0 TO (stlStrings.Count - 1)
      DO
      BEGIN
        TextOut(dc, RectLeft + x, RectTop + y, PCHAR(stlStrings[m]), Length(stlStrings[m]));

        x := 0;
        y := y + lineHeight;
      END;
      y := y - lineHeight;
      x := TextExt(dc, stlStrings[stlStrings.Count - 1]).cx
    END;
  END;

  stlStrings.Free;
  Image1.Canvas.Draw(0, 0, bmpTemp);
  bmpTemp.Free;

  Fonts[1].Free;
  Fonts[2].Free;
  Fonts[3].Free;
end;

The Neil
Avatar of abulka

ASKER

Re: the first clipping problem: this is the code fragment I have that contains the rect/text strings:

BEGIN
  bmpTemp := TBitmap.Create;
{
  bmpTemp.Width := 200;
  bmpTemp.Height := 200;

  RectWidth := 200;
  RectLeft  := 100;
}
  bmpTemp.Width := 200;
  bmpTemp.Height := 200;

  RectWidth := 200;
  RectLeft  := 5;

  RectTop   := 0;

  Str[1] := '102.';
  Str[2] := 'This is the second sentence, the number was the first.';
  Str[3] := 'This is the third sentence. I hope you don''t mind me typing this and talking about all sorts of things, whilst the formatting algorithm does its thing.  Wow I hope this works ok.';

  Fonts[1] := TFont.Create;
  Fonts[2] := TFont.Create;
  Fonts[3] := TFont.Create;
  Fonts[1].Name  := 'Arial';
  Fonts[1].Size  := 14;
  Fonts[1].Color := clBlack;
  Fonts[2].Assign(Fonts[1]);
  Fonts[3].Assign(Fonts[1]);

------------------

Mucking around with various font sizes should generate the problem.  I am running at 1024x768.

By the way, my form is

object Form1: TForm1
  Left = 192
  Top = 107
  Width = 696
  Height = 480
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Image1: TImage
    Left = -1
    Top = 0
    Width = 283
    Height = 187
  end
  object Button1: TButton
    Left = 402
    Top = 201
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
end

------------------
Spotted what you're doing wrong. The code is doing exactly what it's supposed to do. You set the left of the rectangle (RectLeft) to 5. You either need to set it to zero OR set the width of the rectangle to 205. The width of the bitmap needs to be RectLeft + RectWidth otherwise you get text clipping happening.

This is because I set the size of the bitmap to be close to the size of the rectangle. If you define the bitmap to be something big (640x480) then you wouldn't have noticed the problem. Sorry

The Neil =:)
Avatar of abulka

ASKER

The code is looking pretty good now.  I was about to accept when just for fun I tried out the following strings:
  Str[1] := 'hi';
  Str[2] := 'there';
  Str[3] := 'everyone';

and saw that the word 'there' was being chopped off into 'the' !!?  So I see
 'hi the everyone'

ASKER CERTIFIED SOLUTION
Avatar of TheNeil
TheNeil

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of abulka

ASKER

Seems to work great now.  Thanks!
It took some doing but thanks for the points

The Neil =:)