sheetdata2.pas

一个经典的读写Excel的控件

begin
  Result := FSST.MaxBufSize;
end;

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

procedure TSheets.WriteSST(Stream: TXLSStream);
begin
  FSST.Write(Stream);
end;

procedure TSheets.ReadSST(Stream: TXLSStream; RecSize: word);
begin
  FSST.Read(Stream,RecSize);
end;

function TSheets.SheetByName(Name: WideString): TSheet;
var
  i: integer;
begin
  for i := 0 to Count - 1 do begin
{$ifdef ver130}
    if AnsiLowerCase(Items[i].Name) = AnsiLowerCase(Name) then begin
{$else}
    if WideLowerCase(Items[i].Name) = WideLowerCase(Name) then begin
{$endif}
      Result := Items[i];
      Exit;
    end;
  end;
  Result := Nil;
end;

function TSheets.Add: TSheet;
begin
  Result := TSheet(inherited Add);
end;

{ TSheet }

constructor TSheet.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FFormats := TXLSREadWriteII2(TSheets(Collection).FOwner).Formats;
  FRecords := TRecordStorageSheet.Create;
  FRecords.SetDefaultData;
  FCells := TCellStorage.Create;
  FColumns := TXLSColumns.Create(FFormats);
  FColumns.OnFormatChange := ColFormatChange;
  FRows := TXLSRows.Create(FFormats);
  FRows.OnFormatChange := RowFormatChange;
  FRecalcFormulas := True;
  FMergedCells := TMergedCells.Create(Self);
  FPrintSettings := TPrintSettings.Create(Self);
  FPrintSettings.PaperSize := TXLSREadWriteII2(TSheets(Collection).FOwner).DefaultPaperSize;
  FValidations := TDataValidations.Create(Self,TXLSREadWriteII2(TSheets(Collection).FOwner).FormulaHandler);
//  FMSOObjects := TMSOObjects.Create;
  with TXLSReadWriteII2(TSheets(Collection).FOwner) do
    FEscherDrawing := TEscherDrawing.Create(MSOPictures,Fonts,InternalNames);
  FEscherDrawing.OnReadShape := OnEscherReadShape;
  FDrawingObjects := TDrawingObjects.Create(Self,FEscherDrawing,TXLSReadWriteII2(TSheets(Collection).FOwner).FormulaHandler);
  FControlObjects := TControlObjects.Create(Self,FEscherDrawing);
  FCharts := TDrwCharts.Create(Self,FEscherDrawing,TXLSREadWriteII2(TSheets(Collection).FOwner).FormulaHandler,TXLSREadWriteII2(TSheets(Collection).FOwner).Fonts);
  FPane := TPane.Create;
  FApplyFormat := TApplyFormat.Create(TXLSREadWriteII2(TSheets(Collection).FOwner).Formats,FCells);
  FApplyFormat.OnGetDefaultFormat := GetDefaultFormat;
  FHyperlinks := THyperlinks.Create(Self,TXLSREadWriteII2(TSheets(Collection).FOwner).FormulaHandler);
  FConditionalFormats := TConditionalFormats.Create(Self,TXLSREadWriteII2(TSheets(Collection).FOwner).FormulaHandler);
  SetName('Sheet' + IntToStr(ID + 1));
end;

destructor TSheet.Destroy;
begin
  FCells.Free;
  FEscherDrawing.Free;
  FRows.Free;
  FValidations.Free;
  FColumns.Free;
  FMergedCells.Free;
  FPrintSettings.Free;
  FRecords.Free;
  FDrawingObjects.Free;
  FControlObjects.Free;
  FCharts.Free;
  FPane.Free;
  FHyperlinks.Free;
  FApplyFormat.Free;
  FConditionalFormats.Free;
  inherited Destroy;
end;

procedure TSheet.ClearData;
begin
  FRecords.Clear;
  FRecords.SetDefaultData;
  FValidations.Clear;
  FMergedCells.Clear;
  FPrintSettings.Clear;
  FColumns.Clear;
  FRows.Clear;
//  FMSOObjects.Clear;
  FDrawingObjects.Clear;
  FControlObjects.Clear;
  FEscherDrawing.Clear;
  FPane.Clear;
  FHyperlinks.Clear;
  FConditionalFormats.Clear;
  ClearCells;
end;

procedure TSheet.CheckFirstLast(ACol,ARow: integer);
begin
  if ACol < FirstCol then FirstCol := ACol;
  if ACol > LastCol then LastCol := ACol;
  if ARow < FirstRow then FirstRow := ARow;
  if ARow > LastRow then LastRow := ARow;
end;

function TSheet.GetDisplayName: string;
begin
  inherited GetDisplayName;
  Result := GetName;
end;

procedure TSheet.IntWriteBlank(Col,Row: integer; FormatIndex: word);
begin
  FCells[ColRowToRC(Col,Row)] := TBlankCell.Create(ColRowToRC(Col,Row),FFormats,FormatIndex);
end;

procedure TSheet.IntWriteBoolean(Col,Row: integer; FormatIndex: word; Value: boolean);
begin
  FCells[ColRowToRC(Col,Row)] := TBooleanCell.Create(ColRowToRC(Col,Row),FFormats,FormatIndex,Value);
end;

procedure TSheet.IntWriteError(Col,Row: integer; FormatIndex: word; Value: TCellError);
begin
  FCells[ColRowToRC(Col,Row)] := TErrorCell.Create(ColRowToRC(Col,Row),FFormats,FormatIndex,Value);
end;

procedure TSheet.IntWriteNumber(Col,Row: integer; FormatIndex: word; Value: double);
begin
  FCells[ColRowToRC(Col,Row)] := TFloatCell.Create(ColRowToRC(Col,Row),FFormats,FormatIndex,Value);
end;

procedure TSheet.IntWriteSSTStringIndex(Col, Row: integer; FormatIndex: word; Value: integer);
begin
  FCells[ColRowToRC(Col,Row)] := TStringCell.Create(ColRowToRC(Col,Row),FFormats,FormatIndex,TSheets(Collection).FSST.SST[Value]);
  TSheets(Collection).FSST.SST[Value].RefCount := TSheets(Collection).FSST.SST[Value].RefCount + 1;
end;

procedure TSheet.IntWriteSSTString(Col,Row: integer; FormatIndex: word; Value: WideString);
begin
  FCells[ColRowToRC(Col,Row)] := TStringCell.Create(ColRowToRC(Col,Row),FFormats,FormatIndex,TSheets(Collection).FSST.AddString(Value));
end;

procedure TSheet.StreamWriteMergedCells(Version: TExcelVersion; Stream: TXLSStream);
var
  i,j,MaxCount: integer;
  Buf: PByteArray;
begin
  if Version < xvExcel97 then
    Exit;
  GetMem(Buf,TSheets(Collection).MaxBufSize);
  try
    if FMergedCells.Count > 0 then begin
      MaxCount := (TSheets(Collection).MaxBufSize - 2) div 8;
      if FMergedCells.Count < MaxCount then
        MaxCount := FMergedCells.Count;
      j := 0;
      for i := 0 to FMergedCells.Count - 1 do begin
        PRecMERGEDCELLS(Buf).Cells[j].Row1 := FMergedCells[i].Row1;
        PRecMERGEDCELLS(Buf).Cells[j].Row2 := FMergedCells[i].Row2;
        PRecMERGEDCELLS(Buf).Cells[j].Col1 := FMergedCells[i].Col1;
        PRecMERGEDCELLS(Buf).Cells[j].Col2 := FMergedCells[i].Col2;
        Inc(j);
        if j >= MaxCount then begin
          PRecMERGEDCELLS(Buf).Count := j;
          Stream.WriteHeader(BIFFRECID_MERGEDCELLS,2 + j * 8);
          Stream.Write(Buf^,2 + j * 8);
          j := 0;
        end;
      end;
      if j > 0 then begin
        PRecMERGEDCELLS(Buf).Count := j;
        Stream.WriteHeader(BIFFRECID_MERGEDCELLS,2 + j * 8);
        Stream.Write(Buf^,2 + j * 8);
      end;
    end;
  finally
    FreeMem(Buf);
  end;
end;

procedure TSheet.WriteBuf(Stream: TXLSStream; RecId,Size: word; P: Pointer);
begin
  Stream.WriteHeader(RecID,Size);
  if Size > 0 then
    Stream.Write(P^,Size);
end;

function TSheet.GetDefaultFormat(Col,Row: integer): word;
var
  XRow: TXLSRow;
begin
  if (FColumns[Col] <> Nil) and (FColumns[Col].FormatIndex <> DEFAULT_FORMAT) then
    Result := FColumns[Col].FormatIndex
  else begin
    XRow := FRows.Find(Row);
    if (XRow <> Nil) and (XRow.FormatIndex <> DEFAULT_FORMAT) then
      Result := XRow.FormatIndex
    else
      Result := DEFAULT_FORMAT;
  end;
end;

// Check this...
function TSheet.GetDefaultWriteFormat(Version: TExcelVersion; FormatIndex: integer): word;
begin
  if FormatIndex < 0 then
    Result := DEFAULT_FORMAT
  else if TXLSReadWriteII2(TSheets(Collection).FOwner).WriteDefaultData then begin
    if Version < xvExcel50 then
      Result := FormatIndex + DEFAULT_FORMAT40 + 1
    else if Version < xvExcel97 then
      Result := FormatIndex + DEFAULT_FORMATS_COUNT_50
    else
      Result := FormatIndex;
  end
  else
    Result := FormatIndex;
end;

procedure TSheet.StreamWriteCells(Version: TExcelVersion; Stream: TXLSStream);
type TMulRk = packed record
     XF: word;
     RK: longword;
     end;

var
  i,R,C1,C2,Count: integer;
  WrittenCells: integer;
  L: word;
  S: string;
  WS: WideString;
  V: double;
  Row,CurrRow: integer;
  RK: longword;
  Cell: TCell;
  RecBlank: TRecBLANK;
  RecNum: TRecNUMBER;
  RecRK: TRecRK;
  RecBool: TRecBOOLERR;
  RecLabel: TRecLABEL;
  RecLabelSST: TRecLABELSST;
  RecFormula: TRecFORMULA_;
  Buf: PByteArray;
  WordArray: array[0..255] of word;
  RKCache: array[0..255] of TMulRK;
  RKCachePtr: integer;
  RKFirstCol,RKLastCol: integer;

function EncodeRK(const Value: double; var RK: longword): boolean;
var
  D: double;
  pL1, pL2: ^longword;
  Mask: longword;
  i: integer;
begin
  Result := True;
  for i := 0 to 1 do begin
    D := Value * (1 + 99 * i);
    pL1 := @d;
    pL2 := pL1;
    Inc(pL2);
    if (pL1^ = 0) and ((pL2^ and 3) = 0) then begin
      RK := pL2^ + Longword(i);
      Exit;
    end;
    Mask := $1FFFFFFF;
    if (Int(D) = D) and (D <= Mask) and (D >= -Mask - 1) then begin
      RK := Round(D) shl 2 + i + 2;
      Exit;
    end;
  end;
  Result := False;
end;

procedure FlushRkCache;
begin
  if RKCachePtr > 0 then begin
    if RKCachePtr = 1 then begin
      RecRK.Row := CurrRow;
      RecRK.Col := RKFirstCol;
      RecRK.FormatIndex := RKCache[0].XF;
      RecRK.Value := RKCache[0].RK;
      WriteBuf(Stream,BIFFRECID_RK7,SizeOf(TRecRK),@RecRK);
    end
    else begin
      Stream.WriteHeader(BIFFRECID_MULRK,RKCachePtr * SizeOf(TMulRk) + 6);