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

Pascal/Delphi Source File | 2002-10-10 | 14.1 KB | 457 lines

unit UXlsEscher;

interface
uses UXlsBaseRecords, UXlsBaseRecordLists, UXlsOtherRecords,
     XlsMessages, UFlxMessages, Classes, SysUtils, UEscherRecords, UXlsSST, UBreakList,
     UEscherOtherRecords;

type
  TXlsEscherRecord = class (TBaseRecord)
  end;

  TDrawingGroupRecord = class (TXlsEscherRecord)
  end;

  TDrawingRecord = class (TXlsEscherRecord)
  end;


  TDrawingSelectionRecord = class (TXlsEscherRecord)
  end;

  TDrawingGroup= class
  private
    FDggContainer: TEscherContainerRecord;
    FRecordCache: TEscherDwgGroupCache;
    function GetRecordCache: PEscherDwgGroupCache;
  public
    property  RecordCache: PEscherDwgGroupCache read GetRecordCache;

    constructor Create;
    procedure Clear;
    destructor Destroy; override;
    procedure LoadFromStream(const DataStream: TStream; const First: TDrawingGroupRecord);
    procedure SaveToStream(const DataStream: TStream);
    function TotalSize: int64;

    procedure AddDwg;
  end;

  TDrawing=class
  private
    FDgContainer: TEscherContainerRecord;
    FRecordCache: TEscherDwgCache;
    FDrawingGroup: TDrawingGroup;
    function GetDrawingName(index: integer): widestring;
    function GetDrawingRow(index: integer): integer;

  public
    procedure Clear;
    constructor Create(const aDrawingGroup: TDrawingGroup);
    destructor Destroy; override;

    procedure CopyFrom(const aDrawing: TDrawing);
    procedure LoadFromStream(const DataStream: TStream; const First: TDrawingRecord; const SST: TSST);
    procedure SaveToStream(const DataStream: TStream);
    function TotalSize: int64;

    procedure ArrangeInsert(const aPos, aCount:integer; const SheetInfo: TSheetInfo);
    procedure ArrangeCopySheet(const SheetInfo: TSheetInfo);
    procedure InsertAndCopyRows(const FirstRow, LastRow, DestRow, aCount: integer; const SheetInfo: TSheetInfo);
    procedure DeleteRows(const aRow, aCount: word;const SheetInfo: TSheetInfo);

    function FindObjId(const ObjId: word): TEscherClientDataRecord;

    function DrawingCount: integer;
    procedure AssignDrawing(const Index: integer; const Data: string; const DataType: TXlsImgTypes);
    function GetAnchor(const Index: integer): TClientAnchor;
    procedure GetDrawingFromStream(const Index: integer; const Data: TStream; var DataType: TXlsImgTypes);
    property DrawingRow[index: integer]: integer read GetDrawingRow;
    property DrawingName[index: integer]: widestring read GetDrawingName;

  end;

implementation
uses UXlsBaseClientData, UXlsClientData;

{ TDrawingGroup }

procedure TDrawingGroup.AddDwg;
begin
  if FRecordCache.Dgg<>nil then inc(FRecordCache.Dgg.FDgg.DwgSaved);
  //PENDING: fix sheets

end;

procedure TDrawingGroup.Clear;
begin
  FreeAndNil(FDggContainer);
end;

constructor TDrawingGroup.Create;
begin
  inherited Create;
end;

destructor TDrawingGroup.Destroy;
begin
  Clear;
  inherited;
end;

function TDrawingGroup.GetRecordCache: PEscherDwgGroupCache;
begin
  Result:=@FRecordCache;
end;

procedure TDrawingGroup.LoadFromStream(const DataStream: TStream; const First: TDrawingGroupRecord);
const
  DwgCache: TEscherDwgCache= ( MaxObjId:0; Dg: nil; Solver: nil; Patriarch:nil; Anchor: nil; Shape: nil; Obj: nil; Blip: nil);
var
  aPos: integer;
  EscherHeader: TEscherRecordHeader;
  RecordHeader: TRecordHeader;
  MyRecord, CurrentRecord: TBaseRecord;
begin
  if FDggContainer<>nil then raise Exception.Create(ErrExcelInvalid);
  aPos:=0;
  MyRecord:= First; CurrentRecord:= First;
  try
    ReadMem(MyRecord, aPos, SizeOf(EscherHeader), @EscherHeader);
    FDggContainer:= TEscherContainerRecord.Create(EscherHeader, RecordCache, @DwgCache ,nil);
    while not FDggContainer.Loaded do
    begin
      if (MyRecord.Continue=nil) and (aPos=MyRecord.DataSize) then
      begin
        if CurrentRecord<> First then FreeAndNil(CurrentRecord);
        if (DataStream.Read(RecordHeader, sizeof(RecordHeader)) <> sizeof(RecordHeader)) then
          raise Exception.Create(ErrExcelInvalid);
        CurrentRecord:=LoadRecord(DataStream, RecordHeader);
        MyRecord:= CurrentRecord;
        aPos:=0;
        if not(MyRecord is TDrawingGroupRecord) then raise Exception.Create(ErrExcelInvalid);
      end;

      FDggContainer.Load(MyRecord, aPos);

    end; //while
  finally
    if CurrentRecord<>First then FreeAndNil(CurrentRecord);
  end; //finally

  First.Free;   //last statment
end;

procedure TDrawingGroup.SaveToStream(const DataStream: TStream);
var
  BreakList: TBreakList;
  NextPos, RealSize, NewDwg: integer;
begin
  if FDggContainer=nil then exit;
  BreakList:= TBreakList.Create(DataStream.Position);
  try
    NextPos:=0;
    RealSize:=0;
    NewDwg:= xlr_MSODRAWINGGROUP;
    FDggContainer.SplitRecords(NextPos, RealSize, NewDwg, BreakList);
    BreakList.Add(0, NextPos);
    FDggContainer.SaveToStream(DataStream, BreakList);
  finally
    FreeAndNil(BreakList);
  end; //finally
end;

function TDrawingGroup.TotalSize: int64;
var
  NextPos, RealSize, NewDwg: integer;
begin
  if FDggContainer=nil then begin Result:=0; exit;end;

  NextPos:=0; RealSize:=0; NewDwg:= xlr_MSODRAWINGGROUP;
  FDggContainer.SplitRecords(NextPos, RealSize, NewDwg, nil);
  Result:=RealSize;
end;

{ TDrawing }

procedure TDrawing.ArrangeCopySheet(const SheetInfo: TSheetInfo);
begin
  if (FRecordCache.Obj<> nil) then
    FRecordCache.Obj.ArrangeCopySheet(SheetInfo);
end;

procedure TDrawing.ArrangeInsert(const aPos, aCount: integer; const SheetInfo: TSheetInfo);
begin
  if (FRecordCache.Anchor<> nil) and (SheetInfo.FormulaSheet= SheetInfo.InsSheet)then
    FRecordCache.Anchor.ArrangeInsert(aPos, aCount, SheetInfo, false);
  if (FRecordCache.Obj<> nil) then
    FRecordCache.Obj.ArrangeInsert(aPos, aCount, SheetInfo, false);
end;

procedure TDrawing.AssignDrawing(const Index: integer; const Data: string;
  const DataType: TXlsImgTypes);
begin
  FRecordCache.Blip[Index].ReplaceImg(Data, DataType);
end;

procedure TDrawing.Clear;
begin
  FreeAndNil(FDgContainer);
  //Order is important... Cache should be freed after DgContainer
  FreeAndNil(FRecordCache.Anchor);
  FreeAndNil(FRecordCache.Obj);
  FreeAndNil(FRecordCache.Shape);
  FreeAndNil(FRecordCache.Blip);
end;

procedure TDrawing.CopyFrom(const aDrawing: TDrawing);
begin
  Clear;
  FRecordCache.MaxObjId:=0;
  FRecordCache.Dg:=nil; FRecordCache.Patriarch:=nil;

  if aDrawing.FRecordCache.Anchor<>nil then
  begin
    FRecordCache.Anchor:= TEscherAnchorCache.Create;
    FRecordCache.Obj:= TEscherObjCache.Create;
    FRecordCache.Shape:= TEscherShapeCache.Create;
    FRecordCache.Blip:=TEscherOPTCache.Create;
  end;

  if aDrawing.FDgContainer=nil then FreeAndNil(FDgcontainer) else
  begin
    aDrawing.FDgContainer.ClearCopiedTo;
    FDgContainer:=aDrawing.FDgContainer.CopyTo(@FRecordCache, 0) as TEscherContainerRecord;
    FRecordCache.Shape.Sort; // only here the values are loaded...
    if FRecordCache.Solver<>nil then FRecordCache.Solver.CheckMax(aDrawing.FRecordCache.Solver.MaxRuleId);

    FDrawingGroup.AddDwg;
  end;
  //MADE: change cache
end;

constructor TDrawing.Create(const aDrawingGroup: TDrawingGroup);
begin
  inherited Create;
  FDrawingGroup:=aDrawingGroup;
  FRecordCache.Destroying:=false;
end;

procedure TDrawing.DeleteRows(const aRow, aCount: word;
  const SheetInfo: TSheetInfo);
var i: integer;
begin
  //MADE: delete rows
  //MADE: Arreglar los continues...
  //MADE: Conectores
  if FRecordcache.Anchor=nil then exit;
  for i:= FRecordCache.Anchor.Count-1 downto 0 do
    if FRecordCache.Anchor[i].AllowDelete(aRow, aRow+aCount-1)then
    begin
      if (FRecordCache.Patriarch=nil) then raise Exception.Create(ErrLoadingEscher);
      FRecordCache.Patriarch.ContainedRecords.Remove(FRecordCache.Anchor[i].FindRoot);
    end;

  ArrangeInsert(aRow, -aCount, SheetInfo);
end;

destructor TDrawing.Destroy;
begin
  FRecordCache.Destroying:=true;
  Clear;
  inherited;
end;

function TDrawing.DrawingCount: integer;
begin
  if FRecordCache.Blip<>nil then Result:=FRecordCache.Blip.Count else Result:=0;
end;

function TDrawing.FindObjId(const ObjId: word): TEscherClientDataRecord;
var
  i: integer;
begin
  for i:=0 to FRecordCache.Obj.Count-1 do if FRecordCache.Obj[i].ObjId=ObjId then
  begin
    Result:=FRecordCache.Obj[i];
    exit;
  end;
  Result:=nil;
end;

function TDrawing.GetAnchor(const Index: integer): TClientAnchor;
begin
  Assert(Index<FRecordCache.Blip.Count,'Index out of range');
  Result:=FRecordCache.Blip[index].GetAnchor;
end;

procedure TDrawing.GetDrawingFromStream(const Index: integer; const Data: TStream; var DataType: TXlsImgTypes);
begin
  Assert(Index<FRecordCache.Blip.Count,'Index out of range');
  FRecordCache.Blip[index].GetImageFromStream(Data, DataType);
end;

function TDrawing.GetDrawingName(index: integer): widestring;
begin
  Assert(Index<FRecordCache.Blip.Count,'Index out of range');
  Result:=FRecordCache.Blip[index].ShapeName;
end;

function TDrawing.GetDrawingRow(index: integer): integer;
begin
  Assert(Index<FRecordCache.Blip.Count,'Index out of range');
  Result:=FRecordCache.Blip[index].Row;
end;

procedure TDrawing.InsertAndCopyRows(const FirstRow, LastRow, DestRow,
  aCount: integer; const SheetInfo: TSheetInfo);
var
  i,k, myDestRow, myFirstRow, myLastRow: integer;
begin
  if (FDgContainer=nil) or (FRecordCache.Anchor= nil) then exit;  //no drawings on this sheet

  if DestRow>FirstRow then
  begin
    myFirstRow:=FirstRow; myLastRow:=LastRow;
  end else
  begin
    myFirstRow:=FirstRow+aCount*(LastRow-FirstRow+1);
    myLastRow:=LastRow+aCount*(LastRow-FirstRow+1);
  end;

  //Insert cells
  ArrangeInsert(DestRow, aCount*(LastRow-FirstRow+1), SheetInfo);

  //Copy the images
  myDestRow:=DestRow;
  for k:= 0 to aCount-1 do
  begin
    FDgContainer.ClearCopiedTo;
    for i:= 0 to FRecordCache.Anchor.Count-1 do
      if FRecordCache.Anchor[i].AllowCopy(myFirstRow, myLastRow)then
      begin
         FRecordCache.Anchor[i].CopyDwg(myDestRow-myFirstRow);
      end;
    inc(myDestRow, (LastRow-FirstRow+1));
    if FRecordCache.Solver<>nil then FRecordCache.Solver.ArrangeCopyRows;
  end;

end;

procedure TDrawing.LoadFromStream(const DataStream: TStream;
  const First: TDrawingRecord; const SST: TSST);
var
  aPos, CdPos: integer;
  EscherHeader: TEscherRecordHeader;
  RecordHeader: TRecordHeader;
  MyRecord, CurrentRecord, R, CdRecord: TBaseRecord;
  FClientData: TBaseClientData;
  ClientType: ClassOfTBaseClientData;
begin
  Assert (FDrawingGroup<>nil,'DrawingGroup can''t be nil');
  if FDgContainer<>nil then raise Exception.Create(ErrExcelInvalid);

  FRecordCache.MaxObjId:=0;
  FRecordCache.Dg:=nil; FRecordCache.Patriarch:=nil; FRecordCache.Solver:=nil;
  FRecordCache.Anchor:= TEscherAnchorCache.Create;
  FRecordCache.Obj:= TEscherObjCache.Create;
  FRecordCache.Shape:= TEscherShapeCache.Create;
  FRecordCache.Blip:= TEscherOPTCache.Create;

  aPos:=0;
  MyRecord:= First; CurrentRecord:= First;
  try
    ReadMem(MyRecord, aPos, SizeOf(EscherHeader), @EscherHeader);
    FDgContainer:= TEscherContainerRecord.Create(EscherHeader, FDrawingGroup.RecordCache, @FRecordCache ,nil);
    while (not FDgContainer.Loaded) or FDgContainer.WaitingClientData(ClientType) do
    begin
      if not FDgContainer.WaitingClientData(ClientType) then
      begin
        if (MyRecord.Continue=nil) and (aPos=MyRecord.DataSize) then
        begin
          if CurrentRecord<> First then FreeAndNil(CurrentRecord);
          if (DataStream.Read(RecordHeader, sizeof(RecordHeader)) <> sizeof(RecordHeader)) then
            raise Exception.Create(ErrExcelInvalid);
          CurrentRecord:=LoadRecord(DataStream, RecordHeader);
          MyRecord:= CurrentRecord;
          aPos:=0;
          if not(MyRecord is TDrawingRecord) then raise Exception.Create(ErrExcelInvalid);
        end;
        FDgContainer.Load(MyRecord, aPos);
      end else
      begin
        if not ((MyRecord.Continue=nil) and (aPos=MyRecord.DataSize)) then raise Exception.Create(ErrExcelInvalid);
        if (DataStream.Read(RecordHeader, sizeof(RecordHeader)) <> sizeof(RecordHeader)) then
          raise Exception.Create(ErrExcelInvalid);

         R:=LoadRecord(DataStream, RecordHeader);
         try
           if (R is ClientType.ObjRecord) then
           begin
             FClientData:= ClientType.Create;
             try
               FClientData.LoadFromStream(DataStream, R , SST);
               FDgContainer.AssignClientData(FClientData);
               if FClientData.RemainingData<>nil then
               begin
                 CdRecord:=FClientData.RemainingData; //we dont have to free this
                 CdPos:=0;
                 FDgContainer.Load(CdRecord, CdPos);
               end;
             except
               FreeAndNil(FClientData);
               raise;
             end; //except
           end else raise Exception.Create(ErrInvalidDrawing);
         except
           FreeAndNil(R);
           raise;
         end; //Except
      end;

    end; //while
  finally
    if CurrentRecord<>First then FreeAndNil(CurrentRecord);
  end; //finally

  FRecordCache.Shape.Sort; // only here the values are loaded...
  if FRecordCache.Solver <>nil then FRecordCache.Solver.FixPointers;


  //PENDING: Wmf, emf

  First.Free;   //last statment
end;

procedure TDrawing.SaveToStream(const DataStream: TStream);
var
  BreakList: TBreakList;
  NextPos, RealSize, NewDwg: integer;
begin
  if FDgContainer=nil then exit;
  BreakList:= TBreakList.Create(DataStream.Position);
  try
    NextPos:=0;
    RealSize:=0;
    NewDwg:= xlr_MSODRAWING;
    FDgContainer.SplitRecords(NextPos, RealSize, NewDwg, BreakList);
    BreakList.Add(0, NextPos);
    FDgContainer.SaveToStream(DataStream, BreakList);
  finally
    FreeAndNil(BreakList);
  end; //finally
end;

function TDrawing.TotalSize: int64;
var
  NextPos, RealSize, NewDwg: integer;
begin
  if FDgContainer=nil then begin Result:=0; exit;end;

  NextPos:=0; RealSize:=0; NewDwg:= xlr_MSODRAWINGGROUP;
  FDgContainer.SplitRecords(NextPos, RealSize, NewDwg, nil);
  Result:=RealSize;
end;

end.