From 694b61fac2691d91416a71f77ced5cecb8e6f8b8 Mon Sep 17 00:00:00 2001
From: wp_xxyyzz <wp_xxyyzz@8e941d3f-bd1b-0410-a28a-d453659cc2b4>
Date: Wed, 15 Feb 2017 21:56:11 +0000
Subject: [PATCH] fpspreadsheet: Experimental implementation of moving of
 columns (see
 http://forum.lazarus.freepascal.org/index.php/topic,35733.0.html)

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5750 8e941d3f-bd1b-0410-a28a-d453659cc2b4
---
 .../source/common/fpsclasses.pas              | 47 +++++++++++++++++++
 .../source/common/fpspreadsheet.pas           | 27 +++++++++++
 .../source/visual/fpspreadsheetgrid.pas       |  9 ++++
 3 files changed, 83 insertions(+)

diff --git a/components/fpspreadsheet/source/common/fpsclasses.pas b/components/fpspreadsheet/source/common/fpsclasses.pas
index 0dd2185c1..74a5ff695 100644
--- a/components/fpspreadsheet/source/common/fpsclasses.pas
+++ b/components/fpspreadsheet/source/common/fpsclasses.pas
@@ -61,6 +61,7 @@ type
     function GetFirst: PsRowCol;
     function GetLast: PsRowCol;
     procedure InsertRowOrCol(AIndex: Cardinal; IsRow: Boolean);
+    procedure MoveAlongRow(ARow, AFromCol, AToCol: Cardinal);
     procedure Remove(ARow, ACol: Cardinal); overload;
   end;
 
@@ -607,6 +608,52 @@ begin
   end;
 end;
 
+{@@ ----------------------------------------------------------------------------
+  This method moves the cell in the specified row (ARow) and at column AFromCol
+  along the row before the column with index AToCol.
+-------------------------------------------------------------------------------}
+procedure TsRowColAVLTree.MoveAlongRow(ARow, AFromCol, AToCol: Cardinal);
+var
+  c: Cardinal;
+  node: TAVLTreeNode;
+  item: PsRowCol;
+begin
+  if AFromCol = AToCol then
+    exit;
+
+  if AFromCol < AToCol then
+  begin
+    node := FindLowest;
+    while Assigned(node) do
+    begin
+      item := PsRowCol(node.Data);
+      if item^.Row > ARow then exit;
+      if item^.Row = ARow then break;
+      node := FindSuccessor(node);
+    end;
+    c := AFromCol;
+    while c < AToCol do begin
+      Exchange(ARow, c, ARow, c+1);
+      inc(c);
+    end;
+  end else
+  begin
+    node:= FindHighest;
+    while Assigned(node) do
+    begin
+      item := PsRowCol(node.Data);
+      if item^.Row < ARow then exit;
+      if item^.Row = ARow then break;
+      node := FindPrecessor(node);
+    end;
+    c := AFromCol;
+    while c > AToCol do begin
+      Exchange(ARow, c, ARow, c-1);
+      dec(c);
+    end;
+  end;
+end;
+
 {@@ ----------------------------------------------------------------------------
   Removes the node, but does NOT destroy the associated data reocrd
 -------------------------------------------------------------------------------}
diff --git a/components/fpspreadsheet/source/common/fpspreadsheet.pas b/components/fpspreadsheet/source/common/fpspreadsheet.pas
index 43beb71f4..16e295386 100644
--- a/components/fpspreadsheet/source/common/fpspreadsheet.pas
+++ b/components/fpspreadsheet/source/common/fpspreadsheet.pas
@@ -450,6 +450,7 @@ type
     procedure DeleteRow(ARow: Cardinal);
     procedure InsertCol(ACol: Cardinal);
     procedure InsertRow(ARow: Cardinal);
+    procedure MoveCol(AFromCol, AToCol: Cardinal);
     function  ReadDefaultColWidth(AUnits: TsSizeUnits): Single;
     function  ReadDefaultRowHeight(AUnits: TsSizeUnits): Single;
     function  ReadColFont(ACol: PCol): TsFont;
@@ -7397,6 +7398,32 @@ begin
   end;
 end;
 
+{@@ ----------------------------------------------------------------------------
+  Moves a column from a specified column index to another column index.
+  The operation includes everything associated with the column (cell values,
+  cell properties, formats, formulas, column formats, column widths). Formulas
+  are automatically adjusted for the new position.
+-------------------------------------------------------------------------------}
+procedure TsWorksheet.MoveCol(AFromCol, AToCol: Cardinal);
+var
+  r, c: Integer;
+begin
+  if AFromCol = AToCol then
+    // Nothing to do
+    exit;
+
+  Workbook.DisableNotifications;
+  try
+    for r := 0 to GetLastRowIndex do begin
+      FCells.MoveAlongRow(r, AFromCol, AToCol);
+      FComments.MoveAlongRow(r, AFromCol, AToCol);
+      FHyperlinks.MoveAlongRow(r, AFromCol, AToCol);
+    end;
+  finally
+    Workbook.EnableNotifications;
+  end;
+end;
+
 {@@ ----------------------------------------------------------------------------
   Reads the value of the default column width and converts it to the specified
   units
diff --git a/components/fpspreadsheet/source/visual/fpspreadsheetgrid.pas b/components/fpspreadsheet/source/visual/fpspreadsheetgrid.pas
index d34bb5dc0..db53a18ed 100644
--- a/components/fpspreadsheet/source/visual/fpspreadsheetgrid.pas
+++ b/components/fpspreadsheet/source/visual/fpspreadsheetgrid.pas
@@ -206,6 +206,7 @@ type
     function CalcWorksheetRowHeight(AValue: Integer): Single;
     function CellOverflow(ACol, ARow: Integer; AState: TGridDrawState;
       out ACol1, ACol2: Integer; var ARect: TRect): Boolean;
+    procedure ColRowMoved(IsColumn: Boolean; FromIndex,ToIndex: Integer); override;
     procedure CreateHandle; override;
     procedure CreateNewWorkbook;
     procedure DblClick; override;
@@ -1595,6 +1596,14 @@ begin
   UpdateRowHeights(AGridRow);
 end;
 
+procedure TsCustomWorksheetGrid.ColRowMoved(IsColumn: Boolean;
+  FromIndex,ToIndex: Integer);
+begin
+  inherited;
+  if IsColumn then
+    Worksheet.MoveCol(GetWorksheetCol(FromIndex), GetWorksheetCol(ToIndex));
+end;
+
 procedure TsCustomWorksheetGrid.CreateHandle;
 begin
   inherited;