AutoWidthCol doesn't check a "WrapText"
Posted: Wed May 11, 2016 1:45 pm
Dear programmer colleagues!
I don't know if you decide to note the following lines as a bug or as an customer "wish for feature".
The problem is that the TXLSWorksheet.AutoWidthCol does not check if the cells in the column have a "foWrapText" option or not!.
The result the for the FColumns[ACol].PixelWidth must be smaller for a wraped celltext!
wraped text in excel cell
=====================
'Hello this is my wish
for the next update!'
the width will be wrongly calculated for :
==================================
'Hello this is my wish#10for the next update!'
To get the correct maximal ColWidth you can change your routines as follows:
The patched lines are marked!
It would be very nice if this could be included in the next update!
============ Patched source in XLSSheetData5.pas (CurrentVersionNumber = '5.20.75') ==============
function TXLSWorksheet.AutoWidthCol(const ACol: integer): integer;
{$ifdef BABOON}
begin
Result := 0;
end;
{$else}
var
W: integer;
S: AxUCString;
TM: TEXTMETRIC;
CurrFont: TXc12Font;
Canvas: TCanvas;
C: TXLSCellItem;
XF: TXc12XF;
//Patched by HiTec-Zang 11.5.2016
L:TStringList;
i:integer;
//End of patch by HiTec-Zang 11.5.2016
begin
Canvas := TCanvas.Create;
try
Canvas.Handle := GetDC(GetDesktopWindow());
CurrFont := FManager.StyleSheet.Fonts.DefaultFont;
CurrFont.CopyToTFont(Canvas.Font);
GetTextMetrics(Canvas.Handle,TM);
Result := 0; // DefaultColWidth * Canvas.TextWidth('0');
FCells.BeginIterateRow;
while FCells.IterateNextRow do begin
if FCells.FindCell(ACol,FCells.IterCellRow,C) and (FMergedCells.CellInAreas(ACol,FCells.IterCellRow) <= -1) then begin
XF := FManager.StyleSheet.XFs[FCells.GetStyle(@C)];
if Xf.Font <> CurrFont then begin
CurrFont := XF.Font;
CurrFont.CopyToTFont(Canvas.Font);
GetTextMetrics(Canvas.Handle,TM);
end;
//Patched by HiTec-Zang 11.5.2016
if foWrapText in XF.Alignment.Options then
begin
L:=TStringList.Create;
try
L.Text:=GetAsFmtString(ACol,FCells.IterCellRow);
S:='';
for I := 0 to L.Count - 1 do
if Length(L)>Length(S) then
S:=L;
finally
L.free;
end;
end
else S:=GetAsFmtString(ACol,FCells.IterCellRow);
if XF.Alignment.Rotation in [90,180,255] then // Vertical
W := Canvas.TextHeight(S) + TM.tmAveCharWidth + 5
else
W := Canvas.TextWidth(S) + TM.tmAveCharWidth + 5;
//End of patch by HiTec-Zang 11.5.2016
(*old source of Axolot
// Vertical
if XF.Alignment.Rotation in [90,180,255] then
W := Canvas.TextHeight(GetAsFmtString(ACol,FCells.IterCellRow)) + TM.tmAveCharWidth + 5
else begin
S := GetAsFmtString(ACol,FCells.IterCellRow);
W := Canvas.TextWidth(S) + TM.tmAveCharWidth + 5;
end; *)
if XF.Alignment.HorizAlignment = chaRight then
Inc(W,TM.tmAveCharWidth);
if W > Result then
Result := W;
end;
end;
if Result > 0 then
FColumns[ACol].PixelWidth := Result; //Round(((Result) / FManager.StyleSheet.StdFontWidth) * 256);
finally
ReleaseDC(GetDesktopWindow(),Canvas.Handle);
Canvas.Free;
end;
end;
{$endif}
greetings
Heiner Breuer
I don't know if you decide to note the following lines as a bug or as an customer "wish for feature".
The problem is that the TXLSWorksheet.AutoWidthCol does not check if the cells in the column have a "foWrapText" option or not!.
The result the for the FColumns[ACol].PixelWidth must be smaller for a wraped celltext!
wraped text in excel cell
=====================
'Hello this is my wish
for the next update!'
the width will be wrongly calculated for :
==================================
'Hello this is my wish#10for the next update!'
To get the correct maximal ColWidth you can change your routines as follows:
The patched lines are marked!
It would be very nice if this could be included in the next update!
============ Patched source in XLSSheetData5.pas (CurrentVersionNumber = '5.20.75') ==============
function TXLSWorksheet.AutoWidthCol(const ACol: integer): integer;
{$ifdef BABOON}
begin
Result := 0;
end;
{$else}
var
W: integer;
S: AxUCString;
TM: TEXTMETRIC;
CurrFont: TXc12Font;
Canvas: TCanvas;
C: TXLSCellItem;
XF: TXc12XF;
//Patched by HiTec-Zang 11.5.2016
L:TStringList;
i:integer;
//End of patch by HiTec-Zang 11.5.2016
begin
Canvas := TCanvas.Create;
try
Canvas.Handle := GetDC(GetDesktopWindow());
CurrFont := FManager.StyleSheet.Fonts.DefaultFont;
CurrFont.CopyToTFont(Canvas.Font);
GetTextMetrics(Canvas.Handle,TM);
Result := 0; // DefaultColWidth * Canvas.TextWidth('0');
FCells.BeginIterateRow;
while FCells.IterateNextRow do begin
if FCells.FindCell(ACol,FCells.IterCellRow,C) and (FMergedCells.CellInAreas(ACol,FCells.IterCellRow) <= -1) then begin
XF := FManager.StyleSheet.XFs[FCells.GetStyle(@C)];
if Xf.Font <> CurrFont then begin
CurrFont := XF.Font;
CurrFont.CopyToTFont(Canvas.Font);
GetTextMetrics(Canvas.Handle,TM);
end;
//Patched by HiTec-Zang 11.5.2016
if foWrapText in XF.Alignment.Options then
begin
L:=TStringList.Create;
try
L.Text:=GetAsFmtString(ACol,FCells.IterCellRow);
S:='';
for I := 0 to L.Count - 1 do
if Length(L)>Length(S) then
S:=L;
finally
L.free;
end;
end
else S:=GetAsFmtString(ACol,FCells.IterCellRow);
if XF.Alignment.Rotation in [90,180,255] then // Vertical
W := Canvas.TextHeight(S) + TM.tmAveCharWidth + 5
else
W := Canvas.TextWidth(S) + TM.tmAveCharWidth + 5;
//End of patch by HiTec-Zang 11.5.2016
(*old source of Axolot
// Vertical
if XF.Alignment.Rotation in [90,180,255] then
W := Canvas.TextHeight(GetAsFmtString(ACol,FCells.IterCellRow)) + TM.tmAveCharWidth + 5
else begin
S := GetAsFmtString(ACol,FCells.IterCellRow);
W := Canvas.TextWidth(S) + TM.tmAveCharWidth + 5;
end; *)
if XF.Alignment.HorizAlignment = chaRight then
Inc(W,TM.tmAveCharWidth);
if W > Result then
Result := W;
end;
end;
if Result > 0 then
FColumns[ACol].PixelWidth := Result; //Round(((Result) / FManager.StyleSheet.StdFontWidth) * 256);
finally
ReleaseDC(GetDesktopWindow(),Canvas.Handle);
Canvas.Free;
end;
end;
{$endif}
greetings
Heiner Breuer