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.
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.
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;
{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;
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.GetTextExtentPoint 32(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.Coun t - 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
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
FUNCTION TextExt(DC : THandle; Text : STRING): TSize;
begin
Result.cX := 0;
Result.cY := 0;
Windows.GetTextExtentPoint
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.Coun
END;
END;
stlStrings.Free;
Image1.Canvas.Draw(0, 0, bmpTemp);
bmpTemp.Free;
Fonts[1].Free;
Fonts[2].Free;
Fonts[3].Free;
end;
The Neil
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
--------------------
| 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
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
ASKER
Adjusted points to 250
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.
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.
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.
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
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
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?
> 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?
listening
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
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
ASKER
Adjusted points to 300
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.
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.GetTextExtentPoint 32(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.Coun t - 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
Here's the code with the fixed line height calculation
procedure TForm1.Button1Click(Sender
FUNCTION TextExt(DC : THandle; Text : STRING): TSize;
begin
Result.cX := 0;
Result.cY := 0;
Windows.GetTextExtentPoint
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.Coun
END;
END;
stlStrings.Free;
Image1.Canvas.Draw(0, 0, bmpTemp);
bmpTemp.Free;
Fonts[1].Free;
Fonts[2].Free;
Fonts[3].Free;
end;
The Neil
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
------------------
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 =:)
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 =:)
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'
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Seems to work great now. Thanks!
It took some doing but thanks for the points
The Neil =:)
The Neil =:)
have a look at the GetTextExtentExPoint and GetTextExtentPoint32 function
Regards, Zif.