3 replies to this topic

[Ulrich Schaupp]

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?

[Boki (Berg)]

Hello,

Maybe OnMeasuringRowHeight event may help. You will need to set RowHeight (var) parameter inside this event.

regards

[Ulrich Schaupp]

Hello,
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

[wvd_vegt]

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.

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;