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

components/fpspreadsheet/source/visual/fpspreadsheetgrid.pas

@@ -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;