fpspreadsheet: Simplify fpsgrid demo (only new/load/save functionality). More complex version of the demo is available now as demo program "spready". Add "WriteCellAvalueAsString" to TsWorksheet which guesses from the passed string whether it is a number, percentage, date, or time.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3213 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-06-22 13:49:48 +00:00
parent cb7a21cf9d
commit 979d97ffd0
10 changed files with 4655 additions and 4078 deletions

View File

@ -48,9 +48,6 @@
</Win32> </Win32>
</Options> </Options>
</Linking> </Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions> </CompilerOptions>
</Item2> </Item2>
<Item3 Name="Release"> <Item3 Name="Release">
@ -82,9 +79,6 @@
</Win32> </Win32>
</Options> </Options>
</Linking> </Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions> </CompilerOptions>
</Item3> </Item3>
</BuildModes> </BuildModes>
@ -143,9 +137,6 @@
</Win32> </Win32>
</Options> </Options>
</Linking> </Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions> </CompilerOptions>
<Debugging> <Debugging>
<Exceptions Count="5"> <Exceptions Count="5">

File diff suppressed because it is too large Load Diff

View File

@ -6,250 +6,30 @@ interface
uses uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, Menus, ExtCtrls, ComCtrls, ActnList, Spin, Grids, StdCtrls, Menus, ExtCtrls, ComCtrls, ActnList, Spin, Grids, ColorBox, Buttons,
ColorBox, fpspreadsheetgrid, fpspreadsheet, fpsallformats; ButtonPanel, fpspreadsheetgrid, fpspreadsheet, fpsallformats;
type type
{ TForm1 } { TForm1 }
TForm1 = class(TForm) TForm1 = class(TForm)
AcOpen: TAction; BtnOpen: TButton;
AcSaveAs: TAction; BtnSave: TButton;
AcQuit: TAction; BtnNew: TButton;
AcEdit: TAction; SheetsCombo: TComboBox;
AcLeftAlign: TAction;
AcHorCenterAlign: TAction;
AcRightAlign: TAction;
AcHorDefaultAlign: TAction;
AcFontBold: TAction;
AcFontItalic: TAction;
AcFontStrikeout: TAction;
AcFontUnderline: TAction;
AcFont: TAction;
AcBorderTop: TAction;
AcBorderBottom: TAction;
AcBorderBottomDbl: TAction;
AcBorderBottomMedium: TAction;
AcBorderLeft: TAction;
AcBorderRight: TAction;
AcBorderNone: TAction;
AcBorderHCenter: TAction;
AcBorderVCenter: TAction;
AcBorderTopBottom: TAction;
AcBorderTopBottomThick: TAction;
AcBorderInner: TAction;
AcBorderAll: TAction;
AcBorderOuter: TAction;
AcBorderOuterMedium: TAction;
AcTextHoriz: TAction;
AcTextVertCW: TAction;
AcTextVertCCW: TAction;
AcTextStacked: TAction;
AcNFFixed: TAction;
AcNFFixedTh: TAction;
AcNFPercentage: TAction;
AcIncDecimals: TAction;
AcDecDecimals: TAction;
AcNFGeneral: TAction;
AcNFExp: TAction;
AcNFSci: TAction;
AcCopyFormat: TAction;
AcNFCurrency: TAction;
AcNFCurrencyRed: TAction;
AcNFAccounting: TAction;
AcNFAccountingRed: TAction;
AcNFShortDateTime: TAction;
AcNFShortDate: TAction;
AcNFLongDate: TAction;
AcNFShortTime: TAction;
AcNFLongTime: TAction;
AcNFShortTimeAM: TAction;
AcNFLongTimeAM: TAction;
AcNFTimeInterval: TAction;
AcNFFmtDateTimeDM: TAction;
AcNFFmtDateTimeMY: TAction;
AcNFFmtDateTimeMS: TAction;
AcNFFmtDateTimeMSZ: TAction;
AcNew: TAction;
AcWordwrap: TAction;
AcVAlignDefault: TAction;
AcVAlignTop: TAction;
AcVAlignCenter: TAction;
AcVAlignBottom: TAction;
ActionList: TActionList;
CbShowHeaders: TCheckBox;
CbShowGridLines: TCheckBox;
CbBackgroundColor: TColorBox;
CbReadFormulas: TCheckBox;
CbHeaderStyle: TComboBox;
EdFormula: TEdit;
EdCellAddress: TEdit;
FontComboBox: TComboBox;
EdFrozenRows: TSpinEdit;
FontDialog: TFontDialog;
FontSizeComboBox: TComboBox;
ImageList: TImageList;
Label1: TLabel; Label1: TLabel;
Label2: TLabel;
MainMenu: TMainMenu;
MenuItem1: TMenuItem;
MenuItem10: TMenuItem;
MenuItem11: TMenuItem;
MenuItem12: TMenuItem;
MenuItem13: TMenuItem;
MenuItem14: TMenuItem;
MenuItem15: TMenuItem;
MenuItem16: TMenuItem;
MenuItem17: TMenuItem;
MenuItem18: TMenuItem;
MenuItem19: TMenuItem;
MenuItem2: TMenuItem;
MenuItem20: TMenuItem;
MenuItem21: TMenuItem;
MenuItem22: TMenuItem;
MenuItem23: TMenuItem;
MenuItem24: TMenuItem;
MenuItem25: TMenuItem;
MenuItem26: TMenuItem;
MenuItem27: TMenuItem;
MenuItem28: TMenuItem;
MenuItem29: TMenuItem;
MenuItem30: TMenuItem;
MenuItem31: TMenuItem;
MenuItem32: TMenuItem;
MenuItem33: TMenuItem;
MenuItem34: TMenuItem;
MenuItem35: TMenuItem;
MenuItem36: TMenuItem;
MenuItem37: TMenuItem;
MenuItem38: TMenuItem;
MenuItem39: TMenuItem;
MenuItem40: TMenuItem;
MenuItem41: TMenuItem;
MenuItem42: TMenuItem;
MenuItem43: TMenuItem;
MenuItem44: TMenuItem;
MenuItem45: TMenuItem;
MenuItem46: TMenuItem;
MnuFmtDateTimeMSZ: TMenuItem;
MnuTimeInterval: TMenuItem;
MnuShortTimeAM: TMenuItem;
MnuLongTimeAM: TMenuItem;
MnuFmtDateTimeMY: TMenuItem;
MnuFmtDateTimeDM: TMenuItem;
MnuShortTime: TMenuItem;
MnuShortDate: TMenuItem;
MnuLongTime: TMenuItem;
MnuLongDate: TMenuItem;
MnuShortDateTime: TMenuItem;
MnuAccountingRed: TMenuItem;
MnuAccounting: TMenuItem;
MnuCurrencyRed: TMenuItem;
MnuCurrency: TMenuItem;
MnuNumberFormat: TMenuItem;
MnuNFFixed: TMenuItem;
MnuNFFixedTh: TMenuItem;
MnuNFPercentage: TMenuItem;
MnuNFExp: TMenuItem;
MnuNFSci: TMenuItem;
MnuNFGeneral: TMenuItem;
MnuTextRotation: TMenuItem;
MenuItem3: TMenuItem;
MenuItem4: TMenuItem;
MenuItem5: TMenuItem;
MenuItem6: TMenuItem;
MenuItem7: TMenuItem;
MenuItem8: TMenuItem;
MenuItem9: TMenuItem;
MnuWordwrap: TMenuItem;
MnuVertBottom: TMenuItem;
MnuVertCentered: TMenuItem;
MnuVertTop: TMenuItem;
MnuVertDefault: TMenuItem;
MnuVertAlignment: TMenuItem;
MnuFOnt: TMenuItem;
MnuHorDefault: TMenuItem;
MnuHorAlignment: TMenuItem;
mnuFormat: TMenuItem;
mnuEdit: TMenuItem;
mnuFile: TMenuItem;
mnuOpen: TMenuItem;
mnuQuit: TMenuItem;
mnuSaveAs: TMenuItem;
OpenDialog: TOpenDialog; OpenDialog: TOpenDialog;
PageControl1: TPageControl;
Panel1: TPanel; Panel1: TPanel;
BordersPopupMenu: TPopupMenu; Panel2: TPanel;
NumFormatPopupMenu: TPopupMenu;
SaveDialog: TSaveDialog; SaveDialog: TSaveDialog;
EdFrozenCols: TSpinEdit;
FormulaToolBar: TToolBar;
FormulaToolbarSplitter: TSplitter;
ToolButton22: TToolButton;
WorksheetGrid: TsWorksheetGrid; WorksheetGrid: TsWorksheetGrid;
TabSheet1: TTabSheet; procedure BtnNewClick(Sender: TObject);
ToolBar1: TToolBar; procedure BtnOpenClick(Sender: TObject);
FormatToolBar: TToolBar; procedure BtnSaveClick(Sender: TObject);
ToolButton1: TToolButton; procedure SheetsComboSelect(Sender: TObject);
ToolButton10: TToolButton;
ToolButton11: TToolButton;
ToolButton12: TToolButton;
ToolButton13: TToolButton;
ToolButton14: TToolButton;
ToolButton15: TToolButton;
ToolButton16: TToolButton;
ToolButton17: TToolButton;
ToolButton18: TToolButton;
ToolButton19: TToolButton;
ToolButton2: TToolButton;
TbBorders: TToolButton;
TbNumFormats: TToolButton;
ToolButton20: TToolButton;
ToolButton21: TToolButton;
ToolButton24: TToolButton;
ToolButton25: TToolButton;
ToolButton26: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
ToolButton9: TToolButton;
procedure AcBorderExecute(Sender: TObject);
procedure AcCopyFormatExecute(Sender: TObject);
procedure AcEditExecute(Sender: TObject);
procedure AcFontExecute(Sender: TObject);
procedure AcFontStyleExecute(Sender: TObject);
procedure AcHorAlignmentExecute(Sender: TObject);
procedure AcIncDecDecimalsExecute(Sender: TObject);
procedure AcNewExecute(Sender: TObject);
procedure AcNumFormatExecute(Sender: TObject);
procedure AcOpenExecute(Sender: TObject);
procedure AcQuitExecute(Sender: TObject);
procedure AcSaveAsExecute(Sender: TObject);
procedure AcTextRotationExecute(Sender: TObject);
procedure AcVertAlignmentExecute(Sender: TObject);
procedure AcWordwrapExecute(Sender: TObject);
procedure CbBackgroundColorSelect(Sender: TObject);
procedure CbHeaderStyleChange(Sender: TObject);
procedure CbReadFormulasChange(Sender: TObject);
procedure CbShowHeadersClick(Sender: TObject);
procedure CbShowGridLinesClick(Sender: TObject);
procedure CbBackgroundColorGetColors(Sender: TCustomColorBox; Items: TStrings);
procedure EdCellAddressEditingDone(Sender: TObject);
procedure EdFrozenColsChange(Sender: TObject);
procedure EdFrozenRowsChange(Sender: TObject);
procedure FontComboBoxSelect(Sender: TObject);
procedure FontSizeComboBoxSelect(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure PageControl1Change(Sender: TObject);
procedure WorksheetGridSelection(Sender: TObject; aCol, aRow: Integer);
private private
{ private declarations } { private declarations }
FCopiedFormat: TCell;
procedure LoadFile(const AFileName: String); procedure LoadFile(const AFileName: String);
procedure SetupBackgroundColorBox; procedure SetupBackgroundColorBox;
procedure UpdateBackgroundColorIndex; procedure UpdateBackgroundColorIndex;
@ -271,340 +51,75 @@ var
implementation implementation
uses uses
fpcanvas, fpsutils, fpsnumformatparser; fpcanvas, fpsutils;
const
HORALIGN_TAG = 100;
VERTALIGN_TAG = 110;
TEXTROT_TAG = 130;
NUMFMT_TAG = 1000; // differnce 10 per format item
LEFT_BORDER_THIN = $0001;
LEFT_BORDER_THICK = $0002;
LR_INNER_BORDER_THIN = $0008;
RIGHT_BORDER_THIN = $0010;
RIGHT_BORDER_THICK = $0020;
TOP_BORDER_THIN = $0100;
TOP_BORDER_THICK = $0200;
TB_INNER_BORDER_THIN = $0800;
BOTTOM_BORDER_THIN = $1000;
BOTTOM_BORDER_THICK = $2000;
BOTTOM_BORDER_DOUBLE = $3000;
LEFT_BORDER_MASK = $0007;
RIGHT_BORDER_MASK = $0070;
TOP_BORDER_MASK = $0700;
BOTTOM_BORDER_MASK = $7000;
LR_INNER_BORDER = $0008;
TB_INNER_BORDER = $0800;
// Use a combination of these bits for the "Tag" of the Border actions - see FormCreate.
{ TForm1 } { TForm1 }
procedure TForm1.AcEditExecute(Sender: TObject); procedure TForm1.BtnNewClick(Sender: TObject);
begin
if AcEdit.Checked then
WorksheetGrid.Options := WorksheetGrid.Options + [goEditing]
else
WorksheetGrid.Options := WorksheetGrid.Options - [goEditing];
end;
procedure TForm1.AcBorderExecute(Sender: TObject);
const
LINESTYLES: Array[1..3] of TsLinestyle = (lsThin, lsMedium, lsDouble);
var var
r,c: Integer; dlg: TForm;
ls: integer; edCols, edRows: TSpinEdit;
bs: TsCellBorderStyle; x: Integer;
begin begin
bs.Color := scBlack; dlg := TForm.Create(nil);
try
with WorksheetGrid do begin dlg.Width := 220;
TbBorders.Action := TAction(Sender); dlg.Height := 128;
dlg.Position := poMainFormCenter;
BeginUpdate; dlg.Caption := 'New workbook';
try edCols := TSpinEdit.Create(dlg);
if TAction(Sender).Tag = 0 then begin with edCols do begin
CellBorders[Selection] := []; Parent := dlg;
exit; Left := dlg.ClientWidth - Width - 24;
end; Top := 16;
// Top and bottom edges Value := WorksheetGrid.ColCount - ord(WorksheetGrid.DisplayFixedColRow);
for c := Selection.Left to Selection.Right do begin
ls := (TAction(Sender).Tag and TOP_BORDER_MASK) shr 8;
if (ls <> 0) then begin
CellBorder[c, Selection.Top] := CellBorder[c, Selection.Top] + [cbNorth];
bs.LineStyle := LINESTYLES[ls];
CellBorderStyle[c, Selection.Top, cbNorth] := bs;
end;
ls := (TAction(Sender).Tag and BOTTOM_BORDER_MASK) shr 12;
if ls <> 0 then begin
CellBorder[c, Selection.Bottom] := CellBorder[c, Selection.Bottom] + [cbSouth];
bs.LineStyle := LINESTYLES[ls];
CellBorderStyle[c, Selection.Bottom, cbSouth] := bs;
end;
end;
// Left and right edges
for r := Selection.Top to Selection.Bottom do begin
ls := (TAction(Sender).Tag and LEFT_BORDER_MASK);
if ls <> 0 then begin
CellBorder[Selection.Left, r] := CellBorder[Selection.Left, r] + [cbWest];
bs.LineStyle := LINESTYLES[ls];
CellBorderStyle[Selection.Left, r, cbWest] := bs;
end;
ls := (TAction(Sender).Tag and RIGHT_BORDER_MASK) shr 4;
if ls <> 0 then begin
CellBorder[Selection.Right, r] := CellBorder[Selection.Right, r] + [cbEast];
bs.LineStyle := LINESTYLES[ls];
CellBorderStyle[Selection.Right, r, cbEast] := bs;
end;
end;
// Inner edges along row (vertical border lines) - we assume only thin lines.
bs.LineStyle := lsThin;
if (TAction(Sender).Tag and LR_INNER_BORDER <> 0) and (Selection.Right > Selection.Left)
then
for r := Selection.Top to Selection.Bottom do begin
CellBorder[Selection.Left, r] := CellBorder[Selection.Left, r] + [cbEast];
CellBorderStyle[Selection.Left, r, cbEast] := bs;
for c := Selection.Left+1 to Selection.Right-1 do begin
CellBorder[c,r] := CellBorder[c, r] + [cbEast, cbWest];
CellBorderStyle[c, r, cbEast] := bs;
CellBorderStyle[c, r, cbWest] := bs;
end;
CellBorder[Selection.Right, r] := CellBorder[Selection.Right, r] + [cbWest];
CellBorderStyle[Selection.Right, r, cbWest] := bs;
end;
// Inner edges along column (horizontal border lines)
if (TAction(Sender).Tag and TB_INNER_BORDER <> 0) and (Selection.Bottom > Selection.Top)
then
for c := Selection.Left to Selection.Right do begin
CellBorder[c, Selection.Top] := CellBorder[c, Selection.Top] + [cbSouth];
CellBorderStyle[c, Selection.Top, cbSouth] := bs;
for r := Selection.Top+1 to Selection.Bottom-1 do begin
CellBorder[c, r] := CellBorder[c, r] + [cbNorth, cbSouth];
CellBorderStyle[c, r, cbNorth] := bs;
CellBorderStyle[c, r, cbSouth] := bs;
end;
CellBorder[c, Selection.Bottom] := CellBorder[c, Selection.Bottom] + [cbNorth];
CellBorderStyle[c, Selection.Bottom, cbNorth] := bs;
end;
finally
EndUpdate;
end; end;
end; with TLabel.Create(dlg) do begin
end; Parent := dlg;
Left := 24;
procedure TForm1.AcCopyFormatExecute(Sender: TObject); Top := edCols.Top + 3;
var Caption := 'Columns:';
cell: PCell; FocusControl := edCols;
r, c: Cardinal;
begin
with WorksheetGrid do begin
if Workbook = nil then
exit;
if AcCopyFormat.Checked then begin
r := GetWorksheetRow(Row);
c := GetWorksheetCol(Col);
cell := Worksheet.FindCell(r, c);
if cell <> nil then
FCopiedFormat := cell^;
end; end;
end; edRows := TSpinEdit.Create(dlg);
end; with edRows do begin
Parent := dlg;
{ Changes the font of the selected cell by calling a standard font dialog. } Left := edCols.Left;
procedure TForm1.AcFontExecute(Sender: TObject); Top := edCols.Top + edCols.Height + 8;
begin Value := WorksheetGrid.RowCount - ord(WorksheetGrid.DisplayFixedColRow);
with WorksheetGrid do begin
if Workbook = nil then
exit;
FontDialog.Font := CellFonts[Selection];
if FontDialog.Execute then
CellFonts[Selection] := FontDialog.Font;
end;
end;
procedure TForm1.AcFontStyleExecute(Sender: TObject);
var
style: TsFontstyles;
begin
with WorksheetGrid do begin
if Workbook = nil then
exit;
style := [];
if AcFontBold.Checked then Include(style, fssBold);
if AcFontItalic.Checked then Include(style, fssItalic);
if AcFontStrikeout.Checked then Include(style, fssStrikeout);
if AcFontUnderline.Checked then Include(style, fssUnderline);
CellFontStyles[Selection] := style;
end;
end;
procedure TForm1.AcHorAlignmentExecute(Sender: TObject);
var
hor_align: TsHorAlignment;
begin
if TAction(Sender).Checked then
hor_align := TsHorAlignment(TAction(Sender).Tag - HORALIGN_TAG)
else
hor_align := haDefault;
with WorksheetGrid do HorAlignments[Selection] := hor_align;
UpdateHorAlignmentActions;
end;
procedure TForm1.AcIncDecDecimalsExecute(Sender: TObject);
var
cell: PCell;
decs: Byte;
currsym: String;
begin
currsym := Sender.ClassName;
with WorksheetGrid do begin
if Workbook = nil then
exit;
cell := Worksheet.FindCell(GetWorksheetRow(Row), GetWorksheetCol(Col));
if (cell <> nil) then begin
if cell^.NumberFormat = nfGeneral then begin
Worksheet.WriteNumberFormat(cell, nfFixed, '0.00');
exit;
end;
Worksheet.GetNumberFormatAttributes(cell, decs, currSym);
if (Sender = AcIncDecimals) then
Worksheet.WriteDecimals(cell, decs+1)
else
if (Sender = AcDecDecimals) and (decs > 0) then
Worksheet.WriteDecimals(cell, decs-1);
end; end;
end; with TLabel.Create(dlg) do begin
end; Parent := dlg;
Left := 24;
procedure TForm1.AcNewExecute(Sender: TObject); Top := edRows.Top + 3;
begin Caption := 'Rows:';
WorksheetGrid.NewWorksheet(26, 100); FocusControl := edRows;
end;
procedure TForm1.AcNumFormatExecute(Sender: TObject);
const
DATETIME_CUSTOM: array[0..4] of string = ('', 'dd/mmm', 'mmm/yy', 'nn:ss', 'nn:ss.zzz');
var
nf: TsNumberFormat;
c, r: Cardinal;
cell: PCell;
fmt: String;
decs: Byte;
cs: String;
isDateTimeFmt: Boolean;
begin
if TAction(Sender).Checked then
nf := TsNumberFormat((TAction(Sender).Tag - NUMFMT_TAG) div 10)
else
nf := nfGeneral;
fmt := '';
isDateTimeFmt := IsDateTimeFormat(nf);
if nf = nfCustom then begin
fmt := DATETIME_CUSTOM[TAction(Sender).Tag mod 10];
isDateTimeFmt := true;
end;
with WorksheetGrid do begin
c := GetWorksheetCol(Col);
r := GetWorksheetRow(Row);
cell := Worksheet.GetCell(r, c);
Worksheet.GetNumberFormatAttributes(cell, decs, cs);
if cs = '' then cs := '?';
case cell^.ContentType of
cctNumber, cctDateTime:
if isDateTimeFmt then begin
if IsDateTimeFormat(cell^.NumberFormat) then
Worksheet.WriteDateTime(cell, cell^.DateTimeValue, nf, fmt)
else
Worksheet.WriteDateTime(cell, cell^.NumberValue, nf, fmt);
end else
if IsCurrencyFormat(nf) then begin
if IsDateTimeFormat(cell^.NumberFormat) then
Worksheet.WriteCurrency(cell, cell^.DateTimeValue, nf, decs, cs)
else
Worksheet.WriteCurrency(cell, cell^.Numbervalue, nf, decs, cs);
end else begin
if IsDateTimeFormat(cell^.NumberFormat) then
Worksheet.WriteNumber(cell, cell^.DateTimeValue, nf, decs)
else
Worksheet.WriteNumber(cell, cell^.NumberValue, nf, decs)
end;
else
Worksheet.WriteNumberformat(cell, nf, fmt);
end; end;
with TButtonPanel.Create(dlg) do begin
Parent := dlg;
Align := alBottom;
ShowButtons := [pbCancel, pbOK];
end;
if dlg.ShowModal = mrOK then begin
WorksheetGrid.NewWorksheet(edCols.Value, edRows.Value);
SheetsCombo.Items.Clear;
SheetsCombo.Items.Add('Sheet 1');
SheetsCombo.ItemIndex := 0;
end;
finally
dlg.Free;
end; end;
UpdateNumFormatActions;
end; end;
procedure TForm1.AcTextRotationExecute(Sender: TObject); procedure TForm1.BtnOpenClick(Sender: TObject);
var
text_rot: TsTextRotation;
begin
if TAction(Sender).Checked then
text_rot := TsTextRotation(TAction(Sender).Tag - TEXTROT_TAG)
else
text_rot := trHorizontal;
with WorksheetGrid do TextRotations[Selection] := text_rot;
UpdateTextRotationActions;
end;
procedure TForm1.AcVertAlignmentExecute(Sender: TObject);
var
vert_align: TsVertAlignment;
begin
if TAction(Sender).Checked then
vert_align := TsVertAlignment(TAction(Sender).Tag - VERTALIGN_TAG)
else
vert_align := vaDefault;
with WorksheetGrid do VertAlignments[Selection] := vert_align;
UpdateVertAlignmentActions;
end;
procedure TForm1.AcWordwrapExecute(Sender: TObject);
begin
with WorksheetGrid do Wordwraps[Selection] := TAction(Sender).Checked;
end;
procedure TForm1.CbBackgroundColorSelect(Sender: TObject);
begin
with WorksheetGrid do BackgroundColors[Selection] := CbBackgroundColor.ItemIndex;
end;
procedure TForm1.CbHeaderStyleChange(Sender: TObject);
begin
WorksheetGrid.TitleStyle := TTitleStyle(CbHeaderStyle.ItemIndex);
end;
procedure TForm1.CbReadFormulasChange(Sender: TObject);
begin
WorksheetGrid.ReadFormulas := CbReadFormulas.Checked;
end;
procedure TForm1.CbShowHeadersClick(Sender: TObject);
begin
WorksheetGrid.ShowHeaders := CbShowHeaders.Checked;
end;
procedure TForm1.CbShowGridLinesClick(Sender: TObject);
begin
WorksheetGrid.ShowGridLines := CbShowGridLines.Checked;
end;
procedure TForm1.acOpenExecute(Sender: TObject);
begin begin
if OpenDialog.Execute then if OpenDialog.Execute then
LoadFile(OpenDialog.FileName); LoadFile(OpenDialog.FileName);
end; end;
procedure TForm1.acQuitExecute(Sender: TObject);
begin
Close;
end;
procedure TForm1.acSaveAsExecute(Sender: TObject);
// Saves sheet in grid to file, overwriting existing file // Saves sheet in grid to file, overwriting existing file
procedure TForm1.BtnSaveClick(Sender: TObject);
begin begin
if WorksheetGrid.Workbook = nil then if WorksheetGrid.Workbook = nil then
exit; exit;
@ -620,99 +135,14 @@ begin
end; end;
end; end;
procedure TForm1.CbBackgroundColorGetColors(Sender: TCustomColorBox; Items: TStrings); procedure TForm1.SheetsComboSelect(Sender: TObject);
type
TRGB = packed record R,G,B: byte end;
var
clr: TColor;
rgb: TRGB absolute clr;
i: Integer;
begin begin
if WorksheetGrid.Workbook <> nil then begin WorksheetGrid.SelectSheetByIndex(SheetsCombo.ItemIndex);
Items.Clear;
for i:=0 to WorksheetGrid.Workbook.GetPaletteSize-1 do begin
clr := WorksheetGrid.Workbook.GetPaletteColor(i);
Items.AddObject(Format('Color %d: %.2x%.2x%.2x', [i, rgb.R, rgb.G, rgb.B]),
TObject(PtrInt(clr)));
end;
end;
end; end;
procedure TForm1.EdCellAddressEditingDone(Sender: TObject);
var
c, r: integer;
begin
if ParseCellString(EdCellAddress.Text, r, c) then begin
WorksheetGrid.Row := WorksheetGrid.GetGridRow(r);
WorksheetGrid.Col := WorksheetGrid.GetGridCol(c);
end;
end;
procedure TForm1.EdFrozenColsChange(Sender: TObject);
begin
WorksheetGrid.FrozenCols := EdFrozenCols.Value;
end;
procedure TForm1.EdFrozenRowsChange(Sender: TObject);
begin
WorksheetGrid.FrozenRows := EdFrozenRows.Value;
end;
procedure TForm1.FontComboBoxSelect(Sender: TObject);
var
fname: String;
begin
fname := FontCombobox.Items[FontCombobox.ItemIndex];
if fname <> '' then
with WorksheetGrid do CellFontNames[Selection] := fName;
end;
procedure TForm1.FontSizeComboBoxSelect(Sender: TObject);
var
sz: Integer;
begin
sz := StrToInt(FontSizeCombobox.Items[FontSizeCombobox.ItemIndex]);
if sz > 0 then
with WorksheetGrid do CellFontSizes[Selection] := sz;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
if ParamCount > 0 then
LoadFile(ParamStr(1));
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// Adjust format toolbar height, looks strange at 120 dpi
FormatToolbar.Height := FontCombobox.Height + 2*FontCombobox.Top;
FormatToolbar.ButtonHeight := FormatToolbar.Height - 4;
// Populate font combobox
FontCombobox.Items.Assign(Screen.Fonts);
// Set the Tags of the Border actions
AcBorderNone.Tag := 0;
AcBorderLeft.Tag := LEFT_BORDER_THIN;
AcBorderHCenter.Tag := LR_INNER_BORDER_THIN;
AcBorderRight.Tag := RIGHT_BORDER_THIN;
AcBorderTop.Tag := TOP_BORDER_THIN;
AcBorderVCenter.Tag := TB_INNER_BORDER_THIN;
AcBorderBottom.Tag := BOTTOM_BORDER_THIN;
AcBorderBottomDbl.Tag := BOTTOM_BORDER_DOUBLE;
AcBorderBottomMedium.Tag := BOTTOM_BORDER_THICK;
AcBorderTopBottom.Tag := TOP_BORDER_THIN + BOTTOM_BORDER_THIN;
AcBorderTopBottomThick.Tag := TOP_BORDER_THIN + BOTTOM_BORDER_THICK;
AcBorderInner.Tag := LR_INNER_BORDER_THIN + TB_INNER_BORDER_THIN;
AcBorderOuter.Tag := LEFT_BORDER_THIN + RIGHT_BORDER_THIN + TOP_BORDER_THIN + BOTTOM_BORDER_THIN;
AcBorderOuterMedium.Tag := LEFT_BORDER_THICK + RIGHT_BORDER_THICK + TOP_BORDER_THICK + BOTTOM_BORDER_THICK;
AcBorderAll.Tag := AcBorderOuter.Tag + AcBorderInner.Tag;
end;
procedure TForm1.LoadFile(const AFileName: String);
// Loads first worksheet from file into grid // Loads first worksheet from file into grid
procedure TForm1.LoadFile(const AFileName: String);
var var
pages: TStrings;
i: Integer; i: Integer;
begin begin
// Load file // Load file
@ -725,215 +155,65 @@ begin
AFilename, AFilename,
GetFileFormatName(WorksheetGrid.Workbook.FileFormat) GetFileFormatName(WorksheetGrid.Workbook.FileFormat)
]); ]);
CbShowGridLines.Checked := (soShowGridLines in WorksheetGrid.Worksheet.Options);
CbShowHeaders.Checked := (soShowHeaders in WorksheetGrid.Worksheet.Options);
EdFrozenCols.Value := WorksheetGrid.FrozenCols;
EdFrozenRows.Value := WorksheetGrid.FrozenRows;
SetupBackgroundColorBox;
// Create a tab in the pagecontrol for each worksheet contained in the workbook // Collect the sheet names in the combobox for switching sheets.
// This would be easier with a TTabControl. This has display issues, though. WorksheetGrid.GetSheets(SheetsCombo.Items);
pages := TStringList.Create; SheetsCombo.ItemIndex := 0;
try
WorksheetGrid.GetSheets(pages);
WorksheetGrid.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;
WorksheetGridSelection(nil, WorksheetGrid.Col, WorksheetGrid.Row); // WorksheetGridSelection(nil, WorksheetGrid.Col, WorksheetGrid.Row);
finally finally
Screen.Cursor := crDefault; Screen.Cursor := crDefault;
end; end;
end; end;
procedure TForm1.PageControl1Change(Sender: TObject);
begin
WorksheetGrid.Parent := PageControl1.Pages[PageControl1.ActivePageIndex];
WorksheetGrid.SelectSheetByIndex(PageControl1.ActivePageIndex);
end;
procedure TForm1.SetupBackgroundColorBox; procedure TForm1.SetupBackgroundColorBox;
begin begin
// This change triggers re-reading of the workbooks palette by the OnGetColors
// event of the ColorBox.
CbBackgroundColor.Style := CbBackgroundColor.Style - [cbCustomColors];
CbBackgroundColor.Style := CbBackgroundColor.Style + [cbCustomColors];
end;
procedure TForm1.WorksheetGridSelection(Sender: TObject; aCol, aRow: Integer);
var
r, c: Cardinal;
cell: PCell;
s: String;
begin
if WorksheetGrid.Workbook = nil then
exit;
r := WorksheetGrid.GetWorksheetRow(ARow);
c := WorksheetGrid.GetWorksheetCol(ACol);
if AcCopyFormat.Checked then begin
WorksheetGrid.Worksheet.CopyFormat(@FCopiedFormat, r, c);
AcCopyFormat.Checked := false;
end;
cell := WorksheetGrid.Worksheet.FindCell(r, c);
if cell <> nil then begin
s := WorksheetGrid.Worksheet.ReadFormulaAsString(cell);
if s <> '' then
EdFormula.Text := s
else
EdFormula.Text := WorksheetGrid.Worksheet.ReadAsUTF8Text(cell);
end else
EdFormula.Text := '';
EdCellAddress.Text := GetCellString(r, c, [rfRelRow, rfRelCol]);
UpdateHorAlignmentActions;
UpdateVertAlignmentActions;
UpdateWordwraps;
UpdateBackgroundColorIndex;
// UpdateFontActions;
UpdateFontNameIndex;
UpdateFontSizeIndex;
UpdateFontStyleActions;
UpdateTextRotationActions;
UpdateNumFormatActions;
end; end;
procedure TForm1.UpdateBackgroundColorIndex; procedure TForm1.UpdateBackgroundColorIndex;
var
sClr: TsColor;
begin begin
with WorksheetGrid do sClr := BackgroundColors[Selection];
if sClr = scNotDefined then
CbBackgroundColor.ItemIndex := -1
else
CbBackgroundColor.ItemIndex := sClr;
end;
procedure TForm1.UpdateHorAlignmentActions;
var
i: Integer;
ac: TAction;
hor_align: TsHorAlignment;
begin
with WorksheetGrid do hor_align := HorAlignments[Selection];
for i:=0 to ActionList.ActionCount-1 do begin
ac := TAction(ActionList.Actions[i]);
if (ac.Tag >= HORALIGN_TAG) and (ac.Tag < HORALIGN_TAG+10) then
ac.Checked := ((ac.Tag - HORALIGN_TAG) = ord(hor_align));
end;
end; end;
procedure TForm1.UpdateFontNameIndex; procedure TForm1.UpdateFontNameIndex;
var
fname: String;
begin begin
with WorksheetGrid do fname := CellFontNames[Selection];
if fname = '' then
FontCombobox.ItemIndex := -1
else
FontCombobox.ItemIndex := FontCombobox.Items.IndexOf(fname);
end; end;
procedure TForm1.UpdateFontSizeIndex; procedure TForm1.UpdateFontSizeIndex;
var
sz: Single;
begin begin
with WorksheetGrid do sz := CellFontSizes[Selection];
if sz < 0 then
FontSizeCombobox.ItemIndex := -1
else
FontSizeCombobox.ItemIndex := FontSizeCombobox.Items.IndexOf(IntToStr(Round(sz)));
end; end;
procedure TForm1.UpdateFontStyleActions; procedure TForm1.UpdateFontStyleActions;
var
style: TsFontStyles;
begin begin
with WorksheetGrid do style := CellFontStyles[Selection];
AcFontBold.Checked := fssBold in style; end;
AcFontItalic.Checked := fssItalic in style;
AcFontUnderline.Checked := fssUnderline in style; procedure TForm1.UpdateHorAlignmentActions;
AcFontStrikeout.Checked := fssStrikeOut in style; begin
end; end;
procedure TForm1.UpdateNumFormatActions; procedure TForm1.UpdateNumFormatActions;
var
i: Integer;
ac: TAction;
nf: TsNumberFormat;
cell: PCell;
r,c: Cardinal;
found: Boolean;
begin begin
with WorksheetGrid do begin
r := GetWorksheetRow(Row);
c := GetWorksheetCol(Col);
cell := Worksheet.FindCell(r, c);
if (cell = nil) or not (cell^.ContentType in [cctNumber, cctDateTime]) then
nf := nfGeneral
else
nf := cell^.NumberFormat;
for i:=0 to ActionList.ActionCount-1 do begin
ac := TAction(ActionList.Actions[i]);
if (ac.Tag >= NUMFMT_TAG) and (ac.Tag < NUMFMT_TAG + 200) then begin
found := ((ac.Tag - NUMFMT_TAG) div 10 = ord(nf));
if nf = nfCustom then
case (ac.Tag - NUMFMT_TAG) mod 10 of
1: found := cell^.NumberFormatStr = 'dd/mmm';
2: found := cell^.NumberFormatStr = 'mmm/yy';
3: found := cell^.NumberFormatStr = 'nn:ss';
4: found := cell^.NumberFormatStr = 'nn:ss.z';
end;
ac.Checked := found;
end;
end;
Invalidate;
end;
end; end;
procedure TForm1.UpdateTextRotationActions; procedure TForm1.UpdateTextRotationActions;
var
i: Integer;
ac: TAction;
text_rot: TsTextRotation;
begin begin
with WorksheetGrid do text_rot := TextRotations[Selection];
for i:=0 to ActionList.ActionCount-1 do begin
ac := TAction(ActionList.Actions[i]);
if (ac.Tag >= TEXTROT_TAG) and (ac.Tag < TEXTROT_TAG+10) then
ac.Checked := ((ac.Tag - TEXTROT_TAG) = ord(text_rot));
end;
end; end;
procedure TForm1.UpdateVertAlignmentActions; procedure TForm1.UpdateVertAlignmentActions;
var
i: Integer;
ac: TAction;
vert_align: TsVertAlignment;
begin begin
with WorksheetGrid do vert_align := VertAlignments[Selection];
for i:=0 to ActionList.ActionCount-1 do begin
ac := TAction(ActionList.Actions[i]);
if (ac.Tag >= VERTALIGN_TAG) and (ac.Tag < VERTALIGN_TAG+10) then
ac.Checked := ((ac.Tag - VERTALIGN_TAG) = ord(vert_align));
end;
end; end;
procedure TForm1.UpdateWordwraps; procedure TForm1.UpdateWordwraps;
var
wrapped: Boolean;
begin begin
with WorksheetGrid do wrapped := Wordwraps[Selection];
AcWordwrap.Checked := wrapped;
end; end;
initialization initialization

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,943 @@
unit mainform;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, Menus, ExtCtrls, ComCtrls, ActnList, Spin, Grids,
ColorBox, fpspreadsheetgrid, fpspreadsheet, fpsallformats;
type
{ TForm1 }
TForm1 = class(TForm)
AcOpen: TAction;
AcSaveAs: TAction;
AcQuit: TAction;
AcEdit: TAction;
AcLeftAlign: TAction;
AcHorCenterAlign: TAction;
AcRightAlign: TAction;
AcHorDefaultAlign: TAction;
AcFontBold: TAction;
AcFontItalic: TAction;
AcFontStrikeout: TAction;
AcFontUnderline: TAction;
AcFont: TAction;
AcBorderTop: TAction;
AcBorderBottom: TAction;
AcBorderBottomDbl: TAction;
AcBorderBottomMedium: TAction;
AcBorderLeft: TAction;
AcBorderRight: TAction;
AcBorderNone: TAction;
AcBorderHCenter: TAction;
AcBorderVCenter: TAction;
AcBorderTopBottom: TAction;
AcBorderTopBottomThick: TAction;
AcBorderInner: TAction;
AcBorderAll: TAction;
AcBorderOuter: TAction;
AcBorderOuterMedium: TAction;
AcTextHoriz: TAction;
AcTextVertCW: TAction;
AcTextVertCCW: TAction;
AcTextStacked: TAction;
AcNFFixed: TAction;
AcNFFixedTh: TAction;
AcNFPercentage: TAction;
AcIncDecimals: TAction;
AcDecDecimals: TAction;
AcNFGeneral: TAction;
AcNFExp: TAction;
AcNFSci: TAction;
AcCopyFormat: TAction;
AcNFCurrency: TAction;
AcNFCurrencyRed: TAction;
AcNFAccounting: TAction;
AcNFAccountingRed: TAction;
AcNFShortDateTime: TAction;
AcNFShortDate: TAction;
AcNFLongDate: TAction;
AcNFShortTime: TAction;
AcNFLongTime: TAction;
AcNFShortTimeAM: TAction;
AcNFLongTimeAM: TAction;
AcNFTimeInterval: TAction;
AcNFFmtDateTimeDM: TAction;
AcNFFmtDateTimeMY: TAction;
AcNFFmtDateTimeMS: TAction;
AcNFFmtDateTimeMSZ: TAction;
AcNew: TAction;
AcWordwrap: TAction;
AcVAlignDefault: TAction;
AcVAlignTop: TAction;
AcVAlignCenter: TAction;
AcVAlignBottom: TAction;
ActionList: TActionList;
CbShowHeaders: TCheckBox;
CbShowGridLines: TCheckBox;
CbBackgroundColor: TColorBox;
CbReadFormulas: TCheckBox;
CbHeaderStyle: TComboBox;
EdFormula: TEdit;
EdCellAddress: TEdit;
FontComboBox: TComboBox;
EdFrozenRows: TSpinEdit;
FontDialog: TFontDialog;
FontSizeComboBox: TComboBox;
ImageList: TImageList;
Label1: TLabel;
Label2: TLabel;
MainMenu: TMainMenu;
MenuItem1: TMenuItem;
MenuItem10: TMenuItem;
MenuItem11: TMenuItem;
MenuItem12: TMenuItem;
MenuItem13: TMenuItem;
MenuItem14: TMenuItem;
MenuItem15: TMenuItem;
MenuItem16: TMenuItem;
MenuItem17: TMenuItem;
MenuItem18: TMenuItem;
MenuItem19: TMenuItem;
MenuItem2: TMenuItem;
MenuItem20: TMenuItem;
MenuItem21: TMenuItem;
MenuItem22: TMenuItem;
MenuItem23: TMenuItem;
MenuItem24: TMenuItem;
MenuItem25: TMenuItem;
MenuItem26: TMenuItem;
MenuItem27: TMenuItem;
MenuItem28: TMenuItem;
MenuItem29: TMenuItem;
MenuItem30: TMenuItem;
MenuItem31: TMenuItem;
MenuItem32: TMenuItem;
MenuItem33: TMenuItem;
MenuItem34: TMenuItem;
MenuItem35: TMenuItem;
MenuItem36: TMenuItem;
MenuItem37: TMenuItem;
MenuItem38: TMenuItem;
MenuItem39: TMenuItem;
MenuItem40: TMenuItem;
MenuItem41: TMenuItem;
MenuItem42: TMenuItem;
MenuItem43: TMenuItem;
MenuItem44: TMenuItem;
MenuItem45: TMenuItem;
MenuItem46: TMenuItem;
MnuFmtDateTimeMSZ: TMenuItem;
MnuTimeInterval: TMenuItem;
MnuShortTimeAM: TMenuItem;
MnuLongTimeAM: TMenuItem;
MnuFmtDateTimeMY: TMenuItem;
MnuFmtDateTimeDM: TMenuItem;
MnuShortTime: TMenuItem;
MnuShortDate: TMenuItem;
MnuLongTime: TMenuItem;
MnuLongDate: TMenuItem;
MnuShortDateTime: TMenuItem;
MnuAccountingRed: TMenuItem;
MnuAccounting: TMenuItem;
MnuCurrencyRed: TMenuItem;
MnuCurrency: TMenuItem;
MnuNumberFormat: TMenuItem;
MnuNFFixed: TMenuItem;
MnuNFFixedTh: TMenuItem;
MnuNFPercentage: TMenuItem;
MnuNFExp: TMenuItem;
MnuNFSci: TMenuItem;
MnuNFGeneral: TMenuItem;
MnuTextRotation: TMenuItem;
MenuItem3: TMenuItem;
MenuItem4: TMenuItem;
MenuItem5: TMenuItem;
MenuItem6: TMenuItem;
MenuItem7: TMenuItem;
MenuItem8: TMenuItem;
MenuItem9: TMenuItem;
MnuWordwrap: TMenuItem;
MnuVertBottom: TMenuItem;
MnuVertCentered: TMenuItem;
MnuVertTop: TMenuItem;
MnuVertDefault: TMenuItem;
MnuVertAlignment: TMenuItem;
MnuFOnt: TMenuItem;
MnuHorDefault: TMenuItem;
MnuHorAlignment: TMenuItem;
mnuFormat: TMenuItem;
mnuEdit: TMenuItem;
mnuFile: TMenuItem;
mnuOpen: TMenuItem;
mnuQuit: TMenuItem;
mnuSaveAs: TMenuItem;
OpenDialog: TOpenDialog;
PageControl1: TPageControl;
Panel1: TPanel;
BordersPopupMenu: TPopupMenu;
NumFormatPopupMenu: TPopupMenu;
SaveDialog: TSaveDialog;
EdFrozenCols: TSpinEdit;
FormulaToolBar: TToolBar;
FormulaToolbarSplitter: TSplitter;
ToolButton22: TToolButton;
WorksheetGrid: TsWorksheetGrid;
TabSheet1: TTabSheet;
ToolBar1: TToolBar;
FormatToolBar: TToolBar;
ToolButton1: TToolButton;
ToolButton10: TToolButton;
ToolButton11: TToolButton;
ToolButton12: TToolButton;
ToolButton13: TToolButton;
ToolButton14: TToolButton;
ToolButton15: TToolButton;
ToolButton16: TToolButton;
ToolButton17: TToolButton;
ToolButton18: TToolButton;
ToolButton19: TToolButton;
ToolButton2: TToolButton;
TbBorders: TToolButton;
TbNumFormats: TToolButton;
ToolButton20: TToolButton;
ToolButton21: TToolButton;
ToolButton24: TToolButton;
ToolButton25: TToolButton;
ToolButton26: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
ToolButton9: TToolButton;
procedure AcBorderExecute(Sender: TObject);
procedure AcCopyFormatExecute(Sender: TObject);
procedure AcEditExecute(Sender: TObject);
procedure AcFontExecute(Sender: TObject);
procedure AcFontStyleExecute(Sender: TObject);
procedure AcHorAlignmentExecute(Sender: TObject);
procedure AcIncDecDecimalsExecute(Sender: TObject);
procedure AcNewExecute(Sender: TObject);
procedure AcNumFormatExecute(Sender: TObject);
procedure AcOpenExecute(Sender: TObject);
procedure AcQuitExecute(Sender: TObject);
procedure AcSaveAsExecute(Sender: TObject);
procedure AcTextRotationExecute(Sender: TObject);
procedure AcVertAlignmentExecute(Sender: TObject);
procedure AcWordwrapExecute(Sender: TObject);
procedure CbBackgroundColorSelect(Sender: TObject);
procedure CbHeaderStyleChange(Sender: TObject);
procedure CbReadFormulasChange(Sender: TObject);
procedure CbShowHeadersClick(Sender: TObject);
procedure CbShowGridLinesClick(Sender: TObject);
procedure CbBackgroundColorGetColors(Sender: TCustomColorBox; Items: TStrings);
procedure EdCellAddressEditingDone(Sender: TObject);
procedure EdFrozenColsChange(Sender: TObject);
procedure EdFrozenRowsChange(Sender: TObject);
procedure FontComboBoxSelect(Sender: TObject);
procedure FontSizeComboBoxSelect(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure PageControl1Change(Sender: TObject);
procedure WorksheetGridSelection(Sender: TObject; aCol, aRow: Integer);
private
{ private declarations }
FCopiedFormat: TCell;
procedure LoadFile(const AFileName: String);
procedure SetupBackgroundColorBox;
procedure UpdateBackgroundColorIndex;
procedure UpdateFontNameIndex;
procedure UpdateFontSizeIndex;
procedure UpdateFontStyleActions;
procedure UpdateHorAlignmentActions;
procedure UpdateNumFormatActions;
procedure UpdateTextRotationActions;
procedure UpdateVertAlignmentActions;
procedure UpdateWordwraps;
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
uses
fpcanvas, fpsutils, fpsnumformatparser;
const
HORALIGN_TAG = 100;
VERTALIGN_TAG = 110;
TEXTROT_TAG = 130;
NUMFMT_TAG = 1000; // differnce 10 per format item
LEFT_BORDER_THIN = $0001;
LEFT_BORDER_THICK = $0002;
LR_INNER_BORDER_THIN = $0008;
RIGHT_BORDER_THIN = $0010;
RIGHT_BORDER_THICK = $0020;
TOP_BORDER_THIN = $0100;
TOP_BORDER_THICK = $0200;
TB_INNER_BORDER_THIN = $0800;
BOTTOM_BORDER_THIN = $1000;
BOTTOM_BORDER_THICK = $2000;
BOTTOM_BORDER_DOUBLE = $3000;
LEFT_BORDER_MASK = $0007;
RIGHT_BORDER_MASK = $0070;
TOP_BORDER_MASK = $0700;
BOTTOM_BORDER_MASK = $7000;
LR_INNER_BORDER = $0008;
TB_INNER_BORDER = $0800;
// Use a combination of these bits for the "Tag" of the Border actions - see FormCreate.
{ TForm1 }
procedure TForm1.AcEditExecute(Sender: TObject);
begin
if AcEdit.Checked then
WorksheetGrid.Options := WorksheetGrid.Options + [goEditing]
else
WorksheetGrid.Options := WorksheetGrid.Options - [goEditing];
end;
procedure TForm1.AcBorderExecute(Sender: TObject);
const
LINESTYLES: Array[1..3] of TsLinestyle = (lsThin, lsMedium, lsDouble);
var
r,c: Integer;
ls: integer;
bs: TsCellBorderStyle;
begin
bs.Color := scBlack;
with WorksheetGrid do begin
TbBorders.Action := TAction(Sender);
BeginUpdate;
try
if TAction(Sender).Tag = 0 then begin
CellBorders[Selection] := [];
exit;
end;
// Top and bottom edges
for c := Selection.Left to Selection.Right do begin
ls := (TAction(Sender).Tag and TOP_BORDER_MASK) shr 8;
if (ls <> 0) then begin
CellBorder[c, Selection.Top] := CellBorder[c, Selection.Top] + [cbNorth];
bs.LineStyle := LINESTYLES[ls];
CellBorderStyle[c, Selection.Top, cbNorth] := bs;
end;
ls := (TAction(Sender).Tag and BOTTOM_BORDER_MASK) shr 12;
if ls <> 0 then begin
CellBorder[c, Selection.Bottom] := CellBorder[c, Selection.Bottom] + [cbSouth];
bs.LineStyle := LINESTYLES[ls];
CellBorderStyle[c, Selection.Bottom, cbSouth] := bs;
end;
end;
// Left and right edges
for r := Selection.Top to Selection.Bottom do begin
ls := (TAction(Sender).Tag and LEFT_BORDER_MASK);
if ls <> 0 then begin
CellBorder[Selection.Left, r] := CellBorder[Selection.Left, r] + [cbWest];
bs.LineStyle := LINESTYLES[ls];
CellBorderStyle[Selection.Left, r, cbWest] := bs;
end;
ls := (TAction(Sender).Tag and RIGHT_BORDER_MASK) shr 4;
if ls <> 0 then begin
CellBorder[Selection.Right, r] := CellBorder[Selection.Right, r] + [cbEast];
bs.LineStyle := LINESTYLES[ls];
CellBorderStyle[Selection.Right, r, cbEast] := bs;
end;
end;
// Inner edges along row (vertical border lines) - we assume only thin lines.
bs.LineStyle := lsThin;
if (TAction(Sender).Tag and LR_INNER_BORDER <> 0) and (Selection.Right > Selection.Left)
then
for r := Selection.Top to Selection.Bottom do begin
CellBorder[Selection.Left, r] := CellBorder[Selection.Left, r] + [cbEast];
CellBorderStyle[Selection.Left, r, cbEast] := bs;
for c := Selection.Left+1 to Selection.Right-1 do begin
CellBorder[c,r] := CellBorder[c, r] + [cbEast, cbWest];
CellBorderStyle[c, r, cbEast] := bs;
CellBorderStyle[c, r, cbWest] := bs;
end;
CellBorder[Selection.Right, r] := CellBorder[Selection.Right, r] + [cbWest];
CellBorderStyle[Selection.Right, r, cbWest] := bs;
end;
// Inner edges along column (horizontal border lines)
if (TAction(Sender).Tag and TB_INNER_BORDER <> 0) and (Selection.Bottom > Selection.Top)
then
for c := Selection.Left to Selection.Right do begin
CellBorder[c, Selection.Top] := CellBorder[c, Selection.Top] + [cbSouth];
CellBorderStyle[c, Selection.Top, cbSouth] := bs;
for r := Selection.Top+1 to Selection.Bottom-1 do begin
CellBorder[c, r] := CellBorder[c, r] + [cbNorth, cbSouth];
CellBorderStyle[c, r, cbNorth] := bs;
CellBorderStyle[c, r, cbSouth] := bs;
end;
CellBorder[c, Selection.Bottom] := CellBorder[c, Selection.Bottom] + [cbNorth];
CellBorderStyle[c, Selection.Bottom, cbNorth] := bs;
end;
finally
EndUpdate;
end;
end;
end;
procedure TForm1.AcCopyFormatExecute(Sender: TObject);
var
cell: PCell;
r, c: Cardinal;
begin
with WorksheetGrid do begin
if Workbook = nil then
exit;
if AcCopyFormat.Checked then begin
r := GetWorksheetRow(Row);
c := GetWorksheetCol(Col);
cell := Worksheet.FindCell(r, c);
if cell <> nil then
FCopiedFormat := cell^;
end;
end;
end;
{ Changes the font of the selected cell by calling a standard font dialog. }
procedure TForm1.AcFontExecute(Sender: TObject);
begin
with WorksheetGrid do begin
if Workbook = nil then
exit;
FontDialog.Font := CellFonts[Selection];
if FontDialog.Execute then
CellFonts[Selection] := FontDialog.Font;
end;
end;
procedure TForm1.AcFontStyleExecute(Sender: TObject);
var
style: TsFontstyles;
begin
with WorksheetGrid do begin
if Workbook = nil then
exit;
style := [];
if AcFontBold.Checked then Include(style, fssBold);
if AcFontItalic.Checked then Include(style, fssItalic);
if AcFontStrikeout.Checked then Include(style, fssStrikeout);
if AcFontUnderline.Checked then Include(style, fssUnderline);
CellFontStyles[Selection] := style;
end;
end;
procedure TForm1.AcHorAlignmentExecute(Sender: TObject);
var
hor_align: TsHorAlignment;
begin
if TAction(Sender).Checked then
hor_align := TsHorAlignment(TAction(Sender).Tag - HORALIGN_TAG)
else
hor_align := haDefault;
with WorksheetGrid do HorAlignments[Selection] := hor_align;
UpdateHorAlignmentActions;
end;
procedure TForm1.AcIncDecDecimalsExecute(Sender: TObject);
var
cell: PCell;
decs: Byte;
currsym: String;
begin
currsym := Sender.ClassName;
with WorksheetGrid do begin
if Workbook = nil then
exit;
cell := Worksheet.FindCell(GetWorksheetRow(Row), GetWorksheetCol(Col));
if (cell <> nil) then begin
if cell^.NumberFormat = nfGeneral then begin
Worksheet.WriteNumberFormat(cell, nfFixed, '0.00');
exit;
end;
Worksheet.GetNumberFormatAttributes(cell, decs, currSym);
if (Sender = AcIncDecimals) then
Worksheet.WriteDecimals(cell, decs+1)
else
if (Sender = AcDecDecimals) and (decs > 0) then
Worksheet.WriteDecimals(cell, decs-1);
end;
end;
end;
procedure TForm1.AcNewExecute(Sender: TObject);
begin
WorksheetGrid.NewWorksheet(26, 100);
end;
procedure TForm1.AcNumFormatExecute(Sender: TObject);
const
DATETIME_CUSTOM: array[0..4] of string = ('', 'dd/mmm', 'mmm/yy', 'nn:ss', 'nn:ss.zzz');
var
nf: TsNumberFormat;
c, r: Cardinal;
cell: PCell;
fmt: String;
decs: Byte;
cs: String;
isDateTimeFmt: Boolean;
begin
if TAction(Sender).Checked then
nf := TsNumberFormat((TAction(Sender).Tag - NUMFMT_TAG) div 10)
else
nf := nfGeneral;
fmt := '';
isDateTimeFmt := IsDateTimeFormat(nf);
if nf = nfCustom then begin
fmt := DATETIME_CUSTOM[TAction(Sender).Tag mod 10];
isDateTimeFmt := true;
end;
with WorksheetGrid do begin
c := GetWorksheetCol(Col);
r := GetWorksheetRow(Row);
cell := Worksheet.GetCell(r, c);
Worksheet.GetNumberFormatAttributes(cell, decs, cs);
if cs = '' then cs := '?';
case cell^.ContentType of
cctNumber, cctDateTime:
if isDateTimeFmt then begin
if IsDateTimeFormat(cell^.NumberFormat) then
Worksheet.WriteDateTime(cell, cell^.DateTimeValue, nf, fmt)
else
Worksheet.WriteDateTime(cell, cell^.NumberValue, nf, fmt);
end else
if IsCurrencyFormat(nf) then begin
if IsDateTimeFormat(cell^.NumberFormat) then
Worksheet.WriteCurrency(cell, cell^.DateTimeValue, nf, decs, cs)
else
Worksheet.WriteCurrency(cell, cell^.Numbervalue, nf, decs, cs);
end else begin
if IsDateTimeFormat(cell^.NumberFormat) then
Worksheet.WriteNumber(cell, cell^.DateTimeValue, nf, decs)
else
Worksheet.WriteNumber(cell, cell^.NumberValue, nf, decs)
end;
else
Worksheet.WriteNumberformat(cell, nf, fmt);
end;
end;
UpdateNumFormatActions;
end;
procedure TForm1.AcTextRotationExecute(Sender: TObject);
var
text_rot: TsTextRotation;
begin
if TAction(Sender).Checked then
text_rot := TsTextRotation(TAction(Sender).Tag - TEXTROT_TAG)
else
text_rot := trHorizontal;
with WorksheetGrid do TextRotations[Selection] := text_rot;
UpdateTextRotationActions;
end;
procedure TForm1.AcVertAlignmentExecute(Sender: TObject);
var
vert_align: TsVertAlignment;
begin
if TAction(Sender).Checked then
vert_align := TsVertAlignment(TAction(Sender).Tag - VERTALIGN_TAG)
else
vert_align := vaDefault;
with WorksheetGrid do VertAlignments[Selection] := vert_align;
UpdateVertAlignmentActions;
end;
procedure TForm1.AcWordwrapExecute(Sender: TObject);
begin
with WorksheetGrid do Wordwraps[Selection] := TAction(Sender).Checked;
end;
procedure TForm1.CbBackgroundColorSelect(Sender: TObject);
begin
with WorksheetGrid do BackgroundColors[Selection] := CbBackgroundColor.ItemIndex;
end;
procedure TForm1.CbHeaderStyleChange(Sender: TObject);
begin
WorksheetGrid.TitleStyle := TTitleStyle(CbHeaderStyle.ItemIndex);
end;
procedure TForm1.CbReadFormulasChange(Sender: TObject);
begin
WorksheetGrid.ReadFormulas := CbReadFormulas.Checked;
end;
procedure TForm1.CbShowHeadersClick(Sender: TObject);
begin
WorksheetGrid.ShowHeaders := CbShowHeaders.Checked;
end;
procedure TForm1.CbShowGridLinesClick(Sender: TObject);
begin
WorksheetGrid.ShowGridLines := CbShowGridLines.Checked;
end;
procedure TForm1.acOpenExecute(Sender: TObject);
begin
if OpenDialog.Execute then
LoadFile(OpenDialog.FileName);
end;
procedure TForm1.acQuitExecute(Sender: TObject);
begin
Close;
end;
procedure TForm1.acSaveAsExecute(Sender: TObject);
// Saves sheet in grid to file, overwriting existing file
begin
if WorksheetGrid.Workbook = nil then
exit;
if SaveDialog.Execute then
begin
Screen.Cursor := crHourglass;
try
WorksheetGrid.SaveToSpreadsheetFile(SaveDialog.FileName);
finally
Screen.Cursor := crDefault;
end;
end;
end;
procedure TForm1.CbBackgroundColorGetColors(Sender: TCustomColorBox; Items: TStrings);
type
TRGB = packed record R,G,B: byte end;
var
clr: TColor;
rgb: TRGB absolute clr;
i: Integer;
begin
if WorksheetGrid.Workbook <> nil then begin
Items.Clear;
for i:=0 to WorksheetGrid.Workbook.GetPaletteSize-1 do begin
clr := WorksheetGrid.Workbook.GetPaletteColor(i);
Items.AddObject(Format('Color %d: %.2x%.2x%.2x', [i, rgb.R, rgb.G, rgb.B]),
TObject(PtrInt(clr)));
end;
end;
end;
procedure TForm1.EdCellAddressEditingDone(Sender: TObject);
var
c, r: integer;
begin
if ParseCellString(EdCellAddress.Text, r, c) then begin
WorksheetGrid.Row := WorksheetGrid.GetGridRow(r);
WorksheetGrid.Col := WorksheetGrid.GetGridCol(c);
end;
end;
procedure TForm1.EdFrozenColsChange(Sender: TObject);
begin
WorksheetGrid.FrozenCols := EdFrozenCols.Value;
end;
procedure TForm1.EdFrozenRowsChange(Sender: TObject);
begin
WorksheetGrid.FrozenRows := EdFrozenRows.Value;
end;
procedure TForm1.FontComboBoxSelect(Sender: TObject);
var
fname: String;
begin
fname := FontCombobox.Items[FontCombobox.ItemIndex];
if fname <> '' then
with WorksheetGrid do CellFontNames[Selection] := fName;
end;
procedure TForm1.FontSizeComboBoxSelect(Sender: TObject);
var
sz: Integer;
begin
sz := StrToInt(FontSizeCombobox.Items[FontSizeCombobox.ItemIndex]);
if sz > 0 then
with WorksheetGrid do CellFontSizes[Selection] := sz;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
if ParamCount > 0 then
LoadFile(ParamStr(1));
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// Adjust format toolbar height, looks strange at 120 dpi
FormatToolbar.Height := FontCombobox.Height + 2*FontCombobox.Top;
FormatToolbar.ButtonHeight := FormatToolbar.Height - 4;
// Populate font combobox
FontCombobox.Items.Assign(Screen.Fonts);
// Set the Tags of the Border actions
AcBorderNone.Tag := 0;
AcBorderLeft.Tag := LEFT_BORDER_THIN;
AcBorderHCenter.Tag := LR_INNER_BORDER_THIN;
AcBorderRight.Tag := RIGHT_BORDER_THIN;
AcBorderTop.Tag := TOP_BORDER_THIN;
AcBorderVCenter.Tag := TB_INNER_BORDER_THIN;
AcBorderBottom.Tag := BOTTOM_BORDER_THIN;
AcBorderBottomDbl.Tag := BOTTOM_BORDER_DOUBLE;
AcBorderBottomMedium.Tag := BOTTOM_BORDER_THICK;
AcBorderTopBottom.Tag := TOP_BORDER_THIN + BOTTOM_BORDER_THIN;
AcBorderTopBottomThick.Tag := TOP_BORDER_THIN + BOTTOM_BORDER_THICK;
AcBorderInner.Tag := LR_INNER_BORDER_THIN + TB_INNER_BORDER_THIN;
AcBorderOuter.Tag := LEFT_BORDER_THIN + RIGHT_BORDER_THIN + TOP_BORDER_THIN + BOTTOM_BORDER_THIN;
AcBorderOuterMedium.Tag := LEFT_BORDER_THICK + RIGHT_BORDER_THICK + TOP_BORDER_THICK + BOTTOM_BORDER_THICK;
AcBorderAll.Tag := AcBorderOuter.Tag + AcBorderInner.Tag;
end;
procedure TForm1.LoadFile(const AFileName: String);
// Loads first worksheet from file into grid
var
pages: TStrings;
i: Integer;
begin
// Load file
Screen.Cursor := crHourglass;
try
WorksheetGrid.LoadFromSpreadsheetFile(UTF8ToSys(AFileName));
// Update user interface
Caption := Format('spready - %s (%s)', [
AFilename,
GetFileFormatName(WorksheetGrid.Workbook.FileFormat)
]);
CbShowGridLines.Checked := (soShowGridLines in WorksheetGrid.Worksheet.Options);
CbShowHeaders.Checked := (soShowHeaders in WorksheetGrid.Worksheet.Options);
EdFrozenCols.Value := WorksheetGrid.FrozenCols;
EdFrozenRows.Value := WorksheetGrid.FrozenRows;
SetupBackgroundColorBox;
// Create a tab in the pagecontrol for each worksheet contained in the workbook
// This would be easier with a TTabControl. This has display issues, though.
pages := TStringList.Create;
try
WorksheetGrid.GetSheets(pages);
WorksheetGrid.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;
WorksheetGridSelection(nil, WorksheetGrid.Col, WorksheetGrid.Row);
finally
Screen.Cursor := crDefault;
end;
end;
procedure TForm1.PageControl1Change(Sender: TObject);
begin
WorksheetGrid.Parent := PageControl1.Pages[PageControl1.ActivePageIndex];
WorksheetGrid.SelectSheetByIndex(PageControl1.ActivePageIndex);
end;
procedure TForm1.SetupBackgroundColorBox;
begin
// This change triggers re-reading of the workbooks palette by the OnGetColors
// event of the ColorBox.
CbBackgroundColor.Style := CbBackgroundColor.Style - [cbCustomColors];
CbBackgroundColor.Style := CbBackgroundColor.Style + [cbCustomColors];
end;
procedure TForm1.WorksheetGridSelection(Sender: TObject; aCol, aRow: Integer);
var
r, c: Cardinal;
cell: PCell;
s: String;
begin
if WorksheetGrid.Workbook = nil then
exit;
r := WorksheetGrid.GetWorksheetRow(ARow);
c := WorksheetGrid.GetWorksheetCol(ACol);
if AcCopyFormat.Checked then begin
WorksheetGrid.Worksheet.CopyFormat(@FCopiedFormat, r, c);
AcCopyFormat.Checked := false;
end;
cell := WorksheetGrid.Worksheet.FindCell(r, c);
if cell <> nil then begin
s := WorksheetGrid.Worksheet.ReadFormulaAsString(cell);
if s <> '' then
EdFormula.Text := s
else
EdFormula.Text := WorksheetGrid.Worksheet.ReadAsUTF8Text(cell);
end else
EdFormula.Text := '';
EdCellAddress.Text := GetCellString(r, c, [rfRelRow, rfRelCol]);
UpdateHorAlignmentActions;
UpdateVertAlignmentActions;
UpdateWordwraps;
UpdateBackgroundColorIndex;
// UpdateFontActions;
UpdateFontNameIndex;
UpdateFontSizeIndex;
UpdateFontStyleActions;
UpdateTextRotationActions;
UpdateNumFormatActions;
end;
procedure TForm1.UpdateBackgroundColorIndex;
var
sClr: TsColor;
begin
with WorksheetGrid do sClr := BackgroundColors[Selection];
if sClr = scNotDefined then
CbBackgroundColor.ItemIndex := -1
else
CbBackgroundColor.ItemIndex := sClr;
end;
procedure TForm1.UpdateHorAlignmentActions;
var
i: Integer;
ac: TAction;
hor_align: TsHorAlignment;
begin
with WorksheetGrid do hor_align := HorAlignments[Selection];
for i:=0 to ActionList.ActionCount-1 do begin
ac := TAction(ActionList.Actions[i]);
if (ac.Tag >= HORALIGN_TAG) and (ac.Tag < HORALIGN_TAG+10) then
ac.Checked := ((ac.Tag - HORALIGN_TAG) = ord(hor_align));
end;
end;
procedure TForm1.UpdateFontNameIndex;
var
fname: String;
begin
with WorksheetGrid do fname := CellFontNames[Selection];
if fname = '' then
FontCombobox.ItemIndex := -1
else
FontCombobox.ItemIndex := FontCombobox.Items.IndexOf(fname);
end;
procedure TForm1.UpdateFontSizeIndex;
var
sz: Single;
begin
with WorksheetGrid do sz := CellFontSizes[Selection];
if sz < 0 then
FontSizeCombobox.ItemIndex := -1
else
FontSizeCombobox.ItemIndex := FontSizeCombobox.Items.IndexOf(IntToStr(Round(sz)));
end;
procedure TForm1.UpdateFontStyleActions;
var
style: TsFontStyles;
begin
with WorksheetGrid do style := CellFontStyles[Selection];
AcFontBold.Checked := fssBold in style;
AcFontItalic.Checked := fssItalic in style;
AcFontUnderline.Checked := fssUnderline in style;
AcFontStrikeout.Checked := fssStrikeOut in style;
end;
procedure TForm1.UpdateNumFormatActions;
var
i: Integer;
ac: TAction;
nf: TsNumberFormat;
cell: PCell;
r,c: Cardinal;
found: Boolean;
begin
with WorksheetGrid do begin
r := GetWorksheetRow(Row);
c := GetWorksheetCol(Col);
cell := Worksheet.FindCell(r, c);
if (cell = nil) or not (cell^.ContentType in [cctNumber, cctDateTime]) then
nf := nfGeneral
else
nf := cell^.NumberFormat;
for i:=0 to ActionList.ActionCount-1 do begin
ac := TAction(ActionList.Actions[i]);
if (ac.Tag >= NUMFMT_TAG) and (ac.Tag < NUMFMT_TAG + 200) then begin
found := ((ac.Tag - NUMFMT_TAG) div 10 = ord(nf));
if nf = nfCustom then
case (ac.Tag - NUMFMT_TAG) mod 10 of
1: found := cell^.NumberFormatStr = 'dd/mmm';
2: found := cell^.NumberFormatStr = 'mmm/yy';
3: found := cell^.NumberFormatStr = 'nn:ss';
4: found := cell^.NumberFormatStr = 'nn:ss.z';
end;
ac.Checked := found;
end;
end;
Invalidate;
end;
end;
procedure TForm1.UpdateTextRotationActions;
var
i: Integer;
ac: TAction;
text_rot: TsTextRotation;
begin
with WorksheetGrid do text_rot := TextRotations[Selection];
for i:=0 to ActionList.ActionCount-1 do begin
ac := TAction(ActionList.Actions[i]);
if (ac.Tag >= TEXTROT_TAG) and (ac.Tag < TEXTROT_TAG+10) then
ac.Checked := ((ac.Tag - TEXTROT_TAG) = ord(text_rot));
end;
end;
procedure TForm1.UpdateVertAlignmentActions;
var
i: Integer;
ac: TAction;
vert_align: TsVertAlignment;
begin
with WorksheetGrid do vert_align := VertAlignments[Selection];
for i:=0 to ActionList.ActionCount-1 do begin
ac := TAction(ActionList.Actions[i]);
if (ac.Tag >= VERTALIGN_TAG) and (ac.Tag < VERTALIGN_TAG+10) then
ac.Checked := ((ac.Tag - VERTALIGN_TAG) = ord(vert_align));
end;
end;
procedure TForm1.UpdateWordwraps;
var
wrapped: Boolean;
begin
with WorksheetGrid do wrapped := Wordwraps[Selection];
AcWordwrap.Checked := wrapped;
end;
initialization
{$I mainform.lrs}
end.

Binary file not shown.

After

Width:  |  Height:  |  Size: 134 KiB

View File

@ -0,0 +1,159 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="spready"/>
<UseXPManifest Value="True"/>
</General>
<VersionInfo>
<Language Value=""/>
<CharSet Value=""/>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="3">
<Item1 Name="default" Default="True"/>
<Item2 Name="Debug">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<IOChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsStabs"/>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
</Item2>
<Item3 Name="Release">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
</Item3>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="laz_fpspreadsheet_visual"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="spready.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="mainform.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="mainform"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Debugging>
<DebugInfoType Value="dsStabs"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="5">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
<Item4>
<Name Value="Exception"/>
</Item4>
<Item5>
<Name Value="EStreamError"/>
</Item5>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,16 @@
program spready;
{$mode objfpc}{$H+}
uses
Interfaces, // this includes the LCL widgetset
Forms, mainform, laz_fpspreadsheet_visual;
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

View File

@ -511,6 +511,9 @@ type
procedure WriteBlank(ARow, ACol: Cardinal); procedure WriteBlank(ARow, ACol: Cardinal);
procedure WriteBoolValue(ARow, ACol: Cardinal; AValue: Boolean); procedure WriteBoolValue(ARow, ACol: Cardinal; AValue: Boolean);
procedure WriteCellValueAsString(ARow, ACol: Cardinal; AValue: String); overload;
procedure WriteCellValueAsString(ACell: PCell; AValue: String); overload;
procedure WriteCurrency(ARow, ACol: Cardinal; AValue: Double; procedure WriteCurrency(ARow, ACol: Cardinal; AValue: Double;
AFormat: TsNumberFormat = nfCurrency; ADecimals: Integer = 2; AFormat: TsNumberFormat = nfCurrency; ADecimals: Integer = 2;
ACurrencySymbol: String = '?'; APosCurrFormat: Integer = -1; ACurrencySymbol: String = '?'; APosCurrFormat: Integer = -1;
@ -2310,6 +2313,67 @@ begin
ChangedCell(ARow, ACol); ChangedCell(ARow, ACol);
end; end;
procedure TsWorksheet.WriteCellValueAsString(ARow, ACol: Cardinal;
AValue: String);
begin
WriteCellValueAsString(GetCell(ARow, ACol), AValue);
end;
procedure TsWorksheet.WriteCellValueAsString(ACell: PCell; AValue: String);
var
isPercent: Boolean;
number: Double;
begin
if ACell = nil then
exit;
if AValue = '' then begin
WriteBlank(ACell^.Row, ACell^.Col);
exit;
end;
isPercent := Pos('%', AValue) = Length(AValue);
if isPercent then Delete(AValue, Length(AValue), 1);
if TryStrToFloat(AValue, number) then begin
if isPercent then
WriteNumber(ACell, number/100, nfPercentage)
else begin
if IsDateTimeFormat(ACell^.NumberFormat) then begin
ACell^.NumberFormat := nfGeneral;
ACell^.NumberFormatStr := '';
end;
WriteNumber(ACell, number, ACell^.NumberFormat, ACell^.NumberFormatStr);
end;
exit;
end;
if TryStrToDateTime(AValue, number) then begin
if number < 1.0 then begin // this is a time alone
if not IsTimeFormat(ACell^.NumberFormat) then begin
ACell^.NumberFormat := nfLongTime;
ACell^.NumberFormatStr := '';
end;
end else
if frac(number) = 0.0 then begin // this is a date alone
if not (ACell^.NumberFormat in [nfShortDate, nfLongDate, nfShortDateTime])
then begin
ACell^.NumberFormat := nfShortDate;
ACell^.NumberFormatStr := '';
end;
end else begin
if not IsDateTimeFormat(ACell^.NumberFormat) then begin
ACell^.NumberFormat := nfShortDateTime;
ACell^.NumberFormatStr := '';
end;
end;
WriteDateTime(ACell, number, ACell^.NumberFormat, ACell^.NumberFormatStr);
exit;
end;
WriteUTF8Text(ACell, AValue);
end;
{@@ {@@
Writes a currency value to a given cell. Its number format can be provided Writes a currency value to a given cell. Its number format can be provided
optionally by specifying various parameters. optionally by specifying various parameters.

View File

@ -1121,27 +1121,7 @@ begin
if FWorksheet = nil then if FWorksheet = nil then
FWorksheet := TsWorksheet.Create; FWorksheet := TsWorksheet.Create;
cell := FWorksheet.GetCell(Row-FHeaderCount, Col-FHeaderCount); cell := FWorksheet.GetCell(Row-FHeaderCount, Col-FHeaderCount);
if FEditText = '' then FWorksheet.WriteCellValueAsString(cell, FEditText);
cell^.ContentType := cctEmpty
else
if TryStrToFloat(FEditText, cell^.NumberValue) then
cell^.ContentType := cctNumber
else
if TryStrToDateTime(FEditText, cell^.DateTimeValue) then begin
cell^.ContentType := cctDateTime;
if cell^.DateTimeValue < 1.0 then begin // this is a TTime
if not (cell^.NumberFormat in [nfShortDateTime, nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM])
then cell^.NumberFormat := nfLongTime;
end else
if frac(cell^.DateTimeValue) = 0 then begin // this is a TDate
if not (cell^.NumberFormat in [nfShortDateTime, nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM])
then cell^.NumberFormat := nfShortDate
end else
cell^.NumberFormat := nfShortDateTime;
end else begin
cell^.UTF8StringValue := FEditText;
cell^.ContentType := cctUTF8String;
end;
FEditText := ''; FEditText := '';
end; end;
inherited EditingDone; inherited EditingDone;