Link to home
Start Free TrialLog in
Avatar of enigmasolutions
enigmasolutions

asked on

RTF Text Height

PART 1: I need some code to return the height of some RTF Text (as it would be displayed).
PART 2: I need some code to draw RTF Text in the DrawColumnCell
PART 3: (for bonus points) I want to convert a non RTF sting field into RTF formatted text and insert it on the top of the RTF Memo as a title.

If someone can solve part 1 for me I can probably work out part 2 and 3.  But answers to all parts would be appreciated.

I have a dataset with a memo field in it that contains RTF text.  I am trying to display the RTF in a grid with varying row heights depending of the size of the RTF.

I am using the grid from this link (I have attached the code at the bottom of this question)
https://www.experts-exchange.com/questions/23088007/changing-the-rowheight-of-my-dbgrid-according-to-the-stuffs.html .

So in the function TLD_DBGrid.DataRowHeight I need to use something instead of DrawText that works on RTF text.  That is I need h2= height of the formatted RTF Text.  So I need to change the following lines of code.

      if Columns[ci].Field is  TMemoField
        then h2:= DrawText(Canvas.Handle,
                           pchar(Columns[ci].Field.AsString),
                           length(Columns[ci].Field.AsString),
                           r2,
                           DT_CALCRECT OR DT_WORDBREAK OR DT_NOPREFIX)

I can't use a tRichEdit because I don't have a tRichEdit (unless I create a dummy instance of tRichEdit and fudge it - but that sounds ugly).  So is there some delphi function to solve my problem or should I be calling Windows API functions?

Once I solve this question I am sure Part 2 and maybe 3 will sort themselves out.

I have attached the grid source code that I am using.
unit LD_DBGridU;
 
interface
 
uses
//  {$IFDEF VER140} DesignIntf, DesignEditors,
//{$ELSE}{$IFDEF VER150} DesignIntf, DesignEditors,
//  {$ELSE} DsgnIntf, {$ENDIF}
//  {$ENDIF}
  TypInfo, Windows, Messages, SysUtils, Classes, Grids, DBGrids, db, Controls;
 
type
  TDummyGridDataLink = class(TGridDataLink);
 
  TDrawColumnTitleEvent = procedure(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState) of object;
 
  TLD_DBGrid = class(TCustomDBGrid)
   private
    //FRowsPerLine: integer;
    FRowHeightsUpdateNeeded: Boolean;
    FOnResize: TNotifyEvent;
    FOnDrawColumnTitle: TDrawColumnTitleEvent;
    FMaxMemoLines:integer;
    function DataRowHeight: Integer;
    procedure UpdateRowHeights;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    function RawToDataColumn(index: integer): integer;
   protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
    procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
      Column: TColumn; State: TGridDrawState); override;
    procedure RowHeightsChanged; override;
    procedure Scroll(Distance: Integer); override;
    procedure SizeChanged(OldColCount, OldRowCount: Longint); override;
    procedure Paint; Override;
   public
    constructor Create(AOwner: TComponent); override;
    function CellRect(ACol, ARow: Longint): TRect;
    procedure ForceRepaint;
    property ColumnFieldIndex[index: integer]: integer read RawToDataColumn;
    property Canvas;
    property SelectedRows;
    property EditorMode;
    property Row;
    property Col;
    property RowHeights;
    property ColWidths;
   published
    property MaxMemoLines:integer read FMaxMemoLines write FMaxMemoLines;
    property Align;
    property Anchors;
    property BiDiMode;
    property BorderStyle;
    property Color;
    property Columns stored False; //StoreColumns;
    property Constraints;
    property Ctl3D;
    property DataSource;
    property DefaultDrawing;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property FixedColor;
    property Font;
    property ImeMode;
    property ImeName;
    property Options;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property TitleFont;
    property Visible;
    property OnCellClick;
    property OnColEnter;
    property OnColExit;
    property OnColumnMoved;
    property OnDrawDataCell;  { obsolete }
    property OnDrawColumnCell;
    property OnDrawColumnTitle: TDrawColumnTitleEvent read FOnDrawColumnTitle write FOnDrawColumnTitle;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEditButtonClick;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize: TNotifyEvent read FOnResize write FOnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnTitleClick;
  end;
 
  procedure Register;
 
 
implementation
 
{$R *.dcr}
 
{ TLD_DBGrid }
 
function TLD_DBGrid.CellRect(ACol, ARow: Integer): TRect;
begin
  result:= inherited CellRect(ACol, ARow);
end;
 
constructor TLD_DBGrid.Create(AOwner: TComponent);
begin
  inherited;
  //DefaultDrawing := False;
  FMaxMemoLines:=4;
  FRowHeightsUpdateNeeded := True;
end;
 
function TLD_DBGrid.DataRowHeight: Integer;
var ci, h2: integer;
      r2: TRect;
begin
  result:= DefaultRowHeight;
  Canvas.Font:= self.Font;
  for ci:= 0 to Columns.Count-1 do
  begin
    if Columns[ci].Visible
    and (Columns[ci].Field<>nil)
    and (Columns[ci].Field.DataType=ftMemo) then
    begin
      r2:= classes.Rect(0, 0, Columns[ci].Width, DefaultRowHeight);
      InflateRect(r2, -2, 0); //border of 2 around text
      if Columns[ci].Field is  TMemoField
        then h2:= DrawText(Canvas.Handle,
                           pchar(Columns[ci].Field.AsString),
                           length(Columns[ci].Field.AsString),
                           r2,
                           DT_CALCRECT OR DT_WORDBREAK OR DT_NOPREFIX)
        else h2:= DrawText(Canvas.Handle,
                           pchar(Columns[ci].Field.DisplayText),
                           length(Columns[ci].Field.DisplayText),
                           r2,
                           DT_CALCRECT OR DT_WORDBREAK OR DT_NOPREFIX);
      if (result < h2)
        then result:= h2+4; //border of 2 above and below
    end;
  end;
  //Added by Justin to limit to 3 lines
  if result > ((Canvas.TextHeight('Wg') * FMaxMemoLines) +4) then
    result:=  ((Canvas.TextHeight('Wg') * FMaxMemoLines) +4);
end;
 
 
procedure TLD_DBGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
  AState: TGridDrawState);
begin
  inherited;
  if ((ARow <= FixedRows-1) AND (ACol > FixedCols-1)) AND Assigned(OnDrawColumnTitle)
//  if ((ARow = 0) AND (ACol = 0)) AND Assigned(OnDrawColumnTitle)
    then OnDrawColumnTitle(ACol, ARow, ARect, AState);
end;
 
procedure TLD_DBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
 
var r: TRect;
 
  function GetMaxHeightNeeded: integer;
  var ci, h2: integer;
      r2: TRect;
  begin
    result:= 0; //RowHeights[Row];
    for ci:= 0 to Columns.Count-1 do
    begin
      if (Columns[ci].Field<>nil) and Columns[ci].Visible then
      begin
        r2:= classes.Rect(0, 0, Columns[ci].Width, 0);// RowHeights[Row]);
        //r2.Bottom:= r2.Top;
        if Columns[ci].Field is  TMemoField
          then h2:= DrawText(Canvas.Handle,
                             pchar(Columns[ci].Field.AsString),
                             length(Columns[ci].Field.AsString),
                             r2,
                             DT_CALCRECT OR DT_WORDBREAK OR DT_NOPREFIX)
          else h2:= DrawText(Canvas.Handle,
                             pchar(Columns[ci].Field.DisplayText),
                             length(Columns[ci].Field.DisplayText),
                             r2,
                             DT_CALCRECT OR DT_WORDBREAK OR DT_NOPREFIX);
        if (result < h2)
          then result:= h2;
      end;
    end;
  end;
 
 
begin
  if (Column.Field=nil) or (Column.Field.DataType<>ftMemo) then
  begin
    inherited DrawColumnCell(Rect,DataCol,Column,State);
    exit;
  end;
 
  if DefaultDrawing then
  begin
    Canvas.FillRect(Rect);
    r:= Rect;
    InflateRect(r, -2, -2);
 
    DrawText(Canvas.Handle, PChar(Column.Field.AsString),
             Length(Column.Field.AsString), r, DT_WORDBREAK OR DT_NOPREFIX);
  end;
  if Assigned(OnDrawColumnCell) then
    OnDrawColumnCell(Self, Rect, DataCol, Column, State);
end;
 
procedure TLD_DBGrid.ForceRepaint;
begin
  FRowHeightsUpdateNeeded:=true;
  Repaint;
end;
 
procedure TLD_DBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
  Cell: TGridCoord;
begin
  inherited;
 
    //fix TCustomDBGrid bug: OnMouseDown event doesn't fire unless col or row < 0
    Cell := MouseCoord(X, Y);
    if (Cell.X >= 0) AND (Cell.Y >= 0) then
    begin
      if Assigned(OnMouseDown) then
      begin
        OnMouseDown(Self, Button, Shift, x, y);
        //DataSource.DataSet.MoveBy(cell.Y - row);
      end;
    end;
 
end;
 
procedure TLD_DBGrid.Paint;
begin
  if FRowHeightsUpdateNeeded
     and DataLink.Active
     and (UpdateLock = 0)
     and (LayoutLock = 0) then
  begin
    repeat
      //We need TCustomDBGrid.UpdateRowCount (private)! Work-around:
      TDummyGridDataLink(DataLink).DataSetChanged;
      RowHeightsChanged;
      UpdateRowHeights;
    until VisibleRowCount >= RowCount - FixedRows; //> due to possible multiple title
    FRowHeightsUpdateNeeded := False;
    //No inherited Paint because DataSetChanged called invalidate already
  end
  else inherited Paint;
end;
 
function TLD_DBGrid.RawToDataColumn(index: integer): integer;
begin
 
end;
 
procedure TLD_DBGrid.RowHeightsChanged;
begin
  if not FRowHeightsUpdateNeeded then inherited;
end;
 
procedure TLD_DBGrid.Scroll(Distance: Integer);
begin
  FRowHeightsUpdateNeeded := Distance <> 0;
  inherited;
  //fix bug in TCustomDBGrid:
  if (Distance > 1) or (Distance <-1) then
  begin
    //FRowHeightsUpdateNeeded := (Distance > 1) or (Distance <-1);
    ForceRepaint;
  end;
  if Distance <> 0 then SelectCell(Col, Row);
end;
 
procedure TLD_DBGrid.SizeChanged(OldColCount, OldRowCount: Integer);
begin
  FRowHeightsUpdateNeeded := True;
  inherited;
end;
 
procedure TLD_DBGrid.UpdateRowHeights;
var
  OldActiveRecord: Integer;
  iRow: Integer;
  drh:Integer;
begin
  with DataLink do begin
    OldActiveRecord := ActiveRecord;
    try
      for iRow := 0 to RowCount - 1 - FixedRows do begin
        ActiveRecord := iRow;
        drh:= DataRowHeight;
        RowHeights[iRow + FixedRows] := drh;
      end;
    finally
      ActiveRecord := OldActiveRecord;
      inherited RowHeightsChanged; //Self.RowHeightsChanged kills job
    end;
  end;
end;
 
procedure TLD_DBGrid.WMSize(var Message: TWMSize);
begin
  FRowHeightsUpdateNeeded:=true; //Added by Justin
  if Assigned(OnResize) then OnResize(self);
end;
 
procedure Register;
begin
  RegisterComponents('EnigmaS', [TLD_DBGrid]);
//  RegisterPropertyEditor(TypeInfo(TCollection), TLD_DBGrid, 'Columns',
//    TDBGridColumnsProperty);
//    TESDBGridColumnsProperty);
end;
 
end.

Open in new window

Avatar of kretzschmar
kretzschmar
Flag of Germany image

you already has a canvas, just set the canvas.font-properties as needed and use

h := Canvas.TextHeight('YourText');

to get the needed height for your text

you use it already

meikl ;-)

Avatar of enigmasolutions
enigmasolutions

ASKER

Thanks meikl,
That may helpd with something else I am thinking about.
I will spend some time considering this.

But, how can I get Canvas.TextHeight to work if 'Your Text' is RTF with varying fonts etc?

can you give me a sample of a RTF-String you have?
Thanks for getting back to me on this (much appreciated).

For now I am not using different fonts (but may do in the future).

Some sample RTF is as follows
{\rtf1\ansi\deff0{\fonttbl{\f0\fnil\fcharset0 MS Sans Serif;}{\f1\fnil MS Sans Serif;}{\f2\fnil\fcharset2 Symbol;}}
\viewkind4\uc1\pard\lang3081\f0\fs16 This is a test
\par some \b bold \b0 text
\par some \i italic  \i0 text
\par maybe some bullets
\par \pard{\pntext\f2\'B7\tab}{\*\pn\pnlvlblt\pnf2\pnindent0{\pntxtb\'B7}}\fi-200\li200 aaa
\par {\pntext\f2\'B7\tab}bbb
\par {\pntext\f2\'B7\tab}ccc
\par \pard some \ul underline \ulnone text
\par possibly different font sizes too (one day but not now)\f1 
\par }

Open in new window

FYI the text above should look a bit like this (except no spacing around the bullets)

This is a test
some bold text
some italic text
maybe some bullets
  • aaa
  • bbb
  • ccc
some underline text
possibly different font sizes too (one day but not now)

 
well, thanks, will do some tests with this sample, maybe i got a solution . . . hope it won't be an ugly one

will back soon

meikl ;-)
just to put a response --> no working solution yet (the one i had in mind did not work)

but still working on a solution

meikl ;-)
Meikl,

I really appreciate this.  I was thinking that tRichEdit uses Windows API calls to effectively draw the RTF text.  If I had the time / skills I would work out what tRichEdit did and how.

Also please send me an email with details about how we can contract you for some development work.  I don't have a lot at the moment but that could change.

Justin.
hi justin,

my eMail you will find in my profile (just click on my name)

following a first experimental sample (which seems to work for me)

this would be part 1, now working on part 2 (yes, there is an api for "printing" the content on a canvas, will try this)

meikl ;-)
unit calc_re_height_u;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;
 
type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    function getRTFMetrics(aRTFString : String) : TPoint;
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
uses richedit;
 
//sample RTF
const rtfs : String = '{\rtf1\ansi\deff0{\fonttbl{\f0\fnil\fcharset0 MS Sans Serif;}{\f1\fnil MS Sans Serif;}{\f2\fnil\fcharset2 Symbol;}}'+
'\viewkind4\uc1\pard\lang3081\f0\fs16 This is a test'+
'\par some \b bold \b0 text'+
'\par some \i italic  \i0 text'+
'\par maybe some bullets'+
'\par \pard{\pntext\f2\''B7\tab}{\*\pn\pnlvlblt\pnf2\pnindent0{\pntxtb\''B7}}\fi-200\li200 aaa'+
'\par {\pntext\f2\''B7\tab}bbb'+
'\par {\pntext\f2\''B7\tab}ccc'+
'\par \pard some \ul underline \ulnone text'+
'\par possibly different font sizes too (one day but not now)\f1'+
'\par }';
 
 
//sample second RTF
const rtfs2 : String = '{\rtf1\ansi\ansicpg1252\uc1 \deff0\deflang1031\deflangfe1031{\fonttbl{\f0\froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}{\f27\fswiss\fcharset0\fprq2{\*\panose 020b0604030504040204}Tahoma;}'+
'{\f156\fswiss\fcharset0\fprq2{\*\panose 020b0502040204020203}Segoe UI;}{\f157\froman\fcharset238\fprq2 Times New Roman CE;}{\f158\froman\fcharset204\fprq2 Times New Roman Cyr;}{\f160\froman\fcharset161\fprq2 Times New Roman Greek;}'+
'{\f161\froman\fcharset162\fprq2 Times New Roman Tur;}{\f162\froman\fcharset177\fprq2 Times New Roman (Hebrew);}{\f163\froman\fcharset178\fprq2 Times New Roman (Arabic);}{\f164\froman\fcharset186\fprq2 Times New Roman Baltic;}'+
'{\f373\fswiss\fcharset238\fprq2 Tahoma CE;}{\f374\fswiss\fcharset204\fprq2 Tahoma Cyr;}{\f376\fswiss\fcharset161\fprq2 Tahoma Greek;}{\f377\fswiss\fcharset162\fprq2 Tahoma Tur;}{\f378\fswiss\fcharset177\fprq2 Tahoma (Hebrew);}'+
'{\f379\fswiss\fcharset178\fprq2 Tahoma (Arabic);}{\f380\fswiss\fcharset186\fprq2 Tahoma Baltic;}{\f1405\fswiss\fcharset238\fprq2 Segoe UI CE;}{\f1406\fswiss\fcharset204\fprq2 Segoe UI Cyr;}{\f1408\fswiss\fcharset161\fprq2 Segoe UI Greek;}'+
'{\f1409\fswiss\fcharset162\fprq2 Segoe UI Tur;}{\f1412\fswiss\fcharset186\fprq2 Segoe UI Baltic;}}{\colortbl;\red0\green0\blue0;\red0\green0\blue255;\red0\green255\blue255;\red0\green255\blue0;\red255\green0\blue255;\red255\green0\blue0;'+
'\red255\green255\blue0;\red255\green255\blue255;\red0\green0\blue128;\red0\green128\blue128;\red0\green128\blue0;\red128\green0\blue128;\red128\green0\blue0;\red128\green128\blue0;\red128\green128\blue128;\red192\green192\blue192;}{\stylesheet{'+
'\ql \li0\ri0\widctlpar\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 \fs24\lang1031\langfe1031\cgrid\langnp1031\langfenp1031 \snext0 Normal;}{\*\cs10 \additive Default Paragraph Font;}}{\info{\title Dies ist ein Text mit verschiedenen Farben , }'+
'{\author Michael Kretzschmar}{\operator Michael Kretzschmar}{\creatim\yr2009\mo2\dy12\hr7\min37}{\revtim\yr2009\mo2\dy12\hr7\min39}{\version1}{\edmins0}{\nofpages1}{\nofwords0}{\nofchars0}{\*\company  .}{\nofcharsws0}{\vern8269}}'+
'\paperw11906\paperh16838\margl1417\margr1417\margt1417\margb1134 \deftab708\widowctrl\ftnbj\aenddoc\hyphhotz425\noxlattoyen\expshrtn\noultrlspc\dntblnsbdb\nospaceforul\formshade\horzdoc\dgmargin\dghspace180\dgvspace180\dghorigin1417\dgvorigin1417\dghshow1'+
'\dgvshow1\jexpand\viewkind1\viewscale100\pgbrdrhead\pgbrdrfoot\splytwnine\ftnlytwnine\htmautsp\nolnhtadjtbl\useltbaln\alntblind\lytcalctblwd\lyttblrtgr\lnbrkrule \fet0\sectd \linex0\headery708\footery708\colsx708\endnhere\sectlinegrid360\sectdefaultcl'+
'{\*\pnseclvl1\pnucrm\pnstart1\pnindent720\pnhang{\pntxta .}}{\*\pnseclvl2\pnucltr\pnstart1\pnindent720\pnhang{\pntxta .}}{\*\pnseclvl3\pndec\pnstart1\pnindent720\pnhang{\pntxta .}}{\*\pnseclvl4\pnlcltr\pnstart1\pnindent720\pnhang{\pntxta )}}{\*\pnseclvl5'+
'\pndec\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}{\*\pnseclvl6\pnlcltr\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}{\*\pnseclvl7\pnlcrm\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}{\*\pnseclvl8\pnlcltr\pnstart1\pnindent720\pnhang'+
'{\pntxtb (}{\pntxta )}}{\*\pnseclvl9\pnlcrm\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}\pard\plain \ql \li0\ri0\widctlpar\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 \fs24\lang1031\langfe1031\cgrid\langnp1031\langfenp1031 {'+
'Dies ist ein Text mit verschiedenen Farben ,'+
'\par }{\f156 Schriften und }{\b\f156\cf6 Gr\''f6\''dfen}{\f156 .'+
'\par }{\f27\fs40 Dies ist }{\f27\fs40\cf3 ein}{\f27\fs40  Text}{ mit verschiedenen Farben ,'+
'\par Schriften und Gr\''f6\''dfen.'+
'\par }}';
 
 
 
 
function TForm1.getRTFMetrics(aRTFString : String) : TPoint; //x = width, y = height
var
  r : TRichEdit;
  sInfo : ScrollInfo;
 
begin
  result := Point(0,0);   //result-Init
  //using a pseudo-hidden richedit to avoid a wheel-reInventing
  r := TRichEdit.Create(self);
  try
    r.Top := -1000;  //keep it out of view (avoids flicker)
    r.Left := -1000;
    r.width := 0;
    r.height := 0;
    r.parent := self;  //mus have a wincontrol-Parent
    r.Visible := true;  //must be visible for correct rendering
    r.ScrollBars := ssBoth;  //assign Scrollbars, we use they for lookup
    r.WordWrap := false;  //no wordwrap
    r.Text := aRTFString;  //assign the text
    sInfo.cbSize := SizeOf(sInfo);  //read out Scroolbar-Metrics
    sInfo.fMask := SIF_RANGE;
    GetScrollInfo(r.handle, SB_VERT, sInfo);  //for height
    //usual i thought the result is in TWips, but seemed not so
    if sInfo.nMax > 0 then
      result.Y := sInfo.nMax;
    GetScrollInfo(r.handle, SB_HORZ, sInfo);  //for width
    if sInfo.nMax > 0 then
      result.X := sInfo.nMax;
  finally
    r.Free;
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var p : Tpoint;
begin
  richedit1.Text := rtfs; //using as target-Control
  p := getRTFMetrics(rtfs); //get Metrics
  //Adding some Control-Depending Offsets
  richedit1.ClientHeight := p.y + 1;
  richedit1.ClientWidth := p.x + 1;
 
end;
 
procedure TForm1.Button2Click(Sender: TObject);
var p : Tpoint;
begin
  richedit1.Text := rtfs2; //using as target-Control
  p := getRTFMetrics(rtfs2); //get Metrics
  //Adding some Control-Depending Offsets
  richedit1.ClientHeight := p.y + 1;
  richedit1.ClientWidth := p.x + 1;
end;
 
end.

Open in new window

Thank you.

Hmm, in the component I am working on I am only interested in the height that the RTF would occupy, because I am working on a Canvas (that comes from a Cell in a grid) and this cell has a fixed width.

So get metric really needs to just return a height.
But your code would probably work if we set r.Width = canvas.width.

What do you think?
well, you can simple ignore the width-result . . .
By the way you might want to try out the TLD_DBGrid component.  It is pretty cool when displaying a memo in a grid.  I just want to get it working with RTF.

Keep in mind the goal here is to work out whether how many lines (up to a maximum of 4) I want to resize a row in a grid to display the RTF.  Thats why I need to find out the height of the RTF within the cell in the grid.
Hmm, maybe but RTF will word wrap so I would need to pass in the width of the canvas to your function.  Don't you think?
I have to go now but I will look at this tomorrow.

Maybe modify the function as follows to get the result I am after

I will give a test tomorrow.
function TForm1.getRTFMetrics(CvWidth:integer; aRTFString : String) : Integer;
var
  r : TRichEdit;
  sInfo : ScrollInfo;
 
begin
  result := Point(0,0);   //result-Init
  //using a pseudo-hidden richedit to avoid a wheel-reInventing
  r := TRichEdit.Create(self);
  try
    r.Top := -1000;  //keep it out of view (avoids flicker)
    r.Left := -1000;
    r.width := cvWidth;
    r.height := 0;
    r.parent := self;  //mus have a wincontrol-Parent
    r.Visible := true;  //must be visible for correct rendering
    r.ScrollBars := ssVertical;  //assign Scrollbars, we use they for lookup
    r.WordWrap := true;  //wordwrap
    r.Text := aRTFString;  //assign the text
    sInfo.cbSize := SizeOf(sInfo);  //read out Scroolbar-Metrics
    sInfo.fMask := SIF_RANGE;
    GetScrollInfo(r.handle, SB_VERT, sInfo);  //for height
    //usual i thought the result is in TWips, but seemed not so
    if sInfo.nMax > 0 then
      result := sInfo.nMax;
 
    //GetScrollInfo(r.handle, SB_HORZ, sInfo);  //for width
    //if sInfo.nMax > 0 then
    //  result.X := sInfo.nMax;
  finally
    r.Free;
  end;
end;

Open in new window

I got a feeling that the API solution may sort out part 1 and 2.
Just the same way DrawText achieves the same result in the component.

This one is definately a challenge.

Again thanks for looking into it.
A trivial bit of info... I just noticed that function GetMaxHeightNeeded is not used at all and can be removed from the component.
hi again,
for wordwrap it should work as you changed . . .

well, will look closer into the TLD_DBGrid-class this weekend

meikl ;-)

?? guessed this question was solved .  .  .

what is missed?

meikl ;-)
No not solved.  

Meikl, I tried to send you an email.  But I guess it got lost with all the others.

I am keen to get a solution for this one.
Meikl,

Actually, (for PART #1) it might be ok with the code you submitted + suggestions for changes.  I just realised I forgot to test this concept.  So your answer might be ok to get the RTF Text Height.  

BUT I still need a way to draw the RTF to the canvas.
AND I think an API call would be the better option to solve all my questions above.
MAYBE you could suggest some API calls to look at.
Then again maybe I should get off my but and do it myself (so much to do, too little time).

Meikl, If you can send me an email I would be open to talking about paying you for this work.
well, will try a sample

btw. i sent you already an asnwer to your email . . .

meikl ;-)
Meikl,

Thanks - looking forward to seeing your sample.

I didn't get your email (maybe my spam filter is too restrictive). Anyway could you re-send the email AND cc my
(Mail address removed
kretzschmar
PE Delphi)
 (with two underscores). Thanks.
well, sent
ASKER CERTIFIED SOLUTION
Avatar of kretzschmar
kretzschmar
Flag of Germany image

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
btw. next step is the build into your grid-component . . .
Yes I can do that.  And I will post the final component here when done.  I have to go now but will do this early next week.

Your solution is VERY SNEAKY but I like it.

I was kind of hoping for an API solution.  I can't help thinking that there must be a couple of API functions that will do the job for me.  Anyway, I am going to accept your answer, which is a pretty cool work around.

I will give it a go early next week.

Thanks for you help.
Great Job Meikl!
well, of course, optimations are possible
for ex. getHeight and print in one step

i also searched for an api-solution, but all the sample and documents i reviewed pointing out to create a richtext-control before . . . whereas i, instead to create one via api, used the vcl-richedit-control

keep us in contact and if you struggles, just force me to help

meikl ;-)
btw. Part III should be easy now