Chip 2003 January/Chip_2003-01_cd1.bin/zkuste/delphi/kolekce/d567/FLEXCEL.ZIP/XLSAdapter/TemplateStore.pas

Pascal/Delphi Source File | 2002-09-26 | 5.2 KB | 217 lines

unit TemplateStore;

interface
{$R XlsTemplateStore.res}
uses
  SysUtils, Classes, XlsMessages, XlsBaseTemplateStore, contnrs;

type
  TXlsTemplate= class (TCollectionItem)
  private
    FFileName: TFileName;
    FCompress: boolean;
    FStorages: TXlsStorageList;

    procedure SetFileName(const Value: TFileName);
    procedure SetCompress(const Value: boolean);

    property Compress: boolean read FCompress write SetCompress;
  protected
    function GetDisplayName: string; override;
    procedure SetDisplayName(const Value: string); override;

    procedure WriteData(Stream: TStream);
    procedure ReadData(Stream: TStream);
    procedure DefineProperties(Filer: TFiler); override;
    function Equal(aTemplate: TXlsTemplate): Boolean;
  public
    property Storages: TXlsStorageList read FStorages;
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;

    procedure SaveAs(const aFileName: TFileName);
  published
    property FileName: TFileName read FFileName write SetFileName stored false;
  end;

  TXlsTemplateList=class(TOwnedCollection) //Items are TXlsTemplate
  private
    FCompress: boolean;
    procedure SetCompress(const Value: boolean);
    property Compress: boolean read FCompress write SetCompress;
    function GetItems(Index: integer): TXlsTemplate;
  public
    property Items[Index: integer]: TXlsTemplate read GetItems; default;
  end;

  TXlsTemplateStore = class(TXlsBaseTemplateStore)
  private
    FCompress: boolean;
    procedure SetCompress(const Value: boolean);
    { Private declarations }
  protected
    FTemplates: TXlsTemplateList;
    function GetStorages(Name: String): TXlsStorageList; override;
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy;override;
  published
    { Published declarations }
    property Templates: TXlsTemplateList read FTemplates write FTemplates;
    property Compress: boolean read FCompress write SetCompress;


    //PENDING:AssignTo
  end;

procedure Register;

implementation
procedure Register;
begin
  RegisterComponents('FlexCel', [TXlsTemplateStore]);
end;


{ TXlsTemplate }

constructor TXlsTemplate.Create(Collection: TCollection);
begin
  inherited;
  FStorages:=TXlsStorageList.Create;
end;

procedure TXlsTemplate.DefineProperties(Filer: TFiler);

  function DoWrite: Boolean;
  begin
    if Filer.Ancestor <> nil then
      Result := not (Filer.Ancestor is TXlsTemplate) or
        not Equal(TXlsTemplate(Filer.Ancestor))
    else
      Result := FFileName<>'';
  end;

begin
  inherited DefineProperties(Filer);
  Filer.DefineBinaryProperty('TemplateData', ReadData, WriteData, DoWrite);
end;

destructor TXlsTemplate.Destroy;
begin
  FreeAndNil(FStorages);
  inherited;
end;

function TXlsTemplate.Equal(aTemplate: TXlsTemplate): Boolean;
begin
  Result:=FFileName=aTemplate.FFileName;
end;

function TXlsTemplate.GetDisplayName: string;
begin
  Result:=FFileName;
end;

procedure TXlsTemplate.ReadData(Stream: TStream);
var
  Version: SmallInt;
  Ln: integer;
begin
  Stream.ReadBuffer(Version, SizeOf(Version));
  Stream.ReadBuffer(Ln, SizeOF(Ln));
  SetLength(FFileName, Ln);
  Stream.ReadBuffer(FFileName[1], Ln);
  FStorages.ReadData(Stream);
end;

procedure TXlsTemplate.SaveAs(const aFileName: TFileName);
begin
  FStorages.SaveAs(aFileName);
end;

procedure TXlsTemplate.SetCompress(const Value: boolean);
var
  i:integer;
begin
  FCompress := Value;
  for i:=0 to FStorages.Count-1 do FStorages[i].Compress:=Value;
end;

procedure TXlsTemplate.SetDisplayName(const Value: string);
begin
  inherited;
  FileName:=Value;
end;

procedure TXlsTemplate.SetFileName(const Value: TFileName);
begin
  FStorages.LoadFrom(Value);
  FFileName := ExtractFileName(Value);
end;

procedure TXlsTemplate.WriteData(Stream: TStream);
var
  Version: SmallInt;
  Ln: integer;
begin
  Version:=1;
  Stream.WriteBuffer(Version,SizeOf(Version));
  Ln:=Length(FFileName);
  Stream.WriteBuffer(Ln, SizeOf(Ln));
  Stream.WriteBuffer(FFileName[1], Ln);
  FStorages.WriteData(Stream);
end;

{ TXlsTemplateStore }

constructor TXlsTemplateStore.Create(AOwner: TComponent);
begin
  inherited;
  FTemplates:= TXlsTemplateList.Create(Self, TXlsTemplate);
end;

destructor TXlsTemplateStore.Destroy;
begin
  FreeAndNil(FTemplates);
  inherited;
end;

function TXlsTemplateStore.GetStorages(Name: String): TXlsStorageList;
var
  i: integer;
begin
  Name:= ExtractFileName(Name);
  for i:=0 to Templates.Count -1 do if Templates[i].FileName=Name then
  begin
    Result:=Templates[i].Storages;
    exit;
  end;
  raise Exception.CreateFmt(ErrFileNotFound, [Name]);
end;

procedure TXlsTemplateStore.SetCompress(const Value: boolean);
begin
  FCompress := Value;
  Templates.Compress:=Value;
end;

{ TXlsTemplateList }

function TXlsTemplateList.GetItems(Index: integer): TXlsTemplate;
begin
  Result:= inherited Items[Index] as TXlsTemplate;
end;

procedure TXlsTemplateList.SetCompress(const Value: boolean);
var
  i:integer;
begin
  FCompress := Value;
  for i:=0 to Count-1 do Items[i].Compress:=true;
end;

end.