function TsWorksheetHelper.myGetColsWidthPixel(
const AFirstCol, ALastCol: cardinal): integer;
var
i: integer;
begin
Result := 0;
for i := AFirstCol to ALastCol do
Result := Result + Round(GetColWidth(i, suPoints));
end;
function TsWorksheetHelper.myCalcTextWidthPixel(const AText: string;
const AFontName: string; const AFontSize: integer;
const AFontStyle: TsFontStyles): integer;
var
bmp: TBitmap;
FS: TsFontStyle;
begin
Result := 0;
bmp := TBitmap.Create;
try
bmp.Canvas.Font.Name := AFontName;
bmp.Canvas.Font.Size := AFontSize;
bmp.Canvas.Font.Style := [];
with bmp.Canvas.Font do
for FS := Low(AFontStyle) to High(AFontStyle) do
case FS of
fssBold: Style := Style + [fsBold];
fssItalic: Style := Style + [fsItalic];
fssUnderline: Style := Style + [fsUnderline];
end;
Result := bmp.Canvas.TextWidth(AText);
finally
bmp.Free;
end;
end;
function TsWorksheetHelper.myCalcTextHeightPixel(const AText: string;
const AFontName: string; const AFontSize: integer;
const AFontStyle: TsFontStyles): integer;
var
bmp: TBitmap;
FS: TsFontStyle;
begin
Result := 0;
bmp := TBitmap.Create;
try
bmp.Canvas.Font.Name := AFontName;
bmp.Canvas.Font.Size := AFontSize;
bmp.Canvas.Font.Style := [];
with bmp.Canvas.Font do
for FS := Low(AFontStyle) to High(AFontStyle) do
case FS of
fssBold: Style := Style + [fsBold];
fssItalic: Style := Style + [fsItalic];
fssUnderline: Style := Style + [fsUnderline];
end;
Result := bmp.Canvas.TextHeight(AText);
finally
bmp.Free;
end;
end;
procedure TsWorksheetHelper.myWriteAutoRowHeight(const ARow: cardinal;
const AFirstCol, ALastCol: cardinal; const AFontName: string;
const AFontSize: integer; const AFontStyle: TsFontStyles);
var
MergedColsWidthPixel: integer;
TextWidthPixel, TextHeightPixel: integer;
begin
MergedColsWidthPixel := myGetColsWidthPixel(AFirstCol, ALastCol);
TextWidthPixel := myCalcTextWidthPixel(ReadAsText(ARow, AFirstCol),
AFontName, AFontSize, AFontStyle);
TextHeightPixel := myCalcTextHeightPixel(ReadAsText(ARow, AFirstCol),
AFontName, AFontSize, AFontStyle);
if TextWidthPixel < MergedColsWidthPixel then
WriteRowHeight(ARow, TextHeightPixel + (TextHeightPixel div 2), suPoints)
else
WriteRowHeight(ARow, Trunc(((TextWidthPixel / MergedColsWidthPixel) + 1) *
TextHeightPixel), suPoints);
end;