pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Raise an exception if virtual mode is used without an event handler to provide data. Some cosmetics.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3599 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-09-23 21:51:26 +00:00
parent 15f7f52acd
commit 1ed35f0eb1
2 changed files with 180 additions and 66 deletions
Download Patch File Download Diff File Expand all files Collapse all files

126
components/fpspreadsheet/examples/spready/mainform.lfm
View File

@ -4,7 +4,7 @@ object MainFrm: TMainFrm
Top = 258 Top = 258
Width = 884 Width = 884
Caption = 'spready' Caption = 'spready'
ClientHeight = 614 ClientHeight = 619
ClientWidth = 884 ClientWidth = 884
Menu = MainMenu Menu = MainMenu
OnActivate = FormActivate OnActivate = FormActivate
@ -14,7 +14,7 @@ object MainFrm: TMainFrm
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
Height = 78 Height = 78
Top = 536 Top = 541
Width = 884 Width = 884
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
@ -23,7 +23,7 @@ object MainFrm: TMainFrm
TabOrder = 6 TabOrder = 6
object EdFrozenCols: TSpinEdit object EdFrozenCols: TSpinEdit
Left = 429 Left = 429
Height = 28 Height = 23
Top = 8 Top = 8
Width = 52 Width = 52
OnChange = EdFrozenColsChange OnChange = EdFrozenColsChange
@ -31,7 +31,7 @@ object MainFrm: TMainFrm
end end
object EdFrozenRows: TSpinEdit object EdFrozenRows: TSpinEdit
Left = 429 Left = 429
Height = 28 Height = 23
Top = 39 Top = 39
Width = 52 Width = 52
OnChange = EdFrozenRowsChange OnChange = EdFrozenRowsChange
@ -39,37 +39,37 @@ object MainFrm: TMainFrm
end end
object Label1: TLabel object Label1: TLabel
Left = 344 Left = 344
Height = 20 Height = 15
Top = 13 Top = 13
Width = 77 Width = 62
Caption = 'Frozen cols:' Caption = 'Frozen cols:'
FocusControl = EdFrozenCols FocusControl = EdFrozenCols
ParentColor = False ParentColor = False
end end
object Label2: TLabel object Label2: TLabel
Left = 344 Left = 344
Height = 20 Height = 15
Top = 40 Top = 40
Width = 82 Width = 66
Caption = 'Frozen rows:' Caption = 'Frozen rows:'
FocusControl = EdFrozenRows FocusControl = EdFrozenRows
ParentColor = False ParentColor = False
end end
object CbReadFormulas: TCheckBox object CbReadFormulas: TCheckBox
Left = 8 Left = 8
Height = 24 Height = 19
Top = 8 Top = 8
Width = 120 Width = 96
Caption = 'Read formulas' Caption = 'Read formulas'
OnChange = CbReadFormulasChange OnChange = CbReadFormulasChange
TabOrder = 0 TabOrder = 0
end end
object CbHeaderStyle: TComboBox object CbHeaderStyle: TComboBox
Left = 200 Left = 200
Height = 28 Height = 23
Top = 8 Top = 8
Width = 116 Width = 116
ItemHeight = 20 ItemHeight = 15
ItemIndex = 2 ItemIndex = 2
Items.Strings = ( Items.Strings = (
'Lazarus' 'Lazarus'
@ -83,18 +83,18 @@ object MainFrm: TMainFrm
end end
object CbAutoCalcFormulas: TCheckBox object CbAutoCalcFormulas: TCheckBox
Left = 8 Left = 8
Height = 24 Height = 19
Top = 32 Top = 32
Width = 158 Width = 128
Caption = 'Calculate on change' Caption = 'Calculate on change'
OnChange = CbAutoCalcFormulasChange OnChange = CbAutoCalcFormulasChange
TabOrder = 1 TabOrder = 1
end end
object CbTextOverflow: TCheckBox object CbTextOverflow: TCheckBox
Left = 8 Left = 8
Height = 24 Height = 19
Top = 56 Top = 56
Width = 114 Width = 91
Caption = 'Text overflow' Caption = 'Text overflow'
Checked = True Checked = True
OnChange = CbTextOverflowChange OnChange = CbTextOverflowChange
@ -206,19 +206,19 @@ object MainFrm: TMainFrm
end end
object FontComboBox: TComboBox object FontComboBox: TComboBox
Left = 52 Left = 52
Height = 28 Height = 23
Top = 2 Top = 2
Width = 127 Width = 127
ItemHeight = 20 ItemHeight = 15
OnSelect = FontComboBoxSelect OnSelect = FontComboBoxSelect
TabOrder = 0 TabOrder = 0
end end
object FontSizeComboBox: TComboBox object FontSizeComboBox: TComboBox
Left = 179 Left = 179
Height = 28 Height = 23
Top = 2 Top = 2
Width = 48 Width = 48
ItemHeight = 20 ItemHeight = 15
Items.Strings = ( Items.Strings = (
'8' '8'
'9' '9'
@ -392,7 +392,7 @@ object MainFrm: TMainFrm
end end
object InspectorSplitter: TSplitter object InspectorSplitter: TSplitter
Left = 648 Left = 648
Height = 457 Height = 462
Top = 79 Top = 79
Width = 5 Width = 5
Align = alRight Align = alRight
@ -400,7 +400,7 @@ object MainFrm: TMainFrm
end end
object InspectorPageControl: TPageControl object InspectorPageControl: TPageControl
Left = 653 Left = 653
Height = 457 Height = 462
Top = 79 Top = 79
Width = 231 Width = 231
ActivePage = PgCellValue ActivePage = PgCellValue
@ -410,11 +410,11 @@ object MainFrm: TMainFrm
OnChange = InspectorPageControlChange OnChange = InspectorPageControlChange
object PgCellValue: TTabSheet object PgCellValue: TTabSheet
Caption = 'Cell value' Caption = 'Cell value'
ClientHeight = 424 ClientHeight = 434
ClientWidth = 223 ClientWidth = 223
object CellInspector: TValueListEditor object CellInspector: TValueListEditor
Left = 0 Left = 0
Height = 424 Height = 434
Top = 0 Top = 0
Width = 223 Width = 223
Align = alClient Align = alClient
@ -455,7 +455,7 @@ object MainFrm: TMainFrm
end end
object TabControl: TTabControl object TabControl: TTabControl
Left = 0 Left = 0
Height = 457 Height = 462
Top = 79 Top = 79
Width = 648 Width = 648
OnChange = TabControlChange OnChange = TabControlChange
@ -463,7 +463,7 @@ object MainFrm: TMainFrm
TabOrder = 3 TabOrder = 3
object WorksheetGrid: TsWorksheetGrid object WorksheetGrid: TsWorksheetGrid
Left = 2 Left = 2
Height = 452 Height = 457
Top = 3 Top = 3
Width = 644 Width = 644
FrozenCols = 0 FrozenCols = 0
@ -480,7 +480,7 @@ object MainFrm: TMainFrm
TitleStyle = tsNative TitleStyle = tsNative
OnSelection = WorksheetGridSelection OnSelection = WorksheetGridSelection
ColWidths = ( ColWidths = (
56 42
64 64
64 64
64 64
@ -821,9 +821,81 @@ object MainFrm: TMainFrm
end end
object MenuItem73: TMenuItem object MenuItem73: TMenuItem
Action = AcDeleteColumn Action = AcDeleteColumn
Bitmap.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D69E
72C4D3996EF4D19668FFCE9263FFCB8E5EFFC98A5BFFC78756FFC38452FFC384
52FFC38452FFC38452FFC38452FFC38452FFBB7742B0FFFFFF00FFFFFF00D7A1
75FFF8F2EDFFF7F0EAFFF6EDE6FFF4EAE2FFF3E7DEFFF1E4DBFFF0E2D8FFF0E2
D8FFF0E2D8FFF0E2D8FFF0E2D8FFF0E2D8FFC58A5DFDFFFFFF00FFFFFF00D9A4
7AFFF9F3EEFF1C11EAFF1C11EAFF231AECFFFFFFFFFFFFFFFFFFFFFFFFFFEAC7
ADFFFFFFFFFFFFFFFFFFFFFFFFFFF0E2D8FFC68C5FFFFFFFFF00FFFFFF00DDA8
7EFFF9F3EFFF1C11EAFF9399F9FF2E26EEFFEBD0BBFFEBD0BBFFEBD1BDFFEACD
B5FFEACDB5FFEACDB5FFEACDB5FFF0E2D8FFC68A5CFFFFFFFF00FFFFFF00DFAA
82FFF9F3EFFF231AECFF9CA2FAFF3A35F1FFFFFFFFFFFFFFFFFFFFFFFFFFEACF
BAFFFBF6F2FFFFFFFFFFFFFFFFFFF0E2D8FFC88D5FFFFFFFFF00FFFFFF00E1AE
87FFFAF4F0FF2E26EEFFA6ADFBFF4845F4FFEACCB3FFEACCB3FFEACEB7FFE8C7
ACFFE8C7ACFFE8C8B0FFE8C8AEFFF0E2D8FFC48654FFFFFFFF00FFFFFF00E3B1
8CFFFAF6F1FF3A35F1FFB1B9FBFF5654F7FFFFFFFFFFFFFFFFFFFFFFFFFFE8C7
ACFFFFFFFFFFFFFFFFFFFFFFFFFFF1E5DBFFC68655FFFFFFFF00FFFFFF00E5B4
8FFFFAF6F2FF5654F7FFC1CBFCFF6D6FFCFFE9C7ADFFE9C9AEFFE9C9B0FFE8C7
ACFFE9C9B0FFE8C8B0FFE8CCB5FFF2E7DEFFC88A59FFFFFFFF00FFFFFF00E7B7
94FFFBF7F4FF6263FAFFC4CEFDFF7478FEFFFFFFFFFFFFFFFFFFFFFFFFFFE8C7
ACFF95B0E3FF235CC2FF0543BCFF1E58BEFF6B6C8AFFFFFFFF00FFFFFF00E9BA
98FFFBF7F4FF6D6FFCFF7478FEFF7478FEFFE9C3A6FFE9C3A6FFE9C3A6FF818D
B5FF2865C8FF2177E6FF0579EAFF0164DDFF064EBCFF0345B87AFFFFFF00EBBD
9BFFFBF7F4FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF164B
AEFF639DF4FF187FFFFF0076F8FF0076EEFF0368E1FF0345B9E4FFFFFF00ECBF
9EFFFBF7F4FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF0543
BCFFAECDFEFFFFFFFFFFFFFFFFFFFFFFFFFF187FEFFF0442BCFEFFFFFF00EEC1
A1EBFBF7F4FFFBF7F4FFFBF7F4FFFBF7F4FFFBF7F4FFFBF7F4FFFBF7F4FF255D
C2FF8DB5F6FF4D92FFFF1177FFFF2186FFFF408AEBFF0344B9DEFFFFFF00EFC2
A37EEFC1A2E3EDC09FFFEBBE9DFFEBBC9AFFE9BA96FFE7B793FFE6B590FF96B1
E3FF3D76D2FF8DB5F7FFB8D6FEFF72A8F5FF2E6BCAFF0443BA6DFFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF007591C3FF235BC0FF0543BCFF1D58BFFF7591C2FFFFFFFF00
}
end end
object MenuItem74: TMenuItem object MenuItem74: TMenuItem
Action = AcDeleteRow Action = AcDeleteRow
Bitmap.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D69D
72C4D3976DF4D09568FFCE9062FFCB8C5DFFC9885BFFC78655FFC28252FFC282
52FFC28252FFC28252FFC28252FFC28252FFBA7642B0FFFFFF00FFFFFF00D79F
75FFF8F1ECFFF7EFE9FFF6ECE6FFF4E9E2FFF3E6DDFFF1E3DBFFF0E2D8FFF0E2
D8FFF0E2D8FFF0E2D8FFF0E2D8FFF0E2D8FFC5885DFDFFFFFF00FFFFFF00D9A2
79FFF9F2EDFFEBD0BDFFFFFFFFFFEBD2BFFFFFFFFFFFFFFFFFFFFFFFFFFFEAC5
ACFFFFFFFFFFFFFFFFFFFFFFFFFFF0E2D8FFC68B5EFFFFFFFF00FFFFFF00DDA6
7DFFF9F3EFFF6C6CFCFF6262FAFF6262FAFF5353F7FF4644F4FF3835F1FF2C26
EEFF211AECFF1B11E9FF1B11E9FFF0E2D8FFC6895CFFFFFFFF00FFFFFF00DFA8
81FFF9F3EFFF7476FEFFC3CCFDFFC3CCFDFFC0CAFCFFBAC2FCFFB1B8FBFFA5AA
FBFF9CA0FAFF9398F9FF1B11E9FFF0E2D8FFC88B5EFFFFFFFF00FFFFFF00E1AE
87FFFAF4F0FF7476FEFF7476FEFF7476FEFF6C6CFCFF6262FAFF5353F7FF4644
F4FF3835F1FF2C26EEFF211AECFFF0E2D8FFC48454FFFFFFFF00FFFFFF00E3AF
8BFFFAF5F0FFEAC9AEFFFFFFFFFFEAC8B0FFFFFFFFFFFFFFFFFFFFFFFFFFE8C7
ACFFFFFFFFFFFFFFFFFFFFFFFFFFF1E4DBFFC58555FFFFFFFF00FFFFFF00E5B2
8FFFFAF6F2FFE9C4A9FFE9C4ABFFEAC6ACFFE9C7ADFFE9C8ADFFE9C8AFFFE8C7
ACFFE9C8AFFFE8C7B0FFE8CBB4FFF2E7DEFFC88858FFFFFFFF00FFFFFF00E7B6
93FFFBF6F3FFE9C1A5FFFFFFFFFFE8C2A8FFFFFFFFFFFFFFFFFFFFFFFFFFE8C7
ACFF95AFE3FF235AC1FF0541BBFF1E56BEFF6B6B89FFFFFFFF00FFFFFF00E9B9
97FFFBF6F3FFE9C1A5FFE9C1A5FFE9C1A5FFE9C1A5FFE9C1A5FFE9C1A5FF818C
B5FF2862C8FF2075E6FF0577E9FF0164DDFF064BBCFF0342B77AFFFFFF00EBBC
9BFFFBF6F3FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF1648
AEFF629CF4FF177BFFFF0073F8FF0073EEFF0366E1FF0342B9E4FFFFFF00ECBE
9EFFFBF6F3FF9BD5A3FF97D3A0FF94D09DFF90CE97FF8BCB92FF87C98DFF0541
BBFFAECCFEFFFFFFFFFFFFFFFFFFFFFFFFFF187BEEFF0441BCFEFFFFFF00EEBF
A0EBFBF6F3FFFBF6F3FFFBF6F3FFFBF6F3FFFBF6F3FFFBF6F3FFFBF6F3FF255B
C1FF8CB2F6FF4D91FFFF1174FFFF2184FFFF3F86EBFF0342B9DEFFFFFF00EFC1
A37EEFC0A1E3EDBF9FFFEBBD9DFFEBBB99FFE9B995FFE7B693FFE6B390FF95B0
E3FF3D73D1FF8DB3F7FFB8D5FEFF71A5F5FF2E69CAFF0440BA6DFFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF007590C3FF2359BFFF0541BBFF1D55BFFF758FC1FFFFFFFF00
}
end end
end end
object mnuFormat: TMenuItem object mnuFormat: TMenuItem

120
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -5508,6 +5508,10 @@ procedure TsWorkbook.PrepareBeforeReading;
begin begin
// Clear error log // Clear error log
FLog.Clear; FLog.Clear;
// Abort if virtual mode is active without an event handler
if (boVirtualMode in FOptions) and not Assigned(FOnReadCellData) then
raise Exception.Create('[TsWorkbook.PrepareBeforeReading] Event handler "OnReadCellData" required for virtual mode.');
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -5532,6 +5536,10 @@ begin
if (boCalcBeforeSaving in FOptions) then if (boCalcBeforeSaving in FOptions) then
for sheet in FWorksheets do for sheet in FWorksheets do
sheet.CalcFormulas; sheet.CalcFormulas;
// Abort if virtual mode is active without an event handler
if (boVirtualMode in FOptions) and not Assigned(FOnWriteCellData) then
raise Exception.Create('[TsWorkbook.PrepareBeforeWriting] Event handler "OnWriteCellData" required for virtual mode.');
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -5701,13 +5709,16 @@ var
i: Integer; i: Integer;
sheet: TsWorksheet; sheet: TsWorksheet;
begin begin
if (boVirtualMode in Options) then begin if (boVirtualMode in Options) then
begin
ALastRow := FVirtualRowCount - 1; ALastRow := FVirtualRowCount - 1;
ALastCol := FVirtualColCount - 1; ALastCol := FVirtualColCount - 1;
end else begin end else
begin
ALastRow := 0; ALastRow := 0;
ALastCol := 0; ALastCol := 0;
for i:=0 to GetWorksheetCount-1 do begin for i:=0 to GetWorksheetCount-1 do
begin
sheet := GetWorksheetByIndex(i); sheet := GetWorksheetByIndex(i);
ALastRow := Max(ALastRow, sheet.GetLastRowIndex); ALastRow := Max(ALastRow, sheet.GetLastRowIndex);
ALastCol := Max(ALastCol, sheet.GetLastColIndex); ALastCol := Max(ALastCol, sheet.GetLastColIndex);
@ -5890,10 +5901,12 @@ var
valid: Boolean; valid: Boolean;
begin begin
valid := GetFormatFromFileName(AFileName, SheetType); valid := GetFormatFromFileName(AFileName, SheetType);
if valid then WriteToFile(AFileName, SheetType, AOverwriteExisting) if valid then
else raise Exception.Create(Format( WriteToFile(AFileName, SheetType, AOverwriteExisting)
'[TsWorkbook.WriteToFile] Attempt to save a spreadsheet by extension, ' + else
'but the extension %s is not valid.', [ExtractFileExt(AFileName)])); raise Exception.Create(Format(
'[TsWorkbook.WriteToFile] Attempt to save a spreadsheet by extension, ' +
'but the extension %s is not valid.', [ExtractFileExt(AFileName)]));
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -6137,7 +6150,8 @@ var
i: Integer; i: Integer;
begin begin
RemoveAllFonts; RemoveAllFonts;
for i:=0 to ASource.Count-1 do begin for i:=0 to ASource.Count-1 do
begin
fnt := TsFont(ASource.Items[i]); fnt := TsFont(ASource.Items[i]);
AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color); AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
end; end;
@ -6153,7 +6167,8 @@ procedure TsWorkbook.DeleteFont(AFontIndex: Integer);
var var
fnt: TsFont; fnt: TsFont;
begin begin
if AFontIndex < FFontList.Count then begin if AFontIndex < FFontList.Count then
begin
fnt := TsFont(FFontList.Items[AFontIndex]); fnt := TsFont(FFontList.Items[AFontIndex]);
if fnt <> nil then fnt.Free; if fnt <> nil then fnt.Free;
FFontList.Delete(AFontIndex); FFontList.Delete(AFontIndex);
@ -6175,7 +6190,8 @@ function TsWorkbook.FindFont(const AFontName: String; ASize: Single;
var var
fnt: TsFont; fnt: TsFont;
begin begin
for Result := 0 to FFontList.Count-1 do begin for Result := 0 to FFontList.Count-1 do
begin
fnt := TsFont(FFontList.Items[Result]); fnt := TsFont(FFontList.Items[Result]);
if (fnt <> nil) and if (fnt <> nil) and
SameText(AFontName, fnt.FontName) and SameText(AFontName, fnt.FontName) and
@ -6204,7 +6220,8 @@ var
fntSize: Single; fntSize: Single;
begin begin
// Memorize old default font // Memorize old default font
with TsFont(FFontList.Items[0]) do begin with TsFont(FFontList.Items[0]) do
begin
fntName := FontName; fntName := FontName;
fntSize := Size; fntSize := Size;
end; end;
@ -6232,7 +6249,8 @@ var
i: Integer; i: Integer;
fnt: TsFont; fnt: TsFont;
begin begin
for i:=FFontList.Count-1 downto 0 do begin for i:=FFontList.Count-1 downto 0 do
begin
fnt := TsFont(FFontList.Items[i]); fnt := TsFont(FFontList.Items[i]);
fnt.Free; fnt.Free;
FFontList.Delete(i); FFontList.Delete(i);
@ -6251,13 +6269,13 @@ begin
if FFontList.Count = 0 then if FFontList.Count = 0 then
AddFont(AFontName, ASize, [], scBlack) AddFont(AFontName, ASize, [], scBlack)
else else
for i:=0 to FBuiltinFontCount-1 do begin for i:=0 to FBuiltinFontCount-1 do
if (i <> 4) and (i < FFontList.Count) then if (i <> 4) and (i < FFontList.Count) then
with TsFont(FFontList[i]) do begin with TsFont(FFontList[i]) do
begin
FontName := AFontName; FontName := AFontName;
Size := ASize; Size := ASize;
end; end;
end;
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -6462,10 +6480,12 @@ begin
Result := scNotDefined; Result := scNotDefined;
minDist := 1E108; minDist := 1E108;
n := Min(Length(FPalette), AMaxPaletteCount); n := Min(Length(FPalette), AMaxPaletteCount);
for i:=0 to n-1 do begin for i:=0 to n-1 do
begin
rgb := TRGBA(GetPaletteColor(i)); rgb := TRGBA(GetPaletteColor(i));
dist := sqr(rgb.r - rgb0.r) + sqr(rgb.g - rgb0.g) + sqr(rgb.b - rgb0.b); dist := sqr(rgb.r - rgb0.r) + sqr(rgb.g - rgb0.g) + sqr(rgb.b - rgb0.b);
if dist < minDist then begin if dist < minDist then
begin
Result := i; Result := i;
minDist := dist; minDist := dist;
end; end;
@ -6486,11 +6506,13 @@ var
colorvalue: TsColorValue; colorvalue: TsColorValue;
r,g,b: Byte; r,g,b: Byte;
begin begin
if AColor = scRGBColor then begin if AColor = scRGBColor then
begin
r := ARGBColor.Red div $100; r := ARGBColor.Red div $100;
g := ARGBColor.Green div $100; g := ARGBColor.Green div $100;
b := ARGBColor.Blue div $100; b := ARGBColor.Blue div $100;
end else begin end else
begin
colorvalue := GetPaletteColor(AColor); colorvalue := GetPaletteColor(AColor);
r := TRgba(colorvalue).Red; r := TRgba(colorvalue).Red;
g := TRgba(colorvalue).Green; g := TRgba(colorvalue).Green;
@ -6583,7 +6605,8 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsWorkbook.SetPaletteColor(AColorIndex: TsColor; AColorValue: TsColorValue); procedure TsWorkbook.SetPaletteColor(AColorIndex: TsColor; AColorValue: TsColorValue);
begin begin
if (AColorIndex >= 0) and (AColorIndex < GetPaletteSize) then begin if (AColorIndex >= 0) and (AColorIndex < GetPaletteSize) then
begin
if ((FPalette = nil) or (Length(FPalette) = 0)) then if ((FPalette = nil) or (Length(FPalette) = 0)) then
DEFAULT_PALETTE[AColorIndex] := AColorValue DEFAULT_PALETTE[AColorIndex] := AColorValue
else else
@ -6674,7 +6697,8 @@ var
b: TsCellBorder; b: TsCellBorder;
begin begin
Result := true; Result := true;
for i:=0 to GetWorksheetCount-1 do begin for i:=0 to GetWorksheetCount-1 do
begin
sheet := GetWorksheetByIndex(i); sheet := GetWorksheetByIndex(i);
Node := sheet.Cells.FindLowest; Node := sheet.Cells.FindLowest;
while Assigned(Node) do while Assigned(Node) do
@ -6779,7 +6803,8 @@ end;
function TsCustomNumFormatList.AddFormat(AFormatName, AFormatString: String; function TsCustomNumFormatList.AddFormat(AFormatName, AFormatString: String;
ANumFormat: TsNumberFormat): Integer; ANumFormat: TsNumberFormat): Integer;
begin begin
if (AFormatString = '') and (ANumFormat <> nfGeneral) then begin if (AFormatString = '') and (ANumFormat <> nfGeneral) then
begin
Result := 0; Result := 0;
exit; exit;
end; end;
@ -6900,7 +6925,8 @@ var
i: Integer; i: Integer;
begin begin
i := FindByIndex(AFormatIndex); i := FindByIndex(AFormatIndex);
if i > 0 then begin if i > 0 then
begin
lFormatData := Items[i]; lFormatData := Items[i];
fmt := lFormatData.FormatString; fmt := lFormatData.FormatString;
end else end else
@ -6909,10 +6935,12 @@ begin
// Analyzes the format string and tries to convert it to fpSpreadsheet format. // Analyzes the format string and tries to convert it to fpSpreadsheet format.
parser := TsNumFormatParser.Create(Workbook, fmt); parser := TsNumFormatParser.Create(Workbook, fmt);
try try
if parser.Status = psOK then begin if parser.Status = psOK then
begin
ANumFormat := parser.NumFormat; ANumFormat := parser.NumFormat;
AFormatString := parser.FormatString[nfdDefault]; AFormatString := parser.FormatString[nfdDefault];
end else begin end else
begin
// Show an error here? // Show an error here?
end; end;
finally finally
@ -6970,7 +6998,8 @@ function TsCustomNumFormatList.Find(ANumFormat: TsNumberFormat;
var var
item: TsNumFormatData; item: TsNumFormatData;
begin begin
for Result := Count-1 downto 0 do begin for Result := Count-1 downto 0 do
begin
item := Items[Result]; item := Items[Result];
if (item <> nil) and (item.NumFormat = ANumFormat) and (item.FormatString = AFormatString) if (item <> nil) and (item.NumFormat = ANumFormat) and (item.FormatString = AFormatString)
then exit; then exit;
@ -6991,7 +7020,8 @@ var
begin begin
{ We search backwards to find user-defined items first. They usually are { We search backwards to find user-defined items first. They usually are
more appropriate than built-in items. } more appropriate than built-in items. }
for Result := Count-1 downto 0 do begin for Result := Count-1 downto 0 do
begin
item := Items[Result]; item := Items[Result];
if item.FormatString = AFormatString then if item.FormatString = AFormatString then
exit; exit;
@ -7011,7 +7041,8 @@ function TsCustomNumFormatList.FindByIndex(AFormatIndex: Integer): integer;
var var
item: TsNumFormatData; item: TsNumFormatData;
begin begin
for Result := 0 to Count-1 do begin for Result := 0 to Count-1 do
begin
item := Items[Result]; item := Items[Result];
if item.Index = AFormatIndex then if item.Index = AFormatIndex then
exit; exit;
@ -7033,7 +7064,8 @@ function TsCustomNumFormatList.FindByName(AFormatName: String): integer;
var var
item: TsNumFormatData; item: TsNumFormatData;
begin begin
for Result := 0 to Count-1 do begin for Result := 0 to Count-1 do
begin
item := Items[Result]; item := Items[Result];
if item.Name = AFormatName then if item.Name = AFormatName then
exit; exit;
@ -7071,7 +7103,8 @@ var
nf: TsNumberFormat; nf: TsNumberFormat;
begin begin
item := Items[AIndex]; item := Items[AIndex];
if item <> nil then begin if item <> nil then
begin
Result := item.FormatString; Result := item.FormatString;
nf := item.NumFormat; nf := item.NumFormat;
ConvertBeforeWriting(Result, nf); ConvertBeforeWriting(Result, nf);
@ -7095,7 +7128,8 @@ var
item: TsNumFormatData; item: TsNumFormatData;
begin begin
item := GetItem(AIndex); item := GetItem(AIndex);
if item <> nil then begin if item <> nil then
begin
item.Free; item.Free;
SetItem(AIndex, nil); SetItem(AIndex, nil);
end; end;
@ -7355,7 +7389,8 @@ begin
Result := -1; Result := -1;
n := Length(FFormattingStyles); n := Length(FFormattingStyles);
for i := n - 1 downto 0 do begin for i := n - 1 downto 0 do
begin
if (FFormattingStyles[i].UsedFormattingFields <> AFormat^.UsedFormattingFields) then Continue; if (FFormattingStyles[i].UsedFormattingFields <> AFormat^.UsedFormattingFields) then Continue;
if uffHorAlign in AFormat^.UsedFormattingFields then if uffHorAlign in AFormat^.UsedFormattingFields then
@ -7370,7 +7405,8 @@ begin
if uffBorder in AFormat^.UsedFormattingFields then begin if uffBorder in AFormat^.UsedFormattingFields then begin
if (FFormattingStyles[i].Border <> AFormat^.Border) then Continue; if (FFormattingStyles[i].Border <> AFormat^.Border) then Continue;
equ := true; equ := true;
for b in TsCellBorder do begin for b in TsCellBorder do
begin
if FFormattingStyles[i].BorderStyles[b].LineStyle <> AFormat^.BorderStyles[b].LineStyle if FFormattingStyles[i].BorderStyles[b].LineStyle <> AFormat^.BorderStyles[b].LineStyle
then begin then begin
equ := false; equ := false;
@ -7388,7 +7424,8 @@ begin
if uffBackgroundColor in AFormat^.UsedFormattingFields then if uffBackgroundColor in AFormat^.UsedFormattingFields then
if (FFormattingStyles[i].BackgroundColor <> FixColor(AFormat^.BackgroundColor)) then Continue; if (FFormattingStyles[i].BackgroundColor <> FixColor(AFormat^.BackgroundColor)) then Continue;
if uffNumberFormat in AFormat^.UsedFormattingFields then begin if uffNumberFormat in AFormat^.UsedFormattingFields then
begin
if (FFormattingStyles[i].NumberFormat <> AFormat^.NumberFormat) then Continue; if (FFormattingStyles[i].NumberFormat <> AFormat^.NumberFormat) then Continue;
if (FFormattingStyles[i].NumberFormatStr <> AFormat^.NumberFormatStr) then Continue; if (FFormattingStyles[i].NumberFormatStr <> AFormat^.NumberFormatStr) then Continue;
end; end;
@ -7466,12 +7503,14 @@ end;
procedure TsCustomSpreadWriter.GetSheetDimensions(AWorksheet: TsWorksheet; procedure TsCustomSpreadWriter.GetSheetDimensions(AWorksheet: TsWorksheet;
out AFirstRow, ALastRow, AFirstCol, ALastCol: Cardinal); out AFirstRow, ALastRow, AFirstCol, ALastCol: Cardinal);
begin begin
if (boVirtualMode in AWorksheet.Workbook.Options) then begin if (boVirtualMode in AWorksheet.Workbook.Options) then
begin
AFirstRow := 0; AFirstRow := 0;
AFirstCol := 0; AFirstCol := 0;
ALastRow := AWorksheet.Workbook.VirtualRowCount-1; ALastRow := AWorksheet.Workbook.VirtualRowCount-1;
ALastCol := AWorksheet.Workbook.VirtualColCount-1; ALastCol := AWorksheet.Workbook.VirtualColCount-1;
end else begin end else
begin
Workbook.UpdateCaches; Workbook.UpdateCaches;
AFirstRow := AWorksheet.GetFirstRowIndex; AFirstRow := AWorksheet.GetFirstRowIndex;
AFirstCol := AWorksheet.GetFirstColIndex; AFirstCol := AWorksheet.GetFirstColIndex;
@ -7675,7 +7714,7 @@ var
AVLNode: TAVLTreeNode; AVLNode: TAVLTreeNode;
begin begin
AVLNode := ACells.FindLowest; AVLNode := ACells.FindLowest;
While Assigned(AVLNode) do while Assigned(AVLNode) do
begin begin
ACallback(PCell(AVLNode.Data), AStream); ACallback(PCell(AVLNode.Data), AStream);
AVLNode := ACells.FindSuccessor(AVLNode); AVLNode := ACells.FindSuccessor(AVLNode);
@ -7699,13 +7738,16 @@ var
OutputFile: TStream; OutputFile: TStream;
lMode: Word; lMode: Word;
begin begin
if AOverwriteExisting then lMode := fmCreate or fmOpenWrite if AOverwriteExisting then
else lMode := fmCreate; lMode := fmCreate or fmOpenWrite
else
lMode := fmCreate;
if (boBufStream in Workbook.Options) then if (boBufStream in Workbook.Options) then
OutputFile := TBufStream.Create(AFileName, lMode) OutputFile := TBufStream.Create(AFileName, lMode)
else else
OutputFile := TFileStream.Create(AFileName, lMode); OutputFile := TFileStream.Create(AFileName, lMode);
try try
WriteToStream(OutputFile); WriteToStream(OutputFile);
finally finally