home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 October / Chip_2002-10_cd1.bin / zkuste / delphi / kolekce / d56 / FLEXCEL.ZIP / XLSAdapter / UXlsClientData.pas < prev    next >
Pascal/Delphi Source File  |  2002-06-15  |  8KB  |  307 lines
  1. unit UXlsClientData;
  2.  
  3. interface
  4. uses classes, sysutils, UXlsBaseRecords, UXlsBaseRecordLists, UXlsOtherRecords, UXlsChart,
  5.      USST, XlsMessages, UXlsSheet, UXlsBaseClientData;
  6. type
  7.   TMsObj = class(TBaseClientData)
  8.   private
  9.     FObjRecord: TObjRecord;
  10.     FChart: TChart;
  11.     HasPictFmla: boolean;
  12.   protected
  13.     function GetId: Word; override;
  14.     procedure SetId(const Value: Word); override;
  15.     procedure ScanRecord( myRecord: TBaseRecord);
  16.   public
  17.     procedure  ArrangeId(var MaxId: word);override;
  18.  
  19.     constructor Create;
  20.     destructor Destroy; override;
  21.     procedure Clear; override;
  22.     function CopyTo: TBaseClientData; override;
  23.     procedure LoadFromStream(const DataStream: TStream; const First: TBaseRecord; const SST: TSST); override;
  24.     procedure SaveToStream(const DataStream: TStream); override;
  25.     function TotalSize: int64;override;
  26.  
  27.     procedure ArrangeInsert(const aPos, aCount:integer; const SheetInfo: TSheetInfo);override;
  28.  
  29.     class function ObjRecord: ClassOfTBaseRecord; override;
  30.  
  31.   end;
  32.  
  33.   TTXO= class (TBaseClientData)
  34.   private
  35.     FTXO: TTXORecord;
  36.     function GetValue: WideString;
  37.     procedure SetValue(const aValue: WideString);
  38.   public
  39.     constructor Create;
  40.     destructor Destroy; override;
  41.     procedure Clear; override;
  42.     function CopyTo: TBaseClientData; override;
  43.     procedure LoadFromStream(const DataStream: TStream; const First: TBaseRecord; const SST: TSST); override;
  44.     procedure SaveToStream(const DataStream: TStream); override;
  45.     function TotalSize: int64;override;
  46.  
  47.     procedure ArrangeInsert(const aPos, aCount:integer; const SheetInfo: TSheetInfo);override;
  48.     class function ObjRecord: ClassOfTBaseRecord; override;
  49.  
  50.     property Value: WideString read GetValue write SetValue;
  51.   end;
  52.  
  53. implementation
  54.  
  55. { TMsObj }
  56.  
  57. procedure TMsObj.Clear;
  58. begin
  59.   FreeAndNil(FObjRecord);
  60.   FreeAndNil(FChart);
  61.   FreeAndNil(RemainingData);
  62. end;
  63.  
  64. function TMsObj.CopyTo: TBaseClientData;
  65. begin
  66.   if HasPictFmla then Raise Exception.Create(ErrCantCopyPictFmla);
  67.   Result:= TMsObj.Create;
  68.   (Result as TMsObj).FObjRecord:= FObjRecord.CopyTo as TObjRecord;
  69.   if FChart<>nil then (Result as TMsObj).FChart:= FChart.CopyTo as TChart;
  70. end;
  71.  
  72. constructor TMsObj.Create;
  73. begin
  74.   inherited;
  75. end;
  76.  
  77. destructor TMsObj.Destroy;
  78. begin
  79.   Clear;
  80.   inherited;
  81. end;
  82.  
  83. procedure TMsObj.ArrangeInsert(const aPos, aCount: integer; const SheetInfo: TSheetInfo);
  84. begin
  85.   if FChart<>nil then FChart.ArrangeInsert(aPos, aCount, SheetInfo);
  86. end;
  87.  
  88. procedure TMsObj.LoadFromStream(const DataStream: TStream; const First: TBaseRecord; const SST: TSST);
  89. var
  90.   RecordHeader: TRecordHeader;
  91.   R: TBaseRecord;
  92. begin
  93.   Clear;
  94.   if ((First as TObjRecord).ObjId= ftCmo) and ((First as TObjRecord).CmoId = xlCmo_Chart) then
  95.   begin
  96.     if (DataStream.Read(RecordHeader, sizeof(RecordHeader)) <> sizeof(RecordHeader)) then
  97.        raise Exception.Create(ErrExcelInvalid);
  98.     R:=LoadRecord(DataStream, RecordHeader);
  99.     try
  100.       if not(R is TBOFRecord) then raise Exception.Create(ErrExcelInvalid);
  101.       FChart:= TChart.Create(nil);
  102.       try
  103.         FChart.LoadFromStream(DataStream, R as TBOFRecord, SST);
  104.       except
  105.         FreeAndNil(FChart);
  106.         raise
  107.       end; //except
  108.     except
  109.       FreeAndNil(R);
  110.       raise
  111.     end; //Except
  112.   end;
  113.  
  114.   ScanRecord(First);
  115.  
  116.   //this must be the last statment, so if there is an exception, we dont take First
  117.   FObjRecord:= First as TObjRecord;
  118.  
  119. end;
  120.  
  121. procedure TMsObj.SaveToStream(const DataStream: TStream);
  122. begin
  123.   if FObjRecord=nil then raise Exception.Create(ErrExcelInvalid);
  124.   FObjRecord.SaveToStream(DataStream);
  125.   if FChart<>nil then FChart.SaveToStream(DataStream);
  126. end;
  127.  
  128. function TMsObj.TotalSize: int64;
  129. begin
  130.   if FObjRecord=nil then raise Exception.Create(ErrExcelInvalid);
  131.   Result:=FObjRecord.TotalSize;
  132.   if FChart<>nil then Result:=Result+FChart.TotalSize;
  133. end;
  134.  
  135.  
  136.  
  137. class function TMsObj.ObjRecord: ClassOfTBaseRecord;
  138. begin
  139.   Result:= TObjRecord;
  140. end;
  141.  
  142. function TMsObj.GetId: Word;
  143. begin
  144.   if FObjRecord<>nil then GetId:=GetWord( FObjRecord.Data, 6) else GetId:=0;
  145. end;
  146.  
  147. procedure TMsObj.SetId(const Value: Word);
  148. begin
  149.   if FObjRecord<>nil then SetWord( FObjRecord.Data, 6, Value);
  150. end;
  151.  
  152. procedure TMsObj.ArrangeId(var MaxId: word);
  153. begin
  154.   inherited;
  155.   inc(MaxId);
  156.   Id:=MaxId;
  157. end;
  158.  
  159. procedure TMsObj.ScanRecord( myRecord: TBaseRecord);
  160. var
  161.   RHeader: TRecordHeader;
  162.   aPos: integer;
  163. begin
  164.   aPos:=0;
  165.   repeat
  166.     ReadMem(myRecord, aPos, SizeOf(RHeader), @RHeader);
  167.     if RHeader.Id= 9 then HasPictFmla:=true;
  168.     if (myRecord.continue=nil)and(Rheader.Size+aPos>myRecord.DataSize) then //This is not really necessary, just to avoid exceptions
  169.     begin
  170.       //Longer than expected???
  171.       RemainingData:=nil;
  172.       exit;
  173.     end;
  174.  
  175.     try
  176.       ReadMem(myRecord, aPos, RHeader.Size, nil);
  177.     except
  178.       //Longer than expected???
  179.       RemainingData:=nil;
  180.       exit;
  181.     end;
  182.  
  183.   until RHeader.Id=0; // ftEnd
  184.   RemainingData:=myRecord.Continue;
  185.   myRecord.Continue:=nil;
  186. end;
  187.  
  188. { TTXO }
  189.  
  190. procedure TTXO.ArrangeInsert(const aPos, aCount: integer;
  191.   const SheetInfo: TSheetInfo);
  192. begin
  193. end;
  194.  
  195. procedure TTXO.Clear;
  196. begin
  197.   FreeAndNil(FTXO);
  198. end;
  199.  
  200. function TTXO.CopyTo: TBaseClientData;
  201. begin
  202.   Result:= TTXO.Create;
  203.   if FTXO <>nil then (Result as TTXO).FTXO:= FTXO.CopyTo as TTXORecord;
  204. end;
  205.  
  206. constructor TTXO.Create;
  207. begin
  208.   inherited;
  209. end;
  210.  
  211. destructor TTXO.Destroy;
  212. begin
  213.   Clear;
  214.   inherited;
  215. end;
  216.  
  217. function TTXO.GetValue: WideString;
  218. var
  219.   Len: integer;
  220.   s: string;
  221.   ws:Widestring;
  222.   TxtRec: TBaseRecord;
  223.   aPos: integer;
  224. begin
  225.   Result:='';
  226.   if FTXO.Continue=nil then exit;
  227.   Len:= GetWord(FTXO.Data, 10);
  228.   if Len=0 then exit;
  229.  
  230.   TxtRec:=FTXO.Continue; aPos:=1;
  231.   case FTXO.Continue.Data[0] of
  232.     0:  //single byte string
  233.     begin
  234.       SetLength(s, Len);
  235.       ReadMem(TxtRec, aPos, Len, @(s[1]));
  236.       Result:=s;
  237.     end;
  238.     1:  //double byte string
  239.     begin
  240.       SetLength(Ws, Len);
  241.       ReadMem(TxtRec, aPos, Len*2, @(ws[1]));
  242.       Result:=Ws;
  243.     end;
  244.     else Raise Exception.Create(ErrExcelInvalid);
  245.   end; //case
  246. end;
  247.  
  248. procedure TTXO.LoadFromStream(const DataStream: TStream;
  249.   const First: TBaseRecord; const SST: TSST);
  250. begin
  251.   FTXO:=First as TTXORecord;
  252. end;
  253.  
  254. class function TTXO.ObjRecord: ClassOfTBaseRecord;
  255. begin
  256.   Result:= TTXORecord;
  257. end;
  258.  
  259. procedure TTXO.SaveToStream(const DataStream: TStream);
  260. begin
  261.   if FTXO<>nil then FTXO.SaveToStream(DataStream);
  262. end;
  263.  
  264. procedure TTXO.SetValue(const aValue: WideString);
  265. var
  266.   Len: integer;
  267.   Dat: PArrayOfByte;
  268.   s:string;
  269. begin
  270.   Len:=Length(aValue);
  271.   SetWord(FTXO.Data, 10, Len); //length of text
  272.   if Len>0 then SetWord(FTXO.Data, 12, 16) else SetWord(FTXO.Data, 12, 0); //length of formatting runs
  273.   FreeAndNil(FTXO.Continue);
  274.   if Len>0 then
  275.   begin
  276.     if IsWide(aValue) then
  277.       begin
  278.         GetMem(Dat, Len*2+1);
  279.         Dat[0]:=1;
  280.         move(aValue[1], Dat[1], Len*2);
  281.         FTXO.Continue:=TContinueRecord.Create(xlr_CONTINUE, Dat, Len*2+1);
  282.       end else
  283.       begin
  284.         GetMem(Dat, Len+1);
  285.         Dat[0]:=0;
  286.         s:=aValue;
  287.         move(s[1], Dat[1], Len);
  288.         FTXO.Continue:=TContinueRecord.Create(xlr_CONTINUE, Dat, Len+1);
  289.       end;
  290.  
  291.       Len:= 2*8;
  292.       GetMem(Dat, Len);
  293.       FillChar(Dat^, Len, 0);
  294.       SetWord(Dat, 8, Length(aValue));
  295.  
  296.       FTXO.Continue.Continue:= TContinueRecord.Create(xlr_CONTINUE, Dat, Len);
  297.   end;
  298.  
  299. end;
  300.  
  301. function TTXO.TotalSize: int64;
  302. begin
  303.   Result:= FTXO.TotalSize;
  304. end;
  305.  
  306. end.
  307.