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.As String),
length(Columns[ci].Field.A sString),
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.
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.As
length(Columns[ci].Field.A
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.
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?
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?
ASKER
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
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 }
ASKER
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
possibly different font sizes too (one day but not now)
This is a test
some bold text
some italic text
maybe some bullets
- aaa
- bbb
- ccc
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 ;-)
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 ;-)
but still working on a solution
meikl ;-)
ASKER
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.
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 ;-)
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.
ASKER
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?
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 . . .
ASKER
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.
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.
ASKER
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?
ASKER
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.
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;
ASKER
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.
Just the same way DrawText achieves the same result in the component.
This one is definately a challenge.
Again thanks for looking into it.
ASKER
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 ;-)
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 ;-)
what is missed?
meikl ;-)
ASKER
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, 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.
ASKER
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.
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 ;-)
btw. i sent you already an asnwer to your email . . .
meikl ;-)
ASKER
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.
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
btw. next step is the build into your grid-component . . .
ASKER
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.
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.
ASKER
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 ;-)
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
h := Canvas.TextHeight('YourTex
to get the needed height for your text
you use it already
meikl ;-)