diff --git a/components/fpspreadsheet/examples/spready/mainform.lfm b/components/fpspreadsheet/examples/spready/mainform.lfm index 8d6ce1fa4..f319d8837 100644 --- a/components/fpspreadsheet/examples/spready/mainform.lfm +++ b/components/fpspreadsheet/examples/spready/mainform.lfm @@ -21,46 +21,24 @@ object MainFrm: TMainFrm ClientHeight = 78 ClientWidth = 884 TabOrder = 6 - object CbShowHeaders: TCheckBox - Left = 8 - Height = 19 - Top = 8 - Width = 93 - Caption = 'Show headers' - Checked = True - OnClick = CbShowHeadersClick - State = cbChecked - TabOrder = 0 - end - object CbShowGridLines: TCheckBox - Left = 8 - Height = 19 - Top = 39 - Width = 100 - Caption = 'Show grid lines' - Checked = True - OnClick = CbShowGridLinesClick - State = cbChecked - TabOrder = 1 - end object EdFrozenCols: TSpinEdit - Left = 645 + Left = 429 Height = 23 Top = 8 Width = 52 OnChange = EdFrozenColsChange - TabOrder = 5 + TabOrder = 3 end object EdFrozenRows: TSpinEdit - Left = 645 + Left = 429 Height = 23 Top = 39 Width = 52 OnChange = EdFrozenRowsChange - TabOrder = 6 + TabOrder = 4 end object Label1: TLabel - Left = 560 + Left = 344 Height = 15 Top = 13 Width = 62 @@ -69,7 +47,7 @@ object MainFrm: TMainFrm ParentColor = False end object Label2: TLabel - Left = 560 + Left = 344 Height = 15 Top = 40 Width = 66 @@ -78,16 +56,16 @@ object MainFrm: TMainFrm ParentColor = False end object CbReadFormulas: TCheckBox - Left = 160 + Left = 8 Height = 19 Top = 8 Width = 96 Caption = 'Read formulas' OnChange = CbReadFormulasChange - TabOrder = 2 + TabOrder = 0 end object CbHeaderStyle: TComboBox - Left = 408 + Left = 200 Height = 23 Top = 8 Width = 116 @@ -100,17 +78,17 @@ object MainFrm: TMainFrm ) OnChange = CbHeaderStyleChange Style = csDropDownList - TabOrder = 4 + TabOrder = 2 Text = 'Native' end object CbAutoCalcFormulas: TCheckBox - Left = 160 + Left = 8 Height = 19 Top = 39 Width = 128 Caption = 'Calculate on change' OnChange = CbAutoCalcFormulasChange - TabOrder = 3 + TabOrder = 1 end end object ToolBar1: TToolBar @@ -1229,6 +1207,42 @@ object MainFrm: TMainFrm end object MenuItem68: TMenuItem Action = AcMergeCells + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D69E + 72C4D3996EF4D19668FFCE9263FFCB8E5EFFC98A5BFFC78756FFC38452FFC384 + 52FFC38452FFC38452FFC38452FFC38452FFBB7742B0FFFFFF00FFFFFF00D7A1 + 75FFF8F2EDFFF7F0EAFFF6EDE6FFF4EAE2FFF3E7DEFFF1E4DBFFF0E2D8FFF0E2 + D8FFF0E2D8FFF0E2D8FFF0E2D8FFF0E2D8FFC58A5DFDFFFFFF00FFFFFF00D9A4 + 7AFFF9F3EEFFEBD2BEFFFFFFFFFFEBD3BFFFFFFFFFFFFFFFFFFFFFFFFFFFEAC7 + ADFFFFFFFFFFFFFFFFFFFFFFFFFFF0E2D8FFC68C5FFFFFFFFF00FFFFFF00DDA8 + 7EFFF9F3EFFFEBD0BAFFEBD0BBFFC68A5CFFC38452FFC38452FFC38452FFCA92 + 66FFEACDB5FFEACDB5FFEACDB5FFF0E2D8FFC68A5CFFFFFFFF00FFFFFF00DFAA + 82FFF9F3EFFFEACEB7FFFFFFFFFFC88D5FFFFFFFFFFFFFFFFFFFFFFFFFFFC58B + 5EFFFBF6F2FFFFFFFFFFFFFFFFFFF0E2D8FFC88D5FFFFFFFFF00FFFFFF00E1AE + 87FFFAF4F0FFEACBB2FFEACCB3FFC48654FFE9C7ADFFE9C9AEFFE9C9B0FFC68C + 5FFFE8C7ACFFE8C8B0FFE8C8AEFFF0E2D8FFC48654FFFFFFFF00FFFFFF00E3B1 + 8CFFFAF6F1FFEAC9AEFFFFFFFFFFC68655FFFFFFFFFFFFFFFFFFFFFFFFFFC68A + 5CFFFFFFFFFFFFFFFFFFFFFFFFFFF1E5DBFFC68655FFFFFFFF00FFFFFF00E5B4 + 8FFFFAF6F2FFE9C6AAFFE9C6ACFFC98A5BFFC98A5BFFC78756FFC38452FFC384 + 52FFE9C9B0FFE8C8B0FFE8CCB5FFF2E7DEFFC88A59FFFFFFFF00FFFFFF00E7B7 + 94FFFBF7F4FFE9C3A6FFFFFFFFFFE8C4A9FFFFFFFFFFFFFFFFFFFFFFFFFFE8C7 + ACFFFFFFFFFFFFFFFFFFFFFFFFFFF7F1EBFFCB8F5FFFFFFFFF00FFFFFF00E9BA + 98FFFBF7F4FFE9C3A6FFE9C3A6FFE9C3A6FFE9C3A6FFE9C3A6FFE9C3A6FFE9C3 + A6FFE9C3A6FFE9C3A6FFE9C3A6FFFBF7F4FFCE9364FFFFFFFF00FFFFFF00EBBD + 9BFFFBF7F4FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFBF7F4FFD1976AFFFFFFFF00FFFFFF00ECBF + 9EFFFBF7F4FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFFFBF7F4FFD49B6FFFFFFFFF00FFFFFF00EEC1 + A1EBFBF7F4FFFBF7F4FFFBF7F4FFFBF7F4FFFBF7F4FFFBF7F4FFFBF7F4FFFBF7 + F4FFFBF7F4FFFBF7F4FFFBF7F4FFFBF7F4FFD7A074F8FFFFFF00FFFFFF00EFC2 + A37EEFC1A2E3EDC09FFFEBBE9DFFEBBC9AFFE9BA96FFE7B793FFE6B590FFE4B2 + 8CFFE2AF88FFE0AC84FFDDA980FFDCA57DFFDAA37ACAFFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } end end object mnuView: TMenuItem @@ -1237,6 +1251,17 @@ object MainFrm: TMainFrm Action = AcViewInspector AutoCheck = True end + object MenuItem71: TMenuItem + Caption = '-' + end + object MenuItem70: TMenuItem + Action = AcShowGridlines + AutoCheck = True + end + object MenuItem69: TMenuItem + Action = AcShowHeaders + AutoCheck = True + end end end object ImageList: TImageList @@ -2983,6 +3008,22 @@ object MainFrm: TMainFrm ImageIndex = 39 OnExecute = AcMergeCellsExecute end + object AcShowHeaders: TAction + Category = 'View' + AutoCheck = True + Caption = 'Headers' + Checked = True + Hint = 'Show/hide column and row headers' + OnExecute = AcShowHeadersExecute + end + object AcShowGridlines: TAction + Category = 'View' + AutoCheck = True + Caption = 'Grid lines' + Checked = True + Hint = 'Show/hide grid lines' + OnExecute = AcShowGridlinesExecute + end end object FontDialog: TFontDialog MinFontSize = 0 diff --git a/components/fpspreadsheet/examples/spready/mainform.pas b/components/fpspreadsheet/examples/spready/mainform.pas index e0a2270f0..113886a8f 100644 --- a/components/fpspreadsheet/examples/spready/mainform.pas +++ b/components/fpspreadsheet/examples/spready/mainform.pas @@ -73,6 +73,8 @@ type AcAddColumn: TAction; AcAddRow: TAction; AcMergeCells: TAction; + AcShowHeaders: TAction; + AcShowGridlines: TAction; AcViewInspector: TAction; AcWordwrap: TAction; AcVAlignDefault: TAction; @@ -80,8 +82,6 @@ type AcVAlignCenter: TAction; AcVAlignBottom: TAction; ActionList: TActionList; - CbShowHeaders: TCheckBox; - CbShowGridLines: TCheckBox; CbBackgroundColor: TColorBox; CbReadFormulas: TCheckBox; CbHeaderStyle: TComboBox; @@ -157,6 +157,9 @@ type MenuItem66: TMenuItem; MenuItem67: TMenuItem; MenuItem68: TMenuItem; + MenuItem69: TMenuItem; + MenuItem70: TMenuItem; + MenuItem71: TMenuItem; mnuInspector: TMenuItem; mnuView: TMenuItem; MnuFmtDateTimeMSZ: TMenuItem; @@ -263,8 +266,9 @@ type procedure AcOpenExecute(Sender: TObject); procedure AcQuitExecute(Sender: TObject); procedure AcSaveAsExecute(Sender: TObject); + procedure AcShowGridlinesExecute(Sender: TObject); + procedure AcShowHeadersExecute(Sender: TObject); procedure AcTextRotationExecute(Sender: TObject); - procedure AcUnmergeCellsExecute(Sender: TObject); procedure AcVertAlignmentExecute(Sender: TObject); procedure AcViewInspectorExecute(Sender: TObject); procedure AcWordwrapExecute(Sender: TObject); @@ -272,8 +276,6 @@ type 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 EdFormulaEditingDone(Sender: TObject); @@ -284,10 +286,8 @@ type procedure FormActivate(Sender: TObject); procedure FormCreate(Sender: TObject); procedure InspectorPageControlChange(Sender: TObject); - procedure PageControl1Change(Sender: TObject); procedure TabControlChange(Sender: TObject); procedure WorksheetGridSelection(Sender: TObject; aCol, aRow: Integer); - private FCopiedFormat: TCell; procedure LoadFile(const AFileName: String); @@ -617,6 +617,50 @@ begin UpdateNumFormatActions; end; + +procedure TMainFrm.acOpenExecute(Sender: TObject); +begin + if OpenDialog.Execute then + LoadFile(OpenDialog.FileName); +end; + +procedure TMainFrm.acQuitExecute(Sender: TObject); +begin + Close; +end; + +procedure TMainFrm.acSaveAsExecute(Sender: TObject); +// Saves sheet in grid to file, overwriting existing file +var + err: String = ''; +begin + if WorksheetGrid.Workbook = nil then + exit; + + if SaveDialog.Execute then + begin + Screen.Cursor := crHourglass; + try + WorksheetGrid.SaveToSpreadsheetFile(SaveDialog.FileName); + finally + Screen.Cursor := crDefault; + err := WorksheetGrid.Workbook.ErrorMsg; + if err <> '' then + MessageDlg(err, mtError, [mbOK], 0); + end; + end; +end; + +procedure TMainFrm.AcShowGridlinesExecute(Sender: TObject); +begin + WorksheetGrid.ShowGridLines := AcShowGridLines.Checked; +end; + +procedure TMainFrm.AcShowHeadersExecute(Sender: TObject); +begin + WorksheetGrid.ShowHeaders := AcShowHeaders.Checked; +end; + procedure TMainFrm.AcTextRotationExecute(Sender: TObject); var text_rot: TsTextRotation; @@ -629,11 +673,6 @@ begin UpdateTextRotationActions; end; -procedure TMainFrm.AcUnmergeCellsExecute(Sender: TObject); -begin - WorksheetGrid.UnmergeCells; -end; - procedure TMainFrm.AcVertAlignmentExecute(Sender: TObject); var vert_align: TsVertAlignment; @@ -669,6 +708,23 @@ begin WorksheetGrid.AutoCalc := CbAutoCalcFormulas.Checked;; end; +procedure TMainFrm.CbBackgroundColorGetColors(Sender: TCustomColorBox; Items: TStrings); +var + clr: TColor; + clrName: String; + i: Integer; +begin + if WorksheetGrid.Workbook <> nil then begin + Items.Clear; + Items.AddObject('no fill', TObject(PtrInt(clNone))); + for i:=0 to WorksheetGrid.Workbook.GetPaletteSize-1 do begin + clr := WorksheetGrid.Workbook.GetPaletteColor(i); + clrName := WorksheetGrid.Workbook.GetColorName(i); + Items.AddObject(Format('%d: %s', [i, clrName]), TObject(PtrInt(clr))); + end; + end; +end; + procedure TMainFrm.CbBackgroundColorSelect(Sender: TObject); begin if CbBackgroundColor.ItemIndex <= 0 then @@ -687,66 +743,6 @@ begin WorksheetGrid.ReadFormulas := CbReadFormulas.Checked; end; -procedure TMainFrm.CbShowHeadersClick(Sender: TObject); -begin - WorksheetGrid.ShowHeaders := CbShowHeaders.Checked; -end; - -procedure TMainFrm.CbShowGridLinesClick(Sender: TObject); -begin - WorksheetGrid.ShowGridLines := CbShowGridLines.Checked; -end; - -procedure TMainFrm.acOpenExecute(Sender: TObject); -begin - if OpenDialog.Execute then - LoadFile(OpenDialog.FileName); -end; - -procedure TMainFrm.acQuitExecute(Sender: TObject); -begin - Close; -end; - -procedure TMainFrm.acSaveAsExecute(Sender: TObject); -// Saves sheet in grid to file, overwriting existing file -var - err: String = ''; -begin - if WorksheetGrid.Workbook = nil then - exit; - - if SaveDialog.Execute then - begin - Screen.Cursor := crHourglass; - try - WorksheetGrid.SaveToSpreadsheetFile(SaveDialog.FileName); - finally - Screen.Cursor := crDefault; - err := WorksheetGrid.Workbook.ErrorMsg; - if err <> '' then - MessageDlg(err, mtError, [mbOK], 0); - end; - end; -end; - -procedure TMainFrm.CbBackgroundColorGetColors(Sender: TCustomColorBox; Items: TStrings); -var - clr: TColor; - clrName: String; - i: Integer; -begin - if WorksheetGrid.Workbook <> nil then begin - Items.Clear; - Items.AddObject('no fill', TObject(PtrInt(clNone))); - for i:=0 to WorksheetGrid.Workbook.GetPaletteSize-1 do begin - clr := WorksheetGrid.Workbook.GetPaletteColor(i); - clrName := WorksheetGrid.Workbook.GetColorName(i); - Items.AddObject(Format('%d: %s', [i, clrName]), TObject(PtrInt(clr))); - end; - end; -end; - procedure TMainFrm.EdCellAddressEditingDone(Sender: TObject); var c, r: cardinal; @@ -866,6 +862,7 @@ begin WorksheetGrid.LoadFromSpreadsheetFile(UTF8ToSys(AFileName)); except on E: Exception do begin + // In an error occurs show at least an empty valid worksheet AcNewExecute(nil); MessageDlg(E.Message, mtError, [mbOk], 0); exit; @@ -877,29 +874,16 @@ begin AFilename, GetFileFormatName(WorksheetGrid.Workbook.FileFormat) ]); - CbShowGridLines.Checked := (soShowGridLines in WorksheetGrid.Worksheet.Options); - CbShowHeaders.Checked := (soShowHeaders in WorksheetGrid.Worksheet.Options); + AcShowGridLines.Checked := WorksheetGrid.ShowGridLines; + AcShowHeaders.Checked := WorksheetGrid.ShowHeaders; EdFrozenCols.Value := WorksheetGrid.FrozenCols; EdFrozenRows.Value := WorksheetGrid.FrozenRows; SetupBackgroundColorBox; + // Load names of worksheets into tabcontrol and show first sheet WorksheetGrid.GetSheets(TabControl.Tabs); TabControl.TabIndex := 0; - { - // 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; - } + // Update display WorksheetGridSelection(nil, WorksheetGrid.Col, WorksheetGrid.Row); finally @@ -911,19 +895,6 @@ begin end; end; -procedure TMainFrm.PageControl1Change(Sender: TObject); -begin - { - WorksheetGrid.Parent := PageControl1.Pages[PageControl1.ActivePageIndex]; - WorksheetGrid.SelectSheetByIndex(PageControl1.ActivePageIndex); - } -end; - -procedure TMainFrm.TabControlChange(Sender: TObject); -begin - WorksheetGrid.SelectSheetByIndex(TabControl.TabIndex); -end; - procedure TMainFrm.SetupBackgroundColorBox; begin // This change triggers re-reading of the workbooks palette by the OnGetColors @@ -933,63 +904,9 @@ begin Application.ProcessMessages; end; -procedure TMainFrm.WorksheetGridSelection(Sender: TObject; aCol, aRow: Integer); -var - r, c: Cardinal; - cell: PCell; - s: String; +procedure TMainFrm.TabControlChange(Sender: TObject); 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, true); - if s <> '' then begin - if s[1] <> '=' then s := '=' + s; - EdFormula.Text := s; - end - else - case cell^.ContentType of - cctNumber: - EdFormula.Text := FloatToStr(cell^.NumberValue); - cctDateTime: - if cell^.DateTimeValue < 1.0 then - EdFormula.Text := FormatDateTime('tt', cell^.DateTimeValue) - else - EdFormula.Text := FormatDateTime('c', cell^.DateTimeValue); - cctUTF8String: - EdFormula.Text := cell^.UTF8StringValue; - else - EdFormula.Text := WorksheetGrid.Worksheet.ReadAsUTF8Text(cell); - end; - end else - EdFormula.Text := ''; - - EdCellAddress.Text := GetCellString(r, c, [rfRelRow, rfRelCol]); - AcMergeCells.Checked := (cell <> nil) and (cell^.MergedNeighbors <> []); - - UpdateHorAlignmentActions; - UpdateVertAlignmentActions; - UpdateWordwraps; - UpdateBackgroundColorIndex; -// UpdateFontActions; - UpdateFontNameIndex; - UpdateFontSizeIndex; - UpdateFontStyleActions; - UpdateTextRotationActions; - UpdateNumFormatActions; - - UpdateCellInfo(cell); - + WorksheetGrid.SelectSheetByIndex(TabControl.TabIndex); end; procedure TMainFrm.UpdateBackgroundColorIndex; @@ -1241,6 +1158,65 @@ begin AcWordwrap.Checked := wrapped; end; +procedure TMainFrm.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, true); + if s <> '' then begin + if s[1] <> '=' then s := '=' + s; + EdFormula.Text := s; + end + else + case cell^.ContentType of + cctNumber: + EdFormula.Text := FloatToStr(cell^.NumberValue); + cctDateTime: + if cell^.DateTimeValue < 1.0 then + EdFormula.Text := FormatDateTime('tt', cell^.DateTimeValue) + else + EdFormula.Text := FormatDateTime('c', cell^.DateTimeValue); + cctUTF8String: + EdFormula.Text := cell^.UTF8StringValue; + else + EdFormula.Text := WorksheetGrid.Worksheet.ReadAsUTF8Text(cell); + end; + end else + EdFormula.Text := ''; + + EdCellAddress.Text := GetCellString(r, c, [rfRelRow, rfRelCol]); + AcMergeCells.Checked := (cell <> nil) and (cell^.MergedNeighbors <> []); + + UpdateHorAlignmentActions; + UpdateVertAlignmentActions; + UpdateWordwraps; + UpdateBackgroundColorIndex; +// UpdateFontActions; + UpdateFontNameIndex; + UpdateFontSizeIndex; + UpdateFontStyleActions; + UpdateTextRotationActions; + UpdateNumFormatActions; + + UpdateCellInfo(cell); +end; + + initialization {$I mainform.lrs} diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index 64c8b541a..c30c802a7 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/components/fpspreadsheet/fpspreadsheetgrid.pas @@ -710,6 +710,8 @@ end; constructor TsCustomWorksheetGrid.Create(AOwner: TComponent); begin inherited Create(AOwner); + AutoAdvance := aaDown; + ExtendedSelect := true; FHeaderCount := 1; FInitColCount := 26; FInitRowCount := 100; @@ -2069,6 +2071,7 @@ var txtR: TRect; cellR: TRect; flags: Cardinal; + r1,c1,r2,c2: Cardinal; begin Result := 0; if ShowHeaders and ((ACol = 0) or (ARow = 0)) then @@ -2078,6 +2081,14 @@ begin lCell := FWorksheet.FindCell(ARow-FHeaderCount, ACol-FHeaderCount); if lCell <> nil then begin + if lCell^.MergedNeighbors <> [] then begin + FWorksheet.FindMergedRange(lCell, r1, c1, r2, c2); + if r1 <> r2 then + // If the merged range encloses several rows we skip automatic row height + // determination since only the height of the first row of the block + // (containing the merge base cell) would change which is very confusing. + exit; + end; s := GetCellText(ACol, ARow); if s = '' then exit;