From 5e1e29aef87aa2d52c80fed1844d9557435ba29f Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Tue, 29 Apr 2014 21:58:48 +0000 Subject: [PATCH] fpspreadsheet: Show rotated text in fpspreadsheetgrid. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2976 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/excel5demo/excel5write.lpr | 22 ++ .../examples/fpsgrid/mainform.lfm | 7 +- .../examples/fpsgrid/mainform.pas | 62 ++-- components/fpspreadsheet/fpspreadsheet.pas | 13 +- .../fpspreadsheet/fpspreadsheetgrid.pas | 276 +++++++++++++++--- components/fpspreadsheet/xlsbiff5.pas | 4 +- 6 files changed, 319 insertions(+), 65 deletions(-) diff --git a/components/fpspreadsheet/examples/excel5demo/excel5write.lpr b/components/fpspreadsheet/examples/excel5demo/excel5write.lpr index f5c825c45..e9a57de2e 100644 --- a/components/fpspreadsheet/examples/excel5demo/excel5write.lpr +++ b/components/fpspreadsheet/examples/excel5demo/excel5write.lpr @@ -37,6 +37,9 @@ begin // Write some cells MyWorksheet.WriteNumber(0, 0, 1.0);// A1 + MyWorksheet.WriteVertAlignment(0, 0, vaCenter); + + MyWorksheet.WriteNumber(0, 1, 2.0);// B1 MyWorksheet.WriteNumber(0, 2, 3.0);// C1 MyWorksheet.WriteNumber(0, 3, 4.0);// D1 @@ -55,6 +58,7 @@ begin MyWorksheet.WriteUTF8Text(4, 5, 'Stacked text'); MyWorksheet.WriteTextRotation(4, 5, rtStacked); + MyWorksheet.WriteHorAlignment(4, 5, haCenter); MyWorksheet.WriteUTF8Text(4, 6, 'CW-rotated text'); MyWorksheet.WriteTextRotation(4, 6, rt90DegreeClockwiseRotation); @@ -62,6 +66,24 @@ begin MyWorksheet.WriteUTF8Text(4, 7, 'CCW-rotated text'); MyWorksheet.WriteTextRotation(4, 7, rt90DegreeCounterClockwiseRotation); + MyWorksheet.WriteUTF8Text(4, 8, 'CW-rotated text'); + MyWorksheet.WriteTextRotation(4, 8, rt90DegreeClockwiseRotation); + MyWorksheet.WriteVertAlignment(4, 8, vaTop); + MyWorksheet.WriteHorAlignment(4, 8, haLeft); + + MyWorksheet.WriteUTF8Text(4, 9, 'CCW-rotated text'); + MyWorksheet.WriteTextRotation(4, 9, rt90DegreeCounterClockwiseRotation); + MyWorksheet.WriteVertAlignment(4, 9, vaTop); + Myworksheet.WriteHorAlignment(4, 9, haRight); + + MyWorksheet.WriteUTF8Text(4, 10, 'CW-rotated text'); + MyWorksheet.WriteTextRotation(4, 10, rt90DegreeClockwiseRotation); + MyWorksheet.WriteVertAlignment(4, 10, vaCenter); + + MyWorksheet.WriteUTF8Text(4, 11, 'CCW-rotated text'); + MyWorksheet.WriteTextRotation(4, 11, rt90DegreeCounterClockwiseRotation); + MyWorksheet.WriteVertAlignment(4, 11, vaCenter); + // Write current date/time MyWorksheet.WriteDateTime(5, 0, now); MyWorksheet.WriteFont(5, 0, 'Courier New', 20, [fssBold, fssItalic, fssUnderline], scBlue); diff --git a/components/fpspreadsheet/examples/fpsgrid/mainform.lfm b/components/fpspreadsheet/examples/fpsgrid/mainform.lfm index 6f884f756..198c1e528 100644 --- a/components/fpspreadsheet/examples/fpsgrid/mainform.lfm +++ b/components/fpspreadsheet/examples/fpsgrid/mainform.lfm @@ -1,12 +1,13 @@ object Form1: TForm1 - Left = 288 + Left = 370 Height = 339 - Top = 177 + Top = 258 Width = 400 Caption = 'fpsGrid' ClientHeight = 319 ClientWidth = 400 Menu = MainMenu1 + OnActivate = FormActivate ShowHint = True LCLVersion = '1.3' object Panel1: TPanel @@ -72,7 +73,7 @@ object Form1: TForm1 Top = 0 Width = 392 Align = alClient - Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSizing, goColSizing, goThumbTracking, goSmoothScroll, goCellEllipsis] + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSizing, goColSizing, goThumbTracking, goSmoothScroll] TabOrder = 0 TitleStyle = tsNative end diff --git a/components/fpspreadsheet/examples/fpsgrid/mainform.pas b/components/fpspreadsheet/examples/fpsgrid/mainform.pas index 46a600663..032372d04 100644 --- a/components/fpspreadsheet/examples/fpsgrid/mainform.pas +++ b/components/fpspreadsheet/examples/fpsgrid/mainform.pas @@ -45,9 +45,11 @@ type procedure acOpenExecute(Sender: TObject); procedure acQuitExecute(Sender: TObject); procedure acSaveAsExecute(Sender: TObject); + procedure FormActivate(Sender: TObject); procedure PageControl1Change(Sender: TObject); private { private declarations } + procedure LoadFile(const AFileName: String); public { public declarations } end; @@ -87,33 +89,9 @@ begin end; procedure TForm1.acOpenExecute(Sender: TObject); -// Loads first worksheet from file into grid -var - pages: TStrings; - i: Integer; begin if OpenDialog1.Execute then - begin - sWorksheetGrid1.LoadFromSpreadsheetFile(OpenDialog1.FileName); - Caption := Format('fpsGrid - %s (%s)', [ - OpenDialog1.Filename, - GetFileFormatName(sWorksheetGrid1.Workbook.FileFormat) - ]); - - // Create a tab in the pagecontrol for each worksheet contained in the workbook - // This would be easer with a TTabControl. This has display issues, though. - pages := TStringList.Create; - try - sWorksheetGrid1.GetSheets(pages); - sWorksheetGrid1.Parent := PageControl1.Pages[0]; - while PageControl1.PageCount > pages.Count do PageControl1.Pages[1].Free; - while PageControl1.PageCount < pages.Count do PageControl1.AddTabSheet; - for i:=0 to PageControl1.PageCount-1 do - PageControl1.Pages[i].Caption := pages[i]; - finally - pages.Free; - end; - end; + LoadFile(OpenDialog1.FileName); end; procedure TForm1.acQuitExecute(Sender: TObject); @@ -143,13 +121,45 @@ begin end; end; +procedure TForm1.FormActivate(Sender: TObject); +begin + if ParamCount > 0 then + LoadFile(ParamStr(1)); +end; + +procedure TForm1.LoadFile(const AFileName: String); +// Loads first worksheet from file into grid +var + pages: TStrings; + i: Integer; +begin + sWorksheetGrid1.LoadFromSpreadsheetFile(AFileName); + Caption := Format('fpsGrid - %s (%s)', [ + AFilename, + GetFileFormatName(sWorksheetGrid1.Workbook.FileFormat) + ]); + + // Create a tab in the pagecontrol for each worksheet contained in the workbook + // This would be easer with a TTabControl. This has display issues, though. + pages := TStringList.Create; + try + sWorksheetGrid1.GetSheets(pages); + sWorksheetGrid1.Parent := PageControl1.Pages[0]; + while PageControl1.PageCount > pages.Count do PageControl1.Pages[1].Free; + while PageControl1.PageCount < pages.Count do PageControl1.AddTabSheet; + for i:=0 to PageControl1.PageCount-1 do + PageControl1.Pages[i].Caption := pages[i]; + finally + pages.Free; + end; +end; + procedure TForm1.PageControl1Change(Sender: TObject); begin sWorksheetGrid1.Parent := PageControl1.Pages[PageControl1.ActivePageIndex]; sWorksheetGrid1.SelectSheetByIndex(PageControl1.ActivePageIndex); end; - initialization {$I mainform.lrs} diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index ee8cbeb99..618e5f060 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -347,6 +347,7 @@ type procedure WriteBorders(ARow, ACol: Cardinal; ABorders: TsCellBorders); procedure WriteHorAlignment(ARow, ACol: Cardinal; AValue: TsHorAlignment); procedure WriteVertAlignment(ARow, ACol: Cardinal; AValue: TsVertAlignment); + procedure WriteWordwrap(ARow, ACol: Cardinal; AValue: boolean); { Data manipulation methods - For Rows and Cols } function FindRow(ARow: Cardinal): PRow; function FindCol(ACol: Cardinal): PCol; @@ -1477,6 +1478,17 @@ begin lCell^.VertAlignment := AValue; end; +procedure TsWorksheet.WriteWordWrap(ARow, ACol: Cardinal; AValue: Boolean); +var + lCell: PCell; +begin + lCell := GetCell(ARow, ACol); + if AValue then + Include(lCell^.UsedFormattingFields, uffWordwrap) + else + Exclude(lCell^.UsedFormattingFields, uffWordwrap); +end; + function TsWorksheet.FindRow(ARow: Cardinal): PRow; var LElement: TRow; @@ -1690,7 +1702,6 @@ var AReader: TsCustomSpreadReader; begin AReader := CreateSpreadReader(AFormat); - try AReader.ReadFromFile(AFileName, Self); FFormat := AFormat; diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index 4c679fbbc..f61accb75 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/components/fpspreadsheet/fpspreadsheetgrid.pas @@ -21,13 +21,13 @@ type TsCustomWorksheetGrid = class(TCustomDrawGrid) private + { Private declarations } FWorkbook: TsWorkbook; FWorksheet: TsWorksheet; FDisplayFixedColRow: Boolean; function CalcColWidth(AWidth: Single): Integer; function CalcRowHeight(AHeight: Single): Integer; procedure SetDisplayFixedColRow(const AValue: Boolean); - { Private declarations } protected { Protected declarations } procedure DoPrepareCanvas(ACol, ARow: Integer; AState: TGridDrawState); override; @@ -37,7 +37,7 @@ type procedure Loaded; override; procedure Setup; public - { methods } + { public methods } constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure GetSheets(const ASheets: TStrings); @@ -46,6 +46,7 @@ type procedure LoadFromSpreadsheetFile(AFileName: string; AWorksheetIndex: Integer = 0); overload; procedure SaveToWorksheet(AWorksheet: TsWorksheet); procedure SelectSheetByIndex(AIndex: Integer); + { public properties } property DisplayFixedColRow: Boolean read FDisplayFixedColRow write SetDisplayFixedColRow; property Worksheet: TsWorksheet read FWorksheet; property Workbook: TsWorkbook read FWorkbook; @@ -154,7 +155,7 @@ procedure Register; implementation uses - fpCanvas, fpsUtils; + Types, LCLType, LCLIntf, Math, fpCanvas, fpsUtils; var FillPattern_BIFF2: TBitmap = nil; @@ -172,6 +173,72 @@ begin end; end; +function WrapText(ACanvas: TCanvas; const AText: string; AMaxWidth: integer): string; +// code posted by taazz in the Lazarus Forum: +// http://forum.lazarus.freepascal.org/index.php/topic,21305.msg124743.html#msg124743 +var + DC: HDC; + textExtent: TSize; + S, P, E: PChar; + line: string; + isFirstLine: boolean; +begin + Result := ''; + DC := ACanvas.Handle; + isFirstLine := True; + P := PChar(AText); + while P^ = ' ' do + Inc(P); + while P^ <> #0 do begin + S := P; + E := nil; + while (P^ <> #0) and (P^ <> #13) and (P^ <> #10) do begin + LCLIntf.GetTextExtentPoint(DC, S, P - S + 1, textExtent); + if (textExtent.CX > AMaxWidth) and (E <> nil) then begin + if (P^ <> ' ') and (P^ <> ^I) then begin + while (E >= S) do + case E^ of + '.', ',', ';', '?', '!', '-', ':', + ')', ']', '}', '>', '/', '\', ' ': + break; + else + Dec(E); + end; + if E < S then + E := P - 1; + end; + Break; + end; + E := P; + Inc(P); + end; + if E <> nil then begin + while (E >= S) and (E^ = ' ') do + Dec(E); + end; + if E <> nil then + SetString(Line, S, E - S + 1) + else + SetLength(Line, 0); + if (P^ = #13) or (P^ = #10) then begin + Inc(P); + if (P^ <> (P - 1)^) and ((P^ = #13) or (P^ = #10)) then + Inc(P); + if P^ = #0 then + line := line + LineEnding; + end + else if P^ <> ' ' then + P := E + 1; + while P^ = ' ' do + Inc(P); + if isFirstLine then begin + Result := Line; + isFirstLine := False; + end else + Result := Result + LineEnding + line; + end; +end; + procedure Register; begin RegisterComponents('Additional',[TsWorksheetGrid]); @@ -238,28 +305,6 @@ begin c := ACol - FixedCols; lCell := FWorksheet.FindCell(r, c); if lCell <> nil then begin - // Horizontal alignment - case lCell^.HorAlignment of - haDefault: if lCell^.ContentType = cctNumber then - ts.Alignment := taRightJustify - else - ts.Alignment := taLeftJustify; - haLeft : ts.Alignment := taLeftJustify; - haCenter : ts.Alignment := taCenter; - haRight : ts.Alignment := taRightJustify; - end; - // Vertical alignment - case lCell^.VertAlignment of - vaDefault: ts.Layout := tlBottom; - vaTop : ts.Layout := tlTop; - vaCenter : ts.Layout := tlCenter; - vaBottom : ts.layout := tlBottom; - end; - // Word wrap - if (uffWordWrap in lCell^.UsedFormattingFields) then begin - ts.Wordbreak := true; - ts.SingleLine := false; - end; // Background color if (uffBackgroundColor in lCell^.UsedFormattingFields) then begin if FWorkbook.FileFormat = sfExcel2 then begin @@ -293,10 +338,10 @@ begin Canvas.Font.Size := round(fnt.Size); end; end; + // Wordwrap, text alignment and text rotation are handled by "DrawTextInCell". end; end; Canvas.TextStyle := ts; - inherited DoPrepareCanvas(ACol, ARow, AState); end; @@ -332,18 +377,177 @@ begin end; end; -{ Draws the cell text. Calls "GetCellText" to determine the text in the cell. } +{ Draws the cell text. Calls "GetCellText" to determine the text in the cell. + Takes care of horizontal and vertical text alignment, text rotation and + text wrapping } procedure TsCustomWorksheetGrid.DrawTextInCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState); +const + HOR_ALIGNMENTS: array[haLeft..haRight] of TAlignment = ( + taLeftJustify, taCenter, taRightJustify + ); + VERT_ALIGNMENTS: array[TsVertAlignment] of TTextLayout = ( + tlBottom, tlTop, tlCenter, tlBottom + ); +var + ts: TTextStyle; + flags: Cardinal; + txt: String; + txtRect: TRect; + P: TPoint; + w, h, h0, hline: Integer; + i: Integer; + L: TStrings; + c, r: Integer; + wordwrap: Boolean; + horAlign: TsHorAlignment; + vertAlign: TsVertAlignment; + lCell: PCell; begin - DrawCellText(aCol, aRow, aRect, aState, GetCellText(ACol,ARow)); + if FWorksheet = nil then + exit; + + c := ACol - FixedCols; + r := ARow - FixedRows; + lCell := FWorksheet.FindCell(r, c); + if lCell = nil then begin + if FDisplayFixedColRow and ((ACol = 0) or (ARow = 0)) then begin + ts.Alignment := taCenter; + ts.Layout := tlCenter; + Canvas.TextStyle := ts; + end; + inherited DrawCellText(aCol, aRow, aRect, aState, GetCellText(ACol,ARow)); + exit; + end; + + txt := GetCellText(ACol, ARow); + if txt = '' then + exit; + + if lCell^.HorAlignment <> haDefault then + horAlign := lCell^.HorAlignment + else begin + if lCell^.ContentType = cctNumber then + horAlign := haRight + else + horAlign := haLeft; + if lCell^.TextRotation = rt90DegreeCounterClockwiseRotation then begin + if horAlign = haRight then horAlign := haLeft else horAlign := haRight; + end; + end; + vertAlign := lCell^.VertAlignment; + wordwrap := (uffWordWrap in lCell^.UsedFormattingFields) + or (lCell^.TextRotation = rtStacked); + + InflateRect(ARect, -constCellPadding, -constCellPadding); + + if lCell^.TextRotation in [trHorizontal, rtStacked] then begin + // HORIZONAL TEXT DRAWING DIRECTION + ts := Canvas.TextStyle; + if wordwrap then begin + ts.Wordbreak := true; + ts.SingleLine := false; + flags := DT_WORDBREAK and not DT_SINGLELINE; + LCLIntf.DrawText(Canvas.Handle, PChar(txt), Length(txt), txtRect, + DT_CALCRECT or flags); + w := txtRect.Right - txtRect.Left; + h := txtRect.Bottom - txtRect.Top; + end else begin + ts.WordBreak := false; + ts.SingleLine := false; + w := Canvas.TextWidth(txt); + h := Canvas.TextHeight('Tg'); + end; + + Canvas.Font.Orientation := 0; + ts.Alignment := HOR_ALIGNMENTS[horAlign]; + if h > ARect.Bottom - ARect.Top then + ts.Layout := tlTop + else + ts.Layout := VERT_ALIGNMENTS[vertAlign]; + + Canvas.TextStyle := ts; + Canvas.TextRect(ARect, ARect.Left, ARect.Top, txt); + end + else + begin + // ROTATED TEXT DRAWING DIRECTION + L := TStringList.Create; + try + txtRect := Bounds(ARect.Left, ARect.Top, ARect.Bottom - ARect.Top, ARect.Right - ARect.Left); + hline := Canvas.TextHeight('Tg'); + if wordwrap then begin + L.Text := WrapText(Canvas, txt, txtRect.Right - txtRect.Left); + flags := DT_WORDBREAK and not DT_SINGLELINE; + LCLIntf.DrawText(Canvas.Handle, PChar(L.Text), Length(L.Text), txtRect, + DT_CALCRECT or flags); + w := txtRect.Right - txtRect.Left; + h := txtRect.Bottom - txtRect.Top; + h0 := hline; + end + else begin + L.Text := txt; + w := Canvas.TextWidth(txt); + h := hline; + h0 := 0; + end; + + ts := Canvas.TextStyle; + ts.SingleLine := true; // Draw text line by line + ts.Clipping := false; + ts.Layout := tlTop; + ts.Alignment := taLeftJustify; + + if lCell^.TextRotation = rt90DegreeClockwiseRotation then begin + // Clockwise + Canvas.Font.Orientation := -900; + case horAlign of + haLeft : P.X := Min(ARect.Right-1, ARect.Left + h - h0); + haCenter : P.X := Min(ARect.Right-1, (ARect.Left + ARect.Right + h) div 2); + haRight : P.X := ARect.Right - 1; + end; + for i:= 0 to L.Count-1 do begin + w := Canvas.TextWidth(L[i]); + case vertAlign of + vaTop : P.Y := ARect.Top; + vaCenter : P.Y := Max(ARect.Top, (ARect.Top + ARect.Bottom - w) div 2); + vaBottom : P.Y := Max(ARect.Top, ARect.Bottom - w); + end; + Canvas.TextRect(ARect, P.X, P.Y, L[i], ts); + dec(P.X, hline); + end + end + else begin + // Counter-clockwise + Canvas.Font.Orientation := +900; + case horAlign of + haLeft : P.X := ARect.Left; + haCenter : P.X := Max(ARect.Left, (ARect.Left + ARect.Right - h + h0) div 2); + haRight : P.X := MAx(ARect.Left, ARect.Right - h + h0); + end; + for i:= 0 to L.Count-1 do begin + w := Canvas.TextWidth(L[i]); + case vertAlign of + vaTop : P.Y := Min(ARect.Bottom, ARect.Top + w); + vaCenter : P.Y := Min(ARect.Bottom, (ARect.Top + ARect.Bottom + w) div 2); + vaBottom : P.Y := ARect.Bottom; + end; + Canvas.TextRect(ARect, P.X, P.Y, L[i], ts); + inc(P.X, hline); + end; + end; + finally + L.Free; + end; + end; end; -{ This function returns the text to be written in the cell } +{ GetCellText function returns the text to be written in the cell } function TsCustomWorksheetGrid.GetCellText(ACol, ARow: Integer): String; var lCell: PCell; - r, c: Integer; + r, c, i: Integer; + s: String; begin Result := ''; @@ -366,8 +570,16 @@ begin r := ARow - FixedRows; c := ACol - FixedCols; lCell := FWorksheet.FindCell(r, c); - if lCell <> nil then + if lCell <> nil then begin Result := FWorksheet.ReadAsUTF8Text(r, c); + if lCell^.TextRotation = rtStacked then begin + s := Result; + Result := ''; + for i:=1 to Length(s)-1 do + Result := Result + s[i] + LineEnding; + Result := Result + s[Length(s)]; + end; + end; end; end; @@ -392,7 +604,6 @@ end; procedure TsCustomWorksheetGrid.SetDisplayFixedColRow(const AValue: Boolean); begin if AValue = FDisplayFixedColRow then Exit; - FDisplayFixedColRow := AValue; Setup; end; @@ -493,7 +704,6 @@ begin if AWorksheet = nil then Exit; { Copy the contents } - for x := 0 to ColCount - 1 do for y := 0 to RowCount - 1 do begin diff --git a/components/fpspreadsheet/xlsbiff5.pas b/components/fpspreadsheet/xlsbiff5.pas index a726bc17a..5ac51b57d 100755 --- a/components/fpspreadsheet/xlsbiff5.pas +++ b/components/fpspreadsheet/xlsbiff5.pas @@ -1737,7 +1737,7 @@ begin // Text rotation case xf.XFRotation of XF_ROTATION_HORIZONTAL : lData.TextRotation := trHorizontal; - XF_ROTATION_90DEG_CCW : ldata.TextRotation := rt90DegreeCounterClockwiseRotation; + XF_ROTATION_90DEG_CCW : lData.TextRotation := rt90DegreeCounterClockwiseRotation; XF_ROTATION_90DEG_CW : lData.TextRotation := rt90DegreeClockwiseRotation; XF_ROTATION_STACKED : lData.TextRotation := rtStacked; end; @@ -1887,7 +1887,7 @@ var AValue: array[0..255] of Char; AStrValue: ansistring; begin - ReadRowColXF(AStream,ARow,ACol,XF); + ReadRowColXF(AStream, ARow, ACol, XF); { Byte String with 16-bit size } L := AStream.ReadWord();