Can somebody tell me, how I can change the RowHeight automatically, when a cell in this row has Wordwrapped and there is more than one line text?
NextGrid RowHeight
Started by Ulrich Schaupp, May 23 2006 09:43 PM
3 replies to this topic
#1
Posted 23 May 2006 - 09:43 PM
#2
Posted 23 May 2006 - 10:32 PM
Hello,
Maybe OnMeasuringRowHeight event may help. You will need to set RowHeight (var) parameter inside this event.
regards
Maybe OnMeasuringRowHeight event may help. You will need to set RowHeight (var) parameter inside this event.
regards
boki@bergsoft.net | LinkedIn Profile
--
BergSoft Home Page: www.bergsoft.net
Users Section: users.bergsoft.net
Articles and Tutorials: help.bergsoft.net (Developers Network)
--
BergSoft Facebook page
--
Send us applications made with our components and we will submit them on: www.bergsoft.net/apps.htm. Link to this page will be also set on home page too.
--
BergSoft Home Page: www.bergsoft.net
Users Section: users.bergsoft.net
Articles and Tutorials: help.bergsoft.net (Developers Network)
--
BergSoft Facebook page
--
Send us applications made with our components and we will submit them on: www.bergsoft.net/apps.htm. Link to this page will be also set on home page too.
#3
Posted 31 May 2006 - 02:38 PM
QUOTE (Boki @ May 23 2006, 11:32 PM) <{POST_SNAPBACK}>
Hello,
Maybe OnMeasuringRowHeight event may help. You will need to set RowHeight (var) parameter inside this event.
regards
Maybe OnMeasuringRowHeight event may help. You will need to set RowHeight (var) parameter inside this event.
regards
Hello,
how can I calculate the nesessary RowHeight when cell is in edit mode an when I fill cell an need more lines. Please give me an example.
best regards
#4
Posted 31 May 2006 - 03:45 PM
Hi,
Found the following code that might be of help at http://www.delphipra...post270456.html
To make it work, Drop a TImage and a TButton on a Form and attach the ButtonClick Handler.
Note that the author does not claim it's production code, but the test i did looked good.
Found the following code that might be of help at http://www.delphipra...post270456.html
To make it work, Drop a TImage and a TButton on a Form and attach the ButtonClick Handler.
Note that the author does not claim it's production code, but the test i did looked good.
CODE
function TextWidthEx(aCanvas: TCanvas; sText: string): Integer;
var sList : TStringList;
arr : array of Integer;
i : Integer;
begin
Result := -1;
sList := TStringList.Create;
try
sList.Text := sText;
SetLength(arr, sList.Count);
for i := 0 to High(arr) do
arr[i] := aCanvas.TextWidth(sList[i]);
for i := 0 to High(arr) do
if arr[i] > Result then Result := arr[i];
finally
sList.Free;
end;
end;
function TextHeightEx(aCanvas: TCanvas; sText: string): Integer;
var sList : TStringList;
arr : array of Integer;
i : Integer;
begin
Result := -1;
sList := TStringList.Create;
try
sList.Text := sText;
SetLength(arr, sList.Count);
for i := 0 to High(arr) do
arr[i] := aCanvas.TextHeight(sList[i]);
for i := 0 to High(arr) do
if arr[i] > Result then Result := arr[i];
finally
sList.Free;
end;
end;
function CreateFormattedStrings(sInput: TStrings; OnCanvas: TCanvas; FPxWidth: Integer): TStringlist;
var
sWord, sNonWord, sTmp, sResult, sLine: string;
LastChar, MaxChar : Integer;
Clusters : TStringlist;
DidLB : Boolean;
const
WordSeperators = [' '];
begin
Result := TStringlist.Create;
Clusters := TStringlist.Create;
sTmp := sInput.Text;
sResult := '';
LastChar := 1;
MaxChar := Length(sTmp);
sWord := '';
sNonWord := '';
sLine := '';
Clusters.Clear;
while LastChar < MaxChar do
try
//sLine bilden
sLine := '';
while (TextWidthEx(OnCanvas, sLine) < FPxWidth)
and (LastChar < MaxChar) do
begin
sWord := '';
sNonWord := '';
DidLB := false;
Clusters.Clear;
//Wort finden
while (LastChar <= MaxChar) and not (sTmp[LastChar] in WordSeperators) do
begin
sWord := sWord + sTmp[LastChar];
Inc(LastChar);
end;
//ShowMessage('sWord:' + '"'+sWord+'"');
//Leerzeichen finden
while (LastChar <= MaxChar) and (sTmp[LastChar] in WordSeperators) do
begin
sNonWord := sNonWord + sTmp[LastChar];
Inc(LastChar);
end;
//Passt das Wort noch in sLine?
if TextWidthEx(OnCanvas, sLine + sWord) > FPxWidth then
begin
DidLB := true;
Clusters.Add('');
//Ist das Wort zu lang für 1 Zeile?
if TextWidthEx(OnCanvas, sWord) > FPxWidth then
begin
while (Length(sWord) > 0) do
begin
if TextWidthEx(OnCanvas, Clusters[Clusters.Count - 1]) > FPxWidth then Clusters.Add('');
Clusters[Clusters.Count - 1] := Clusters[Clusters.Count - 1] + sWord[1];
Delete(sWord, 1, 1);
if TextWidthEx(OnCanvas, sWord) <= FPxWidth then break;
end;
end;
while (Clusters.Count > 0) and (Clusters[Clusters.Count - 1] = #13#10) do
Clusters.Delete(Clusters.Count - 1);
//If Clusters.Text = #13#10 then Windows.Beep(400,100);
sLine := sLine + Clusters.Text + sWord;
end
//Das Wort passt noch in sLine
else sLine := sLine + sWord;
sLine := sLine + sNonWord;
end;
//sLine hinzufügen
if not DidLB then sLine := sLine + #13#10;
//ShowMessage('sLine:' + '"'+sLine+'"');
sResult := sResult + sLine;
except
exit;
end;
//ShowMessage('Final Result:' + #13#10 + '"' + sResult + '"');
Result.Text := sResult;
while (Result.Count > 0) and (Result[Result.Count - 1] = #13#10) do
Result.Delete(Result.Count - 1);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
sl : TStringList;
i : Integer;
begin
Image1.Width := 80;
sl := TStringList.Create;
sl.Add('The Quick Brown Fox Jumps the Lazy Dog.');
ShowMessage(CreateFormattedStrings(sl, Image1.Canvas, 80).Text);;
sl.Text := CreateFormattedStrings(sl, Image1.Canvas, 80).Text;
for i := 0 to Pred(sl.Count) do
Image1.Canvas.TextOut(0, i * Image1.Canvas.TextHeight('X'), sl[i]);
end;
var sList : TStringList;
arr : array of Integer;
i : Integer;
begin
Result := -1;
sList := TStringList.Create;
try
sList.Text := sText;
SetLength(arr, sList.Count);
for i := 0 to High(arr) do
arr[i] := aCanvas.TextWidth(sList[i]);
for i := 0 to High(arr) do
if arr[i] > Result then Result := arr[i];
finally
sList.Free;
end;
end;
function TextHeightEx(aCanvas: TCanvas; sText: string): Integer;
var sList : TStringList;
arr : array of Integer;
i : Integer;
begin
Result := -1;
sList := TStringList.Create;
try
sList.Text := sText;
SetLength(arr, sList.Count);
for i := 0 to High(arr) do
arr[i] := aCanvas.TextHeight(sList[i]);
for i := 0 to High(arr) do
if arr[i] > Result then Result := arr[i];
finally
sList.Free;
end;
end;
function CreateFormattedStrings(sInput: TStrings; OnCanvas: TCanvas; FPxWidth: Integer): TStringlist;
var
sWord, sNonWord, sTmp, sResult, sLine: string;
LastChar, MaxChar : Integer;
Clusters : TStringlist;
DidLB : Boolean;
const
WordSeperators = [' '];
begin
Result := TStringlist.Create;
Clusters := TStringlist.Create;
sTmp := sInput.Text;
sResult := '';
LastChar := 1;
MaxChar := Length(sTmp);
sWord := '';
sNonWord := '';
sLine := '';
Clusters.Clear;
while LastChar < MaxChar do
try
//sLine bilden
sLine := '';
while (TextWidthEx(OnCanvas, sLine) < FPxWidth)
and (LastChar < MaxChar) do
begin
sWord := '';
sNonWord := '';
DidLB := false;
Clusters.Clear;
//Wort finden
while (LastChar <= MaxChar) and not (sTmp[LastChar] in WordSeperators) do
begin
sWord := sWord + sTmp[LastChar];
Inc(LastChar);
end;
//ShowMessage('sWord:' + '"'+sWord+'"');
//Leerzeichen finden
while (LastChar <= MaxChar) and (sTmp[LastChar] in WordSeperators) do
begin
sNonWord := sNonWord + sTmp[LastChar];
Inc(LastChar);
end;
//Passt das Wort noch in sLine?
if TextWidthEx(OnCanvas, sLine + sWord) > FPxWidth then
begin
DidLB := true;
Clusters.Add('');
//Ist das Wort zu lang für 1 Zeile?
if TextWidthEx(OnCanvas, sWord) > FPxWidth then
begin
while (Length(sWord) > 0) do
begin
if TextWidthEx(OnCanvas, Clusters[Clusters.Count - 1]) > FPxWidth then Clusters.Add('');
Clusters[Clusters.Count - 1] := Clusters[Clusters.Count - 1] + sWord[1];
Delete(sWord, 1, 1);
if TextWidthEx(OnCanvas, sWord) <= FPxWidth then break;
end;
end;
while (Clusters.Count > 0) and (Clusters[Clusters.Count - 1] = #13#10) do
Clusters.Delete(Clusters.Count - 1);
//If Clusters.Text = #13#10 then Windows.Beep(400,100);
sLine := sLine + Clusters.Text + sWord;
end
//Das Wort passt noch in sLine
else sLine := sLine + sWord;
sLine := sLine + sNonWord;
end;
//sLine hinzufügen
if not DidLB then sLine := sLine + #13#10;
//ShowMessage('sLine:' + '"'+sLine+'"');
sResult := sResult + sLine;
except
exit;
end;
//ShowMessage('Final Result:' + #13#10 + '"' + sResult + '"');
Result.Text := sResult;
while (Result.Count > 0) and (Result[Result.Count - 1] = #13#10) do
Result.Delete(Result.Count - 1);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
sl : TStringList;
i : Integer;
begin
Image1.Width := 80;
sl := TStringList.Create;
sl.Add('The Quick Brown Fox Jumps the Lazy Dog.');
ShowMessage(CreateFormattedStrings(sl, Image1.Canvas, 80).Text);;
sl.Text := CreateFormattedStrings(sl, Image1.Canvas, 80).Text;
for i := 0 to Pred(sl.Count) do
Image1.Canvas.TextOut(0, i * Image1.Canvas.TextHeight('X'), sl[i]);
end;
G.W. van der Vegt
0 user(s) are reading this topic
0 members, 0 guests, 0 anonymous users