From 750a0c68f5ba6f5d6f2c7bafdfee8e1a59eb3d21 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sun, 31 May 2015 16:34:40 +0000 Subject: [PATCH] fpspreadsheet: Move some general procedures from fpspreadsheet.pas to fpsutils.pas git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4168 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/fpspreadsheet/fpspreadsheet.pas | 138 ------------------ components/fpspreadsheet/fpstypes.pas | 35 ++--- components/fpspreadsheet/fpsutils.pas | 77 +++++++++- .../fpspreadsheet/tests/insertdeletetests.pas | 2 +- 4 files changed, 86 insertions(+), 166 deletions(-) diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index cb3915671..da01996ae 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -772,17 +772,7 @@ type {@@ TsSpreadWriter class reference type } TsSpreadWriterClass = class of TsBasicSpreadWriter; - procedure CopyCellFormat(AFromCell, AToCell: PCell); -procedure CopyCellValue(AFromCell, AToCell: PCell); - -//function SameCellBorders(ACell1, ACell2: PCell): Boolean; overload; -function SameCellBorders(AFormat1, AFormat2: PsCellFormat): Boolean; //overload; - -function HasFormula(ACell: PCell): Boolean; - -{ For debugging purposes } -procedure DumpFontsToFile(AWorkbook: TsWorkbook; AFileName: String); implementation @@ -849,35 +839,13 @@ begin else begin fmt := sourceSheet.ReadCellFormat(AFromCell); - //destSheet.WriteCellFormat(AToCell, fmt); - { - if (uffBackground in fmt.UsedFormattingFields) then - begin - clr := sourceSheet.Workbook.GetPaletteColor(fmt.Background.BgColor); - fmt.Background.BgColor := destSheet.Workbook.AddColorToPalette(clr); - clr := sourceSheet.Workbook.GetPaletteColor(fmt.Background.FgColor); - fmt.Background.FgColor := destSheet.Workbook.AddColorToPalette(clr); - end; - } if (uffFont in fmt.UsedFormattingFields) then begin font := sourceSheet.ReadCellFont(AFromCell); - { - clr := sourceSheet.Workbook.GetPaletteColor(font.Color); - font.Color := destSheet.Workbook.AddColorToPalette(clr); - } fmt.FontIndex := destSheet.Workbook.FindFont(font.FontName, font.Size, font.Style, font.Color); if fmt.FontIndex = -1 then fmt.FontIndex := destSheet.Workbook.AddFont(font.FontName, font.Size, font.Style, font.Color); end; - { - if (uffBorder in fmt.UsedFormattingFields) then - for cb in fmt.Border do - begin - clr := sourceSheet.Workbook.GetPaletteColor(fmt.BorderStyles[cb].Color); - fmt.BorderStyles[cb].Color := destSheet.Workbook.AddColorToPalette(clr); - end; - } if (uffNumberformat in fmt.UsedFormattingFields) then begin numFmtParams := sourceSheet.Workbook.GetNumberFormat(fmt.NumberFormatIndex); @@ -892,76 +860,6 @@ begin end; end; -{@@ ---------------------------------------------------------------------------- - Copies the value of a cell to another one. Does not copy the formula, erases - the formula of the destination cell if there is one! - - @param AFromCell Cell from which the value is to be copied - @param AToCell Cell to which the value is to be copied --------------------------------------------------------------------------------} -procedure CopyCellValue(AFromCell, AToCell: PCell); -begin - Assert(AFromCell <> nil); - Assert(AToCell <> nil); - - AToCell^.ContentType := AFromCell^.ContentType; - AToCell^.NumberValue := AFromCell^.NumberValue; - AToCell^.DateTimeValue := AFromCell^.DateTimeValue; - AToCell^.BoolValue := AFromCell^.BoolValue; - AToCell^.ErrorValue := AFromCell^.ErrorValue; - AToCell^.UTF8StringValue := AFromCell^.UTF8StringValue; - AToCell^.FormulaValue := ''; // This is confirmed with Excel -end; - -{@@ ---------------------------------------------------------------------------- - Checks whether two format records have same border attributes - - @param AFormat1 Pointer to the first one of the two format records to be compared - @param AFormat2 Pointer to the second one of the two format records to be compared --------------------------------------------------------------------------------} -function SameCellBorders(AFormat1, AFormat2: PsCellFormat): Boolean; - - function NoBorder(AFormat: PsCellFormat): Boolean; - begin - Result := (AFormat = nil) or - not (uffBorder in AFormat^.UsedFormattingFields) or - (AFormat^.Border = []); - end; - -var - nobrdr1, nobrdr2: Boolean; - cb: TsCellBorder; -begin - nobrdr1 := NoBorder(AFormat1); - nobrdr2 := NoBorder(AFormat2); - if (nobrdr1 and nobrdr2) then - Result := true - else - if (nobrdr1 and (not nobrdr2) ) or ( (not nobrdr1) and nobrdr2) then - Result := false - else begin - Result := false; - if AFormat1^.Border <> AFormat2^.Border then - exit; - for cb in TsCellBorder do begin - if AFormat1^.BorderStyles[cb].LineStyle <> AFormat2^.BorderStyles[cb].LineStyle then - exit; - if AFormat1^.BorderStyles[cb].Color <> AFormat2^.BorderStyles[cb].Color then - exit; - end; - Result := true; - end; -end; - -{@@ ---------------------------------------------------------------------------- - Returns TRUE if the cell contains a formula. - - @param ACell Pointer to the cell checked --------------------------------------------------------------------------------} -function HasFormula(ACell: PCell): Boolean; -begin - Result := Assigned(ACell) and (Length(ACell^.FormulaValue) > 0); -end; function CompareCells(Item1, Item2: Pointer): Integer; begin @@ -988,42 +886,6 @@ begin end; -{@@ ---------------------------------------------------------------------------- - Write the fonts stored for a given workbook to a file. - FOR DEBUGGING ONLY. --------------------------------------------------------------------------------} -procedure DumpFontsToFile(AWorkbook: TsWorkbook; AFileName: String); -var - L: TStringList; - i: Integer; - fnt: TsFont; -begin - L := TStringList.Create; - try - for i:=0 to AWorkbook.GetFontCount-1 do begin - fnt := AWorkbook.GetFont(i); - if fnt = nil then - L.Add(Format('#%.3d: ---------------', [i])) - else - L.Add(Format('#%.3d: %-15s %4.1f %s%s%s%s %s', [ - i, - fnt.FontName, - fnt.Size, - IfThen(fssBold in fnt.Style, 'b', '.'), - IfThen(fssItalic in fnt.Style, 'i', '.'), - IfThen(fssUnderline in fnt.Style, 'u', '.'), - IfThen(fssStrikeOut in fnt.Style, 's', '.'), - ColorToHTMLColorStr(fnt.Color) - //AWorkbook.GetPaletteColorAsHTMLStr(fnt.Color) - ])); - end; - L.SaveToFile(AFileName); - finally - L.Free; - end; -end; - - {******************************************************************************* * TsWorksheet * *******************************************************************************} diff --git a/components/fpspreadsheet/fpstypes.pas b/components/fpspreadsheet/fpstypes.pas index 5863c28bc..897fa8f00 100644 --- a/components/fpspreadsheet/fpstypes.pas +++ b/components/fpspreadsheet/fpstypes.pas @@ -59,18 +59,6 @@ const type - (* - {@@ Possible encodings for a non-unicode encoded text } - TsEncoding = ( - seLatin1, - seLatin2, - seCyrillic, - seGreek, - seTurkish, - seHebrew, - seArabic, - seUTF16 - ); *) {@@ Tokens to identify the elements in an expanded formula. @@ -122,7 +110,6 @@ type ElementKind: TFEKind; Row, Row2: Cardinal; // zero-based Col, Col2: Cardinal; // zero-based -// Param1, Param2: Word; // Extra parameters DoubleValue: double; IntValue: Word; StringValue: String; @@ -150,11 +137,7 @@ type {@@ Pointer to a TsComment record } PsComment = ^TsComment; - (* - {@@ Specifies whether a hyperlink refers to an internal cell address - within the current workbook, or a URI (file://, http://, mailto, etc). } - TsHyperlinkKind = (hkNone, hkInternal, hkURI); - *) + {@@ The record TsHyperlink contains info on a hyperlink in a cell @param Row Row index of the cell containing the hyperlink @param Col Column index of the cell containing the hyperlink @@ -197,17 +180,17 @@ type TsUsedFormattingFields = set of TsUsedFormattingField; const - { @@ Codes for curreny format according to FormatSettings.CurrencyFormat: - "C" = currency symbol, "V" = currency value, "S" = space character - For the negative value formats, we use also: - "B" = bracket, "M" = Minus + {@@ Codes for curreny format according to FormatSettings.CurrencyFormat: + "C" = currency symbol, "V" = currency value, "S" = space character + For the negative value formats, we use also: + "B" = bracket, "M" = Minus - The order of these characters represents the order of these items. + The order of these characters represents the order of these items. - Example: 1000 dollars --> "$1000" for pCV, or "1000 $" for pVsC - -1000 dollars --> "($1000)" for nbCVb, or "-$ 1000" for nMCSV + Example: 1000 dollars --> "$1000" for pCV, or "1000 $" for pVsC + -1000 dollars --> "($1000)" for nbCVb, or "-$ 1000" for nMCSV - Assignment taken from "sysstr.inc" } + Assignment taken from "sysstr.inc" } pcfDefault = -1; // use value from Worksheet.FormatSettings.CurrencyFormat pcfCV = 0; // $1000 pcfVC = 1; // 1000$ diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index f5b278c77..8028bb2a8 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/components/fpspreadsheet/fpsutils.pas @@ -167,6 +167,10 @@ procedure InitCell(ARow, ACol: Cardinal; out ACell: TCell); overload; procedure InitFormatRecord(out AValue: TsCellFormat); procedure InitPageLayout(out APageLayout: TsPageLayout); +procedure CopyCellValue(AFromCell, AToCell: PCell); +function HasFormula(ACell: PCell): Boolean; +function SameCellBorders(AFormat1, AFormat2: PsCellFormat): Boolean; + procedure AppendToStream(AStream: TStream; const AString: String); inline; overload; procedure AppendToStream(AStream: TStream; const AString1, AString2: String); inline; overload; procedure AppendToStream(AStream: TStream; const AString1, AString2, AString3: String); inline; overload; @@ -176,11 +180,11 @@ procedure Unused(const A1); procedure Unused(const A1, A2); procedure Unused(const A1, A2, A3); - var {@@ Default value for the screen pixel density (pixels per inch). Is needed for conversion of distances to pixels} ScreenPixelsPerInch: Integer = 96; + {@@ FPC format settings for which all strings have been converted to UTF8 } UTF8FormatSettings: TFormatSettings; @@ -2342,6 +2346,77 @@ begin end; end; +{@@ ---------------------------------------------------------------------------- + Copies the value of a cell to another one. Does not copy the formula, erases + the formula of the destination cell if there is one! + + @param AFromCell Cell from which the value is to be copied + @param AToCell Cell to which the value is to be copied +-------------------------------------------------------------------------------} +procedure CopyCellValue(AFromCell, AToCell: PCell); +begin + Assert(AFromCell <> nil); + Assert(AToCell <> nil); + + AToCell^.ContentType := AFromCell^.ContentType; + AToCell^.NumberValue := AFromCell^.NumberValue; + AToCell^.DateTimeValue := AFromCell^.DateTimeValue; + AToCell^.BoolValue := AFromCell^.BoolValue; + AToCell^.ErrorValue := AFromCell^.ErrorValue; + AToCell^.UTF8StringValue := AFromCell^.UTF8StringValue; + AToCell^.FormulaValue := ''; // This is confirmed with Excel +end; + +{@@ ---------------------------------------------------------------------------- + Returns TRUE if the cell contains a formula. + + @param ACell Pointer to the cell checked +-------------------------------------------------------------------------------} +function HasFormula(ACell: PCell): Boolean; +begin + Result := Assigned(ACell) and (Length(ACell^.FormulaValue) > 0); +end; + +{@@ ---------------------------------------------------------------------------- + Checks whether two format records have same border attributes + + @param AFormat1 Pointer to the first one of the two format records to be compared + @param AFormat2 Pointer to the second one of the two format records to be compared +-------------------------------------------------------------------------------} +function SameCellBorders(AFormat1, AFormat2: PsCellFormat): Boolean; + + function NoBorder(AFormat: PsCellFormat): Boolean; + begin + Result := (AFormat = nil) or + not (uffBorder in AFormat^.UsedFormattingFields) or + (AFormat^.Border = []); + end; + +var + nobrdr1, nobrdr2: Boolean; + cb: TsCellBorder; +begin + nobrdr1 := NoBorder(AFormat1); + nobrdr2 := NoBorder(AFormat2); + if (nobrdr1 and nobrdr2) then + Result := true + else + if (nobrdr1 and (not nobrdr2) ) or ( (not nobrdr1) and nobrdr2) then + Result := false + else begin + Result := false; + if AFormat1^.Border <> AFormat2^.Border then + exit; + for cb in TsCellBorder do begin + if AFormat1^.BorderStyles[cb].LineStyle <> AFormat2^.BorderStyles[cb].LineStyle then + exit; + if AFormat1^.BorderStyles[cb].Color <> AFormat2^.BorderStyles[cb].Color then + exit; + end; + Result := true; + end; +end; + {@@ ---------------------------------------------------------------------------- Appends a string to a stream diff --git a/components/fpspreadsheet/tests/insertdeletetests.pas b/components/fpspreadsheet/tests/insertdeletetests.pas index 30b11f424..b3600f8b7 100644 --- a/components/fpspreadsheet/tests/insertdeletetests.pas +++ b/components/fpspreadsheet/tests/insertdeletetests.pas @@ -220,7 +220,7 @@ type implementation uses - StrUtils; + StrUtils, fpsUtils; const InsertColRowSheet = 'InsertDelete_ColumnsRows';