fpspreadsheet: Add multiline string cell editor, it is activated by property EditorLineMode = elmMultiline

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5849 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2017-05-12 16:30:22 +00:00
parent 055a4eb439
commit 281b728a74

View File

@ -31,12 +31,13 @@ interface
uses uses
Classes, SysUtils, LMessages, LResources, Variants, Classes, SysUtils, LMessages, LResources, Variants,
Forms, Controls, Graphics, Dialogs, Grids, ExtCtrls, Forms, Controls, Graphics, Dialogs, Grids, StdCtrls, ExtCtrls,
fpstypes, fpspreadsheet, fpspreadsheetctrls; fpstypes, fpspreadsheet, fpspreadsheetctrls;
type type
{ TsCustomWorksheetGrid } { TsCustomWorksheetGrid }
TsCustomWorksheetGrid = class;
TsAutoExpandMode = ( TsAutoExpandMode = (
{@@ Expands grid dimensions if a cell is written outside current grid dimensions } {@@ Expands grid dimensions if a cell is written outside current grid dimensions }
@ -48,6 +49,8 @@ type
); );
TsAutoExpandModes = set of TsAutoExpandMode; TsAutoExpandModes = set of TsAutoExpandMode;
TsEditorLineMode = (elmSingleLine, elmMultiLine);
TsHyperlinkClickEvent = procedure(Sender: TObject; TsHyperlinkClickEvent = procedure(Sender: TObject;
const AHyperlink: TsHyperlink) of object; const AHyperlink: TsHyperlink) of object;
@ -59,6 +62,28 @@ type
property JoinStyle default pjsMiter; property JoinStyle default pjsMiter;
end; end;
TMultilineStringCellEditor = class(TMemo)
private
FGrid: TsCustomWorksheetGrid;
FCol,FRow:Integer;
protected
procedure WndProc(var TheMessage : TLMessage); override;
procedure Change; override;
procedure KeyDown(var Key : Word; Shift : TShiftState); override;
procedure msg_SetValue(var Msg: TGridMessage); message GM_SETVALUE;
procedure msg_GetValue(var Msg: TGridMessage); message GM_GETVALUE;
procedure msg_SetGrid(var Msg: TGridMessage); message GM_SETGRID;
procedure msg_SelectAll(var Msg: TGridMessage); message GM_SELECTALL;
procedure msg_SetPos(var Msg: TGridMessage); message GM_SETPOS;
procedure msg_GetGrid(var Msg: TGridMessage); message GM_GETGRID;
public
constructor Create(Aowner : TComponent); override;
procedure EditingDone; override;
// property EditText;
property OnEditingDone;
end;
// TsSelectionRectMode = (srmDThickXOR, srmThick, srmDottedXOR, // TsSelectionRectMode = (srmDThickXOR, srmThick, srmDottedXOR,
{@@ TsCustomWorksheetGrid is the ancestor of TsWorksheetGrid and is able to {@@ TsCustomWorksheetGrid is the ancestor of TsWorksheetGrid and is able to
display spreadsheet data along with their formatting. } display spreadsheet data along with their formatting. }
@ -93,6 +118,9 @@ type
FTopLeft: TPoint; FTopLeft: TPoint;
FReadOnly: Boolean; FReadOnly: Boolean;
FOnClickHyperlink: TsHyperlinkClickEvent; FOnClickHyperlink: TsHyperlinkClickEvent;
FOldEditorText: String;
FMultilineStringEditor: TMultilineStringCellEditor;
FLineMode: TsEditorLineMode;
function CalcAutoRowHeight(ARow: Integer): Integer; function CalcAutoRowHeight(ARow: Integer): Integer;
function CalcColWidthFromSheet(AWidth: Single): Integer; function CalcColWidthFromSheet(AWidth: Single): Integer;
function CalcRowHeightFromSheet(AHeight: Single): Integer; function CalcRowHeightFromSheet(AHeight: Single): Integer;
@ -171,6 +199,7 @@ type
procedure SetColWidths(ACol: Integer; AValue: Integer); procedure SetColWidths(ACol: Integer; AValue: Integer);
procedure SetDefColWidth(AValue: Integer); procedure SetDefColWidth(AValue: Integer);
procedure SetDefRowHeight(AValue: Integer); procedure SetDefRowHeight(AValue: Integer);
procedure SetEditorLineMode(AValue: TsEditorLineMode);
procedure SetFrozenCols(AValue: Integer); procedure SetFrozenCols(AValue: Integer);
procedure SetFrozenRows(AValue: Integer); procedure SetFrozenRows(AValue: Integer);
procedure SetHorAlignment(ACol, ARow: Integer; AValue: TsHorAlignment); procedure SetHorAlignment(ACol, ARow: Integer; AValue: TsHorAlignment);
@ -279,7 +308,11 @@ type
default [aeData, aeNavigation, aeDefault]; default [aeData, aeNavigation, aeDefault];
{@@ Displays column and row headers in the fixed col/row style of the grid. {@@ Displays column and row headers in the fixed col/row style of the grid.
Deprecated. Use ShowHeaders instead. } Deprecated. Use ShowHeaders instead. }
property DisplayFixedColRow: Boolean read GetShowHeaders write SetShowHeaders default true; property DisplayFixedColRow: Boolean read GetShowHeaders write SetShowHeaders
default true;
{@@ Determines whether a single- or multi-line cell editor is used }
property EditorLineMode: TsEditorLineMode read FLineMode write SetEditorLineMode
default elmSingleLine;
{@@ This number of columns at the left is "frozen", i.e. it is not possible to {@@ This number of columns at the left is "frozen", i.e. it is not possible to
scroll these columns } scroll these columns }
property FrozenCols: Integer read FFrozenCols write SetFrozenCols; property FrozenCols: Integer read FFrozenCols write SetFrozenCols;
@ -315,6 +348,7 @@ type
procedure DeleteCol(AGridCol: Integer); reintroduce; procedure DeleteCol(AGridCol: Integer); reintroduce;
procedure DeleteRow(AGridRow: Integer); reintroduce; procedure DeleteRow(AGridRow: Integer); reintroduce;
procedure EditingDone; override; procedure EditingDone; override;
function EditorByStyle(Style: TColumnButtonStyle): TWinControl; override;
procedure EndUpdate(ARefresh: Boolean = true); procedure EndUpdate(ARefresh: Boolean = true);
function GetGridCol(ASheetCol: Cardinal): Integer; inline; function GetGridCol(ASheetCol: Cardinal): Integer; inline;
function GetGridRow(ASheetRow: Cardinal): Integer; inline; function GetGridRow(ASheetRow: Cardinal): Integer; inline;
@ -534,6 +568,8 @@ type
{@@ Displays column and row headers in the fixed col/row style of the grid. {@@ Displays column and row headers in the fixed col/row style of the grid.
Deprecated. Use ShowHeaders instead. } Deprecated. Use ShowHeaders instead. }
property DisplayFixedColRow; deprecated 'Use ShowHeaders'; property DisplayFixedColRow; deprecated 'Use ShowHeaders';
{@@ Determines whether a single- or multiline cell editor is used }
property EditorLineMode;
{@@ This number of columns at the left is "frozen", i.e. it is not possible to {@@ This number of columns at the left is "frozen", i.e. it is not possible to
scroll these columns. } scroll these columns. }
property FrozenCols; property FrozenCols;
@ -761,7 +797,7 @@ procedure Register;
implementation implementation
uses uses
Types, LCLType, LCLIntf, LCLProc, Math, StrUtils, Types, LCLType, LCLIntf, LCLProc, LazUTF8, Math, StrUtils,
fpCanvas, {%H-}fpsPatches, fpCanvas, {%H-}fpsPatches,
fpsStrings, fpsUtils, fpsVisualUtils, fpsHTMLUtils, fpsImages, fpsNumFormat; fpsStrings, fpsUtils, fpsVisualUtils, fpsHTMLUtils, fpsImages, fpsNumFormat;
@ -1025,6 +1061,160 @@ begin
end; end;
{*******************************************************************************
* TMultilineStringCellEditor *
*******************************************************************************}
constructor TMultilineStringCellEditor.Create(Aowner: TComponent);
begin
inherited Create(AOwner);
AutoSize := false;
end;
procedure TMultilineStringCellEditor.Change;
begin
inherited Change;
if (FGrid <> nil) and Visible then
FGrid.EditorTextChanged(FCol, FRow, Text);
end;
procedure TMultilineStringCellEditor.EditingDone;
begin
inherited EditingDone;
if FGrid <> nil then
FGrid.EditingDone;
end;
procedure TMultilineStringCellEditor.KeyDown(var Key: Word; Shift: TShiftState);
function AllSelected: boolean;
begin
result := (SelLength > 0) and (SelLength = UTF8Length(Text));
end;
function AtStart: Boolean;
begin
Result:= (SelStart = 0);
end;
function AtEnd: Boolean;
begin
result := ((SelStart + 1) > UTF8Length(Text)) or AllSelected;
end;
procedure doEditorKeyDown;
begin
if FGrid <> nil then
FGrid.EditorkeyDown(Self, key, shift);
end;
procedure doGridKeyDown;
begin
if FGrid <> nil then
FGrid.KeyDown(Key, shift);
end;
function GetFastEntry: boolean;
begin
if FGrid <> nil then
Result := FGrid.FastEditing
else
Result := False;
end;
procedure CheckEditingKey;
begin
if (FGrid = nil) or FGrid.EditorIsReadOnly then
Key := 0;
end;
var
IntSel: boolean;
begin
inherited KeyDown(Key,Shift);
case Key of
VK_F2:
if AllSelected then begin
SelLength := 0;
SelStart := Length(Text);
end;
VK_DELETE, VK_BACK:
CheckEditingKey;
VK_UP, VK_DOWN:
doGridKeyDown;
VK_LEFT, VK_RIGHT:
if GetFastEntry then begin
IntSel:=
((Key=VK_LEFT) and not AtStart) or
((Key=VK_RIGHT) and not AtEnd);
if not IntSel then begin
doGridKeyDown;
end;
end;
VK_END, VK_HOME:
;
VK_ESCAPE:
begin
doGridKeyDown;
if key<>0 then begin
Text := FGrid.FOldEditorText;
// Lines.Text := ''; // FIXME: FGrid.FEditorOldvalue;
// SetEditText(FGrid.FEditorOldValue);
FGrid.EditorHide;
end;
end;
else
doEditorKeyDown;
end;
end;
procedure TMultilineStringCellEditor.msg_GetGrid(var Msg: TGridMessage);
begin
Msg.Grid := FGrid;
Msg.Options:= EO_IMPLEMENTED;
end;
procedure TMultilineStringCellEditor.msg_GetValue(var Msg: TGridMessage);
begin
Msg.Col := FCol;
Msg.Row := FRow;
Msg.Value := Text;
end;
procedure TMultilineStringCellEditor.msg_SelectAll(var Msg: TGridMessage);
begin
SelectAll;
end;
procedure TMultilineStringCellEditor.msg_SetGrid(var Msg: TGridMessage);
begin
FGrid := Msg.Grid as TsCustomWorksheetGrid;
Msg.Options := EO_AUTOSIZE or EO_SELECTALL or EO_HOOKKEYPRESS or EO_HOOKKEYUP;
end;
procedure TMultilineStringCellEditor.msg_SetPos(var Msg: TGridMessage);
begin
FCol := Msg.Col;
FRow := Msg.Row;
end;
procedure TMultilineStringCellEditor.msg_SetValue(var Msg: TGridMessage);
begin
Text := Msg.Value;
SelStart := UTF8Length(Text);
end;
procedure TMultilineStringCellEditor.WndProc(var TheMessage: TLMessage);
begin
if FGrid <> nil then
case TheMessage.Msg of
LM_CLEAR, LM_CUT, LM_PASTE:
if FGrid.EditorIsReadOnly then exit;
end;
inherited WndProc(TheMessage);
end;
{******************************************************************************* {*******************************************************************************
* TsCustomWorksheetGrid * * TsCustomWorksheetGrid *
*******************************************************************************} *******************************************************************************}
@ -1084,6 +1274,7 @@ begin
FInternalWorkbookSource.RemoveListener(self); // will be destroyed automatically FInternalWorkbookSource.RemoveListener(self); // will be destroyed automatically
FreeAndNil(FCellFont); FreeAndNil(FCellFont);
FreeAndNil(FSelPen); FreeAndNil(FSelPen);
FreeAndNil(FMultilineStringEditor);
inherited Destroy; inherited Destroy;
end; end;
@ -1755,6 +1946,7 @@ var
Rct: TRect; Rct: TRect;
delta: Integer; delta: Integer;
begin begin
FOldEditorText := GetCellText(Row, Col);
inherited; inherited;
if (Worksheet <> nil) and (Editor is TStringCellEditor) then if (Worksheet <> nil) and (Editor is TStringCellEditor) then
begin begin
@ -1777,7 +1969,6 @@ procedure TsCustomWorksheetGrid.DoOnResize;
begin begin
if (csDesigning in ComponentState) and (Worksheet = nil) then if (csDesigning in ComponentState) and (Worksheet = nil) then
NewWorkbook(ColCount, RowCount); NewWorkbook(ColCount, RowCount);
// NewWorkbook(FInitColCount, FInitRowCount);
inherited; inherited;
end; end;
@ -2871,6 +3062,14 @@ begin
FEnhEditMode := false; FEnhEditMode := false;
end; end;
function TsCustomWorksheetGrid.EditorByStyle(Style: TColumnButtonStyle): TWinControl;
begin
if (Style = cbsAuto) and (FLineMode = elmMultiLine) then
Result := FMultilineStringEditor
else
Result := inherited;
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
The BeginUpdate/EndUpdate pair suppresses unnecessary painting of the grid. The BeginUpdate/EndUpdate pair suppresses unnecessary painting of the grid.
Call BeginUpdate to stop refreshing the grid, and call EndUpdate to release Call BeginUpdate to stop refreshing the grid, and call EndUpdate to release
@ -6175,6 +6374,23 @@ begin
Worksheet.WriteDefaultRowHeight(CalcWorksheetRowHeight(GetDefaultRowHeight), Workbook.Units); Worksheet.WriteDefaultRowHeight(CalcWorksheetRowHeight(GetDefaultRowHeight), Workbook.Units);
end; end;
procedure TscustomWorksheetGrid.SetEditorLineMode(AValue: TsEditorLineMode);
begin
if FLineMode = AValue then
exit;
FLineMode := AValue;
if (FLineMode = elmMultiline) and (FMultilineStringEditor = nil) then
begin
FMultilineStringEditor := TMultilineStringCellEditor.Create(nil);
FMultilineStringEditor.name :='StringEditor';
FMultilineStringEditor.Text:='';
FMultilineStringEditor.Visible:=False;
FMultilineStringEditor.Align:=alNone;
FMultilineStringEditor.BorderStyle := bsNone;
end;
end;
procedure TsCustomWorksheetGrid.SetFrozenCols(AValue: Integer); procedure TsCustomWorksheetGrid.SetFrozenCols(AValue: Integer);
begin begin
FFrozenCols := AValue; FFrozenCols := AValue;