controlobj2.pas

一个经典的读写Excel的控件

unit ControlObj2;

{
********************************************************************************
******* XLSReadWriteII V2.00                                             *******
*******                                                                  *******
******* Copyright(C) 1999,2004 Lars Arvidsson, Axolot Data               *******
*******                                                                  *******
******* email: [e-mail]                                     *******
******* URL:   http://www.axolot.com                                     *******
********************************************************************************
** Users of the XLSReadWriteII component must accept the following            **
** disclaimer of warranty:                                                    **
**                                                                            **
** XLSReadWriteII is supplied as is. The author disclaims all warranties,     **
** expressedor implied, including, without limitation, the warranties of      **
** merchantability and of fitness for any purpose. The author assumes no      **
** liability for damages, direct or consequential, which may result from the  **
** use of XLSReadWriteII.                                                     **
********************************************************************************
}

{$B-}

interface

uses Classes, SysUtils, DrawingObjAnchor2, XLSUtils2, BIFFRecsII2, Escher2,
     XLSStream2;

type
//: A list box control. The list box is filled with the cell values given in
//: SourceArea. When one of the items in the list box is selected, the cell in
//: DestCell is assigned this value.
    TControlListBox = class(TDrwAnchor)
private
     function GetDestCell: string;
     function GetSourceArea: string;
     procedure SetDestCell(const Value: string);
     procedure SetSourceArea(const Value: string);
protected
public
     constructor Create(Collection: TCollection); override;
published
     //: Area of cells that fills the list in the list box.
     property SourceArea: string read GetSourceArea write SetSourceArea;
     //: The destination cell that is assigned the selected line in the list
     //: box.
     property DestCell: string read GetDestCell write SetDestCell;
     end;

type
//: A list of TControlListBox objects.
    TControlListBoxes = class(TCollection)
private
     function  GetControlListBox(Index: integer): TControlListBox;
protected
     FOwner: TPersistent;
     FDrawing: TEscherDrawing;
     FFileAdd: boolean;

     function  GetOwner: TPersistent; override;
public
     constructor Create(AOwner: TPersistent; Drawing: TEscherDrawing);
     //: Add a new TControlListBox.
     function  Add: TControlListBox;
     // @exclude
     procedure Clear;
     // @exclude
     procedure AddFromFile(Shape: TShapeClientAnchor);

     //: The TControlListBox objects in the list.
     property Items[Index: integer]: TControlListBox read GetControlListBox; default;
     end;

type
//: A combo box control. The combo box is filled with the cell values given in
//: SourceArea. When one of the items in the combo box is selected, the cell in
//: DestCell is assigned this value.
    TControlComboBox = class(TDrwAnchor)
private
     function GetDestCell: string;
     function GetSourceArea: string;
     procedure SetDestCell(const Value: string);
     procedure SetSourceArea(const Value: string);
protected
public
     constructor Create(Collection: TCollection); override;
published
     //: Area of cells that fills the list in the conbo box.
     property SourceArea: string read GetSourceArea write SetSourceArea;
     //: The destination cell that is assigned the selected line in the conbo
     //: box.
     property DestCell: string read GetDestCell write SetDestCell;
     end;

type
//: A list of TControlComboBox objects.
    TControlComboBoxes = class(TCollection)
private
     function  GetControlComboBox(Index: integer): TControlComboBox;
protected
     FOwner: TPersistent;
     FDrawing: TEscherDrawing;
     FFileAdd: boolean;

     function  GetOwner: TPersistent; override;
public
     constructor Create(AOwner: TPersistent; Drawing: TEscherDrawing);
     //: Add a new TControlComboBox.
     function  Add: TControlComboBox;
     // @exclude
     procedure Clear;
     // @exclude
     procedure AddFromFile(Shape: TShapeClientAnchor);

     //: The TControlComboBox objects in the list.
     property Items[Index: integer]: TControlComboBox read GetControlComboBox; default;
     end;

type
//: A button object. A button can have a macro assigned to it, that is executed
//: when the button is clicked.
    TControlButton = class(TDrwAnchor)
private
     function  GetMacroName: WideString;
     procedure SetMacroName(const Value: WideString);
     function  GetText: WideString;
     procedure SetText(const Value: WideString);
protected
public
     constructor Create(Collection: TCollection); override;
published
     //: The name of the macro that is execudet when the button is clicked.
     property MacroName: WideString read GetMacroName write SetMacroName;
     //: Text on the button.
     property Text: WideString read GetText write SetText;
     end;

type
//: A list of TControlButton objects.
    TControlButtons = class(TCollection)
private
     function  GetControlButton(Index: integer): TControlButton;
protected
     FOwner: TPersistent;
     FDrawing: TEscherDrawing;
     FFileAdd: boolean;

     function  GetOwner: TPersistent; override;
public
     constructor Create(AOwner: TPersistent; Drawing: TEscherDrawing);
     //: Add a new TControlButton.
     function  Add: TControlButton;
     // @exclude
     procedure Clear;
     // @exclude
     procedure AddFromFile(Shape: TShapeClientAnchor);

     //: The TControlButton objects in the list.
     property Items[Index: integer]: TControlButton read GetControlButton; default;
     end;

type
// Class with lists of all control objects.
   TControlObjects = class(TPersistent)
private
     FOwner: TPersistent;
     FDrawing: TEscherDrawing;

     FListBoxes: TControlListBoxes;
     FComboBoxes: TControlComboBoxes;
     FButtons: TControlButtons;
protected
     function  GetOwner: TPersistent; override;
public
     constructor Create(AOwner: TPersistent; Drawing: TEscherDrawing);
     destructor Destroy; override;
     procedure Clear;
published
     // List box objects.
     property ListBoxes: TControlListBoxes read FListBoxes write FListBoxes;
     // Combo box objects.
     property ComboBoxes: TControlComboBoxes read FComboBoxes write FComboBoxes;
     // Button objects.
     property Buttons: TControlButtons read FButtons write FButtons;
     end;

implementation

{ TControlListBox }

constructor TControlListBox.Create(Collection: TCollection);
begin
  if not TControlListBoxes(Collection).FFileAdd then
    FShape := TControlListBoxes(Collection).FDrawing.AddListBox;
  inherited Create(Collection);
  FName := 'ListBox ' + IntToStr(ID);
end;

function TControlListBox.GetDestCell: string;
var
  Col,Row: integer;
begin
  TShapeControlListBox(FShape.ExShape).GetDestCell(Col,Row);
  Result := ColRowToRefStr(Col,Row,True,True);
end;

function TControlListBox.GetSourceArea: string;
var
  Col1,Row1,Col2,Row2: integer;
begin
  TShapeControlListBox(FShape.ExShape).GetSourceArea(Col1,Row1,Col2,Row2);
  Result := AreaToRefStr(Col1,Row1,Col2,Row2,True,True,True,True);
end;

procedure TControlListBox.SetDestCell(const Value: string);
var
  Col,Row: integer;
  AbsCol,AbsRow: boolean;
begin
  if not RefStrToColRow(Value,Col,Row,AbsCol,AbsRow) then
    raise Exception.Create('Invalid cell reference');
  TShapeControlListBox(FShape.ExShape).SetDestCell(Col,Row);
end;

procedure TControlListBox.SetSourceArea(const Value: string);
var
  Col1,Row1,Col2,Row2: integer;
  AbsCol1,AbsRow1,AbsCol2,AbsRow2: boolean;
begin
  if not AreaStrToColRow(Value,Col1,Row1,Col2,Row2,AbsCol1,AbsRow1,AbsCol2,AbsRow2) then
    raise Exception.Create('Invalid area reference');
  TShapeControlListBox(FShape.ExShape).SetSourceArea(Col1,Row1,Col2,Row2);
end;

{ TControlListBoxes }

function TControlListBoxes.Add: TControlListBox;
begin
  Result := TControlListBox(inherited Add);
end;

procedure TControlListBoxes.AddFromFile(Shape: TShapeClientAnchor);
begin
  FFileAdd := True;
  try
    TControlListBox(inherited Add).FShape := Shape;
  finally
    FFileAdd := False;
  end;
end;

procedure TControlListBoxes.Clear;
var
  i: integer;
begin
  for i := 0 to Count - 1 do
    FDrawing.DeleteShape(Items[i].FShape.SpId);
  inherited Clear;
end;

constructor TControlListBoxes.Create(AOwner: TPersistent; Drawing: TEscherDrawing);
begin
  inherited Create(TControlListBox);
  FOwner := AOwner;
  FDrawing := Drawing;
end;

function TControlListBoxes.GetControlListBox(Index: integer): TControlListBox;
begin
  Result := TControlListBox(inherited Items[Index]);
end;

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

{ TControlObjects }

procedure TControlObjects.Clear;
begin
  FListBoxes.Clear;
  FButtons.Clear;
end;

constructor TControlObjects.Create(AOwner: TPersistent; Drawing: TEscherDrawing);
begin
  FOwner := AOwner;
  FDrawing := Drawing;
  FListBoxes := TControlListBoxes.Create(Self,FDrawing);
  FComboBoxes := TControlComboBoxes.Create(Self,Drawing);
  FButtons := TControlButtons.Create(Self,FDrawing);
end;

destructor TControlObjects.Destroy;
begin
  FButtons.Free;
  FComboBoxes.Free;
  FListBoxes.Free;
  inherited;
end;

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

{ TControlButton }

constructor TControlButton.Create(Collection: TCollection);
begin
  if not TControlButtons(Collection).FFileAdd then
    FShape := TControlButtons(Collection).FDrawing.AddButton;
  inherited Create(Collection);
  FName := 'Button ' + IntToStr(ID);
end;

function TControlButton.GetMacroName: WideString;
begin
  Result :=TShapeControlButton(FShape.ExShape).GetMacro;
end;

function TControlButton.GetText: WideString;
begin
  Result := TShapeControlButton(FShape.ExShape).Text;
end;

procedure TControlButton.SetMacroName(const Value: WideString);
begin
  TShapeControlButton(FShape.ExShape).SetMacro(Value);
end;

procedure TControlButton.SetText(const Value: WideString);
begin
  TShapeControlButton(FShape.ExShape).Text := Value;
end;

{ TControlButtons }

function TControlButtons.Add: TControlButton;
begin
  Result := TControlButton(inherited Add);
end;

procedure TControlButtons.AddFromFile(Shape: TShapeClientAnchor);
begin
  FFileAdd := True;
  try
    TControlButton(inherited Add).FShape := Shape;
  finally
    FFileAdd := False;
  end;
end;

procedure TControlButtons.Clear;
var
  i: integer;
begin
  for i := 0 to Count - 1 do
    FDrawing.DeleteShape(Items[i].FShape.SpId);
  inherited Clear;
end;

constructor TControlButtons.Create(AOwner: TPersistent; Drawing: TEscherDrawing);
begin
  inherited Create(TControlButton);
  FOwner := AOwner;
  FDrawing := Drawing;
end;

function TControlButtons.GetControlButton(Index: integer): TControlButton;
begin
  Result := TControlButton(inherited Items[Index]);
end;

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

{ TControlComboBox }

constructor TControlComboBox.Create(Collection: TCollection);
begin
  if not TControlComboBoxes(Collection).FFileAdd then
    FShape := TControlComboBoxes(Collection).FDrawing.AddComboBox;
  inherited Create(Collection);
  FName := 'ComboBox ' + IntToStr(ID);
end;

function TControlComboBox.GetDestCell: string;
var
  Col,Row: integer;
begin
  TShapeControlComboBox(FShape.ExShape).GetDestCell(Col,Row);
  Result := ColRowToRefStr(Col,Row,True,True);
end;

function TControlComboBox.GetSourceArea: string;
var
  Col1,Row1,Col2,Row2: integer;
begin
  TShapeControlComboBox(FShape.ExShape).GetSourceArea(Col1,Row1,Col2,Row2);
  Result := AreaToRefStr(Col1,Row1,Col2,Row2,True,True,True,True);
end;

procedure TControlComboBox.SetDestCell(const Value: string);
var
  Col,Row: integer;
  AbsCol,AbsRow: boolean;
begin
  if not RefStrToColRow(Value,Col,Row,AbsCol,AbsRow) then
    raise Exception.Create('Invalid cell reference');
  TShapeControlComboBox(FShape.ExShape).SetDestCell(Col,Row);
end;

procedure TControlComboBox.SetSourceArea(const Value: string);
var
  Col1,Row1,Col2,Row2: integer;
  AbsCol1,AbsRow1,AbsCol2,AbsRow2: boolean;
begin
  if not AreaStrToColRow(Value,Col1,Row1,Col2,Row2,AbsCol1,AbsRow1,AbsCol2,AbsRow2) then
    raise Exception.Create('Invalid area reference');
  TShapeControlComboBox(FShape.ExShape).SetSourceArea(Col1,Row1,Col2,Row2);
end;

{ TControlComboBoxes }

function TControlComboBoxes.Add: TControlComboBox;
begin
  Result := TControlComboBox(inherited Add);
end;

procedure TControlComboBoxes.AddFromFile(Shape: TShapeClientAnchor);
begin
  FFileAdd := True;
  try
    TControlComboBox(inherited Add).FShape := Shape;
  finally
    FFileAdd := False;
  end;
end;

procedure TControlComboBoxes.Clear;
var
  i: integer;
begin
  for i := 0 to Count - 1 do
    FDrawing.DeleteShape(Items[i].FShape.SpId);
  inherited Clear;
end;

constructor TControlComboBoxes.Create(AOwner: TPersistent; Drawing: TEscherDrawing);
begin
  inherited Create(TControlComboBox);
  FOwner := AOwner;
  FDrawing := Drawing;
end;

function TControlComboBoxes.GetControlComboBox(Index: integer): TControlComboBox;
begin
  Result := TControlComboBox(inherited Items[Index]);
end;

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

end.