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

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

Browse Source 
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
1 changed files with 220 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

224
components/fpspreadsheet/source/visual/fpspreadsheetgrid.pas
View File

@ -31,12 +31,13 @@ interface
uses
Classes, SysUtils, LMessages, LResources, Variants,
Forms, Controls, Graphics, Dialogs, Grids, ExtCtrls,
Forms, Controls, Graphics, Dialogs, Grids, StdCtrls, ExtCtrls,
fpstypes, fpspreadsheet, fpspreadsheetctrls;
type
{ TsCustomWorksheetGrid }
TsCustomWorksheetGrid = class;
TsAutoExpandMode = (
{@@ Expands grid dimensions if a cell is written outside current grid dimensions }
@ -48,6 +49,8 @@ type
);
TsAutoExpandModes = set of TsAutoExpandMode;
TsEditorLineMode = (elmSingleLine, elmMultiLine);
TsHyperlinkClickEvent = procedure(Sender: TObject;
const AHyperlink: TsHyperlink) of object;
@ -59,6 +62,28 @@ type
property JoinStyle default pjsMiter;
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,
{@@ TsCustomWorksheetGrid is the ancestor of TsWorksheetGrid and is able to
display spreadsheet data along with their formatting. }
@ -93,6 +118,9 @@ type
FTopLeft: TPoint;
FReadOnly: Boolean;
FOnClickHyperlink: TsHyperlinkClickEvent;
FOldEditorText: String;
FMultilineStringEditor: TMultilineStringCellEditor;
FLineMode: TsEditorLineMode;
function CalcAutoRowHeight(ARow: Integer): Integer;
function CalcColWidthFromSheet(AWidth: Single): Integer;
function CalcRowHeightFromSheet(AHeight: Single): Integer;
@ -171,6 +199,7 @@ type
procedure SetColWidths(ACol: Integer; AValue: Integer);
procedure SetDefColWidth(AValue: Integer);
procedure SetDefRowHeight(AValue: Integer);
procedure SetEditorLineMode(AValue: TsEditorLineMode);
procedure SetFrozenCols(AValue: Integer);
procedure SetFrozenRows(AValue: Integer);
procedure SetHorAlignment(ACol, ARow: Integer; AValue: TsHorAlignment);
@ -279,7 +308,11 @@ type
default [aeData, aeNavigation, aeDefault];
{@@ Displays column and row headers in the fixed col/row style of the grid.
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
scroll these columns }
property FrozenCols: Integer read FFrozenCols write SetFrozenCols;
@ -315,6 +348,7 @@ type
procedure DeleteCol(AGridCol: Integer); reintroduce;
procedure DeleteRow(AGridRow: Integer); reintroduce;
procedure EditingDone; override;
function EditorByStyle(Style: TColumnButtonStyle): TWinControl; override;
procedure EndUpdate(ARefresh: Boolean = true);
function GetGridCol(ASheetCol: 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.
Deprecated. Use ShowHeaders instead. }
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
scroll these columns. }
property FrozenCols;
@ -761,7 +797,7 @@ procedure Register;
implementation
uses
Types, LCLType, LCLIntf, LCLProc, Math, StrUtils,
Types, LCLType, LCLIntf, LCLProc, LazUTF8, Math, StrUtils,
fpCanvas, {%H-}fpsPatches,
fpsStrings, fpsUtils, fpsVisualUtils, fpsHTMLUtils, fpsImages, fpsNumFormat;
@ -1025,6 +1061,160 @@ begin
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 *
*******************************************************************************}
@ -1084,6 +1274,7 @@ begin
FInternalWorkbookSource.RemoveListener(self); // will be destroyed automatically
FreeAndNil(FCellFont);
FreeAndNil(FSelPen);
FreeAndNil(FMultilineStringEditor);
inherited Destroy;
end;
@ -1755,6 +1946,7 @@ var
Rct: TRect;
delta: Integer;
begin
FOldEditorText := GetCellText(Row, Col);
inherited;
if (Worksheet <> nil) and (Editor is TStringCellEditor) then
begin
@ -1777,7 +1969,6 @@ procedure TsCustomWorksheetGrid.DoOnResize;
begin
if (csDesigning in ComponentState) and (Worksheet = nil) then
NewWorkbook(ColCount, RowCount);
// NewWorkbook(FInitColCount, FInitRowCount);
inherited;
end;
@ -2871,6 +3062,14 @@ begin
FEnhEditMode := false;
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.
Call BeginUpdate to stop refreshing the grid, and call EndUpdate to release
@ -6175,6 +6374,23 @@ begin
Worksheet.WriteDefaultRowHeight(CalcWorksheetRowHeight(GetDefaultRowHeight), Workbook.Units);
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);
begin
FFrozenCols := AValue;