paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fpspreadsheet: Move some general procedures from fpspreadsheet.pas to fpsutils.pas

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4168 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2015-05-31 16:34:40 +00:00
parent f8f72e3847
commit 750a0c68f5
4 changed files with 86 additions and 166 deletions

138
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -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 *
*******************************************************************************}

35
components/fpspreadsheet/fpstypes.pas
View File

@ -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 <b>elements in an expanded formula</b>.
@ -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$

77
components/fpspreadsheet/fpsutils.pas
View File

@ -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

2
components/fpspreadsheet/tests/insertdeletetests.pas
View File

@ -220,7 +220,7 @@ type
implementation
uses
StrUtils;
StrUtils, fpsUtils;
const
InsertColRowSheet = 'InsertDelete_ColumnsRows';