{@@ ---------------------------------------------------------------------------- Unit fpspreadsheetctrls implements some **visual controls** which help to create a spreadsheet application without writing too much code. AUTHORS: Werner Pamler LICENSE: See the file COPYING.modifiedLGPL.txt, included in the Lazarus distribution, for details about the license. EXAMPLE OF USAGE: * Add a _WorkbookSource_ component to the form. * Add a _WorksheetTabControl_ * Add a _WorksheetGrid_ (from unit fpspreadsheetgrid) * Link their _WorkbookSource_ properties to the added _WorkbookSource_ component * Set the property _FileName_ of the _WorkbookSource_ to a spreadsheet file. As a result, the _WorksheetTabControl_ displays tabs for each worksheet in the file, and the _WorksheetGrid_ displays the worksheet according to the selected tab. -------------------------------------------------------------------------------} unit fpspreadsheetctrls; {$MODE objfpc}{$H+} {$include ..\fps.inc} interface uses LCLType, LCLIntf, LCLProc, LCLVersion, LMessages, LResources, Classes, Types, Graphics, SysUtils, Controls, StdCtrls, ComCtrls, ValEdit, ActnList, fpstypes, fpspreadsheet; const {@@ User-defined message for input validation } UM_VALIDATEINPUT = LM_USER + 100; type {@@ Event handler procedure for displaying a message if an error or warning occurs during reading of a workbook. } TsWorkbookSourceErrorEvent = procedure (Sender: TObject; const AMsg: String) of object; {@@ Describes during communication between WorkbookSource and visual controls which kind of item has changed: the workbook, the worksheet, a cell value, or a cell formatting, etc. } TsNotificationItem = (lniWorkbook, lniWorksheet, lniWorksheetAdd, lniWorksheetRemoving, lniWorksheetRemove, lniWorksheetRename, lniWorksheetZoom, lniCell, lniSelection, lniAbortSelection, lniRow, lniCol, lniChart); {@@ This set accompanies the notification between WorkbookSource and visual controls and describes which items have changed in the spreadsheet. } TsNotificationItems = set of TsNotificationItem; { TsWorkbookSource } {@@ TsWorkbookSource links a workbook to the visual spreadsheet controls and help to display or edit the workbook without written code. } TsWorkbookSource = class(TComponent) private FWorkbook: TsWorkbook; FWorksheet: TsWorksheet; FListeners: TFPList; FAutoDetectFormat: Boolean; FFileName: TFileName; FFileFormatID: TsSpreadFormatID; FUserFileFormatID: TsSpreadFormatID; FPendingSelection: TsCellRangeArray; FPendingOperation: TsCopyOperation; FOptions: TsWorkbookOptions; FOnError: TsWorkbookSourceErrorEvent; FOnQueryPassword: TsOnQueryPassword; // Getters / setters function GetFileFormat: TsSpreadsheetFormat; procedure SetFileFormat(AValue: TsSpreadsheetFormat); procedure SetFileFormatID(AValue: TsSpreadFormatID); procedure SetFileName(const AFileName: TFileName); procedure SetOptions(AValue: TsWorkbookOptions); // Local event handlers procedure CellChangedHandler(Sender: TObject; ARow, ACol: Cardinal); procedure CellFontChangedHandler(Sender: TObject; ARow, ACol: Cardinal); procedure CellSelectedHandler(Sender: TObject; ARow, ACol: Cardinal); procedure ColChangedHandler(Sender: TObject; ACol: Cardinal); procedure RowChangedHandler(Sender: TObject; ARow: Cardinal); // procedure WorkbookChangedPaletteHandler(Sender: TObject); procedure WorkbookOpenedHandler(Sender: TObject); procedure WorksheetAddedHandler(Sender: TObject; ASheet: TsWorksheet); procedure WorksheetChangedHandler(Sender: TObject; ASheet: TsWorksheet); procedure WorksheetRemovedHandler(Sender: TObject; ASheetIndex: Integer); procedure WorksheetRemovingHandler(Sender: TObject; AWorksheet: TsWorksheet); procedure WorksheetRenamedHandler(Sender: TObject; AWorksheet: TsWorksheet); procedure WorksheetSelectedHandler(Sender: TObject; AWorksheet: TsWorksheet); procedure WorksheetZoomHandler(Sender: TObject); protected procedure AbortSelection; function DoQueryPassword: String; procedure DoShowError(const AErrorMsg: String); procedure InternalCreateNewWorkbook(AWorkbook: TsWorkbook = nil); procedure InternalLoadFromFile(AFileName: string; AAutoDetect: Boolean; AFormatID: TsSpreadFormatID; AWorksheetIndex: Integer; APassword: String); procedure InternalLoadFromWorkbook(AWorkbook: TsWorkbook; AWorksheetIndex: Integer = -1); procedure Loaded; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; public procedure AddListener(AListener: TComponent); procedure RemoveListener(AListener: TComponent); procedure NotifyListeners(AChangedItems: TsNotificationItems; AData: Pointer = nil); public procedure CreateNewWorkbook; procedure LoadFromProtectedSpreadsheetFile(AFileName: String; AFormatID: TsSpreadFormatID; APassword: String; AWorksheetIndex: Integer = -1); procedure LoadFromSpreadsheetFile(AFileName: string; AFormat: TsSpreadsheetFormat; AWorksheetIndex: Integer = -1); overload; procedure LoadFromSpreadsheetFile(AFileName: string; AFormatID: TsSpreadFormatID = sfidUnknown; AWorksheetIndex: Integer = -1); overload; procedure LoadFromWorkbook(AWorkbook: TsWorkbook; AWorksheetIndex: Integer = -1); procedure SaveToSpreadsheetFile(AFileName: string; AOverwriteExisting: Boolean = true); overload; procedure SaveToSpreadsheetFile(AFileName: string; AFormat: TsSpreadsheetFormat; AOverwriteExisting: Boolean = true); overload; procedure SaveToSpreadsheetFile(AFileName: string; AFormatID: TsSpreadFormatID; AOverwriteExisting: Boolean = true); overload; procedure SelectCell(ASheetRow, ASheetCol: Cardinal); procedure SelectWorksheet(AWorkSheet: TsWorksheet); procedure ExecutePendingOperation; procedure SetPendingOperation(AOperation: TsCopyOperation; const ASelection: TsCellRangeArray); { Clipboard } // function CellClipboardEmpty: Boolean; // procedure ClearCellClipboard; procedure CopyCellsToClipboard; procedure CutCellsToClipboard; procedure PasteCellsFromClipboard(AItem: TsCopyOperation; ATransposed: Boolean = false); public {@@ Workbook linked to the WorkbookSource } property Workbook: TsWorkbook read FWorkbook; {@@ Currently selected worksheet of the workbook } property Worksheet: TsWorksheet read FWorksheet; {@@ Indicates that which operation is waiting to be executed at next cell select } property PendingOperation: TsCopyOperation read FPendingOperation; {@@ File format identifier of the next spreadsheet file to be loaded by means of the Filename property. Not used when AutoDetectFormat is TRUE. Unlike the published property "FileFormat" the FileFormatID also takes care of user-defined formats. } property FileFormatID: TsSpreadFormatID read FFileFormatID write SetFileFormatID; published {@@ Automatically detects the fileformat when loading the spreadsheet file specified by FileName } property AutoDetectFormat: Boolean read FAutoDetectFormat write FAutoDetectFormat default true; {@@ File format of the next spreadsheet file to be loaded by means of the Filename property. Not used when AutoDetectFormat is TRUE. Note that if FileFormat is sfUser then the format ID must be specified at runtime. } property FileFormat: TsSpreadsheetFormat read GetFileFormat write SetFileFormat default sfOOXML; {@@ Name of the loaded spreadsheet file which is loaded by assigning a file name to this property. Format detection is determined by the properties AutoDetectFormat and FileFormat. Using this property loads the file at design-time. } property FileName: TFileName read FFileName write SetFileName; {@@ A set of options to be transferred to the workbook, for e.g. formula calculation etc. } property Options: TsWorkbookOptions read FOptions write SetOptions; {@@ A message box is displayey if an error occurs during loading of a spreadsheet. This behavior can be replaced by means of the event OnError. } property OnError: TsWorkbookSourceErrorEvent read FOnError write FOnError; {@@ Event fired when a password is required. Handler must return the pwd. } property OnQueryPassword: TsOnQueryPassword read FOnQueryPassword write FOnQueryPassword; end; const GUID_SpreadsheetControl = '{CBCAAE52-D29E-4D0C-A7F4-1016C873448A}'; type { IsSpreadsheetControl } {@@ Interface which allows the workbook source to notify linked controls of changes in the associated workbook. } IsSpreadsheetControl = interface [GUID_SpreadsheetControl] procedure ListenerNotification(AChangedItems: TsNotificationItems; AData: Pointer = nil); procedure RemoveWorkbookSource; end; { TsWorkbookTabControl } {@@ TsWorkbookTabControl is a tab control which displays the sheets of the workbook currently loaded by the WorkbookSource in tabs. Selecting another tab is communicated to other spreadsheet controls via the WorkbookSource. } TsWorkbookTabControl = class(TTabControl, IsSpreadsheetControl) private FWorkbookSource: TsWorkbookSource; FLockCount: Integer; FShowAllSheets: Boolean; procedure SetShowAllSheets(AValue: Boolean); procedure SetWorkbookSource(AValue: TsWorkbookSource); protected procedure Change; override; procedure GetSheetList(AList: TStrings); function GetWorkbook: TsWorkbook; function GetWorksheet: TsWorksheet; procedure Notification(AComponent: TComponent; Operation: TOperation); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure ListenerNotification(AChangedItems: TsNotificationItems; AData: Pointer = nil); procedure RemoveWorkbookSource; {@@ The worksheet names of this workbook are currently displayed as tabs of the TabControl. } property Workbook: TsWorkbook read GetWorkbook; {@@ Identifies the worksheet which corresponds to the selected tab } property Worksheet: TsWorksheet read GetWorksheet; published property ShowAllSheets: boolean read FShowAllSheets write SetShowAllSheets default true; {@@ Link to the WorkbookSource which provides the data. } property WorkbookSource: TsWorkbookSource read FWorkbookSource write SetWorkbookSource; end; { TsWorksheetIndicator } {@@ TsWorksheetIndicator is a combobox control which displays the sheets of the workbook currently loaded by the WorkbookSource. } TsWorksheetIndicator = class(TCustomComboBox, IsSpreadsheetControl) private FWorkbookSource: TsWorkbookSource; FLockCount: Integer; FShowAllSheets: Boolean; procedure SetShowAllSheets(AValue: Boolean); procedure SetWorkbookSource(AValue: TsWorkbookSource); protected procedure Change; override; procedure GetSheetList(AList: TStrings); function GetWorkbook: TsWorkbook; function GetWorksheet: TsWorksheet; procedure Notification(AComponent: TComponent; Operation: TOperation); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure ListenerNotification(AChangedItems: TsNotificationItems; AData: Pointer = nil); procedure RemoveWorkbookSource; property Workbook: TsWorkbook read GetWorkbook; property Worksheet: TsWorksheet read GetWorksheet; published property ShowAllSheets: boolean read FShowAllSheets write SetShowAllSheets default true; property WorkbookSource: TsWorkbookSource read FWorkbookSource write SetWorkbookSource; { inherited properties } property Align; property Anchors; property ArrowKeysTraverseList; property AutoComplete; property AutoCompleteText; property AutoDropDown; property AutoSelect; property AutoSize; // Note: windows has a fixed height in some styles property BidiMode; property BorderSpacing; property BorderStyle; property CharCase; property Color; property Constraints; property DragCursor; property DragKind; property DragMode; property DropDownCount; property Enabled; property Font; // property ItemHeight; property ItemIndex; // property Items; property ItemWidth; property MaxLength; property OnChange; property OnChangeBounds; property OnClick; property OnCloseUp; property OnContextPopup; property OnDblClick; property OnDragDrop; property OnDragOver; property OnDrawItem; property OnEndDrag; property OnDropDown; property OnEditingDone; property OnEnter; property OnExit; property OnGetItems; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMeasureItem; property OnMouseDown; property OnMouseEnter; property OnMouseLeave; property OnMouseMove; property OnMouseUp; property OnMouseWheel; property OnMouseWheelDown; property OnMouseWheelUp; property OnSelect; property OnStartDrag; property OnUTF8KeyPress; property ParentBidiMode; property ParentColor; property ParentFont; property ParentShowHint; property PopupMenu; // property ReadOnly; property ShowHint; property Sorted; // property Style; property TabOrder; property TabStop; property Text; property Visible; end; { TsCellEdit } {@@ TsCellEdit allows to edit the content or formula of the active cell of a worksheet, simular to Excel's cell editor above the cell grid. } TsCellEdit = class(TMemo, IsSpreadsheetControl) private FWorkbookSource: TsWorkbookSource; FShowHTMLText: Boolean; FOldText: String; FFormulaError: Boolean; FRefocusing: TObject; FRefocusingCol, FRefocusingRow: Cardinal; FRefocusingSelStart: Integer; function GetSelectedCell: PCell; function GetWorkbook: TsWorkbook; function GetWorksheet: TsWorksheet; procedure SetWorkbookSource(AValue: TsWorkbookSource); procedure ValidateInput(var Msg: TLMessage); message UM_VALIDATEINPUT; procedure WMKillFocus(var AMessage: TLMKillFocus); message LM_KILLFOCUS; protected FEditText: String; function CanEditCell(ACell: PCell): Boolean; overload; function CanEditCell(ARow, ACol: Cardinal): Boolean; overload; procedure DoEnter; override; procedure DoExit; override; function DoValidText(const AText: String): Boolean; virtual; function ValidFormula(AFormula: String; out AErrMsg: String): Boolean; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure KeyUp(var Key: Word; Shift: TShiftState); override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure ShowCell(ACell: PCell); virtual; procedure WriteToCell; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure EditingDone; override; procedure ListenerNotification(AChangedItems: TsNotificationItems; AData: Pointer = nil); procedure RemoveWorkbookSource; {@@ Pointer to the currently active cell in the workbook. This cell is displayed in the control and can be edited. } property SelectedCell: PCell read GetSelectedCell; {@@ Refers to the underlying workbook to which the edited cell belongs. } property Workbook: TsWorkbook read GetWorkbook; {@@ Refers to the underlying worksheet to which the edited cell belongs. } property Worksheet: TsWorksheet read GetWorksheet; published property ShowHTMLText: Boolean read FShowHTMLText write FShowHTMLText default true; {@@ Link to the WorkbookSource which provides the workbook and worksheet. } property WorkbookSource: TsWorkbookSource read FWorkbookSource write SetWorkbookSource; property WantReturns default false; end; { TsCellIndicator } {@@ TsCellIndicator displays the address of the currently active cell of the worksheet and workbook. Editing the address allows to jump to the corresponding cell. } TsCellIndicator = class(TCustomEdit, IsSpreadsheetControl) private FWorkbookSource: TsWorkbookSource; function GetWorkbook: TsWorkbook; function GetWorksheet: TsWorksheet; procedure SetWorkbookSource(AValue: TsWorkbookSource); protected procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure UpdateDisplay; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure EditingDone; override; procedure ListenerNotification(AChangedItems: TsNotificationItems; AData: Pointer = nil); procedure RemoveWorkbookSource; {@@ Refers to the underlying worksheet to which the edited cell belongs. } property Workbook: TsWorkbook read GetWorkbook; {@@ Refers to the underlying worksheet to which the edited cell belongs. } property Worksheet: TsWorksheet read GetWorksheet; published {@@ Link to the WorkbookSource which provides the workbook and worksheet. } property WorkbookSource: TsWorkbookSource read FWorkbookSource write SetWorkbookSource; // Inherited from TCustomEdit, published in TEdit. Omit those which are not needed property Action; property Align; property Alignment default taCenter; // centered text by default property Anchors; property AutoSize; property AutoSelect; property BidiMode; property BorderSpacing; property BorderStyle; // property CharCase; property Color; property Constraints; property DragCursor; property DragKind; property DragMode; // property EchoMode; property Enabled; property Font; property HideSelection; property MaxLength; // property NumbersOnly; property ParentBidiMode; property OnChange; property OnChangeBounds; property OnClick; property OnContextPopup; property OnDblClick; property OnDragDrop; property OnDragOver; property OnEditingDone; property OnEndDrag; property OnEnter; property OnExit; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseEnter; property OnMouseLeave; property OnMouseMove; property OnMouseUp; property OnMouseWheel; property OnMouseWheelDown; property OnMouseWheelUp; property OnResize; property OnStartDrag; property OnUTF8KeyPress; property ParentColor; property ParentFont; property ParentShowHint; // property PasswordChar; property PopupMenu; property ReadOnly; property ShowHint; property TabStop; property TabOrder; property Text; // property TextHint; property Visible; end; { TsCellFormatItem, TsFormatTarget } TsCellFormatItem = (cfiFontName, cfiFontSize, cfiFontColor, cfiBackgroundColor, cfiBorderColor); TsFormatTarget = (ftCell, ftRow, ftCol, ftDefault); { TsCellCombobox } TsColorNameEvent = procedure (Sender: TObject; AColor: TColor; out AColorName: String) of object; {@@ TsCellCombobox is a multi-purpose combobox for selection of formatting items of a cell } TsCellCombobox = class(TCustomCombobox, IsSpreadsheetControl) private FWorkbookSource: TsWorkbookSource; FFormatItem: TsCellFormatItem; FColorRectOffset: Integer; FColorRectWidth: Integer; FFormatTarget: TsFormatTarget; FOnAddColors: TNotifyEvent; FOnGetColorName: TsColorNameEvent; function GetWorkbook: TsWorkbook; function GetWorksheet: TsWorksheet; procedure SetColorRectOffset(AValue: Integer); procedure SetColorRectWidth(AValue: Integer); procedure SetFormatItem(AValue: TsCellFormatItem); procedure SetFormatTarget(AValue: TsFormatTarget); procedure SetWorkbookSource(AValue: TsWorkbookSource); protected procedure ApplyFormatToCell(ARow, ACol: Cardinal); virtual; procedure ApplyFormatToCol(ACol: Cardinal); virtual; procedure ApplyFormatToDefault; virtual; procedure ApplyFormatToRow(ARow: Cardinal); virtual; procedure ApplyFormat(ARow, ACol: cardinal); procedure Change; override; procedure DrawItem(AIndex: Integer; ARect: TRect; AState: TOwnerDrawState); override; procedure ExtractFromCell(ARow, ACol: Cardinal); virtual; procedure ExtractFromCol(ACol: Cardinal); virtual; procedure ExtractFromDefault; virtual; procedure ExtractFromRow(ARow: Cardinal); virtual; procedure ExtractFromSheet; function GetActiveCell: PCell; procedure Loaded; override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure Populate; virtual; procedure ProcessItem; procedure Select; override; property Items stored false; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure AddColor(AColor: TsColor; AColorName: String); procedure ListenerNotification(AChangedItems: TsNotificationItems; AData: Pointer = nil); procedure RemoveWorkbookSource; {@@ Refers to the underlying workbook } property Workbook: TsWorkbook read GetWorkbook; {@@ Refers to the underlying worksheet containing the displayed cell } property Worksheet: TsWorksheet read GetWorksheet; published {@@ Identifies the cell format property to be used in the combobox } property CellFormatItem: TsCellFormatItem read FFormatItem write SetFormatItem default cfiFontName; {@@ Margin around the color box } property ColorRectOffset: Integer read FColorRectOffset write SetColorRectOffset default 2; {@@ Width of the color box shown for the color-related format items } property ColorRectWidth: Integer read FColorRectWidth write SetColorRectWidth default 10; {@@ Determine whether the selected color applies to a cell, row, column or default format } property FormatTarget: TsFormatTarget read FFormatTarget write SetFormatTarget default ftCell; {@@ Link to the WorkbookSource which provides the workbook and worksheet. } property WorkbookSource: TsWorkbookSource read FWorkbookSource write SetWorkbookSource; {@@ Event which adds the colors to the combobox } property OnAddColors: TNotifyEvent read FOnAddColors write FOnAddColors; {@@ Event to get a decent name of the colors of the combo } property OnGetColorName: TsColorNameEvent read FOnGetColorName write FOnGetColorName; { inherited properties } property Align; property Anchors; property ArrowKeysTraverseList; property AutoComplete; property AutoCompleteText; property AutoDropDown; property AutoSelect; property AutoSize; // Note: windows has a fixed height in some styles property BidiMode; property BorderSpacing; property BorderStyle; property CharCase; property Color; property Constraints; property DragCursor; property DragKind; property DragMode; property DropDownCount; property Enabled; property Font; // property ItemHeight; property ItemIndex; // property Items; property ItemWidth; property MaxLength; property OnChange; property OnChangeBounds; property OnClick; property OnCloseUp; property OnContextPopup; property OnDblClick; property OnDragDrop; property OnDragOver; property OnDrawItem; property OnEndDrag; property OnDropDown; property OnEditingDone; property OnEnter; property OnExit; property OnGetItems; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMeasureItem; property OnMouseDown; property OnMouseEnter; property OnMouseLeave; property OnMouseMove; property OnMouseUp; property OnMouseWheel; property OnMouseWheelDown; property OnMouseWheelUp; property OnSelect; property OnStartDrag; property OnUTF8KeyPress; property ParentBidiMode; property ParentColor; property ParentFont; property ParentShowHint; property PopupMenu; // property ReadOnly; property ShowHint; property Sorted; // property Style; property TabOrder; property TabStop; property Text; property Visible; end; { TsSpreadsheetInspector } {@@ Classification of data displayed by the SpreadsheetInspector. Each item can be assigned to a tab of a TabControl. } TsInspectorMode = (imWorkbook, imWorksheet, imCellValue, imCellProperties, imRow, imCol); {@@ Inspector expanded nodes } TsInspectorExpandedNode = (ienFormatSettings, ienConditionalFormats, ienPageLayout, ienFonts, ienFormats, ienEmbeddedObj, ienImages, ienCryptoInfo); TsInspectorExpandedNodes = set of TsInspectorExpandedNode; {@@ TsSpreadsheetInspector displays all properties of a workbook, worksheet, cell content and cell formatting in a way similar to the Object Inspector of Lazarus. } TsSpreadsheetInspector = class(TValueListEditor, IsSpreadsheetControl) private FWorkbookSource: TsWorkbookSource; FMode: TsInspectorMode; FExpanded: TsInspectorExpandedNodes; FCurrRow, FCurrCol: Integer; function GetWorkbook: TsWorkbook; function GetWorksheet: TsWorksheet; procedure SetExpanded(AValue: TsInspectorExpandedNodes); procedure SetMode(AValue: TsInspectorMode); procedure SetWorkbookSource(AValue: TsWorkbookSource); protected procedure DblClick; override; procedure DoUpdate; virtual; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure UpdateCellValue(ACell: PCell; AStrings: TStrings); virtual; procedure UpdateCellProperties(ACell: PCell; AStrings: TStrings); virtual; procedure UpdateCol(ACol: Integer; AStrings: TStrings); virtual; procedure UpdateFormatProperties(AFormatIndex: integer; AStrings: TStrings); virtual; procedure UpdateRow(ARow: Integer; AStrings: TStrings); virtual; procedure UpdateWorkbook(AWorkbook: TsWorkbook; AStrings: TStrings); virtual; procedure UpdateWorksheet(ASheet: TsWorksheet; AStrings: TStrings); virtual; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure ListenerNotification(AChangedItems: TsNotificationItems; AData: Pointer = nil); procedure RemoveWorkbookSource; {@@ Refers to the underlying workbook which is displayed by the inspector. } property Workbook: TsWorkbook read GetWorkbook; {@@ Refers to the underlying worksheet which is displayed by the inspector. } property Worksheet: TsWorksheet read GetWorksheet; published {@@ Refers to the underlying worksheet from which the active cell is taken } property WorkbookSource: TsWorkbookSource read FWorkbookSource write SetWorkbookSource; {@@ Classification of data displayed by the SpreadsheetInspector. Each mode can be assigned to a tab of a TabControl. } property Mode: TsInspectorMode read FMode write SetMode; {@@ inherited from TValueListEditor, activates column titles and automatic column width adjustment by default } property DisplayOptions default [doColumnTitles, doAutoColResize]; {@@ Displays subproperties } property ExpandedNodes: TsInspectorExpandedNodes read FExpanded write SetExpanded default [ienFormatSettings, ienConditionalFormats, ienPageLayout, ienFonts, ienFormats, ienEmbeddedObj, ienImages, ienCryptoInfo]; {@@ inherited from TValueListEditor. Turns of the fixed column by default} property FixedCols default 0; {@@ inherited from TStringGrid, but not published in TValueListEditor. } property ExtendedColSizing; end; function SpreadsheetFormatInClipboard: Boolean; {$IFDEF LCL_FULLVERSION_LT_180} function ScalePPI(ALength: Integer): Integer; {$IFEND} implementation uses Math, StrUtils, TypInfo, Dialogs, Forms, Clipbrd, fpsStrings, fpsCrypto, fpsReaderWriter, fpsUtils, fpsNumFormat, fpsImages, fpsHTMLUtils, fpsExprParser; var cfBiff8Format: Integer = 0; cfBiff5Format: Integer = 0; cfHTMLFormat: Integer = 0; cfTextHTMLFormat: Integer = 0; cfCSVFormat: Integer = 0; { not working... cfOpenDocumentFormat: Integer = 0; cfStarObjectDescriptor: Integer = 0; } {@@ ---------------------------------------------------------------------------- Returns @TRUE if the clipboard contains a format good for pasting into a worksheet grid. -------------------------------------------------------------------------------} function SpreadsheetFormatInClipboard: Boolean; begin Result := Clipboard.HasFormat(cfBiff8Format) or Clipboard.HasFormat(cfBiff5Format) or // Clipboard.HasFormat(cfOpenDocumentFormat) or Clipboard.HasFormat(cfHTMLFormat) or Clipboard.HasFormat(cfTextHTMLFormat) or Clipboard.HasFormat(cfCSVFormat) or Clipboard.HasFormat(CF_TEXT); end; {$IFDEF LCL_FullVersion_LT_180} function ScalePPI(ALength: Integer): Integer; begin Result := MulDiv(ALength, Screen.PixelsPerInch, 96); end; {$IFEND} {------------------------------------------------------------------------------} { TsCellList } {------------------------------------------------------------------------------} type TsCellList = class(TList) private FMultipleRanges: Boolean; function GetCell(AIndex: Integer): PCell; procedure SetCell(AIndex: Integer; ACell: PCell); public destructor Destroy; override; function Add(ACell: PCell): Integer; function AddCell(ACell: PCell): Integer; function AddEmptyCell(ARow, ACol: Cardinal): Integer; procedure Clear; override; procedure Delete(AIndex: Integer); function IndexOf(ACell: PCell): Integer; property CellByIndex[AIndex: Integer]: PCell read GetCell write SetCell; property MultipleRanges: Boolean read FMultipleRanges write FMultipleRanges; end; destructor TsCellList.Destroy; begin Clear; inherited; end; function TsCellList.Add(ACell: PCell): Integer; begin Result := AddCell(ACell); end; { Adds a copy of a specific cell to the list } function TsCellList.AddCell(ACell: PCell): Integer; var cell: PCell; begin if ACell = nil then raise Exception.Create('[TsCellList.AddCell] Cell is nil, use AddEmptyCell.'); Result := IndexOf(ACell); if Result = - 1 then begin New(cell); cell^ := ACell^; Result := inherited Add(cell); end; end; {@@ Adds a "non-existing" cell to the list. Such a cell is nil in the worksheet. Here it has ContentType = cctEmpty and UsedFormattingFields = [], i.e. it is an empty cell without formatting. } function TsCellList.AddEmptyCell(ARow, ACol: Cardinal): Integer; var cell: PCell; begin New(cell); InitCell(nil, ARow, ACol, cell^); Result := inherited Add(cell); end; procedure TsCellList.Clear; var i: Integer; begin for i := Count-1 downto 0 do Delete(i); inherited Clear; end; procedure TsCellList.Delete(AIndex: Integer); var cell: PCell; begin cell := GetCell(AIndex); Dispose(cell); inherited Delete(AIndex); end; function TsCellList.GetCell(AIndex: Integer): PCell; begin Result := PCell(inherited Items[AIndex]); end; function TsCellList.IndexOf(ACell: PCell): Integer; var cell: PCell; begin for Result:=0 to Count-1 do begin cell := GetCell(Result); if (cell^.Row = ACell^.Row) and (cell^.Col = ACell^.Col) then exit; end; Result := -1; end; procedure TsCellList.SetCell(AIndex: Integer; ACell: PCell); var cell: PCell; begin cell := GetCell(AIndex); cell^ := ACell^; end; {------------------------------------------------------------------------------} { TsWorkbookSource } {------------------------------------------------------------------------------} {@@ ---------------------------------------------------------------------------- Constructor of the WorkbookSource class. Creates the internal list for the notified ("listening") components, and creates an empty workbook. @param AOwner Component which is responsibile for destroying the WorkbookSource. -------------------------------------------------------------------------------} constructor TsWorkbookSource.Create(AOwner: TComponent); begin inherited Create(AOwner); FListeners := TFPList.Create; FFileFormatID := ord(sfOOXML); FAutoDetectFormat := True; CreateNewWorkbook; end; {@@ ---------------------------------------------------------------------------- Destructor of the WorkbookSource class. Cleans up the of listening component list and destroys the linked workbook. -------------------------------------------------------------------------------} destructor TsWorkbookSource.Destroy; var i: Integer; begin // Tell listeners that the workbook source will no longer exist for i:= FListeners.Count-1 downto 0 do RemoveListener(TComponent(FListeners[i])); // Destroy listener list FListeners.Free; // Destroy the instance of the workbook FWorkbook.Free; inherited Destroy; end; {@@ ---------------------------------------------------------------------------- Generates a message to the grid to abort the selection process. Needed when copying a format (e.g.) cannot be executed due to overlapping ranges. Without the message, the grid would still be in selection mode. -------------------------------------------------------------------------------} procedure TsWorkbookSource.AbortSelection; begin NotifyListeners([lniAbortSelection], nil); end; {@@ ---------------------------------------------------------------------------- Adds a component to the listener list. All these components are notified of changes in the workbook. @param(AListener Component to be added to the listener list notified of changes.) -------------------------------------------------------------------------------} procedure TsWorkbookSource.AddListener(AListener: TComponent); begin if FListeners.IndexOf(AListener) = -1 then // Avoid duplicates FListeners.Add(AListener); end; {@@ ---------------------------------------------------------------------------- Event handler for the OnChangeCell event of TsWorksheet which is fired whenver cell content or formatting changes. @param Sender Pointer to the worksheet @param ARow Row index (in sheet notation) of the cell changed @param ACol Column index (in sheet notation) of the cell changed -------------------------------------------------------------------------------} procedure TsWorkbookSource.CellChangedHandler(Sender: TObject; ARow, ACol: Cardinal); begin if FWorksheet <> nil then NotifyListeners([lniCell], FWorksheet.FindCell(ARow, ACol)); end; {@@ ---------------------------------------------------------------------------- Event handler for the OnChangeCol event of TsWorksheet which is fired whenver a column width or column format changes. @param Sender Pointer to the worksheet @param ACol Index (in sheet notation) of the column changed -------------------------------------------------------------------------------} procedure TsWorkbookSource.ColChangedHandler(Sender: TObject; ACol: Cardinal); begin if FWorksheet <> nil then NotifyListeners([lniCol], {%H-}Pointer(PtrInt(ACol))); end; {@@ ---------------------------------------------------------------------------- Event handler for the OnChangeFont event of TsWorksheet which is fired whenever a cell font changes. The listener, in particular the worksheetGrid, must adapt the height of non-fixed rows -------------------------------------------------------------------------------} procedure TsWorkbookSource.CellFontChangedHandler(Sender: TObject; ARow, ACol: Cardinal); begin if FWorksheet <> nil then begin NotifyListeners([lniCell], Worksheet.FindCell(ARow, ACol)); NotifyListeners([lniRow], {%H-}Pointer(PtrInt(ARow))); end; end; {@@ ---------------------------------------------------------------------------- Event handler for the OnSelectCell event of TsWorksheet which is fired whenever another cell is selected in the worksheet. Notifies the listeners of the changed selection. @param Sender Pointer to the worksheet @param ARow Row index (in sheet notation) of the newly selected cell @param ACol Column index (in sheet notation) of the newly selected cell -------------------------------------------------------------------------------} procedure TsWorkbookSource.CellSelectedHandler(Sender: TObject; ARow, ACol: Cardinal); var dummycell: TCell; begin dummycell.Row := ARow; dummycell.Col := ACol; // Unused(ARow, ACol); NotifyListeners([lniSelection], @dummycell); if FPendingOperation <> coNone then begin ExecutePendingOperation; FPendingOperation := coNone; end; end; {@@ ---------------------------------------------------------------------------- Event handler for the OnChangeRow event of TsWorksheet which is fired whenver a row width or row format changes. Adds the index of the affected row to the Data field of the notification event. @param Sender Pointer to the worksheet @param ARow Index (in sheet notation) of the row changed -------------------------------------------------------------------------------} procedure TsWorkbookSource.RowChangedHandler(Sender: TObject; ARow: Cardinal); begin if FWorksheet <> nil then NotifyListeners([lniRow], {%H-}Pointer(PtrInt(ARow))); end; {@@ ---------------------------------------------------------------------------- Creates a new empty workbook and adds a single worksheet -------------------------------------------------------------------------------} procedure TsWorkbookSource.CreateNewWorkbook; begin FFileName := ''; FFileFormatID := sfidUnknown; InternalCreateNewWorkbook; FWorksheet := FWorkbook.AddWorksheet(Format(rsDefaultSheetName,[1])); SelectWorksheet(FWorksheet); end; function TsWorkbookSource.DoQueryPassword: String; var crs: TCursor; begin crs := Screen.Cursor; Screen.Cursor := crDefault; try if Assigned(FOnQueryPassword) then Result := FOnQueryPassword() else Result := InputBox('Password required to open workbook', 'Password', ''); finally Screen.Cursor := crs; end; end; {@@ ---------------------------------------------------------------------------- An error has occured during loading of the workbook. Shows a message box by default. But a different behavior can be obtained by means of the OnError event. @param(AErrorMsg Error message text created by the workbook reader and to be displayed in a messagebox or by means of the OnError handler.) -------------------------------------------------------------------------------} procedure TsWorkbookSource.DoShowError(const AErrorMsg: String); begin if Assigned(FOnError) then FOnError(self, AErrorMsg) else MessageDlg(AErrorMsg, mtError, [mbOK], 0); end; {@@ ---------------------------------------------------------------------------- Executes a "pending operation" -------------------------------------------------------------------------------} procedure TsWorkbookSource.ExecutePendingOperation; var destSelection: TsCellRangeArray = nil; srcCell, destCell: PCell; // Pointers to source and destination cells i, j, k: Cardinal; ofsRow, ofsCol: LongInt; function DistinctRanges(R1, R2: TsCellRange): Boolean; begin Result := (R2.Col1 > R1.Col2) or (R1.Col1 > R2.Col2) or (R2.Row1 > R1.Row2) or (R1.Row1 > R2.Row2); end; begin ofsRow := Worksheet.ActiveCellRow - FPendingSelection[0].Row1; ofsCol := Worksheet.ActiveCellCol - FPendingSelection[0].Col1; // Calculate destination ranges which begin at the active cell SetLength(destSelection, Length(FPendingSelection)); for i := 0 to High(FPendingSelection) do destSelection[i] := TsCellRange(Rect( LongInt(FPendingSelection[i].Row1) + ofsRow, LongInt(FPendingSelection[i].Col1) + ofsCol, LongInt(FPendingSelection[i].Row2) + ofsRow, LongInt(FPendingSelection[i].Col2) + ofsCol )); // Check for intersection between source and destination ranges for i:=0 to High(FPendingSelection) do for j:=0 to High(FPendingSelection) do if not DistinctRanges(FPendingSelection[i], destSelection[j]) then begin MessageDlg('Source and destination selections are overlapping. Operation aborted.', mtError, [mbOK], 0); AbortSelection; exit; end; // Execute pending operation for i:=0 to High(FPendingSelection) do for j:=0 to FPendingSelection[i].Row2-FPendingSelection[i].Row1 do for k:=0 to FPendingSelection[i].Col2-FPendingSelection[i].Col1 do begin srcCell := Worksheet.FindCell(FPendingSelection[i].Row1+j, FPendingSelection[i].Col1+k); destCell := Worksheet.GetCell(destSelection[i].Row1+j, destSelection[i].Col1+k); case FPendingOperation of coCopyCell : Worksheet.CopyCell(srcCell, destCell); coCopyFormat : Worksheet.CopyFormat(srcCell, destCell); coCopyFormula: Worksheet.CopyFormula(srcCell, destCell); coCopyValue : Worksheet.CopyValue(srcCell, destCell); end; end; end; {@@ ---------------------------------------------------------------------------- Getter for property "FileFormat -------------------------------------------------------------------------------} function TsWorkbookSource.GetFileFormat: TsSpreadsheetFormat; begin if FFileFormatID < 0 then Result := sfUser else Result := TsSpreadsheetFormat(FFileFormatID); end; {@@ ---------------------------------------------------------------------------- Internal helper method which creates a new workbook without sheets -------------------------------------------------------------------------------} procedure TsWorkbookSource.InternalCreateNewWorkbook(AWorkbook: TsWorkbook = nil); begin FreeAndNil(FWorkbook); FWorksheet := nil; if AWorkbook = nil then FWorkbook := TsWorkbook.Create else FWorkbook := AWorkbook; FWorkbook.OnOpenWorkbook := @WorkbookOpenedHandler; FWorkbook.OnAddWorksheet := @WorksheetAddedHandler; FWorkbook.OnChangeWorksheet := @WorksheetChangedHandler; FWorkbook.OnRemoveWorksheet := @WorksheetRemovedHandler; FWorkbook.OnRemovingWorksheet := @WorksheetRemovingHandler; FWorkbook.OnRenameWorksheet := @WorksheetRenamedHandler; FWorkbook.OnSelectWorksheet := @WorksheetSelectedHandler; // Pass options to workbook SetOptions(FOptions); end; {@@ ---------------------------------------------------------------------------- Internal loader for the spreadsheet file. Is called with various combinations of arguments from several procedures. @param(AFilename Name of the spreadsheet file to be loaded.) @param(AAutoDetect Instructs the loader to automatically detect the file format from the file extension or by temporarily opening the file in all available formats. Note that an exception is raised in the IDE when an incorrect format is tested.) @param(AFormatID Identifier of the spreadsheet file format assumed for the loader. Is ignored when AAutoDetect is @false.) @param(AWorksheetIndex Index of the worksheet to be selected after loading.) @param(APassword Password to open encrypted workbook. Note: this is supported only by ods and xlsx readers.) -------------------------------------------------------------------------------} procedure TsWorkbookSource.InternalLoadFromFile(AFileName: string; AAutoDetect: Boolean; AFormatID: TsSpreadFormatID; AWorksheetIndex: Integer; APassword: String); var book: TsWorkbook; begin book := TsWorkbook.Create; try book.Options := FOptions; book.OnQueryPassword := @DoQueryPassword; if AAutoDetect then book.ReadfromFile(AFileName, APassword) else book.ReadFromFile(AFileName, AFormatID, APassword); InternalLoadFromWorkbook(book, AWorksheetIndex); except // book is normally used as current workbook. But it must be destroyed // if the file cannot be read. book.Free; raise; end; end; procedure TsWorkbookSource.InternalLoadFromWorkbook(AWorkbook: TsWorkbook; AWorksheetIndex: Integer = -1); begin AWorkbook.DisableNotifications; if AWorkbook <> FWorkbook then InternalCreateNewWorkbook(AWorkbook) else SetOptions(FOptions); WorkbookOpenedHandler(self); if AWorksheetIndex = -1 then begin if FWorkbook.ActiveWorksheet <> nil then AWorksheetIndex := FWorkbook.GetWorksheetIndex(FWorkbook.ActiveWorksheet) else AWorksheetIndex := 0; end; SelectWorksheet(FWorkbook.GetWorksheetByIndex(AWorksheetIndex)); AWorkbook.EnableNotifications; // If required, display loading error message if FWorkbook.ErrorMsg <> '' then DoShowError(FWorkbook.ErrorMsg); end; {@@ ---------------------------------------------------------------------------- Inherited method which is called after reading the WorkbookSource from the lfm file. Is overridden here to open a spreadsheet file if a file name has been assigned to the FileName property at design-time. -------------------------------------------------------------------------------} procedure TsWorkbookSource.Loaded; begin inherited; if (FFileName <> '') then SetFileName(FFilename) else CreateNewWorkbook; end; {@@ ---------------------------------------------------------------------------- Public spreadsheet loader to be used if file format is known. Call this method only for built-in file formats. @param(AFilename Name of the spreadsheet file to be loaded.) @param(AFormat Spreadsheet file format assumed for the file.) @param(AWorksheetIndex Index of the worksheet to be selected after loading. (If empty then the active worksheet is loaded) ) -------------------------------------------------------------------------------} procedure TsWorkbookSource.LoadFromSpreadsheetFile(AFileName: string; AFormat: TsSpreadsheetFormat; AWorksheetIndex: Integer = -1); begin if AFormat = sfUser then raise Exception.Create('[TsWorkbook.ReadFromFile] Don''t call this method for user-provided file formats.'); LoadFromSpreadsheetFile(AFileName, ord(AFormat), AWorksheetIndex); end; {@@ ---------------------------------------------------------------------------- Public loader of a spreadsheet file. Call this method for both built-in and user-provided file formats. If the workbook is password-protected the password is prompted by a dialog. @param(AFilename Name of the spreadsheet file to be loaded.) @param(AFormatID Identifier of the spreadsheet file format assumed for the file.) @param(AWorksheetIndex Index of the worksheet to be selected after loading. (If empty then the active worksheet is loaded) ) -------------------------------------------------------------------------------} procedure TsWorkbookSource.LoadFromSpreadsheetFile(AFileName: string; AFormatID: TsSpreadFormatID = sfidUnknown; AWorksheetIndex: Integer = -1); var autodetect: Boolean; begin autodetect := (AFormatID = sfidUnknown); InternalLoadFromFile(AFileName, autodetect, AFormatID, AWorksheetIndex, ''); end; (* {@@ ------------------------------------------------------------------------------ Public spreadsheet loader to be used if file format is not known. The file format is determined from the file extension, or - if this is holds for several formats (such as .xls) - by assuming a format. Note that exceptions are raised in the IDE if in incorrect format is tested. This does not occur outside the IDE. @param AFilename Name of the spreadsheet file to be loaded @param AWorksheetIndex Index of the worksheet to be selected after loading. (If empty then the active worksheet is loaded) -------------------------------------------------------------------------------} procedure TsWorkbookSource.LoadFromSpreadsheetFile(AFileName: string; AWorksheetIndex: Integer = -1); const sfNotNeeded = sfUnknown; // The parameter AFormat if InternalLoadFromFile is not needed here, // but the compiler wants a value... begin InternalLoadFromFile(AFileName, true, sfNotNeeded, AWorksheetIndex); end; *) {@@ ---------------------------------------------------------------------------- Uses an already existing workbook in the visual controls. IMPORTANT: THE CALLING ROUTINE MUST NOT DESTROY THE WORKBOOK, it is destroyed here by the TsWorkbookSource. -------------------------------------------------------------------------------} procedure TsWorkbookSource.LoadFromWorkbook(AWorkbook: TsWorkbook; AWorksheetIndex: Integer = -1); begin InternalLoadFromWorkbook(AWorkbook, AWorksheetIndex); end; {@@ ---------------------------------------------------------------------------- Public loader of a spreadsheet file. Should be called in case of password-protected files when the password is already known and no password dialog should appear. Call this method for both built-in and user-provided file formats. @param(AFilename Name of the spreadsheet file to be loaded.) @param(AFormatID Identifier of the spreadsheet file format assumed for the file.) @param(AWorksheetIndex Index of the worksheet to be selected after loading. (If empty then the active worksheet is loaded) ) -------------------------------------------------------------------------------} procedure TsWorkbookSource.LoadFromProtectedSpreadsheetFile(AFileName: String; AFormatID: TsSpreadFormatID; APassword: String; AWorksheetIndex: Integer = -1); begin InternalLoadFromFile(AFileName, false, AFormatID, AWorksheetIndex, APassword); end; {@@ ---------------------------------------------------------------------------- Notifies listeners of workbook, worksheet, cell, or selection changes. The changed item is identified by the parameter AChangedItems. @param(AChangedItems A set of elements lniWorkbook, lniWorksheet, lniCell, lniSelection which indicate which item has changed.) @param(AData Additional information on the change. Is used only for lniCell and points to the cell having a changed value or formatting.) -------------------------------------------------------------------------------} procedure TsWorkbookSource.NotifyListeners(AChangedItems: TsNotificationItems; AData: Pointer = nil); var j: Integer; I: IsSpreadsheetControl; C: TComponent; begin for j:=0 to FListeners.Count-1 do begin C := TComponent(FListeners[j]); if (C <> nil) then begin if C.GetInterface(GUID_SpreadsheetControl, I) then I.ListenerNotification(AChangedItems, AData) else raise Exception.CreateFmt('[TsWorkbookSource.NotifyListeners] Class %s is not prepared to be a spreadsheet listener.', [C.ClassName]); end; end; // Cleanup listener list from removed listeners (= set to nil) while // NotifyListeners was running for j := FListeners.Count-1 downto 0 do if FListeners[j] = nil then FListeners.Delete(j); end; {@@ ---------------------------------------------------------------------------- Removes a component from the listener list. The component is no longer notified of changes in workbook, worksheet or cells @param AListener Listening component to be removed -------------------------------------------------------------------------------} procedure TsWorkbookSource.RemoveListener(AListener: TComponent); var j: Integer; I: IsSpreadsheetControl; C: TComponent; begin for j:=FListeners.Count-1 downto 0 do begin C := TComponent(FListeners[j]); if C = AListener then begin FListeners[j] := nil; // Do not delete the listener here (FListeners.Delete(j)) because // RemoveListeners may be called while NotifyListeners is still running. // The problem can be that a chart may destroy a listening chart source // which would trigger RemoveListener. If the chart source then would be // deleted from the list the NotifiyListeners loop would access // unallocated memory --> crash if C <> nil then begin if C.GetInterface(GUID_SpreadsheetControl, I) then I.RemoveWorkbookSource else raise Exception.CreateFmt('Class %s not prepared for listening.',[AListener.ClassName]); end; end; end; end; {@@ ---------------------------------------------------------------------------- Writes the workbook of the WorkbookSource component to a spreadsheet file. Call this method only for built-in file formats. @param(AFileName Name of the file to which the workbook is to be saved.) @param(AFormat Spreadsheet file format in which the file is to be saved.) @param(AOverwriteExisting If the file already exists, it is overwritten in the case of AOverwriteExisting = @true, or an exception is raised otherwise.) -------------------------------------------------------------------------------} procedure TsWorkbookSource.SaveToSpreadsheetFile(AFileName: String; AFormat: TsSpreadsheetFormat; AOverwriteExisting: Boolean = true); begin if AFormat = sfUser then raise Exception.Create('[TsWorkbook.ReadFromFile] Don''t call this method for user-provided file formats.'); SaveToSpreadsheetFile(AFileName, ord(AFormat), AOverwriteExisting); end; {@@ ---------------------------------------------------------------------------- Writes the workbook of the WorkbookSource component to a spreadsheet file. Call this method for both built-in and user-provided file formats. @param(AFileName Name of the file to which the workbook is to be saved.) @param(AFormatID Identifier of the spreadsheet file format in which the file is to be saved.) @param(AOverwriteExisting If the file already exists, it is overwritten in the case of AOverwriteExisting = @true, or an exception is raised otherwise.) -------------------------------------------------------------------------------} procedure TsWorkbookSource.SaveToSpreadsheetFile(AFileName: String; AFormatID: TsSpreadFormatID; AOverwriteExisting: Boolean = true); begin if FWorkbook <> nil then begin FWorkbook.WriteToFile(AFileName, AFormatID, AOverwriteExisting); FFileName := AFilename; FFileFormatID := AFormatID; // If required, display loading error message if FWorkbook.ErrorMsg <> '' then DoShowError(FWorkbook.ErrorMsg); end; end; {@@ ---------------------------------------------------------------------------- Saves the workbook into a file with the specified file name. The file format is determined automatically from the extension. If this file name already exists the file is overwritten if AOverwriteExisting is true. @param(AFileName Name of the file to which the workbook is to be saved. If the file format is not known is is written as BIFF8/XLS. ) @param(AOverwriteExisting If this file already exists it is overwritten if AOverwriteExisting = @true, or an exception is raised if AOverwriteExisting = @false.) -------------------------------------------------------------------------------} procedure TsWorkbookSource.SaveToSpreadsheetFile(AFileName: String; AOverwriteExisting: Boolean = true); begin if FWorkbook <> nil then begin FWorkbook.WriteToFile(AFileName, AOverwriteExisting); // If required, display loading error message if FWorkbook.ErrorMsg <> '' then DoShowError(FWorkbook.ErrorMsg); end; end; {@@ ---------------------------------------------------------------------------- Usually called by code or from the spreadsheet grid component. The method identifies a cell to be "selected". Stores its coordinates in the worksheet ("active cell") and notifies the listening controls -------------------------------------------------------------------------------} procedure TsWorkbookSource.SelectCell(ASheetRow, ASheetCol: Cardinal); begin if FWorksheet <> nil then begin FWorksheet.SelectCell(ASheetRow, ASheetCol); NotifyListeners([lniSelection]); end; end; {@@ ---------------------------------------------------------------------------- Selects a worksheet and notifies the controls. This method is usually called by code or from the worksheet tabcontrol. @param AWorksheet Instance of the newly selected worksheet. -------------------------------------------------------------------------------} procedure TsWorkbookSource.SelectWorksheet(AWorkSheet: TsWorksheet); begin FWorksheet := AWorksheet; if (FWorkbook <> nil) and (FWorksheet <> nil) then FWorkbook.SelectWorksheet(AWorksheet); end; {@@ ---------------------------------------------------------------------------- Setter method for the property "FileFormat" -------------------------------------------------------------------------------} procedure TsWorkbookSource.SetFileFormat(AValue: TsSpreadsheetFormat); begin if AValue = sfUser then FFileFormatID := FUserFileFormatID else FFileFormatID := ord(AValue); end; {@@ ---------------------------------------------------------------------------- Setter method for the (public) property "FileFormatID" -------------------------------------------------------------------------------} procedure TsWorkbookSource.SetFileFormatID(AValue: TsSpreadFormatID); begin if AValue >= ord(High(TsSpreadsheetFormat)) then // ">= High()" because we don't want sfUser here. raise Exception.Create('Illegal ID for built-in format ID'); FFileFormatID := AValue; if FFileFormatID < 0 then FUserFileFormatID := FFileFormatID; end; {@@ ---------------------------------------------------------------------------- Setter for the file name property. Loads the spreadsheet file and uses the values of the properties AutoDetectFormat or FileFormat. Useful if the spreadsheet is to be loaded already at design time. But note that an exception can be raised if the file format cannot be determined from the file extension alone. @param AFileName Name of the spreadsheet file to be loaded. -------------------------------------------------------------------------------} procedure TsWorkbookSource.SetFileName(const AFileName: TFileName); begin FFileName := AFileName; if AFileName = '' then begin CreateNewWorkbook; exit; end; if FileExists(FFileName) then begin if FAutoDetectFormat then LoadFromSpreadsheetFile(FFileName) else if (csDesigning in ComponentState) and (FFileFormatID < 0) then raise Exception.Create('[TsWorkbookSource.SetFileName] User-defined file format not allowed in design mode.') else LoadFromSpreadsheetFile(FFileName, FFileFormatID); end else raise Exception.CreateFmt(rsFileNotFound, [ExpandFileName(AFileName)]); end; {@@ ---------------------------------------------------------------------------- Setter for the property Options. Copies the options of the WorkbookSource to the workbook -------------------------------------------------------------------------------} procedure TsWorkbookSource.SetOptions(AValue: TsWorkbookOptions); var AutoCalcChanged: Boolean; begin AutoCalcChanged := (FOptions * [boAutoCalc]) <> (AValue* [boAutoCalc]); FOptions := AValue; if Workbook <> nil then begin Workbook.Options := FOptions; if AutoCalcChanged and (boAutoCalc in FOptions) then Workbook.CalcFormulas; end; end; {@@ ---------------------------------------------------------------------------- Defines a "pending operation" which will be executed at next cell select. Source of the operation is the selection passes as a parameter. -------------------------------------------------------------------------------} procedure TsWorkbookSource.SetPendingOperation(AOperation: TsCopyOperation; const ASelection: TsCellRangeArray); var i: Integer; begin SetLength(FPendingSelection, Length(ASelection)); for i:=0 to High(FPendingSelection) do FPendingSelection[i] := ASelection[i]; FPendingSelection := ASelection; FPendingOperation := AOperation; end; {@@ ---------------------------------------------------------------------------- Copies the selected cells of the worksheet to an internal list ("Clipboard"). Note that this is not the system clipboard in the current implementation. -------------------------------------------------------------------------------} procedure TsWorkbookSource.CopyCellsToClipboard; var sel: TsCellRangeArray; stream: TStream; savedCSVParams: TsCSVParams; s: String; procedure CopyToClipboard(AStream: TStream; AFileFormat: TsSpreadsheetFormat; AClipboardFormat: Integer; AParams: TsStreamParams = []); begin if AClipboardFormat = 0 then exit; FWorkbook.CopyToClipboardStream(AStream, AFileFormat, AParams); Clipboard.AddFormat(AClipboardFormat, AStream); (AStream as TMemoryStream).Clear; end; begin sel := FWorksheet.GetSelection; if Length(sel) = 0 then exit; Clipboard.Open; try Clipboard.Clear; stream := TMemoryStream.Create; try { -- not working... // Write OpenDocument format CopyToClipboard(stream, sfOpenDocument, cfOpenDocumentFormat); // Write OpenDocument's "Star Object Descriptor" WriteStarObjectDescriptorToStream(stream); if cfStarObjectDescriptor <> 0 then Clipboard.AddFormat(cfStarObjectDescriptor, stream); (stream as TMemoryStream).Clear; } // Write BIFF8 format CopyToClipboard(stream, sfExcel8, cfBiff8Format); // Then write BIFF5 format CopyToClipboard(stream, sfExcel5, cfBiff5Format); // Then write Windows HTML format {$IFDEF MSWINDOWS} CopyToClipboard(stream, sfHTML, cfHtmlFormat, [spWindowsClipboardHTML]); {$ENDIF} // Write standard html format (MIME-type "text/html") CopyToClipboard(stream, sfHTML, cfTextHTMLFormat); // Then write CSV format savedCSVParams := CSVParams; CsvParams.Delimiter := ';'; CsvParams.AutoDetectNumberFormat := false; CsvParams.SheetIndex := FWorkbook.GetWorksheetIndex(FWorkbook.ActiveWorksheet); CopyToClipboard(stream, sfCSV, cfCSVFormat); // Finally write TEXT format if FWorksheet.GetSelectionCount = 1 then begin s := FWorksheet.ReadAsText(FWorksheet.ActiveCellRow, FWorksheet.ActiveCellCol); if s <> '' then begin stream.Write(s[1], Length(s)); stream.WriteByte(0); stream.Position := 0; Clipboard.AddFormat(CF_TEXT, stream); (stream as TMemoryStream).Clear; end; end else begin CsvParams.Delimiter := #9; CopyToClipboard(stream, sfCSV, CF_TEXT); CSVParams := savedCSVParams; end; // To do: XML format, ods format finally stream.Free; end; finally Clipboard.Close; end; end; {@@ ---------------------------------------------------------------------------- Copies the selected cells of the worksheet to an internal list ("Clipboard") and deletes them afterwards. -------------------------------------------------------------------------------} procedure TsWorkbookSource.CutCellsToClipboard; begin CopyCellsToClipboard; FWorksheet.DeleteSelection; end; {@@ ---------------------------------------------------------------------------- Pastes the cells stored in the internal list "Clipboard" into the worksheet. Using their stored row/col indexes the stored cells are translated such that the first stored cell appears at the currently active cell in the worksheet. AOperation determines which "item" of the cell (all, values, formats, formula) is pasted. If ATranspose is @TRUE then rows and columns are interchanged. -------------------------------------------------------------------------------} procedure TsWorkbookSource.PasteCellsFromClipboard(AItem: TsCopyOperation; ATransposed: Boolean = false); var fmt: TsSpreadsheetFormat; stream: TStream; params: TsStreamParams; begin stream := TMemoryStream.Create; try params := [spClipboard]; // Check whether the clipboard content is suitable for fpspreadsheet {if Clipboard.GetFormat(cfOpenDocumentFormat, stream) then fmt := sfOpenDocument else} if Clipboard.GetFormat(cfBiff8Format, stream) then fmt := sfExcel8 else if Clipboard.GetFormat(cfBiff5Format, stream) then fmt := sfExcel5 else if Clipboard.GetFormat(cfHTMLFormat, stream) then begin fmt := sfHTML; params := params + [spWindowsClipboardHTML]; end else if Clipboard.GetFormat(cfTextHTMLFormat, stream) then fmt := sfHTML else if Clipboard.GetFormat(cfCSVFormat, stream) then fmt := sfCSV else if Clipboard.GetFormat(CF_TEXT, stream) then fmt := sfCSV else begin // Exit if there are no spreadsheet data in clipboard MessageDlg('No appropriate spreadsheet data in clipboard', mtError, [mbOk], 0); exit; end; // Paste stream into workbook stream.Position := 0; FWorkbook.PasteFromClipboardStream(stream, fmt, AItem, params, ATransposed); // To do: XML format, ods format finally stream.Free; end; end; {@@ ---------------------------------------------------------------------------- Event handler called whenever a new workbook is opened. -------------------------------------------------------------------------------} procedure TsWorkbookSource.WorkbookOpenedHandler(Sender: TObject); begin Unused(Sender); NotifyListeners([lniWorkbook]); if FWorkbook.ActiveWorksheet = nil then SelectWorksheet(FWorkbook.GetFirstWorksheet) else SelectWorksheet(FWorkbook.ActiveWorksheet); end; {@@ ---------------------------------------------------------------------------- Event handler called whenever a new worksheet is added to the workbook @param Sender Pointer to the workbook to which a new worksheet has been added @param ASheet Worksheet which is added to the workbook. -------------------------------------------------------------------------------} procedure TsWorkbookSource.WorksheetAddedHandler(Sender: TObject; ASheet: TsWorksheet); begin Unused(Sender); NotifyListeners([lniWorksheetAdd]); SelectWorksheet(ASheet); end; {@@ ---------------------------------------------------------------------------- Event handler canned whenever worksheet properties have changed. Currently only used for changing the workbook name. @param Sender Workbook containing the modified worksheet @param ASheet Worksheet which has been modified -------------------------------------------------------------------------------} procedure TsWorkbookSource.WorksheetChangedHandler(Sender: TObject; ASheet: TsWorksheet); begin Unused(Sender, ASheet); NotifyListeners([lniWorkbook, lniWorksheet]); end; {@@ ---------------------------------------------------------------------------- Event handler called AFTER a worksheet has been removed (deleted) from the workbook @param(Sender Points to the workbook from which the sheet has been deleted.) @param(ASheetIndex Index of the sheet that was deleted. The sheet itself does not exist any more.) -------------------------------------------------------------------------------} procedure TsWorkbookSource.WorksheetRemovedHandler(Sender: TObject; ASheetIndex: Integer); var i, sheetCount: Integer; sheet: TsWorksheet; begin // It is very possible that the currently selected worksheet has been deleted. // Look for the selected worksheet in the workbook. Does it still exist? ... i := Workbook.GetWorksheetIndex(FWorksheet); if i = -1 then begin // ... no - it must have been the sheet deleted. // We have to select another worksheet. sheetCount := Workbook.GetWorksheetCount; if (ASheetIndex >= sheetCount) then sheet := Workbook.GetWorksheetByIndex(sheetCount-1) else sheet := Workbook.GetWorksheetbyIndex(ASheetIndex); end else if ASheetIndex > -1 then sheet := FWorksheet else sheet := nil; // all sheets were removed // FWorksheet := sheet; // is needed by listeners! NotifyListeners([lniWorksheetRemove]); SelectWorksheet(sheet); end; {@@ ---------------------------------------------------------------------------- Event handler called BEFORE a worksheet is deleted. @param Sender Workbook containing the worksheet @param AWorksheet Worksheet which is to be deleted -------------------------------------------------------------------------------} procedure TsWorkbookSource.WorksheetRemovingHandler(Sender: TObject; AWorksheet: TsWorksheet); begin NotifyListeners([lniWorksheetRemoving], AWorksheet); end; {@@ ---------------------------------------------------------------------------- Event handler called after a worksheet has been renamed @param Sender Workbook containing the worksheet @param AWorksheet Worksheet which has been renamed -------------------------------------------------------------------------------} procedure TsWorkbookSource.WorksheetRenamedHandler(Sender: TObject; AWorksheet: TsWorksheet); begin NotifyListeners([lniWorksheetRename], AWorksheet); end; {@@ ---------------------------------------------------------------------------- Event handler called whenever a the workbook makes a worksheet "active". @param Sender Workbook containing the worksheet @param AWorksheet Worksheet which has been activated -------------------------------------------------------------------------------} procedure TsWorkbookSource.WorksheetSelectedHandler(Sender: TObject; AWorksheet: TsWorksheet); var r, c: Cardinal; begin FWorksheet := AWorksheet; if FWorksheet <> nil then begin FWorksheet.OnChangeCell := @CellChangedHandler; FWorksheet.OnChangeCol := @ColChangedHandler; FWorksheet.OnChangeFont := @CellFontChangedHandler; FWorksheet.OnChangeRow := @RowChangedHandler; FWorksheet.OnSelectCell := @CellSelectedHandler; FWorksheet.OnZoom := @WorksheetZoomHandler; NotifyListeners([lniWorksheet]); FWorksheet := AWorksheet; // !!!!! if FWorksheet.ActiveCellRow = UNASSIGNED_ROW_COL_INDEX then r := FWorksheet.TopPaneHeight else r := FWorksheet.ActiveCellRow; if FWorksheet.ActiveCellCol = UNASSIGNED_ROW_COL_INDEX then c := FWorksheet.LeftPaneWidth else c := FWorksheet.ActiveCellCol; SelectCell(r, c); end else NotifyListeners([lniWorksheet]); end; {@@ ---------------------------------------------------------------------------- Event handler called whenever the workbook is zoomed -------------------------------------------------------------------------------} procedure TsWorkbookSource.WorksheetZoomHandler(Sender: TObject); begin NotifyListeners([lniWorksheetZoom], FWorksheet); end; {------------------------------------------------------------------------------} { TsWorkbookTabControl } {------------------------------------------------------------------------------} {@@ ---------------------------------------------------------------------------- Constructor of the WorkbookTabControl. -------------------------------------------------------------------------------} constructor TsWorkbookTabControl.Create(AOwner: TComponent); begin inherited Create(AOwner); FShowAllSheets := true; end; {@@ ---------------------------------------------------------------------------- Destructor of the WorkbookTabControl. Removes itself from the WorkbookSource's listener list. -------------------------------------------------------------------------------} destructor TsWorkbookTabControl.Destroy; begin if FWorkbookSource <> nil then FWorkbookSource.RemoveListener(self); inherited Destroy; end; {@@ ---------------------------------------------------------------------------- The currently active tab has been changed. The WorkbookSource must activate the corresponding worksheet and notify its listening components of the change. -------------------------------------------------------------------------------} procedure TsWorkbookTabControl.Change; var sheetName: String; begin if (FWorkbookSource <> nil) and (FLockCount = 0) then begin sheetName := Tabs[TabIndex]; FWorkbookSource.SelectWorksheet(Workbook.GetWorksheetByName(sheetName)); end; inherited; end; {@@ ---------------------------------------------------------------------------- Populates a (string) list with the names of the workbook's sheet names. If ShowHiddenSheets is false hidden worksheets are skipped. Is called whenever the workbook changes. -------------------------------------------------------------------------------} procedure TsWorkbookTabControl.GetSheetList(AList: TStrings); var i: Integer; sheet: TsWorksheet; begin AList.Clear; if Workbook <> nil then for i:=0 to Workbook.GetWorksheetCount-1 do begin sheet := Workbook.GetWorksheetByIndex(i); if FShowAllSheets or not (soHidden in sheet.Options) then AList.Add(sheet.Name); end; end; {@@ ---------------------------------------------------------------------------- Getter method for property "Workbook" -------------------------------------------------------------------------------} function TsWorkbookTabControl.GetWorkbook: TsWorkbook; begin if FWorkbookSource <> nil then Result := FWorkbookSource.Workbook else Result := nil; end; {@@ ---------------------------------------------------------------------------- Getter method for property "Worksheet" -------------------------------------------------------------------------------} function TsWorkbookTabControl.GetWorksheet: TsWorksheet; begin if FWorkbookSource <> nil then Result := FWorkbookSource.Worksheet else Result := nil; end; {@@ ---------------------------------------------------------------------------- Notification message received from the WorkbookSource telling which spreadsheet item has changed. Responds to workbook changes by reading the worksheet names into the tabs, and to worksheet changes by selecting the tab corresponding to the selected worksheet. @param(AChangedItems Set with elements identifying whether workbook, worksheet cell content or cell formatting has changed.) @param(AData Additional data, not used here.) -------------------------------------------------------------------------------} procedure TsWorkbookTabControl.ListenerNotification( AChangedItems: TsNotificationItems; AData: Pointer = nil); var i: Integer; sheet: TsWorksheet; begin Unused(AData); // Workbook changed: new workbook, worksheet added/renamed/deleted if (AChangedItems * [lniWorkbook, lniWorksheetAdd, lniWorksheetRemove, lniWorksheetRename] <> []) then begin inc(FLockCount); // avoid WorkbookSelect message when adding each tab GetSheetList(Tabs); if (lniWorkbook in AChangedItems) and (Workbook <> nil) then begin i := Tabs.IndexOf(Workbook.ActiveWorksheet.Name); if i > -1 then TabIndex := i else TabIndex := 0 end else if (lniWorksheetAdd in AChangedItems) then TabIndex := Tabs.Count-1 else if (lniWorksheetRename in AChangedItems) then begin sheet := TsWorksheet(AData); TabIndex := Tabs.IndexOf(sheet.Name); end; dec(FLockCount); end; // Worksheet selected if (lniWorksheet in AChangedItems) and (Worksheet <> nil) then begin i := Tabs.IndexOf(Worksheet.Name); if i <> TabIndex then TabIndex := i; end; end; {@@ ---------------------------------------------------------------------------- Standard component notification. Must clean up the WorkbookSource field when the workbook source is going to be deleted. -------------------------------------------------------------------------------} procedure TsWorkbookTabControl.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if (Operation = opRemove) and (AComponent = FWorkbookSource) then SetWorkbookSource(nil); end; {@@ ---------------------------------------------------------------------------- Removes the link of the TabControl to the WorkbookSource. Required before destruction. -------------------------------------------------------------------------------} procedure TsWorkbookTabControl.RemoveWorkbookSource; begin SetWorkbookSource(nil); end; {@@ ---------------------------------------------------------------------------- Setter method for the property ShowHiddenSheets -------------------------------------------------------------------------------} procedure TsWorkbookTabControl.SetShowAllSheets(AValue: Boolean); var idx, i: Integer; sheet: TsWorksheet; begin if AValue = FShowAllSheets then exit; FShowAllSheets := AValue; idx := -1; // Find tabindex of next visible sheet if not FShowAllSheets and (Workbook <> nil) then begin for i:=0 to Workbook.GetWorksheetCount-1 do begin sheet := Workbook.GetWorksheetByIndex(i); if sheet = Worksheet then break; if not (soHidden in sheet.Options) then inc(idx); end; i := idx; while (sheet <> nil) and (soHidden in sheet.Options) do begin inc(i); sheet := Workbook.GetWorksheetByIndex(i); end; if sheet = nil then begin i := idx; while (sheet <> nil) and (soHidden in sheet.Options) do begin dec(i); sheet := Workbook.GetWorksheetByIndex(i); end; if sheet = nil then idx := -1; end; end; Change; if (not FShowAllSheets) then TabIndex := idx; end; {@@ ---------------------------------------------------------------------------- Setter method for the WorkbookSource -------------------------------------------------------------------------------} procedure TsWorkbookTabControl.SetWorkbookSource(AValue: TsWorkbookSource); begin if AValue = FWorkbookSource then exit; if FWorkbookSource <> nil then FWorkbookSource.RemoveListener(self); FWorkbookSource := AValue; if FWorkbookSource <> nil then FWorkbookSource.AddListener(self); ListenerNotification([lniWorkbook, lniWorksheet]); end; {------------------------------------------------------------------------------} { TsWorksheetIndicator } {------------------------------------------------------------------------------} constructor TsWorksheetIndicator.Create(AOwner: TComponent); begin inherited Create(AOwner); FShowAllSheets := true; end; destructor TsWorksheetIndicator.Destroy; begin if FWorkbookSource <> nil then FWorkbookSource.RemoveListener(self); inherited Destroy; end; procedure TsWorksheetIndicator.Change; var sheetName: String; begin if (FWorkbookSource <> nil) and (FLockCount = 0) then begin sheetName := Items[ItemIndex]; FWorkbookSource.SelectWorksheet(Workbook.GetWorksheetByName(sheetName)); end; inherited; end; procedure TsWorksheetIndicator.GetSheetList(AList: TStrings); var i: Integer; sheet: TsWorksheet; begin AList.Clear; if Workbook <> nil then for i:=0 to Workbook.GetWorksheetCount-1 do begin sheet := Workbook.GetWorksheetByIndex(i); if FShowAllSheets or not (soHidden in sheet.Options) then AList.Add(sheet.Name); end; end; function TsWorksheetIndicator.GetWorkbook: TsWorkbook; begin if FWorkbookSource <> nil then Result := FWorkbookSource.Workbook else Result := nil; end; function TsWorksheetIndicator.GetWorksheet: TsWorksheet; begin if FWorkbookSource <> nil then Result := FWorkbookSource.Worksheet else Result := nil; end; procedure TsWorksheetIndicator.ListenerNotification( AChangedItems: TsNotificationItems; AData: Pointer = nil); var i: Integer; sheet: TsWorksheet; begin Unused(AData); // Workbook changed: new workbook, worksheet added/renamed/deleted if (AChangedItems * [lniWorkbook, lniWorksheetAdd, lniWorksheetRemove, lniWorksheetRename] <> []) then begin inc(FLockCount); // avoid WorkbookSelect message when adding each tab GetSheetList(Items); if (lniWorkbook in AChangedItems) and (Workbook <> nil) then begin i := Items.IndexOf(Workbook.ActiveWorksheet.Name); if i > -1 then ItemIndex := i else ItemIndex := 0 end else if (lniWorksheetAdd in AChangedItems) then ItemIndex := Items.Count-1 else if (lniWorksheetRename in AChangedItems) then begin sheet := TsWorksheet(AData); ItemIndex := Items.IndexOf(sheet.Name); end; dec(FLockCount); end; // Worksheet selected if (lniWorksheet in AChangedItems) and (Worksheet <> nil) then begin i := Items.IndexOf(Worksheet.Name); if i <> ItemIndex then ItemIndex := i; end; end; procedure TsWorksheetIndicator.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if (Operation = opRemove) and (AComponent = FWorkbookSource) then SetWorkbookSource(nil); end; procedure TsWorksheetIndicator.RemoveWorkbookSource; begin SetWorkbookSource(nil); end; procedure TsWorksheetIndicator.SetShowAllSheets(AValue: Boolean); var idx, i: Integer; sheet: TsWorksheet; begin if AValue = FShowAllSheets then exit; FShowAllSheets := AValue; idx := -1; // Find ItemIndex of next visible sheet if not FShowAllSheets and (Workbook <> nil) then begin for i:=0 to Workbook.GetWorksheetCount-1 do begin sheet := Workbook.GetWorksheetByIndex(i); if sheet = Worksheet then break; if not (soHidden in sheet.Options) then inc(idx); end; i := idx; while (sheet <> nil) and (soHidden in sheet.Options) do begin inc(i); sheet := Workbook.GetWorksheetByIndex(i); end; if sheet = nil then begin i := idx; while (sheet <> nil) and (soHidden in sheet.Options) do begin dec(i); sheet := Workbook.GetWorksheetByIndex(i); end; if sheet = nil then idx := -1; end; end; Change; if (not FShowAllSheets) then ItemIndex := idx; end; procedure TsWorksheetIndicator.SetWorkbookSource(AValue: TsWorkbookSource); begin if AValue = FWorkbookSource then exit; if FWorkbookSource <> nil then FWorkbookSource.RemoveListener(self); FWorkbookSource := AValue; if FWorkbookSource <> nil then FWorkbookSource.AddListener(self); ListenerNotification([lniWorkbook, lniWorksheet]); end; {------------------------------------------------------------------------------} { TsCellEdit } {------------------------------------------------------------------------------} {@@ ---------------------------------------------------------------------------- Constructor of the spreadsheet edit control. Disables RETURN and TAB keys. RETURN characters can still be entered into the edited text by pressing CTRL+RETURN @param AOwner Component which is responsible to destroy the CellEdit -------------------------------------------------------------------------------} constructor TsCellEdit.Create(AOwner: TComponent); begin inherited Create(AOwner); FShowHTMLText := True; WantReturns := false; WantTabs := false; AutoSize := true; end; {@@ ---------------------------------------------------------------------------- Destructor of the TsCellEdit. Removes itself from the WorkbookSource's listener list. -------------------------------------------------------------------------------} destructor TsCellEdit.Destroy; begin if FWorkbookSource <> nil then FWorkbookSource.RemoveListener(self); inherited Destroy; end; function TsCellEdit.CanEditCell(ACell: PCell): Boolean; begin if Worksheet.IsMerged(ACell) then ACell := Worksheet.FindMergeBase(ACell); Result := not ( Worksheet.IsProtected and (spCells in Worksheet.Protection) and ((ACell = nil) or (cpLockcell in Worksheet.ReadCellProtection(ACell))) ); end; function TsCellEdit.CanEditCell(ARow, ACol: Cardinal): Boolean; var cell: PCell; begin cell := Worksheet.FindCell(ARow, ACol); Result := CanEditCell(cell); end; procedure TsCellEdit.DoEnter; begin if Worksheet = nil then exit; if not CanEditCell(Worksheet.ActiveCellRow, Worksheet.ActiveCellCol) then begin MessageDlg('This cell is protected from editing. Unlock worksheet protection '+ 'before continuing.', mtInformation, [mbOK], 0); Abort; end; if FRefocusing = self then FRefocusing := nil; inherited; end; {@@ ---------------------------------------------------------------------------- DoExit is called when the edit has lost focus. Posts a message to the end of the message queue in order to complete the focus change operation and to trigger validation of the edit afterwards (which will restore the edit as focused control if validation fails. Source of the idea: https://community.embarcadero.com/article/technical-articles/149-tools/12766-validating-input-in-tedit-components -------------------------------------------------------------------------------} procedure TsCellEdit.DoExit; begin if FRefocusing = nil then begin // Remember current text in editor... FEditText := Text; // ... as well as currently selected cell. FRefocusingRow := Worksheet.ActiveCellRow; FRefocusingCol := Worksheet.ActiveCellCol; FRefocusingSelStart := SelStart; // Initiate validation of current input PostMessage(Handle, UM_VALIDATEINPUT, 0, LParam(Self)); end; inherited; end; {@@ ---------------------------------------------------------------------------- Validation function for the current text in the edit control called by the handler of the message posted in DoExit. Checks whether a formula is valid. If not, the currently selected cell and the edit's Text are restored, and an error message is displayed. -------------------------------------------------------------------------------} function TsCellEdit.DoValidText(const AText: String): Boolean; var err: String; begin Result := ValidFormula(AText, err); Worksheet.SelectCell(FRefocusingRow, FRefocusingCol); Text := AText; // restore orig text lost by interaction with grid SelStart := FRefocusingSelStart; if Result then WriteToCell else MessageDlg(err, mtError, [mbOK], 0); end; {@@ ---------------------------------------------------------------------------- EditingDone is called when the user presses the RETURN key to finish editing. If the current Text is an invalid formula an error message is displayed and nothing else happens. Otherwise, however, the edited text is written to the worksheet which tries to figure out the data type. -------------------------------------------------------------------------------} procedure TsCellEdit.EditingDone; var s: String; begin if (Worksheet = nil) then exit; if not ValidFormula(Text, s) then begin MessageDlg(s, mtError, [mbOK], 0); exit; end; WriteToCell; inherited; end; {@@ ---------------------------------------------------------------------------- Getter method for the property SelectedCell which points to the currently active cell in the selected worksheet -------------------------------------------------------------------------------} function TsCellEdit.GetSelectedCell: PCell; begin if (Worksheet <> nil) then with Worksheet do Result := FindCell(ActiveCellRow, ActiveCellCol) else Result := nil; end; {@@ ---------------------------------------------------------------------------- Getter method for the property Workbook which is currently loaded by the WorkbookSource -------------------------------------------------------------------------------} function TsCellEdit.GetWorkbook: TsWorkbook; begin if FWorkbookSource <> nil then Result := FWorkbookSource.Workbook else Result := nil; end; {@@ ---------------------------------------------------------------------------- Getter method for the property Worksheet which is currently "selected" in the WorkbookSource -------------------------------------------------------------------------------} function TsCellEdit.GetWorksheet: TsWorksheet; begin if FWorkbookSource <> nil then Result := FWorkbookSource.Worksheet else Result := nil; end; {@@ ---------------------------------------------------------------------------- Inherited KeyDown method. Overridden here in order to be able to restore the old cell content if ESC is pressed. -------------------------------------------------------------------------------} procedure TsCellEdit.KeyDown(var Key: Word; Shift : TShiftState); var selpos: Integer; errMsg: String; begin FFormulaError := false; case Key of VK_RETURN: if not ValidFormula(Text, errMsg) then begin Key := 0; FFormulaError := true; MessageDlg(errMsg, mtError, [mbOK], 0); end; VK_ESCAPE: begin Key := 0; selpos := SelStart; Lines.Text := FOldText; SelStart := selpos; exit; end; end; inherited; end; procedure TsCellEdit.KeyUp(var Key: Word; Shift : TShiftState); begin if FFormulaError and (Key = VK_RETURN) then Key := 0; inherited; end; {@@ ---------------------------------------------------------------------------- Notification message received from the WorkbookSource telling which item of the spreadsheet has changed. Responds to selection and cell changes by updating the cell content. @param(AChangedItems Set with elements identifying whether workbook, worksheet cell content or cell formatting has changed.) @param(AData If AChangedItems contains nliCell then AData points to the modified cell.) -------------------------------------------------------------------------------} procedure TsCellEdit.ListenerNotification( AChangedItems: TsNotificationItems; AData: Pointer = nil); var cell: PCell; begin if (FWorkbookSource = nil) or (FRefocusing = self) then exit; if (lniSelection in AChangedItems) or ((lniCell in AChangedItems) and (PCell(AData) = SelectedCell)) then begin if Worksheet.IsMerged(SelectedCell) then cell := Worksheet.FindMergeBase(SelectedCell) else cell := SelectedCell; ShowCell(cell); end; end; {@@ ---------------------------------------------------------------------------- Standard component notification. Called when the WorkbookSource is deleted. -------------------------------------------------------------------------------} procedure TsCellEdit.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if (Operation = opRemove) and (AComponent = FWorkbookSource) then SetWorkbookSource(nil); end; {@@ ---------------------------------------------------------------------------- Removes the link of the CellEdit to the WorkbookSource. Required before destruction. -------------------------------------------------------------------------------} procedure TsCellEdit.RemoveWorkbookSource; begin SetWorkbookSource(nil); end; {@@ ---------------------------------------------------------------------------- Setter method for the WorkbookSource -------------------------------------------------------------------------------} procedure TsCellEdit.SetWorkbookSource(AValue: TsWorkbookSource); begin if AValue = FWorkbookSource then exit; if FWorkbookSource <> nil then FWorkbookSource.RemoveListener(self); FWorkbookSource := AValue; if FWorkbookSource <> nil then FWorkbookSource.AddListener(self); Text := ''; ListenerNotification([lniSelection]); end; {@@ ---------------------------------------------------------------------------- Loads the contents of a cell into the editor. Shows the formula if available, but not the calculation result. Numbers are displayed in full precision. Date and time values are shown in the long formats. @param ACell Pointer to the cell loaded into the cell editor. -------------------------------------------------------------------------------} procedure TsCellEdit.ShowCell(ACell: PCell); var s: String; hideformula: Boolean; begin if (FWorkbookSource <> nil) and (ACell <> nil) then begin hideformula := Worksheet.IsProtected and (spCells in Worksheet.Protection) and (cpHideFormulas in Worksheet.ReadCellProtection(ACell)); s := Worksheet.ReadFormulaAsString(ACell, true); if (s <> '') then begin if hideformula then s := '(Formula hidden)' else if s[1] <> '=' then s := '=' + s; Lines.Text := s; end else case ACell^.ContentType of cctNumber: Lines.Text := FloatToStr(ACell^.NumberValue); cctDateTime: if ACell^.DateTimeValue < 1.0 then // Time only Lines.Text := FormatDateTime('tt', ACell^.DateTimeValue) else if frac(ACell^.DateTimeValue) = 0 then // Date only Lines.Text := FormatDateTime('ddddd', ACell^.DateTimevalue) else // both Lines.Text := FormatDateTime('c', ACell^.DateTimeValue); cctUTF8String: if FShowHTMLText then begin RichTextToHTML(Workbook, Worksheet.ReadCellFont(ACell), ACell^.UTF8StringValue, ACell^.RichTextParams, s); Lines.Text := s; end else Lines.Text := ACell^.UTF8StringValue; else Lines.Text := Worksheet.ReadAsText(ACell); end; end else Clear; FOldText := Lines.Text; ReadOnly := not CanEditCell(ACell); end; {@@ ---------------------------------------------------------------------------- Validation routine of current input initiated when the edit lost focus. If input is not correct (DoValidText) then state before focus change is re-established. -------------------------------------------------------------------------------} procedure TsCellEdit.ValidateInput(var Msg: TLMessage); var s: String; begin if TControl(Msg.lParam) is TsCellEdit then begin s := TsCellEdit(Msg.lParam).FEditText; if not DoValidText(s) then begin FRefocusing := TControl(Msg.lParam); // Avoid an endless loop TWinControl(Msg.lParam).SetFocus; // Set focus back end; end; end; {@@ ---------------------------------------------------------------------------- Checks valididty of the provided formula and creates a corresponding error message. It is assumed that the formula is localized. @Returns(@TRUE if the provided string is a valid formula or no formula, @FALSE otherwise. In the latter case an error message string is returned as well.) -------------------------------------------------------------------------------} function TsCellEdit.ValidFormula(AFormula: String; out AErrMsg: String): Boolean; var parser: TsSpreadsheetParser; begin Result := true; AErrMsg := ''; if Assigned(Worksheet) and (AFormula <> '') and (AFormula[1] = '=') then begin parser := TsSpreadsheetParser.Create(Worksheet); try try parser.Expression[fdLocalized] := AFormula; except on E: Exception do begin AErrMsg := E.Message; Result := false; end; end; finally parser.Free; end; end; end; procedure TsCellEdit.WMKillFocus(var AMessage: TLMKillFocus); begin Unused(AMessage); // Override inherited behavior because we don't want to call EditingDone // here. end; {@@ ---------------------------------------------------------------------------- Writes the current edit text to the cell @Note All validation checks already have been performed. -------------------------------------------------------------------------------} procedure TsCellEdit.WriteToCell; var cell: PCell; s: String; begin cell := Worksheet.GetCell(Worksheet.ActiveCellRow, Worksheet.ActiveCellCol); if Worksheet.IsMerged(cell) then cell := Worksheet.FindMergeBase(cell); s := Lines.Text; if (s <> '') and (s[1] = '=') then Worksheet.WriteFormula(cell, Copy(s, 2, Length(s)), true) else Worksheet.WriteCellValueAsString(cell, s); end; {------------------------------------------------------------------------------} { TsCellIndicator } {------------------------------------------------------------------------------} {@@ ---------------------------------------------------------------------------- Constructor of the TsCellIndicator class. Is overridden to set the default value of the Alignment property to taCenter. -------------------------------------------------------------------------------} constructor TsCellIndicator.Create(AOwner: TComponent); begin inherited Create(AOwner); Alignment := taCenter; end; {@@ ---------------------------------------------------------------------------- Destructor of the cell indicator. Removes itself from the WorkbookSource's listener list. -------------------------------------------------------------------------------} destructor TsCellIndicator.Destroy; begin if FWorkbookSource <> nil then FWorkbookSource.RemoveListener(self); inherited Destroy; end; {@@ ---------------------------------------------------------------------------- EditingDone is called when the user presses the RETURN key to finish editing, or the TAB key which removes focus from the control, or clicks somewhere else The edited text is interpreted as a cell address. The corresponding cell is selected. -------------------------------------------------------------------------------} procedure TsCellIndicator.EditingDone; var r, c: Cardinal; begin if (WorkbookSource <> nil) and ParseCellString(Text, r, c) then WorkbookSource.SelectCell(r, c); end; {@@ ---------------------------------------------------------------------------- Getter method for the property Workbook which is currently loaded by the WorkbookSource -------------------------------------------------------------------------------} function TsCellIndicator.GetWorkbook: TsWorkbook; begin if FWorkbookSource <> nil then Result := FWorkbookSource.Workbook else Result := nil; end; {@@ ---------------------------------------------------------------------------- Getter method for the property Worksheet which is currently loaded by the WorkbookSource -------------------------------------------------------------------------------} function TsCellIndicator.GetWorksheet: TsWorksheet; begin if FWorkbookSource <> nil then Result := FWorkbookSource.Worksheet else Result := nil; end; {@@ ---------------------------------------------------------------------------- The cell indicator reacts to notification that the selection has changed and displays the address of the newly selected cell as editable text. @param(AChangedItems Set with elements identifying whether workbook, worksheet cell or selection has changed. Only the latter element is considered by the cell indicator.) @param(AData If AChangedItems contains nliCell then AData points to the modified cell.) -------------------------------------------------------------------------------} procedure TsCellIndicator.ListenerNotification(AChangedItems: TsNotificationItems; AData: Pointer = nil); begin Unused(AData); if (lniSelection in AChangedItems) and (Worksheet <> nil) then UpdateDisplay; end; {@@ ---------------------------------------------------------------------------- Standard component notification called when the WorkbookSource is deleted. -------------------------------------------------------------------------------} procedure TsCellIndicator.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if (Operation = opRemove) and (AComponent = FWorkbookSource) then SetWorkbooksource(nil); end; {@@ ---------------------------------------------------------------------------- Removes the link of the CellIndicator to the WorkbookSource. Required before destruction. -------------------------------------------------------------------------------} procedure TsCellIndicator.RemoveWorkbookSource; begin SetWorkbookSource(nil); end; {@@ ---------------------------------------------------------------------------- Setter method for the WorkbookSource -------------------------------------------------------------------------------} procedure TsCellIndicator.SetWorkbookSource(AValue: TsWorkbookSource); begin if AValue = FWorkbookSource then exit; if FWorkbookSource <> nil then FWorkbookSource.RemoveListener(self); FWorkbookSource := AValue; if FWorkbookSource <> nil then FWorkbookSource.AddListener(self); Text := ''; ListenerNotification([lniSelection]); end; procedure TsCellIndicator.UpdateDisplay; var sel: TsCellRangeArray; s: String; rng: TsCellRange; numrows, numcols: Integer; r, c: Cardinal; cell: PCell; begin r := Worksheet.ActiveCellRow; c := Worksheet.ActiveCellCol; cell := Worksheet.FindCell(r, c); if cell <> nil then begin cell := Worksheet.FindMergeBase(cell); if cell <> nil then begin r := cell^.Row; c := cell^.Col; end; end; s := GetCellString(r, c); sel := Worksheet.GetSelection; if Length(sel) > 0 then begin rng := sel[High(sel)]; numrows := rng.Row2 - rng.Row1 + 1; numcols := rng.Col2 - rng.Col1 + 1; if (numrows <> 1) or (numcols <> 1) then s := Format('%s (%d R x %d C)', [s, rng.Row2-rng.Row1+1, rng.Col2-rng.Col1+1]); end; Text := s; end; {------------------------------------------------------------------------------} { TsCellCombobox } {------------------------------------------------------------------------------} {@@ ---------------------------------------------------------------------------- Constructor of the Cell Combobox. Populates the items list -------------------------------------------------------------------------------} constructor TsCellCombobox.Create(AOwner: TComponent); begin inherited Create(AOwner); FColorRectWidth := 10; FColorRectOffset := 2; ItemHeight := -1; end; {@@ ---------------------------------------------------------------------------- Destructor of the WorkbookTabControl. Removes itself from the WorkbookSource's listener list. -------------------------------------------------------------------------------} destructor TsCellCombobox.Destroy; begin if FWorkbookSource <> nil then FWorkbookSource.RemoveListener(self); inherited Destroy; end; {@@ ---------------------------------------------------------------------------- Adds a named color to the combobox items -------------------------------------------------------------------------------} procedure TsCellCombobox.AddColor(AColor: TsColor; AColorName: String); var noText: Boolean; begin if (FFormatItem in [cfiFontColor, cfiBackgroundColor, cfiBorderColor]) then begin noText := (FColorRectWidth = -1); Items.AddObject(StrUtils.IfThen(noText, '', AColorName), TObject(PtrInt(AColor))); end; end; {@@ ---------------------------------------------------------------------------- Apply the selected format style to the cell, column, row or default format (depending in FFormatTarget) -------------------------------------------------------------------------------} procedure TsCellCombobox.ApplyFormat(ARow, ACol: Cardinal); begin case FFormatTarget of ftCell : ApplyFormatToCell(ARow, ACol); ftCol : ApplyFormatToCol(ACol); ftRow : ApplyFormatToRow(ARow); ftDefault : ApplyformatToDefault; end; end; {@@ ---------------------------------------------------------------------------- Applies the format to a cell. Override according to the format item for which the combobox is responsible. -------------------------------------------------------------------------------} procedure TsCellCombobox.ApplyFormatToCell(ARow, ACol: Cardinal); var fnt: TsFont; clr: TColor; cell: PCell; begin if (Worksheet = nil) then exit; // Find cell at this location. Create a new cell here, if required. cell := Worksheet.GetCell(ARow, ACol); if Worksheet.IsMerged(cell) then cell := Worksheet.FindMergeBase(cell); case FFormatItem of cfiFontName: if Text <> '' then begin fnt := Worksheet.ReadCellFont(cell); Worksheet.WriteFont(cell, Text, fnt.Size, fnt.Style, fnt.Color); end; cfiFontSize: if Text <> '' then begin fnt := Worksheet.ReadCellFont(cell); Worksheet.WriteFont(cell, fnt.FontName, StrToFloat(Text), fnt.Style, fnt.Color); end; cfiFontColor: if ItemIndex > -1 then begin fnt := Worksheet.ReadCellFont(cell); clr := PtrInt(Items.Objects[ItemIndex]); Worksheet.WriteFont(cell, fnt.FontName, fnt.Size, fnt.style, clr); end; cfiBackgroundColor: if ItemIndex <= 0 then Worksheet.WriteBackgroundColor(cell, scTransparent) else begin clr := PtrInt(Items.Objects[ItemIndex]); Worksheet.WriteBackgroundColor(cell, clr); end; cfiBorderColor: ; else raise Exception.Create('[TsCellFormatCombobox.ApplyFormatToCell] Unknown format item'); end; end; {@@ ---------------------------------------------------------------------------- Applies the format to a column format record. Override according to the format item for which the combobox is responsible. -------------------------------------------------------------------------------} procedure TsCellCombobox.ApplyFormatToCol(ACol: Cardinal); var fnt: TsFont; col: PCol; fmt: PsCellFormat; idx: Integer; clr: TsColor; begin if (Worksheet = nil) then exit; // Find column record having the specified index. Create new record if required. col := Worksheet.GetCol(ACol); fmt := Workbook.GetPointerToCellFormat(col^.FormatIndex); case FFormatItem of cfiFontName: if Text <> '' then begin fnt := Workbook.GetFont(fmt^.FontIndex); fnt.FontName := Text; fmt^.FontIndex := Workbook.AddFont(fnt); Worksheet.WriteColFormatIndex(ACol, Workbook.AddCellFormat(fmt^)); end; cfiFontSize: if Text <> '' then begin fnt := Workbook.GetFont(fmt^.FontIndex); fnt.Size := StrToFloat(Text); fmt^.FontIndex := Workbook.AddFont(fnt); Worksheet.WriteColFormatIndex(ACol, Workbook.AddCellFormat(fmt^)); end; cfiFontColor: if ItemIndex > -1 then begin fnt := Workbook.GetFont(fmt^.FontIndex); fnt.Color := PtrInt(Items.Objects[ItemIndex]); fmt^.FontIndex := Workbook.AddFont(fnt); Worksheet.WriteColFormatIndex(ACol, Workbook.AddCelLFormat(fmt^)); end; cfiBackgroundColor: begin if ItemIndex <= 0 then idx := Worksheet.ChangeBackground(col^.FormatIndex, fsNoFill, scTransparent, scTransparent) else begin clr := PtrInt(Items.Objects[ItemIndex]); idx := Worksheet.ChangeBackground(col^.FormatIndex, fsSolidFill, clr, clr); end; Worksheet.WriteColFormatIndex(ACol, idx); end; cfiBorderColor: ; else raise Exception.Create('[TsCellFormatCombobox.ApplyFormatToCol] Unknown format item'); end; end; procedure TsCellCombobox.ApplyFormatToDefault; var fnt: TsFont; fmt: PsCellFormat; begin fmt := Workbook.GetPointerToCellFormat(0); case FFormatItem of cfiFontName: if Text <> '' then begin fnt := Workbook.GetDefaultFont; Workbook.SetDefaultFont(Text, fnt.Size); end; cfiFontSize: if Text <> '' then begin fnt := Workbook.GetDefaultFont; Workbook.SetDefaultFont(fnt.FontName, StrToFloat(Text)); end; cfiFontColor: ; // No change of default font color cfiBackgroundColor: begin if ItemIndex <= 0 then fmt^.UsedFormattingFields := fmt^.UsedFormattingFields - [uffBackground] else fmt^.UsedFormattingfields := fmt^.UsedFormattingFields + [uffBackground]; fmt^.Background.Style := fsSolidFill; fmt^.Background.BgColor := PtrInt(Items.Objects[ItemIndex]);; fmt^.Background.FgColor := fmt^.Background.BgColor; end; cfiBorderColor: ; end; end; {@@ ---------------------------------------------------------------------------- Applies the format to a row format record. Override according to the format item for which the combobox is responsible. -------------------------------------------------------------------------------} procedure TsCellCombobox.ApplyFormatToRow(ARow: Cardinal); var fnt: TsFont; row: PRow; fmt: PsCellFormat; idx: Integer; clr: TsColor; begin if (Worksheet = nil) then exit; // Find row record having the specified index. Create new record if required. row := Worksheet.GetRow(ARow); fmt := Workbook.GetPointerToCellFormat(row^.FormatIndex); case FFormatItem of cfiFontName: if Text <> '' then begin fnt := Workbook.GetFont(fmt^.FontIndex); fnt.FontName := Text; fmt^.FontIndex := Workbook.AddFont(fnt); Worksheet.WriteRowFormatIndex(ARow, Workbook.AddCellFormat(fmt^)); end; cfiFontSize: if Text <> '' then begin fnt := Workbook.GetFont(fmt^.FontIndex); fnt.Size := StrToFloat(Text); fmt^.FontIndex := Workbook.AddFont(fnt); Worksheet.WriteRowFormatIndex(ARow, Workbook.AddCellFormat(fmt^)); end; cfiFontColor: if ItemIndex > -1 then begin fnt := Workbook.GetFont(fmt^.FontIndex); fnt.Color := PtrInt(Items.Objects[ItemIndex]); fmt^.FontIndex := Workbook.AddFont(fnt); Worksheet.WriteRowFormatIndex(ARow, Workbook.AddCelLFormat(fmt^)); end; cfiBackgroundColor: begin if ItemIndex <= 0 then idx := Worksheet.ChangeBackground(row^.FormatIndex, fsNoFill, scTransparent, scTransparent) else begin clr := PtrInt(Items.Objects[ItemIndex]); idx := Worksheet.ChangeBackground(row^.FormatIndex, fsSolidFill, clr, clr); end; Worksheet.WriteRowFormatIndex(ARow, idx); end; cfiBorderColor: ; else raise Exception.Create('[TsCellFormatCombobox.ApplyFormatToRow] Unknown format item'); end; end; {@@ ---------------------------------------------------------------------------- The text of the currently selected combobox item has been changed. Calls "ProcessValue" to changes the selected cells according to the Mode property by calling ApplyFormat. -------------------------------------------------------------------------------} procedure TsCellCombobox.Change; begin inherited; ProcessItem; end; {@@ ---------------------------------------------------------------------------- Customdraws an item in the combobox. This is overridden to paint a color box for the color-related format items. ------------------------------------------------------------------------------} procedure TsCellCombobox.DrawItem(AIndex: Integer; ARect: TRect; AState: TOwnerDrawState); { This code is adapted from colorbox.pas} var r: TRect; clr: TsColor; brushColor, penColor: TColor; brushStyle: TBrushStyle; noFill: Boolean; begin if AIndex = -1 then Exit; if FFormatItem in [cfiFontColor, cfiBackgroundColor, cfiBorderColor] then begin r.Top := ARect.Top + FColorRectOffset; r.Bottom := ARect.Bottom - FColorRectOffset; r.Left := ARect.Left + FColorRectOffset; if FColorRectWidth = -1 then r.Right := ARect.Right - FColorRectOffset else r.Right := r.Left + FColorRectWidth; // Note: odPainted was renamed in LCL (v1.9) to odBackgroundPainted {$IF lcl_fullversion = 01090000} Exclude(AState, TOwnerDrawStateType(13)); // ord(odPainted) = ord(odBackgroundPainted) = 13 {$ELSEIF lcl_fullversion < 01090000} Exclude(AState, odPainted); {$ELSE} Exclude(AState, odBackgroundPainted); {$ENDIF} noFill := false; with Canvas do begin FillRect(ARect); brushStyle := Brush.Style; brushColor := Brush.Color; penColor := Pen.Color; clr := TsColor(PtrInt(Items.Objects[AIndex])); if (clr = scTransparent) or (clr = scNotDefined) then begin noFill := true; Brush.Style := bsClear; end else begin Brush.Color := clr and $00FFFFFF; Brush.Style := bsSolid; end; Pen.Color := clBlack; r := BiDiFlipRect(r, ARect, UseRightToLeftAlignment); Rectangle(r); if noFill then begin Line(r.Left, r.Top, r.Right-1, r.Bottom-1); Line(r.Left, r.Bottom-1, r.Right-1, r.Top); end; Brush.Style := brushStyle; Brush.Color := brushColor; Pen.Color := penColor; end; if FColorRectWidth > -1 then begin r := ARect; inc(r.Left, FColorRectWidth + 2*FColorRectOffset); inherited DrawItem(AIndex, BidiFlipRect(r, ARect, UseRightToLeftAlignment), AState); end; end else begin r := ARect; inherited DrawItem(AIndex, BidiFlipRect(r, ARect, UseRightToLeftAlignment), AState); end; end; {@@ ---------------------------------------------------------------------------- Extracts the format item the combobox is responsible for from the cell and selectes the corresponding combobox item. -------------------------------------------------------------------------------} procedure TsCellCombobox.ExtractFromCell(ARow, ACol: Cardinal); var fnt: TsFont; clr: TsColor; cell: PCell; begin cell := Worksheet.FindCell(ARow, ACol); if Worksheet.IsMerged(cell) then cell := Worksheet.FindMergeBase(cell); case FFormatItem of cfiFontName: begin fnt := Worksheet.ReadCellFont(cell); // No check for nil required because fnt is at least DefaultFont ItemIndex := Items.IndexOf(fnt.FontName); if ItemIndex = -1 then Text := fnt.FontName; end; cfiFontSize: begin fnt := Worksheet.ReadCellFont(cell); ItemIndex := Items.IndexOf(Format('%.0f', [fnt.Size])); if ItemIndex = -1 then Text := Format('%.2g', [fnt.Size]); end; cfiFontColor: begin fnt := Worksheet.ReadCellFont(cell); ItemIndex := Items.IndexOfObject(TObject(PtrInt(fnt.Color))); if ItemIndex = -1 then Text := GetColorName(fnt.Color); end; cfiBackgroundColor: begin clr := Worksheet.ReadBackgroundColor(cell); ItemIndex := Max(0, Items.IndexOfObject(TObject(PtrInt(clr)))); if ItemIndex = -1 then Text := GetColorName(clr); end; cfiBorderColor: ; else raise Exception.Create('[TsCellFormatItem.ExtractFromCell] Unknown format item'); end; end; procedure TsCellCombobox.ExtractFromCol(ACol: Cardinal); var col: PCol; clr: TsColor; fnt: TsFont; begin col := Worksheet.FindCol(ACol); case FFormatItem of cfiFontName: begin fnt := Worksheet.ReadColFont(col); // No check for nil required because fnt is at least DefaultFont ItemIndex := Items.IndexOf(fnt.FontName); end; cfiFontSize: begin fnt := Worksheet.ReadColFont(col); ItemIndex := Items.IndexOf(Format('%.0f', [fnt.Size])); end; cfiFontColor: begin fnt := Worksheet.ReadColFont(col); itemIndex := Items.IndexOfObject(TObject(PtrInt(fnt.Color))); end; cfiBackgroundColor: begin if col <> nil then clr := Worksheet.ReadBackgroundColor(col^.FormatIndex) else clr := Worksheet.ReadBackgroundColor(0); ItemIndex := Max(0, Items.IndexOfObject(TObject(PtrInt(clr)))); end; cfiBorderColor: ; else raise Exception.Create('[TsCellFormatItem.ExtractFromCol] Unknown format item'); end; end; procedure TsCellCombobox.ExtractFromDefault; var fnt: TsFont; fmt: PsCellFormat; begin fnt := Workbook.GetDefaultFont; case FFormatItem of cfiFontName: ItemIndex := Items.IndexOf(fnt.FontName); cfiFontSize: ItemIndex := Items.IndexOf(Format('%.0f', [fnt.Size])); cfiFontColor: ItemIndex := Items.IndexOfObject(TObject(PtrInt(fnt.Color))); cfiBackgroundColor: begin fmt := Workbook.GetPointerToCellFormat(0); if (uffBackground in fmt^.UsedFormattingFields) then ItemIndex := Items.IndexOfObject(TObject(PtrInt(fmt^.Background.BgColor))) else ItemIndex := Items.IndexOfObject(TObject(PtrInt(scTransparent))); end; cfiBorderColor: ; end; end; procedure TsCellCombobox.ExtractFromRow(ARow: Cardinal); var row: PRow; clr: TsColor; fnt: TsFont; begin row := Worksheet.FindRow(ARow); case FFormatItem of cfiFontName: begin fnt := Worksheet.ReadRowFont(row); // No check for nil required because fnt is at least DefaultFont ItemIndex := Items.IndexOf(fnt.FontName); end; cfiFontSize: begin fnt := Worksheet.ReadRowFont(row); ItemIndex := Items.IndexOf(Format('%.0f', [fnt.Size])); end; cfiFontColor: begin fnt := Worksheet.ReadRowFont(row); itemIndex := Items.IndexOfObject(TObject(PtrInt(fnt.Color))); end; cfiBackgroundColor: begin if row <> nil then clr := Worksheet.ReadBackgroundColor(row^.FormatIndex) else clr := Worksheet.ReadBackgroundColor(0); ItemIndex := Max(0, Items.IndexOfObject(TObject(PtrInt(clr)))); end; cfiBorderColor: ; else raise Exception.Create('[TsCellFormatItem.ExtractFromCol] Unknown format item'); end; end; procedure TsCellCombobox.ExtractFromSheet; begin if (WorkbookSource = nil) or (Worksheet = nil) then exit; case FFormatTarget of ftCell: ExtractFromCell(Worksheet.ActiveCellRow, Worksheet.ActiveCellCol); ftRow: ExtractFromRow(Worksheet.ActiveCellRow); ftCol: ExtractFromCol(Worksheet.ActiveCellCol); ftDefault: ExtractFromDefault; end; end; {@@ ---------------------------------------------------------------------------- Returns the currently active cell of the worksheet -------------------------------------------------------------------------------} function TsCellCombobox.GetActiveCell: PCell; begin if FWorkbookSource <> nil then Result := Worksheet.FindCell(Worksheet.ActiveCellRow, Worksheet.ActiveCellCol) else Result := nil; end; {@@ ---------------------------------------------------------------------------- Getter method for the property Workbook which is currently loaded by the WorkbookSource -------------------------------------------------------------------------------} function TsCellCombobox.GetWorkbook: TsWorkbook; begin if FWorkbookSource <> nil then Result := FWorkbookSource.Workbook else Result := nil; end; {@@ ---------------------------------------------------------------------------- Getter method for the property Worksheet which is currently loaded by the WorkbookSource -------------------------------------------------------------------------------} function TsCellCombobox.GetWorksheet: TsWorksheet; begin if FWorkbookSource <> nil then Result := FWorkbookSource.Worksheet else Result := nil; end; {@@ ---------------------------------------------------------------------------- Notification procedure received whenver "something" changes in the workbook. Reacts on all events. @param(AChangedItems Set with elements identifying whether workbook, worksheet cell or selection has changed.) @param(AData If AChangedItems contains nliCell then AData points to the modified cell.) -------------------------------------------------------------------------------} procedure TsCellCombobox.ListenerNotification( AChangedItems: TsNotificationItems; AData: Pointer = nil); var activeCell: PCell; begin Unused(AData); if (Worksheet = nil) or ([lniCell, lniSelection]*AChangedItems = []) then exit; case FFormatTarget of ftCell: begin activeCell := GetActiveCell; if (([lniCell]*AChangedItems <> []) and (PCell(AData) = activeCell)) or (lniSelection in AChangedItems) then ExtractFromCell(Worksheet.ActiveCellRow, Worksheet.ActiveCellCol); end; ftRow: if (([lniRow] * AChangedItems <> []) and ({%H-}PtrUInt(AData) = Worksheet.ActiveCellRow)) or (lniSelection in AChangedItems) then ExtractFromRow(Worksheet.ActiveCellRow); ftCol: if (([lniCol] * AChangedItems <> []) and ({%H-}PtrUInt(AData) = Worksheet.ActiveCellCol)) or (lniSelection in AChangedItems) then ExtractFromCol(Worksheet.ActiveCellCol); ftDefault: ExtractFromDefault; end; end; {@@ ---------------------------------------------------------------------------- Standard method. Overridden to populate combobox since items are not stored in lfm file. -------------------------------------------------------------------------------} procedure TsCellCombobox.Loaded; begin inherited; Populate; end; {@@ ---------------------------------------------------------------------------- Standard component notification method called when the WorkbookSource is deleted. -------------------------------------------------------------------------------} procedure TsCellCombobox.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if (Operation = opRemove) and (AComponent = FWorkbookSource) then SetWorkbookSource(nil); end; {@@ ---------------------------------------------------------------------------- Descendants override this method to populate the items of the combobox. Color index into the workbook's palette is stored in the "Objects" property. -------------------------------------------------------------------------------} procedure TsCellCombobox.Populate; var noText: Boolean; begin if Workbook = nil then exit; case FFormatItem of cfiFontName: Items.Assign(Screen.Fonts); cfiFontSize: Items.CommaText := '8,9,10,11,12,13,14,16,18,20,22,24,26,28,32,36,48,72'; cfiBackgroundColor, cfiFontColor, cfiBorderColor: begin noText := (FColorRectWidth = -1); Items.Clear; if FFormatItem = cfiBackgroundColor then Items.AddObject(StrUtils.IfThen(noText, '', '(none)'), TObject(scTransparent)); if Assigned(FOnAddColors) then FOnAddColors(self) else begin // By default, add the Excel2 colors. AddColor(scBlack, GetColorName(scBlack)); AddColor(scWhite, GetColorName(scWhite)); AddColor(scRed, GetColorName(scRed)); AddColor(scGreen, GetColorName(scGreen)); AddColor(scBlue, GetColorName(scBlue)); AddColor(scYellow, GetColorName(scYellow)); AddColor(scMagenta, GetColorName(scMagenta)); AddColor(scCyan, GetColorName(scCyan)); end; end; else raise Exception.Create('[TsCellCombobox.Populate] Unknown cell format item.'); end; end; {@@ ---------------------------------------------------------------------------- Processes the selected combobox item after a new item has been selected or the item text has been edited. Changes the selected cells according to the Mode property by calling ApplyFormatToCell. -------------------------------------------------------------------------------} procedure TsCellCombobox.ProcessItem; var r, c: Cardinal; range: Integer; sel: TsCellRangeArray; begin if Worksheet = nil then exit; sel := Worksheet.GetSelection; if Length(sel) = 0 then begin SetLength(sel, 1); sel[0].Col1 := Worksheet.ActiveCellCol; sel[0].Row1 := Worksheet.ActiveCellRow; sel[0].Col2 := sel[0].Col1; sel[0].Row2 := sel[0].Row2; end; for range := 0 to High(sel) do for r := sel[range].Row1 to sel[range].Row2 do for c := sel[range].Col1 to sel[range].Col2 do ApplyFormat(r, c); end; {@@ ---------------------------------------------------------------------------- Removes the link of the CellCombobox to the WorkbookSource. Required before destruction. -------------------------------------------------------------------------------} procedure TsCellCombobox.RemoveWorkbookSource; begin SetWorkbookSource(nil); end; {@@ ---------------------------------------------------------------------------- A new item in the combobox is selected. Calls "ProcessValue" to changes the selected cells according to the Mode property by calling ApplyFormatToCell. -------------------------------------------------------------------------------} procedure TsCellCombobox.Select; begin inherited Select; ProcessItem; end; {@@ ---------------------------------------------------------------------------- Setter method for the ColorRectOffset property -------------------------------------------------------------------------------} procedure TsCellCombobox.SetColorRectOffset(AValue: Integer); begin if FColorRectOffset = AValue then exit; FColorRectOffset := AValue; Invalidate; end; {@@ ---------------------------------------------------------------------------- Setter method for the ColorRectWidth property -------------------------------------------------------------------------------} procedure TsCellCombobox.SetColorRectWidth(AValue: Integer); begin if FColorRectWidth = AValue then exit; FColorRectWidth := AValue; Invalidate; end; {@@ ---------------------------------------------------------------------------- Setter method for the FormatItem property -------------------------------------------------------------------------------} procedure TsCellCombobox.SetFormatItem(AValue: TsCellFormatItem); begin FFormatItem := AValue; if FFormatItem in [cfiFontColor, cfiBackgroundColor, cfiBorderColor] then inherited Style := csOwnerDrawFixed else inherited Style := csDropdown; Populate; ExtractFromSheet; end; {@@ ---------------------------------------------------------------------------- Setter method for the FormatTarget -------------------------------------------------------------------------------} procedure TsCellCombobox.SetFormatTarget(AValue: TsFormatTarget); begin if AValue = FFormatTarget then exit; FFormatTarget := AValue; ExtractFromSheet; end; {@@ ---------------------------------------------------------------------------- Setter method for the WorkbookSource -------------------------------------------------------------------------------} procedure TsCellCombobox.SetWorkbookSource(AValue: TsWorkbookSource); begin if AValue = FWorkbookSource then exit; if FWorkbookSource <> nil then FWorkbookSource.RemoveListener(self); FWorkbookSource := AValue; if FWorkbookSource <> nil then FWorkbookSource.AddListener(self); Text := ''; ListenerNotification([lniSelection]); end; {------------------------------------------------------------------------------} { TsSpreadsheetInspector } {------------------------------------------------------------------------------} {@@ ---------------------------------------------------------------------------- Constructor of the TsSpreadsheetInspector class. Is overridden to set the default values of DisplayOptions and FixedCols, and to define the column captions. -------------------------------------------------------------------------------} constructor TsSpreadsheetInspector.Create(AOwner: TComponent); begin inherited Create(AOwner); DisplayOptions := DisplayOptions - [doKeyColFixed]; FixedCols := 0; FExpanded := [ienFormatSettings, ienConditionalFormats, ienPageLayout, ienFonts, ienFormats, ienEmbeddedObj, ienImages, ienCryptoInfo]; with (TitleCaptions as TStringList) do begin OnChange := nil; // This fixes an issue with Laz 1.0 Clear; Add('Properties'); Add('Values'); OnChange := @TitlesChanged; end; end; {@@ ---------------------------------------------------------------------------- Destructor of the spreadsheet inspector. Removes itself from the WorkbookSource's listener list. -------------------------------------------------------------------------------} destructor TsSpreadsheetInspector.Destroy; begin if FWorkbookSource <> nil then FWorkbookSource.RemoveListener(self); inherited Destroy; end; {@@ ---------------------------------------------------------------------------- Double-click on an expandable line expands or collapsed the sub-items -------------------------------------------------------------------------------} procedure TsSpreadsheetInspector.DblClick; var s: String; expNodes: TsInspectorExpandedNodes; begin expNodes := FExpanded; s := Cells[0, Row]; if (pos('FormatSettings', s) > 0) or (pos('Format settings', s) > 0) then begin if (ienFormatSettings in expNodes) then Exclude(expNodes, ienFormatSettings) else Include(expNodes, ienFormatSettings); end else if (pos('Conditional formats', s) > 0) or (pos('ConditionalFormats', s) > 0) then begin if (ienConditionalFormats in expNodes) then Exclude(expNodes, ienConditionalFormats) else Include(expNodes, ienConditionalFormats); end else if (pos('Page layout', s) > 0) or (pos('PageLayout', s) > 0) then begin if (ienPageLayout in expNodes) then Exclude(expNodes, ienPageLayout) else Include(expNodes, ienPageLayout); end else if (pos('Images', s) > 0) then begin if (ienEmbeddedObj in expNodes) then Exclude(expNodes, ienEmbeddedObj) else Include(expNodes, ienEmbeddedObj); if (ienImages in expNodes) then Exclude(expNodes, ienImages) else Include(expNodes, ienImages); end else if (pos('Fonts', s) > 0) then begin if (ienFonts in expNodes) then Exclude(expNodes, ienFonts) else Include(expNodes, ienFonts); end else if (pos('Cell formats', s) > 0) then begin if (ienFormats in expNodes) then Exclude(expNodes, ienFormats) else Include(expNodes, ienFormats); end else if (pos('CryptoInfo', s) > 0) then begin if (ienCryptoInfo in expNodes) then Exclude(expNodes, ienCryptoInfo) else Include(expNodes, ienCryptoInfo); end else exit; SetExpanded(expNodes); end; {@@ ---------------------------------------------------------------------------- Updates the data shown by the inspector grid. Display depends on the FMode setting (workbook, worksheet, cell values, cell properties). -------------------------------------------------------------------------------} procedure TsSpreadsheetInspector.DoUpdate; var cell: PCell; sheet: TsWorksheet; book: TsWorkbook; list: TStringList; begin cell := nil; sheet := nil; book := nil; if FWorkbookSource <> nil then begin book := FWorkbookSource.Workbook; sheet := FWorkbookSource.Worksheet; if sheet <> nil then begin FCurrRow := sheet.ActiveCellRow; FCurrCol := sheet.ActiveCellCol; cell := sheet.FindCell(FCurrRow, FCurrCol); end; end; list := TStringList.Create; try case FMode of imCellValue : UpdateCellValue(cell, list); imCellProperties : UpdateCellProperties(cell, list); imWorksheet : UpdateWorksheet(sheet, list); imWorkbook : UpdateWorkbook(book, list); imRow : UpdateRow(FCurrRow, list); imCol : UpdateCol(FCurrCol, list); end; Strings.Assign(list); finally list.Free; end; end; {@@ ---------------------------------------------------------------------------- Getter method for the property Workbook which is currently loaded by the WorkbookSource -------------------------------------------------------------------------------} function TsSpreadsheetInspector.GetWorkbook: TsWorkbook; begin if FWorkbookSource <> nil then Result := FWorkbookSource.Workbook else Result := nil; end; {@@ ---------------------------------------------------------------------------- Getter method for the property Worksheet which is currently loaded by the WorkbookSource -------------------------------------------------------------------------------} function TsSpreadsheetInspector.GetWorksheet: TsWorksheet; begin if FWorkbookSource <> nil then Result := FWorkbookSource.Worksheet else Result := nil; end; {@@ ---------------------------------------------------------------------------- Notification procedure received whenver "something" changes in the workbook. Reacts on all events. @param(AChangedItems Set with elements identifying whether workbook, worksheet cell or selection has changed.) @param(AData If AChangedItems contains nliCell then AData points to the modified cell.) -------------------------------------------------------------------------------} procedure TsSpreadsheetInspector.ListenerNotification( AChangedItems: TsNotificationItems; AData: Pointer = nil); begin case FMode of imWorkbook: if ([lniWorkbook, lniWorksheet]*AChangedItems <> []) then DoUpdate; imWorksheet: if ([lniWorksheet, lniSelection, lniWorksheetZoom]*AChangedItems <> []) then DoUpdate; imCellValue, imCellProperties: if ([lniCell, lniSelection]*AChangedItems <> []) then DoUpdate; imRow: begin if ([lniSelection] * AChangedItems <> []) then begin if AData <> nil then FCurrRow := PCell(AData)^.Row; end else if ([lniRow] * AChangedItems <> []) then FCurrRow := {%H-}PtrInt(AData) else exit; DoUpdate; end; imCol: begin if ([lniSelection] * AChangedItems <> []) then begin if AData <> nil then FCurrCol := PCell(AData)^.Col; end else if ([lniCol] * AChangedItems <> []) then FCurrCol := {%H-}PtrInt(AData) else exit; DoUpdate; end; end; end; {@@ ---------------------------------------------------------------------------- Standard component notification method called when the WorkbookSource is deleted. -------------------------------------------------------------------------------} procedure TsSpreadsheetInspector.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if (Operation = opRemove) and (AComponent = FWorkbookSource) then SetWorkbookSource(nil); end; {@@ ---------------------------------------------------------------------------- Removes the link of the SpreadsheetInspector to the WorkbookSource. Required before destruction. -------------------------------------------------------------------------------} procedure TsSpreadsheetInspector.RemoveWorkbookSource; begin SetWorkbookSource(nil); end; {@@ ---------------------------------------------------------------------------- Setter method for the Expanded property -------------------------------------------------------------------------------} procedure TsSpreadsheetInspector.SetExpanded(AValue: TsInspectorExpandedNodes); begin if AValue = FExpanded then exit; FExpanded := AValue; DoUpdate; end; {@@ ---------------------------------------------------------------------------- Setter method for the Mode property. This property filters groups of properties for display (workbook-, worksheet-, cell value- or cell formatting-related data). -------------------------------------------------------------------------------} procedure TsSpreadsheetInspector.SetMode(AValue: TsInspectorMode); begin if AValue = FMode then exit; FMode := AValue; DoUpdate; end; {@@ ---------------------------------------------------------------------------- Setter method for the WorkbookSource -------------------------------------------------------------------------------} procedure TsSpreadsheetInspector.SetWorkbookSource(AValue: TsWorkbookSource); begin if AValue = FWorkbookSource then exit; if FWorkbookSource <> nil then FWorkbookSource.RemoveListener(self); FWorkbookSource := AValue; if FWorkbookSource <> nil then FWorkbookSource.AddListener(self); ListenerNotification([lniWorkbook, lniWorksheet, lniSelection]); end; {@@ ---------------------------------------------------------------------------- Creates a string list containing the formatting properties of a specific cell. The string list items are name-value pairs in the format "name=value". The string list is displayed in the inspector's grid. @param ACell Pointer to cell under investigation @param AStrings Stringlist receiving the name-value pairs. -------------------------------------------------------------------------------} procedure TsSpreadsheetInspector.UpdateCellProperties(ACell: PCell; AStrings: TStrings); var s: String; r1, r2, c1, c2: Cardinal; rtp: TsRichTextParam; begin if ACell <> nil then UpdateFormatProperties(ACell^.FormatIndex, AStrings) else UpdateFormatProperties(-1, AStrings); if (ACell <> nil) and (Length(ACell^.RichTextParams) > 0) then begin s := ''; for rtp in ACell^.RichTextParams do s := Format('%s; Font #%d at pos %d', [s, rtp.FontIndex, rtp.FirstIndex]); Delete(s, 1, 2); if s = '' then s := '(none)'; AStrings.Add('Rich-text parameters='+s); end else AStrings.Add('Rich-text parameters=(none)'); if (Worksheet = nil) or not Worksheet.IsMerged(ACell) then AStrings.Add('Merged range=(none)') else begin Worksheet.FindMergedRange(ACell, r1, c1, r2, c2); AStrings.Add('Merged range=' + GetCellRangeString(r1, c1, r2, c2)); end; end; procedure TsSpreadsheetInspector.UpdateFormatProperties(AFormatIndex: integer; AStrings: TStrings); var s: String; cb: TsCellBorder; fmt: TsCellFormat; numFmt: TsNumFormatParams; cp: TsCellProtection; begin if AFormatIndex > -1 then fmt := Workbook.GetCellFormat(AFormatIndex) else InitFormatRecord(fmt); if (AFormatIndex = -1) then AStrings.Add('FormatIndex=(default)') else AStrings.Add(Format('FormatIndex=%d', [AFormatIndex])); if (AFormatIndex = -1) or not (uffFont in fmt.UsedFormattingFields) then AStrings.Add('FontIndex=(default)') else AStrings.Add(Format('FontIndex=%d (%s)', [ fmt.FontIndex, Workbook.GetFontAsString(fmt.FontIndex) ])); if (AFormatIndex = -1) or not (uffTextRotation in fmt.UsedFormattingFields) then AStrings.Add('TextRotation=(default)') else AStrings.Add(Format('TextRotation=%s', [ GetEnumName(TypeInfo(TsTextRotation), ord(fmt.TextRotation)) ])); if (AFormatIndex = -1) or not (uffHorAlign in fmt.UsedFormattingFields) then AStrings.Add('HorAlignment=(default)') else AStrings.Add(Format('HorAlignment=%s', [ GetEnumName(TypeInfo(TsHorAlignment), ord(fmt.HorAlignment)) ])); if (AFormatIndex = -1) or not (uffVertAlign in fmt.UsedFormattingFields) then AStrings.Add('VertAlignment=(default)') else AStrings.Add(Format('VertAlignment=%s', [ GetEnumName(TypeInfo(TsVertAlignment), ord(fmt.VertAlignment)) ])); if (AFormatIndex = -1) or not (uffWordwrap in fmt.UsedFormattingFields) then AStrings.Add('Wordwrap=(default)') else AStrings.Add(Format('Wordwrap=%s', [ BoolToStr(uffWordwrap in fmt.UsedFormattingFields, true) ])); if (AFormatIndex = -1) or not (uffBorder in fmt.UsedFormattingFields) then AStrings.Add('Borders=(none)') else begin s := ''; for cb in TsCellBorder do if cb in fmt.Border then s := s + ', ' + GetEnumName(TypeInfo(TsCellBorder), ord(cb)); if s <> '' then Delete(s, 1, 2); AStrings.Add('Borders='+s); end; for cb in TsCellBorder do if AFormatIndex = -1 then AStrings.Add(Format('BorderStyles[%s]=(default)', [ GetEnumName(TypeInfo(TsCellBorder), ord(cb))])) else AStrings.Add(Format('BorderStyles[%s]=%s, %s', [ GetEnumName(TypeInfo(TsCellBorder), ord(cb)), GetEnumName(TypeInfo(TsLineStyle), ord(fmt.BorderStyles[cb].LineStyle)), GetColorName(fmt.BorderStyles[cb].Color)])); if (AFormatIndex = -1) or not (uffBackground in fmt.UsedformattingFields) then begin AStrings.Add('Style=(default)'); AStrings.Add('PatternColor=(default)'); AStrings.Add('BackgroundColor=(default)'); end else begin AStrings.Add(Format('Style=%s', [ GetEnumName(TypeInfo(TsFillStyle), ord(fmt.Background.Style))])); AStrings.Add(Format('PatternColor=$%.8x (%s)', [ fmt.Background.FgColor, GetColorName(fmt.Background.FgColor)])); AStrings.Add(Format('BackgroundColor=$%.8x (%s)', [ fmt.Background.BgColor, GetColorName(fmt.Background.BgColor)])); end; if (AFormatIndex = -1) or not (uffNumberFormat in fmt.UsedFormattingFields) then begin AStrings.Add('NumberFormatIndex=-1'); AStrings.Add('NumberFormat=(default)'); AStrings.Add('NumberFormatStr=(none)'); end else begin AStrings.Add(Format('NumberFormatIndex=%d', [fmt.NumberFormatIndex])); numFmt := Workbook.GetNumberFormat(fmt.NumberFormatIndex); AStrings.Add(Format('NumberFormat=%s', [ GetEnumName(TypeInfo(TsNumberFormat), ord(numFmt.NumFormat))])); AStrings.Add('NumberFormatStr=' + numFmt.NumFormatStr); end; if (AFormatIndex = -1) or not (uffBiDi in fmt.UsedFormattingFields) then AStrings.Add('BiDi=(bdDefault)') else AStrings.Add(Format('BiDiMode=%s', [ GetEnumName(TypeInfo(TsBiDiMode), ord(fmt.BiDiMode))])); if (AFormatIndex = -1) then AStrings.Add('Protection=(default)') else begin if Worksheet.IsProtected and (spCells in Worksheet.Protection) then begin s := ''; for cp in TsCellProtection do if cp in fmt.Protection then s := s + ', ' + GetEnumName(TypeInfo(TsCellProtection), ord(cp)); if s <> '' then Delete(s, 1, 2) else s := '(not protected)'; end else s := '(not protected)'; AStrings.Add('Protection=' + s); end; end; {@@ ---------------------------------------------------------------------------- Creates a string list containing the value data of a specific cell. The string list items are name-value pairs in the format "name=value". The string list is displayed in the inspector's grid. @param ACell Pointer to cell under investigation @param AStrings Stringlist receiving the name-value pairs. -------------------------------------------------------------------------------} procedure TsSpreadsheetInspector.UpdateCellValue(ACell: PCell; AStrings: TStrings); var hyperlink: PsHyperlink; comment: String; s: String; begin if ACell = nil then begin if Worksheet <> nil then begin AStrings.Add(Format('Row=%d', [Worksheet.ActiveCellRow])); AStrings.Add(Format('Col=%d', [Worksheet.ActiveCellCol])); end else begin AStrings.Add('Row='); AStrings.Add('Col='); end; AStrings.Add('ContentType=(none)'); end else begin AStrings.Add(Format('Row=%d', [ACell^.Row])); AStrings.Add(Format('Col=%d', [ACell^.Col])); AStrings.Add(Format('Flags=[%s]', [ SetToString(PTypeInfo(TypeInfo(TsCellflags)), integer(ACell^.Flags), false) ])); AStrings.Add(Format('ContentType=%s', [ GetEnumName(TypeInfo(TCellContentType), ord(ACell^.ContentType)) ])); if ACell^.ContentType = cctNumber then AStrings.Add(Format('NumberValue=%g', [ACell^.NumberValue])); if ACell^.ContentType = cctDateTime then AStrings.Add(Format('DateTimeValue=%g', [ACell^.DateTimeValue])); if ACell^.ContentType = cctUTF8String then AStrings.Add(Format('UTF8StringValue=%s', [ACell^.UTF8StringValue])); if ACell^.ContentType = cctBool then AStrings.Add(Format('BoolValue=%s', [BoolToStr(ACell^.BoolValue)])); if ACell^.ContentType = cctError then AStrings.Add(Format('ErrorValue=%s', [GetEnumName(TypeInfo(TsErrorValue), ord(ACell^.ErrorValue))])); AStrings.Add(Format('FormulaValue=%s', [Worksheet.ReadFormulaAsString(ACell, true)])); { if ACell^.SharedFormulaBase = nil then AStrings.Add('SharedFormulaBase=') else AStrings.Add(Format('SharedFormulaBase=%s', [GetCellString( ACell^.SharedFormulaBase^.Row, ACell^.SharedFormulaBase^.Col) ])); } if (cfHyperlink in ACell^.Flags) then begin hyperlink := Worksheet.FindHyperlink(ACell); if hyperlink <> nil then begin if hyperlink^.Tooltip <> '' then s := hyperlink^.Target + ' (tooltip: ' + hyperlink^.Tooltip + ')' else s := hyperlink^.Target; AStrings.Add(Format('Hyperlink=%s', [s])); end; end; if (cfHasComment in ACell^.Flags) then begin comment := Worksheet.ReadComment(ACell); AStrings.Add(Format('Comment=%s', [comment])); end; end; end; {@@ ---------------------------------------------------------------------------- Creates a string list containing the properties of a column. The string list items are name-value pairs in the format "name=value". The string list is displayed in the inspector's grid. @param ACol index of the investigated column @param AStrings Stringlist receiving the name-value pairs. -------------------------------------------------------------------------------} procedure TsSpreadsheetInspector.UpdateCol(ACol: Integer; AStrings: TStrings); var unitStr: String; lCol: PCol; begin if (Workbook = nil) or (Worksheet = nil) then exit; if (ACol < 0) or (ACol <> Integer(Worksheet.ActiveCellCol)) then exit; unitStr := SizeUnitNames[Workbook.Units]; lCol := Worksheet.FindCol(ACol); AStrings.Add(Format('Col=%d', [ACol])); if lCol <> nil then begin AStrings.Add(Format('Width=%.1f %s (%.1f pt)', [ lCol^.Width, unitstr, Workbook.ConvertUnits(lCol^.Width, Workbook.Units, suPoints) ])); AStrings.Add(Format('ColWidthType=%s', [ ColWidthTypeNames[lCol^.ColWidthType] ])); UpdateFormatProperties(lCol^.FormatIndex, AStrings); AStrings.Add(Format('Hidden=%s', [ BoolToStr(croHidden in lCol^.Options, true) ])); AStrings.Add(Format('PageBreak=%s', [ BoolToStr(croPageBreak in lCol^.Options, true) ])); end else begin AStrings.Add('No column record='); AStrings.Add(Format('DefaultColWidth=%.1f %s (%.1f pt)', [ Worksheet.ReadDefaultColWidth(Workbook.Units), unitStr, Worksheet.ReadDefaultColWidth(suPoints) ])); // UpdateFormatProperties(-1, AStrings); end; end; {@@ ---------------------------------------------------------------------------- Creates a string list containing the properties of a row. The string list items are name-value pairs in the format "name=value". The string list is displayed in the inspector's grid. @param ARow index of the investigated row @param AStrings Stringlist receiving the name-value pairs. -------------------------------------------------------------------------------} procedure TsSpreadsheetInspector.UpdateRow(ARow: Integer; AStrings: TStrings); var lRow: PRow; unitStr: String; begin if (Workbook = nil) or (Worksheet = nil) then exit; if (ARow < 0) or (ARow <> Integer(Worksheet.ActiveCellRow)) then exit; unitStr := SizeUnitNames[Workbook.Units]; lRow := Worksheet.FindRow(ARow); AStrings.Add(Format('Row=%d', [ARow])); if lRow <> nil then begin AStrings.Add(Format('Height=%.1f %s (%.1f pt)', [ lRow^.Height, unitStr, Workbook.ConvertUnits(lRow^.Height, Workbook.Units, suPoints) ])); AStrings.Add(Format('RowHeightType=%s', [ RowHeightTypeNames[lRow^.RowHeightType] ])); UpdateFormatProperties(lRow^.FormatIndex, AStrings); AStrings.Add(Format('Hidden=%s', [ BoolToStr(croHidden in lRow^.Options, true) ])); AStrings.Add(Format('PageBreak=%s', [ BoolToStr(croPageBreak in lRow^.Options, true) ])); end else begin AStrings.Add('No row record='); AStrings.Add(Format('DefaultRowHeight=%.1f %s (%.1f pt)', [ Worksheet.ReadDefaultRowHeight(Workbook.Units), unitStr, Worksheet.ReadDefaultRowHeight(suPoints) ])); end; end; {@@ ---------------------------------------------------------------------------- Creates a string list containing the properties of the workbook. The string list items are name-value pairs in the format "name=value". The string list is displayed in the inspector's grid. @param AWorkbook Workbook under investigation @param AStrings Stringlist receiving the name-value pairs. -------------------------------------------------------------------------------} procedure TsSpreadsheetInspector.UpdateWorkbook(AWorkbook: TsWorkbook; AStrings: TStrings); var bo: TsWorkbookOption; s: String; i: Integer; embobj: TsEmbeddedObj; bp: TsWorkbookProtection; begin if AWorkbook = nil then begin AStrings.Add('FileName='); AStrings.Add('FileFormat='); AStrings.Add('Options='); AStrings.Add('ActiveWorksheet='); AStrings.Add('FormatSettings='); AStrings.Add('Images='); AStrings.Add('Protection='); end else begin AStrings.Add(Format('FileName=%s', [AWorkbook.FileName])); if AWorkbook.FileFormatID = -1 then AStrings.Add('FileFormat=(unknown)') else AStrings.Add(Format('FileFormat=%d [%s]', [ AWorkbook.FileFormatID, GetSpreadTechnicalName(AWorkbook.FileFormatID) ])); if AWorkbook.ActiveWorksheet <> nil then AStrings.Add('ActiveWorksheet=' + AWorkbook.ActiveWorksheet.Name) else AStrings.Add('ActiveWorksheet='); s := ''; for bo in TsWorkbookOption do if bo in AWorkbook.Options then s := s + ', ' + GetEnumName(TypeInfo(TsWorkbookOption), ord(bo)); if s <> '' then Delete(s, 1, 2); AStrings.Add('Options='+s); if (ienFormatSettings in FExpanded) then begin AStrings.Add('(-) FormatSettings='); AStrings.Add(' ThousandSeparator='+AWorkbook.FormatSettings.ThousandSeparator); AStrings.Add(' DecimalSeparator='+AWorkbook.FormatSettings.DecimalSeparator); AStrings.Add(' ListSeparator='+AWorkbook.FormatSettings.ListSeparator); AStrings.Add(' DateSeparator='+AWorkbook.FormatSettings.DateSeparator); AStrings.Add(' TimeSeparator='+AWorkbook.FormatSettings.TimeSeparator); AStrings.Add(' ShortDateFormat='+AWorkbook.FormatSettings.ShortDateFormat); AStrings.Add(' LongDateFormat='+AWorkbook.FormatSettings.LongDateFormat); AStrings.Add(' ShortTimeFormat='+AWorkbook.FormatSettings.ShortTimeFormat); AStrings.Add(' LongTimeFormat='+AWorkbook.FormatSettings.LongTimeFormat); AStrings.Add(' TimeAMString='+AWorkbook.FormatSettings.TimeAMString); AStrings.Add(' TimePMString='+AWorkbook.FormatSettings.TimePMString); s := AWorkbook.FormatSettings.ShortMonthNames[1]; for i:=2 to 12 do s := s + ', ' + AWorkbook.FormatSettings.ShortMonthNames[i]; AStrings.Add(' ShortMonthNames='+s); s := AWorkbook.FormatSettings.LongMonthnames[1]; for i:=2 to 12 do s := s +', ' + AWorkbook.FormatSettings.LongMonthNames[i]; AStrings.Add(' LongMontNames='+s); s := AWorkbook.FormatSettings.ShortDayNames[1]; for i:=2 to 7 do s := s + ', ' + AWorkbook.FormatSettings.ShortDayNames[i]; AStrings.Add(' ShortMonthNames='+s); s := AWorkbook.FormatSettings.LongDayNames[1]; for i:=2 to 7 do s := s +', ' + AWorkbook.FormatSettings.LongDayNames[i]; AStrings.Add(' LongMontNames='+s); AStrings.Add(' CurrencyString='+AWorkbook.FormatSettings.CurrencyString); AStrings.Add(' PosCurrencyFormat='+IntToStr(AWorkbook.FormatSettings.CurrencyFormat)); AStrings.Add(' NegCurrencyFormat='+IntToStr(AWorkbook.FormatSettings.NegCurrFormat)); AStrings.Add(' TwoDigitYearCenturyWindow='+IntToStr(AWorkbook.FormatSettings.TwoDigitYearCenturyWindow)); end else AStrings.Add('(+) FormatSettings=(dblclick for more...)'); if (ienEmbeddedObj in FExpanded) then begin AStrings.Add('(-) Images='); for i:=0 to AWorkbook.GetEmbeddedObjCount-1 do begin embObj := AWorkbook.GetEmbeddedObj(i); AStrings.Add(' Filename='+embobj.FileName); AStrings.Add(Format(' ImageWidth=%.2f mm', [embObj.ImageWidth])); AStrings.Add(Format(' ImageHeight=%.2f mm', [embObj.ImageHeight])); end; end else AStrings.Add('(+) Images=(dblclick for more...)'); if (ienFonts in FExpanded) then begin AStrings.Add('(-) Fonts='); for i:=0 to AWorkbook.GetFontCount-1 do AStrings.Add(Format(' Font%d=%s', [i, AWorkbook.GetFontAsString(i)])); end else AStrings.Add('(+) Fonts=(dblclick for more...)'); if (ienFormats in FExpanded) then begin AStrings.Add('(-) Cell formats='); for i:=0 to AWorkbook.GetNumCellFormats-1 do AStrings.Add(Format(' CellFormat%d=%s', [i, AWorkbook.GetCellFormatAsString(i)])); end else AStrings.Add('(+) Cell formats=(dblclick for more...)'); s := ''; for bp in TsWorkbookProtection do if bp in AWorkbook.Protection then s := s + ', ' + GetEnumName(TypeInfo(TsWorkbookProtection), ord(bp)); if s <> '' then Delete(s, 1, 2) else s := '(default)'; AStrings.Add('Protection=' + s); if (ienCryptoInfo in FExpanded) then begin AStrings.Add('(-) CryptoInfo='); AStrings.Add(Format(' PasswordHash=%s', [Workbook.CryptoInfo.PasswordHash])); AStrings.Add(Format(' Algorithm=%s', [AlgorithmToStr(Workbook.CryptoInfo.Algorithm, auExcel)])); AStrings.Add(Format(' SaltValue=%s', [Workbook.CryptoInfo.SaltValue])); AStrings.Add(Format(' SpinCount=%d', [Workbook.CryptoInfo.SpinCount])); end else AStrings.Add('(+) CryptoInfo=(dblclick for more...)'); end; end; {@@ ---------------------------------------------------------------------------- Creates a string list containing the properties of a worksheet. The string list items are name-value pairs in the format "name=value". The string list is displayed in the inspector's grid. @param ASheet Worksheet under investigation @param AStrings Stringlist receiving the name-value pairs. -------------------------------------------------------------------------------} procedure TsSpreadsheetInspector.UpdateWorksheet(ASheet: TsWorksheet; AStrings: TStrings); var i: Integer; s: String; po: TsPrintOption; img: TsImage; embObj: TsEmbeddedObj; so: TsSheetOption; sp: TsWorksheetProtection; begin if ASheet = nil then begin AStrings.Add('Name='); AStrings.Add('Index='); AStrings.Add('First row='); AStrings.Add('Last row='); AStrings.Add('First column='); AStrings.Add('Last column='); AStrings.Add('Active cell='); AStrings.Add('Selection='); AStrings.Add('Default column width='); AStrings.Add('Default row height='); AStrings.Add('Zoom factor='); AStrings.Add('Page layout='); AStrings.Add('Options='); AStrings.Add('Protection='); AStrings.Add('TabColor='); AStrings.Add('Conditional formats='); end else begin AStrings.Add(Format('Name=%s', [ASheet.Name])); AStrings.Add(Format('Index=%d', [ASheet.Index])); AStrings.Add(Format('First row=%d', [Integer(ASheet.GetFirstRowIndex)])); AStrings.Add(Format('Last row=%d', [ASheet.GetLastRowIndex(true)])); AStrings.Add(Format('First column=%d', [Integer(ASheet.GetFirstColIndex)])); AStrings.Add(Format('Last column=%d', [ASheet.GetLastColIndex(true)])); AStrings.Add(Format('Active cell=%s', [GetCellString(ASheet.ActiveCellRow, ASheet.ActiveCellCol)])); AStrings.Add(Format('Selection=%s', [ASheet.GetSelectionAsString])); AStrings.Add(Format('Default column width=%.1f %s', [ ASheet.ReadDefaultColWidth(ASheet.Workbook.Units), SizeUnitNames[ASheet.Workbook.Units]])); AStrings.Add(Format('Default row height=%.1f %s', [ ASheet.ReadDefaultRowHeight(ASheet.Workbook.Units), SizeUnitNames[ASheet.Workbook.Units]])); AStrings.Add(Format('Zoom factor=%d%%', [round(ASheet.ZoomFactor*100)])); AStrings.Add(Format('Comments=%d items', [ASheet.Comments.Count])); AStrings.Add(Format('Hyperlinks=%d items', [ASheet.Hyperlinks.Count])); AStrings.Add(Format('MergedCells=%d items', [ASheet.MergedCells.Count])); AStrings.Add(Format('TabColor=$%.8x (%s)', [ASheet.TabColor, GetColorName(ASheet.TabColor)])); (* if ienConditionalFormats in FExpanded then begin AStrings.Add('(-) Conditional formats='); AStrings.Add(Format(' Count=%d', [ASheet.ConditionalFormatCount])); for i := 0 to ASheet.ConditionalFormatCount-1 do begin cf := ASheet.ReadConditionalFormat(i); AStrings.Add(' Item #' + IntToStr(i) + ':'); with cf.CellRange do AStrings.Add(Format(' CellRange=%s', [GetCellRangeString(Row1, Col1, Row2, Col2)])); end; end else begin AStrings.Add('(+) Conditional formats=(dblclick for more...)'); end; *) if ienPageLayout in FExpanded then begin AStrings.Add('(-) Page layout='); AStrings.Add(Format(' Orientation=%s', [ GetEnumName(TypeInfo(TsPageOrientation), ord(ASheet.PageLayout.Orientation))])); AStrings.Add(Format(' Page width=%.1f mm', [ASheet.PageLayout.PageWidth])); AStrings.Add(Format(' Page height=%.1f mm', [ASheet.PageLayout.PageHeight])); AStrings.Add(Format(' Left margin=%.1f mm', [ASheet.PageLayout.LeftMargin])); AStrings.Add(Format(' Right margin=%.1f mm', [ASheet.PageLayout.RightMargin])); AStrings.Add(Format(' Top margin=%.1f mm', [ASheet.PageLayout.TopMargin])); AStrings.Add(Format(' Bottom margin=%.1f mm', [ASheet.PageLayout.BottomMargin])); AStrings.Add(Format(' Header distance=%.1f mm', [ASheet.PageLayout.HeaderMargin])); AStrings.Add(Format(' Footer distance=%.1f mm', [ASheet.PageLayout.FooterMargin])); if poUseStartPageNumber in ASheet.PageLayout.Options then AStrings.Add(Format(' Start page number=%d', [ASheet.pageLayout.StartPageNumber])) else AStrings.Add(' Start page number=automatic'); AStrings.Add(Format(' Scaling factor (Zoom)=%d%%', [ASheet.PageLayout.ScalingFactor])); AStrings.Add(Format(' Copies=%d', [ASheet.PageLayout.Copies])); if (ASheet.PageLayout.Options * [poDifferentOddEven, poDifferentFirst] <> []) then begin AStrings.Add(Format(' Header (first)=%s', [StringReplace(ASheet.PageLayout.Headers[0], LineEnding, '\n', [rfReplaceAll])])); AStrings.Add(Format(' Header (odd)=%s', [StringReplace(ASheet.PageLayout.Headers[1], LineEnding, '\n', [rfReplaceAll])])); AStrings.Add(Format(' Header (even)=%s', [StringReplace(ASheet.PageLayout.Headers[2], LineEnding, '\n', [rfReplaceAll])])); AStrings.Add(Format(' Footer (first)=%s', [StringReplace(ASheet.PageLayout.Footers[0], LineEnding, '\n', [rfReplaceAll])])); AStrings.Add(Format(' Footer (odd)=%s', [StringReplace(ASheet.PageLayout.Footers[1], LineEnding, '\n', [rfReplaceall])])); AStrings.Add(Format(' Footer (even)=%s', [StringReplace(ASheet.PageLayout.Footers[2], LineEnding, '\n', [rfReplaceAll])])); end else begin AStrings.Add(Format(' Header=%s', [StringReplace(ASheet.PageLayout.Headers[1], LineEnding, '\n', [rfReplaceAll])])); AStrings.Add(Format(' Footer=%s', [StringReplace(ASheet.PageLayout.Footers[1], LineEnding, '\n', [rfReplaceAll])])); end; if ASheet.PageLayout.HeaderImages[hfsLeft].Index > -1 then AStrings.Add(Format(' HeaderImage, left=%s', [ASheet.Workbook.GetEmbeddedObj(ASheet.PageLayout.HeaderImages[hfsLeft].Index).FileName])) else AStrings.Add(' HeaderImage, left ='); if ASheet.PageLayout.HeaderImages[hfsCenter].Index > -1 then AStrings.Add(Format(' HeaderImage, center=%s', [ASheet.Workbook.GetEmbeddedObj(ASheet.PageLayout.HeaderImages[hfsCenter].Index).FileName])) else AStrings.Add(' HeaderImage, center='); if ASheet.PageLayout.HeaderImages[hfsRight].Index > -1 then AStrings.Add(Format(' HeaderImage, right=%s', [ASheet.Workbook.GetEmbeddedObj(ASheet.PageLayout.HeaderImages[hfsRight].Index).FileName])) else AStrings.Add(' HeaderImage, right='); if ASheet.PageLayout.FooterImages[hfsLeft].Index > -1 then AStrings.Add(Format(' FooterImage, left=%s', [ASheet.Workbook.GetEmbeddedObj(ASheet.PageLayout.FooterImages[hfsLeft].Index).FileName])) else AStrings.Add(' FooterImage, left ='); if ASheet.PageLayout.FooterImages[hfsCenter].Index > -1 then AStrings.Add(Format(' FooterImage, center=%s', [ASheet.Workbook.GetEmbeddedObj(ASheet.PageLayout.FooterImages[hfsCenter].Index).FileName])) else AStrings.Add(' FooterImage, center='); if ASheet.PageLayout.FooterImages[hfsRight].Index > -1 then AStrings.Add(Format(' FooterImage, right=%s', [ ASheet.Workbook.GetEmbeddedObj(ASheet.PageLayout.FooterImages[hfsRight].Index).FileName])) else AStrings.Add(' FooterImage, right='); if ASheet.PageLayout.NumPrintRanges = 0 then AStrings.Add(' Print ranges=') else for i := 0 to ASheet.PageLayout.NumPrintRanges-1 do with ASheet.PageLayout.PrintRange[i] do AStrings.Add(Format(' Print range #%d=$%s$%s:$%s$%s', [ i, GetColString(Col1), GetRowString(Row1), GetColString(Col2), GetRowString(Row2) ])); if ASheet.PageLayout.RepeatedRows.FirstIndex = UNASSIGNED_ROW_COL_INDEX then AStrings.Add(' Repeated rows=') else if ASheet.PageLayout.RepeatedRows.FirstIndex = ASheet.PageLayout.RepeatedRows.LastIndex then AStrings.Add(Format(' Repeated rows=$%s', [ GetRowString(ASheet.PageLayout.RepeatedRows.FirstIndex) ])) else AStrings.Add(Format(' Repeated rows=$%s:$%s', [ GetRowString(ASheet.PageLayout.RepeatedRows.FirstIndex), GetRowString(ASheet.PageLayout.RepeatedRows.lastIndex) ])); if ASheet.PageLayout.RepeatedCols.FirstIndex = UNASSIGNED_ROW_COL_INDEX then AStrings.Add(' Repeated columns=') else if ASheet.PageLayout.RepeatedCols.FirstIndex = ASheet.PageLayout.RepeatedCols.LastIndex then AStrings.Add(Format(' Repeated columns=$%s', [ GetColString(ASheet.PageLayout.RepeatedCols.FirstIndex) ])) else AStrings.Add(Format(' Repeated columns=$%s:$%s', [ GetColString(ASheet.PageLayout.RepeatedCols.FirstIndex), GetColString(ASheet.PageLayout.RepeatedCols.lastIndex) ])); s := ''; for po in TsPrintOption do if po in ASheet.PageLayout.Options then s := s + '; ' + GetEnumName(typeInfo(TsPrintOption), ord(po)); if s <> '' then Delete(s, 1, 2); AStrings.Add(Format(' Options=%s', [s])); end else AStrings.Add('(+) Page layout=(dblclick for more...)'); if (ienImages in FExpanded) then begin AStrings.Add('(-) Images='); for i:=0 to ASheet.GetImageCount-1 do begin img := ASheet.GetImage(i); AStrings.Add(Format(' Row=%d', [img.Row])); AStrings.Add(Format(' Col=%d', [img.Col])); embObj := ASheet.Workbook.GetEmbeddedObj(img.Index); AStrings.Add(Format(' Index=%d [%s; %.2fmm x %.2fmm]', [img.Index, embobj.FileName, embObj.ImageWidth, embObj.ImageHeight])); AStrings.Add(Format(' OffsetX=%.2f mm', [img.OffsetX])); AStrings.Add(Format(' OffsetY=%.2f mm', [img.OffsetY])); AStrings.Add(Format(' ScaleX=%.2f', [img.ScaleX])); AStrings.Add(Format(' ScaleY=%.2f', [img.ScaleY])); AStrings.Add(Format(' HyperlinkTarget=%s', [img.HyperlinkTarget])); AStrings.Add(Format(' HyperlinkTooltip=%s', [img.HyperlinkToolTip])); end; end else AStrings.Add('(+) Images=(dblclick for more...)'); s := ''; for so in TsSheetOption do if so in ASheet.Options then s := s + ', ' + GetEnumName(TypeInfo(TsSheetOption), ord(so)); if s <> '' then Delete(s, 1, 2); AStrings.Add('Options='+s); if ASheet.IsProtected then begin s := ''; for sp in TsWorksheetProtection do if sp in ASheet.Protection then s := s + ', ' + GetEnumName(TypeInfo(TsWorksheetProtection), ord(sp)); if s <> '' then Delete(s, 1, 2) else s := '(default)'; end else s := '(not protected)'; AStrings.Add('Protection=' + s); if (ienCryptoInfo in FExpanded) then begin AStrings.Add('(-) CryptoInfo='); AStrings.Add(Format(' PasswordHash=%s', [Worksheet.CryptoInfo.PasswordHash])); AStrings.Add(Format(' Algorithm=%s', [AlgorithmToStr(Worksheet.CryptoInfo.Algorithm, auExcel)])); AStrings.Add(Format(' SaltValue=%s', [Worksheet.CryptoInfo.SaltValue])); AStrings.Add(Format(' SpinCount=%d', [Worksheet.CryptoInfo.SpinCount])); end else AStrings.Add('(+) CryptoInfo=(dblclick for more...)'); end; end; initialization RegisterPropertyToSkip(TsSpreadsheetInspector, 'RowHeights', 'For compatibility with older Laz versions.', ''); RegisterPropertyToSkip(TsSpreadsheetInspector, 'ColWidths', 'For compatibility with older Laz versions.', ''); { Clipboard formats } cfBiff8Format := RegisterclipboardFormat('Biff8'); cfBiff5Format := RegisterClipboardFormat('Biff5'); cfHTMLFormat := RegisterClipboardFormat('HTML Format'); cfTextHTMLFormat := RegisterClipboardFormat('text/html'); cfCSVFormat := RegisterClipboardFormat('CSV'); { not working... cfOpenDocumentFormat := RegisterClipboardFormat('application/x-openoffice-embed-source-xml;windows_formatname="Star Embed Source (XML)"'); cfStarObjectDescriptor := RegisterClipboardFormat('application/x-openoffice-objectdescriptor-xml;windows_formatname="Star Object Descriptor (XML)"'); } end.