{***************************************************************************}
{ TAdvGridWorkbook component                                                }
{ for Delphi & C++Builder                                                   }
{ version 3.3                                                               }
{                                                                           }
{ written by TMS Software                                                   }
{            copyright © 2003 - 2006                                        }
{            Email : info@tmssoftware.com                                   }
{            Web : http://www.tmssoftware.com                               }
{                                                                           }
{ The source code is given as is. The author is not responsible             }
{ for any possible damage done due to the use of this code.                 }
{ The component can be freely used in any application. The complete         }
{ source code remains property of the author and may not be distributed,    }
{ published, given or sold in any form as such. No parts of the source      }
{ code can be included in any other component or application without        }
{ written authorization of the author.                                      }
{***************************************************************************}

unit AdvGridWorkbook;

interface

uses
  Classes, Windows, Controls, ExtCtrls, Tabs, StdCtrls, AdvGrid, BaseGrid,
  Grids, Dialogs, Forms, Messages, Graphics, SysUtils, AdvObj;

const
  MAJ_VER = 3; // Major version nr.
  MIN_VER = 3; // Minor version nr.
  REL_VER = 0; // Release nr.
  BLD_VER = 1; // Build nr.
  DATE_VER = 'Apr, 2006'; // Month version

  // 2.8.8.3 : Fixed issue with streaming non visible workbook component
  // 3.3.0.0 : Release compatible with latest TAdvStringGrid
  // 3.3.0.1 : Fix for reparenting

type
  TSheetChangeEvent = procedure(Sender: TObject; NewSheet: Integer; var AllowChange: Boolean) of object;

  TAdvGridWorkbook = class;

  TTabLook = class(TPersistent)
  private
    FDitherBackground: Boolean;
    FSelectColor: TColor;
    FUnSelectColor: TColor;
    FBackgroundColor: TColor;
    FFont: TFont;
    FOnChange: TNotifyEvent;
    procedure SetBackgroundColor(const Value: TColor);
    procedure SetDitherBackground(const Value: Boolean);
    procedure SetFont(const Value: TFont);
    procedure SetSelectColor(const Value: TColor);
    procedure SetUnSelectColor(const Value: TColor);
  protected
    procedure FontChanged(Sender: TObject);
    procedure Changed;
  public
    constructor Create;
    destructor Destroy; override;
  published
    property Font: TFont read FFont write SetFont;
    property SelectColor: TColor read FSelectColor write SetSelectColor default clBtnFace;
    property UnSelectColor: TColor read FUnSelectColor write SetUnSelectColor default clWhite;
    property DitherBackground: Boolean read FDitherBackground write SetDitherBackground default true;
    property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor default clBtnFace;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TGridSheet = class(TCollectionItem)
  private
    FData: TMemoryStream;
    FTag: Integer;
    FName: string;
    FCol: integer;
    FRow: integer;
    FLeftCol: integer;
    FTopRow: integer;
    FColWidths: TIntList;
    FRowHeights: TIntList;
    FSortColumn: Integer;
    procedure SetName(const Value: string);
  protected
    procedure Changed;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    property Data: TMemoryStream read FData;
    property Col: integer read FCol write FCol;
    property Row: integer read FRow write FRow;
    property TopRow: integer read FTopRow write FTopRow;
    property LeftCol: integer read FLeftCol write FLeftCol;
    property ColWidths: TIntList read FColWidths;
    property RowHeights: TIntList read FRowHeights;
    property SortColumn: Integer read FSortColumn write FSortColumn;
  published
    property Name: string read FName write SetName;
    property Tag: Integer read FTag write FTag;
  end;

  TGridSheetCollection = class(TCollection)
  private
    FOwner: TAdvGridWorkBook;
    FOnChange: TNotifyEvent;
    function GetItem(Index: Integer): TGridSheet;
    procedure SetItem(Index: Integer; const Value: TGridSheet);
  protected
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(AOwner: TAdvGridWorkbook);
    procedure Clear;
    function Add: TGridSheet;
    function Insert(Index: Integer): TGridSheet;
    property Items[Index: Integer]: TGridSheet read GetItem write SetItem; default;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    function GetOwner: TPersistent; override;
  end;

  TAdvGridWorkbook = class(TCustomControl)
  private
    FTabSet: TTabSet;
    FGrid: TAdvStringGrid;
    FActiveSheet: Integer;
    FAutoCreated: Boolean;
    FWinCreated: Boolean;
    FSheets: TGridSheetCollection;
    FDefaultColCount: Integer;
    FDefaultRowCount: Integer;
    FDefaultRowHeight: Integer;
    FDefaultColWidth: Integer;
    FOnSheetChange: TSheetChangeEvent;
    FTabLook: TTabLook;
    procedure NCPaintProc;
    procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT;
    procedure TabChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean);
    procedure SheetChange(Sender: TObject);
    procedure TabLookChange(Sender: TObject);
    function GetSheets: TGridSheetCollection;
    procedure SetSheets(const Value: TGridSheetCollection);
    procedure SetActiveSheet(const Value: Integer);
    procedure StoreActiveSheet;
    function GetVersion: string;
    procedure SetVersion(const Value: string);
  protected
    procedure Notification(AComponent: TComponent; AOperation: TOperation); override;
  public
    function GetVersionNr: Integer; virtual;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    constructor Create(AOwner: TComponent); override;
    procedure CreateParams(var Params: TCreateParams); override;
    destructor Destroy; override;
    procedure CreateWnd; override;
    property Grid: TAdvStringGrid read FGrid;
    procedure RemoveSheet(Index: Integer);
    procedure InsertSheet(Index: Integer; SheetName: string);
    procedure AddSheet(SheetName: string);
  published
    property ActiveSheet: Integer read FActiveSheet write SetActiveSheet;
    property Sheets: TGridSheetCollection read GetSheets write SetSheets;
    property TabLook: TTabLook read FTabLook write FTabLook;
    property OnSheetChange: TSheetChangeEvent read FOnSheetChange write FOnSheetChange;
    property Align;
    property Anchors;
    property Constraints;
    property PopupMenu;
    property TabOrder;
    property TabStop;
    property Visible;
    property Version: string read GetVersion write SetVersion;    
  end;



implementation


{ TAdvGridWorkbook }

constructor TAdvGridWorkbook.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FAutoCreated := false;
  FWinCreated := false;
  
  BorderWidth := 1;
  Ctl3D := false;

  FSheets := TGridSheetCollection.Create(Self);
  FSheets.Add.Name := 'Sheet 1';
  FSheets.Add.Name := 'Sheet 2';
  FSheets.Add.Name := 'Sheet 3';

  FGrid := nil;
  Width := 320;
  Height := 150;

  ControlStyle := ControlStyle + [csAcceptsControls];

  FTabLook := TTabLook.Create;
end;

procedure TAdvGridWorkbook.CreateParams(var Params: TCreateParams);
begin
  inherited;
  with Params do
  begin
    Style := Style or WS_TABSTOP;
    Style := Style or WS_BORDER;
  end;
end;

procedure TAdvGridWorkbook.CreateWnd;
var
  i: integer;
  TabSetNeeded: boolean;
begin
  inherited;

  FWinCreated := true;

  TabSetNeeded := (FTabSet = nil);

  if ControlCount = 0 then
  begin
    FGrid := TAdvStringGrid.Create(self);
    FGrid.Parent := self;
    FGrid.Visible := true;
    FGrid.BorderStyle := bsNone;
  end
  else
  begin
    FGrid := TAdvStringGrid(Controls[0]);
    FAutoCreated := true;
  end;

  FDefaultRowCount := FGrid.RowCount;
  FDefaultColCount := FGrid.ColCount;
  FDefaultRowHeight := FGrid.DefaultRowHeight;
  FDefaultColWidth := FGrid.DefaultColWidth;

  if TabSetNeeded then
    FTabSet := TTabSet.Create(Self);

  FTabSet.Parent := self;
  FTabSet.Align := alBottom;
  {$IFDEF DELPHI6_LVL}
  FTabSet.SoftTop := true;
  {$ENDIF}

  FGrid.Align := alClient;
  FGrid.Options := FGrid.Options + [goEditing];
  
  if not FAutoCreated then
  begin
    FGrid.Name := 'WorkBookGrid'+inttostr(Parent.ControlCount);
  end;

  if TabSetNeeded then
    for i := 1 to FSheets.Count do
      FTabSet.Tabs.Add(FSheets[i - 1].Name);

  if FTabSet.Tabs.Count > 0 then
    FTabSet.TabIndex := 0;

  FSheets.OnChange := SheetChange;  
  FTabSet.OnChange := TabChange;
  FTabLook.OnChange := TabLookChange;

  TabLookChange(Self);
end;

destructor TAdvGridWorkbook.Destroy;
begin
  FSheets.Free;
  FTabLook.Free;

  if (FGrid <> nil) and not FAutoCreated then
    FGrid.Free;

  FTabSet.Free;
  inherited;
end;


function TAdvGridWorkbook.GetSheets: TGridSheetCollection;
begin
  Result := FSheets;
end;

procedure TAdvGridWorkbook.NCPaintProc;
var
  DC: HDC;
  WindowBrush:hBrush;
  Canvas: TCanvas;
begin
  if BorderWidth = 0 then
    Exit;

  DC := GetWindowDC(Handle);
  WindowBrush := 0;
  try
    Canvas := TCanvas.Create;
    Canvas.Handle := DC;

    WindowBrush := CreateSolidBrush(ColorToRGB(clRed));

    if (1>0) then
      Canvas.Pen.Color := $B99D7F
    else
      Canvas.Pen.Color := clGray;

    Canvas.MoveTo(1,Height);
    Canvas.LineTo(1,1);
    Canvas.LineTo(Width - 2,1);
    Canvas.LineTo(Width - 2,Height - 2);
    Canvas.LineTo(1,Height - 2);

    if (Parent is TWinControl) then
    begin
      Canvas.Pen.Color := (Parent as TWinControl).Brush.Color;
      Canvas.MoveTo(0,Height);
      Canvas.LineTo(0,0);
      Canvas.LineTo(Width - 1,0);
      Canvas.LineTo(Width - 1,Height - 1);
      Canvas.LineTo(0,Height-1);
    end;
    Canvas.Free;
  finally
    DeleteObject(WindowBrush);
    ReleaseDC(Handle,DC);
  end;
end;

procedure TAdvGridWorkbook.StoreActiveSheet;
var
  i: Integer;
begin
  FSheets[FActiveSheet].Data.Clear;
  FGrid.SaveFixedCells := True;
  FGrid.ExpandAll;   // required to make sure all rows are saved
  FGrid.SaveToBinStream(FSheets[FActiveSheet].Data);
  FSheets[FActiveSheet].Row := FGrid.Row;
  FSheets[FActiveSheet].Col := FGrid.Col;
  FSheets[FActiveSheet].TopRow := FGrid.TopRow;
  FSheets[FActiveSheet].LeftCol := FGrid.LeftCol;
  FSheets[FActiveSheet].Sortcolumn := FGrid.SortSettings.Column;

  FSheets[FActiveSheet].RowHeights.Clear;
  for i := 1 to FGrid.RowCount do
    FSheets[FActiveSheet].RowHeights.Add(FGrid.RowHeights[i - 1]);

  FSheets[FActiveSheet].ColWidths.Clear;
  for i := 1 to FGrid.ColCount do
    FSheets[FActiveSheet].ColWidths.Add(FGrid.ColWidths[i - 1]);

end;

procedure TAdvGridWorkbook.SetActiveSheet(const Value: Integer);
var
  i: Integer;
  sfc: Boolean;
begin
  if not Assigned(FGrid) then
    Exit;

  if (FActiveSheet <> Value) and (Value >= 0) and (Value < Sheets.Count) then
  begin
    FGrid.HideInplaceEdit;
    sfc := FGrid.SaveFixedCells;
    if FActiveSheet >= 0 then
    begin
      StoreActiveSheet;
      {
      FSheets[FActiveSheet].Data.Clear;
      FGrid.SaveFixedCells := True;
      FGrid.SaveToBinStream(FSheets[FActiveSheet].Data);
      FSheets[FActiveSheet].Row := FGrid.Row;
      FSheets[FActiveSheet].Col := FGrid.Col;
      FSheets[FActiveSheet].TopRow := FGrid.TopRow;
      FSheets[FActiveSheet].LeftCol := FGrid.LeftCol;
      FSheets[FActiveSheet].Sortcolumn := FGrid.SortSettings.Column;

      FSheets[FActiveSheet].RowHeights.Clear;
      for i := 1 to FGrid.RowCount do
        FSheets[FActiveSheet].RowHeights.Add(FGrid.RowHeights[i - 1]);

      FSheets[FActiveSheet].ColWidths.Clear;
      for i := 1 to FGrid.ColCount do
        FSheets[FActiveSheet].ColWidths.Add(FGrid.ColWidths[i - 1]);
      }
    end;

    if FSheets[Value].Data.Size <> 0 then
    begin
      FSheets[Value].Data.Position := 0;
      FGrid.LoadFromBinStream(FSheets[Value].Data);

      if FSheets[Value].Row < FGrid.RowCount then
        FGrid.Row := FSheets[Value].Row;
      if FSheets[Value].Col < FGrid.ColCount then
        FGrid.Col := FSheets[Value].Col;

      FGrid.TopRow := FSheets[Value].TopRow;
      FGrid.LeftCol := FSheets[Value].LeftCol;

      for i := 1 to FSheets[Value].ColWidths.Count do
        if i < FGrid.ColCount then
          FGrid.ColWidths[i - 1] := FSheets[Value].ColWidths[i - 1];

      for i := 1 to FSheets[Value].RowHeights.Count do
        if i < FGrid.RowCount then
          FGrid.RowHeights[i - 1] := FSheets[Value].RowHeights[i - 1];

      FGrid.SortSettings.Column := FSheets[Value].SortColumn;
    end
    else
    begin
      FGrid.Clear;
      FGrid.Col := FGrid.FixedCols;
      FGrid.Row := FGrid.FixedRows;
      FGrid.TopRow := FGrid.FixedRows;
      FGrid.LeftCol := FGrid.FixedCols;
      FGrid.ColCount := FDefaultColCount;
      FGrid.RowCount := FDefaultRowCount;
      FGrid.DefaultRowHeight := FDefaultRowHeight;
      FGrid.DefaultColWidth := FDefaultColWidth;
    end;

    // restore saved value
    FGrid.SaveFixedCells := sfc;

    FActiveSheet := Value;
    FTabSet.TabIndex := Value;
  end;

end;


procedure TAdvGridWorkbook.SetSheets(const Value: TGridSheetCollection);
begin
  FSheets.Assign(Value);
end;

procedure TAdvGridWorkbook.SheetChange(Sender: TObject);
var
  i: integer;
begin
  while FTabSet.Tabs.Count > FSheets.Count do
    FTabSet.Tabs.Delete(FTabSet.Tabs.Count - 1);

  while FTabSet.Tabs.Count < FSheets.Count do
    FTabSet.Tabs.Add('');

  for i := 1 to FSheets.Count do
  begin
    FTabSet.Tabs[i - 1] := FSheets[i - 1].Name;
  end;
end;


procedure TAdvGridWorkbook.TabChange(Sender: TObject; NewTab: Integer;
  var AllowChange: Boolean);
begin
  if Assigned(FOnSheetChange) then
    FOnSheetChange(Self, NewTab, AllowChange);

  if AllowChange then
    ActiveSheet := NewTab;
end;

procedure TAdvGridWorkbook.WMNCPaint(var Message: TMessage);
begin
  inherited;
  NCPaintProc;
  Message.Result := 0;
end;

procedure TAdvGridWorkbook.GetChildren(Proc: TGetChildProc;
  Root: TComponent);
begin
  inherited;
  if not FAutoCreated and FWinCreated then
    Proc(FGrid);
end;

procedure TAdvGridWorkbook.Notification(AComponent: TComponent;
  AOperation: TOperation);
begin
  inherited;
  if (AOperation = opRemove) and (AComponent = FGrid) then
    FGrid := nil;
end;

procedure TAdvGridWorkbook.TabLookChange(Sender: TObject);
begin
  FTabSet.SelectedColor := FTabLook.SelectColor;
  FTabSet.UnSelectedColor := FTabLook.UnSelectColor;
  FTabSet.DitherBackground := FTabLook.DitherBackground;
  FTabSet.BackgroundColor := FTabLook.BackgroundColor;
  FTabSet.Font.Assign(FTabLook.Font);
end;

procedure TAdvGridWorkbook.AddSheet(SheetName: string);
begin
  FSheets.Add.Name := SheetName;
  ActiveSheet := FSheets.Count - 1;
end;

procedure TAdvGridWorkbook.InsertSheet(Index: Integer; SheetName: string);
begin
  if Index < Sheets.Count then
  begin
    StoreActiveSheet;
    FActiveSheet := -1;
    FSheets.Insert(Index).Name := SheetName;
    ActiveSheet := Index;
  end;
end;

procedure TAdvGridWorkbook.RemoveSheet(Index: Integer);
begin
  if Index < Sheets.Count then
  begin
    ActiveSheet := Index;
    if FTabSet<>nil then
      FTabSet.Tabs.Delete(Index);
    FSheets.Items[Index].Free;
    FActiveSheet := -1;
    ActiveSheet := 0;
  end;
end;


function TAdvGridWorkbook.GetVersion: string;
var
  vn: Integer;
begin
  vn := GetVersionNr;
  Result := IntToStr(Hi(Hiword(vn)))+'.'+IntToStr(Lo(Hiword(vn)))+'.'+IntToStr(Hi(Loword(vn)))+'.'+IntToStr(Lo(Loword(vn)));
end;

procedure TAdvGridWorkbook.SetVersion(const Value: string);
begin

end;

function TAdvGridWorkbook.GetVersionNr: Integer;
begin
  Result := MakeLong(MakeWord(BLD_VER,REL_VER),MakeWord(MIN_VER,MAJ_VER));
end;

{ TGridSheetCollection }

function TGridSheetCollection.Add: TGridSheet;
begin
  Result := TGridSheet(inherited Add);
end;

procedure TGridSheetCollection.Clear;
begin
  while (Count > 0) do
    FOwner.RemoveSheet(0);
end;

constructor TGridSheetCollection.Create(AOwner: TAdvGridWorkbook);
begin
  inherited Create(TGridSheet);
  FOwner := AOwner;
end;

function TGridSheetCollection.GetItem(Index: Integer): TGridSheet;
begin
  Result := TGridSheet(inherited Items[Index]);
end;

function TGridSheetCollection.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

function TGridSheetCollection.Insert(Index: Integer): TGridSheet;
begin
  Result := TGridSheet(inherited Insert(Index));
end;

procedure TGridSheetCollection.SetItem(Index: Integer;
  const Value: TGridSheet);
begin
  inherited Items[Index] := Value;
end;

procedure TGridSheetCollection.Update(Item: TCollectionItem);
begin
  inherited;
  if Assigned(OnChange) then
    OnChange(Self); 
end;

{ TGridSheet }

procedure TGridSheet.Changed;
begin
  if Assigned(TGridSheetCollection(Collection).OnChange) then
    TGridSheetCollection(Collection).OnChange(Collection);
end;

constructor TGridSheet.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FData := TMemoryStream.Create;
  FColWidths := TIntList.Create(0,0);
  FRowHeights := TIntList.Create(0,0);
  FSortColumn := -1;
  Changed;
end;

destructor TGridSheet.Destroy;
begin
  Changed;
  FData.Free;
  FColWidths.Free;
  FRowHeights.Free;
  inherited;
end;

procedure TGridSheet.SetName(const Value: string);
begin
  FName := Value;
  Changed;
end;

{ TTabLook }

constructor TTabLook.Create;
begin
  inherited;
  FFont := TFont.Create;
  FSelectColor := clBtnFace;
  FUnSelectColor := clWhite;
  FDitherBackground := true;
  FBackgroundColor := clBtnFace;
  FFont.OnChange := FontChanged;
end;

destructor TTabLook.Destroy;
begin
  FFont.Free;
  inherited;
end;

procedure TTabLook.Changed;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TTabLook.SetBackgroundColor(const Value: TColor);
begin
  FBackgroundColor := Value;
  Changed;
end;

procedure TTabLook.SetDitherBackground(const Value: Boolean);
begin
  FDitherBackground := Value;
  Changed;
end;

procedure TTabLook.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
  Changed;
end;

procedure TTabLook.SetSelectColor(const Value: TColor);
begin
  FSelectColor := Value;
  Changed;
end;

procedure TTabLook.SetUnSelectColor(const Value: TColor);
begin
  FUnSelectColor := Value;
  Changed;
end;

procedure TTabLook.FontChanged(Sender: TObject);
begin
  Changed;
end;

end.
