xlswriteii2.pas

一个经典的读写Excel的控件

      FXLS.SheetCharts.SaveToStream(k,FXLSStream);
      Inc(k);
    end;
    if FXLS.PreserveMacros and (FXLS.ExtraObjects.Count > 0) then
      FXLSStream.WriteVBA;
    if FXLS.WritePassword <> '' then
      FXLSStream.EncryptFile(FXLS.WritePassword);
  finally
    FXLSStream.Close;
  end;
  FBoundsheetList.Clear;
end;

procedure TXLSWriteII.WriteToStream40(Stream: TStream);
begin
  try
    FXLSStream.TargetStream := Stream;
    FXLSStream.OpenWrite(FXLS.Filename,FXLS.Version);
    WREC_BOF(stWorksheet);
    WREC_WRITEACCESS;
  //  WREC_CODENAME;
    WREC_CALCMODE;
    WREC_CALCCOUNT;
    WREC_REFMODE;
    WREC_ITERATION;
    WREC_DELTA;
    WREC_SAVERECALC;
    WREC_PRECISION;
    WREC_1904;
    WREC_PRINTHEADERS;
    WREC_PRINTGRIDLINES;
    WREC_GRIDSET;
    WREC_GUTS;
    WREC_DEFAULTROWHEIGHT;
    WREC_COUNTRY;
    WREC_HIDEOBJ;
    WREC_WSBOOL;

    WREC_FONT;
    WREC_HEADER;
    WREC_FOOTER;
    WREC_HCENTER;
    WREC_VCENTER;
    WREC_SETUP;
    WREC_BACKUP;
    WREC_FORMAT;
    WREC_WINDOWPROTECT;
    WREC_XF;
    WREC_STYLE;
    WREC_DEFCOLWIDTH;
    WREC_DIMENSIONS;
  //  WREC_ROW;
    FXLS.Sheets[0].StreamWriteCells(FXLS.Version,FXLSStream);
    WREC_WINDOW1;
    WREC_WINDOW2;
    WREC_SELECTION;
  //  WREC_GCW;
      WREC_EOF;
  finally
    FXLSStream.Close;
  end;
end;

procedure TXLSWriteII.WREC_1904;
begin
//  WriteWord(BIFFRECID_1904,Integer(FXLS.DateSystem1904));
end;

procedure TXLSWriteII.WREC_ADDMENU;
begin
  // Not used
end;

procedure TXLSWriteII.WREC_BACKUP;
begin
  WriteWord(BIFFRECID_BACKUP,Word(FXLS.Backup));
end;

procedure TXLSWriteII.WREC_BOF(SubStreamType: TSubStreamType);
begin
  case FXLS.Version of
    xvExcel40: begin
      PRecBOF4(PBuf).A := $0000;
      PRecBOF4(PBuf).B := $0010;
      PRecBOF4(PBuf).C := $18AF;
    end;
    xvExcel50: begin
      PRecBOF8(PBuf).VersionNumber := $0500;
      // Can not be zero.
      PRecBOF8(PBuf).BuildIdentifier := $0DBB;
      // Can not be zero.
      PRecBOF8(PBuf).BuildYear := $07CE;
    end;
    xvExcel97: begin
      PRecBOF8(PBuf).VersionNumber := $0600;
      PRecBOF8(PBuf).BuildIdentifier := $18AF;
      PRecBOF8(PBuf).BuildYear := $07CD;
      PRecBOF8(PBuf).FileHistoryFlags := 0;
      if FXLS.IsMac then
        PRecBOF8(PBuf).FileHistoryFlags := $00000010;
      PRecBOF8(PBuf).LowBIFF := $00000106;
    end;
  end;
  if FXLS.Version > xvExcel40 then begin
    case SubStreamType of
      stGlobals:      PRecBOF8(PBuf).SubStreamType := $0005;
      stVBModule:     PRecBOF8(PBuf).SubStreamType := $0006;
      stWorksheet:    PRecBOF8(PBuf).SubStreamType := $0010;
      stChart:        PRecBOF8(PBuf).SubStreamType := $0020;
      stExcel4Macro:  PRecBOF8(PBuf).SubStreamType := $0040;
      stWorkspace:    PRecBOF8(PBuf).SubStreamType := $0100;
    end;
  end;
  case FXLS.Version of
    xvExcel40: WriteBuf($0409,SizeOf(TRecBOF4));
    xvExcel50: WriteBuf($0809,SizeOf(TRecBOF7));
    xvExcel97: WriteBuf($0809,SizeOf(TRecBOF8));
  end;
end;

procedure TXLSWriteII.WREC_BOOKBOOL;
begin
  WriteWord(BIFFRECID_BOOKBOOL,Word(FXLS.OptionsDialog.SaveExtLinkVal));
end;

procedure TXLSWriteII.WREC_BOUNDSHEET(Index: integer);
var
  S: string;
begin
  if FXLS.Version >= xvExcel97 then begin
    FBoundsheetList[Index].FilePos := FXLSStream.Pos + SizeOf(TBIFFHeader);
    PRecBOUNDSHEET8(PBuf).BOFPos := 0;
    case FBoundsheetList[Index].FBoundsheetType of
      btSheet: PRecBOUNDSHEET8(PBuf).Options := $0000;
      btChart: PRecBOUNDSHEET8(PBuf).Options := $0200;
    end;
    PRecBOUNDSHEET8(PBuf).NameLen := Length(FBoundsheetList[Index].Name);
    PRecBOUNDSHEET8(PBuf).Name[0] := $01;
    Move(Pointer(FBoundsheetList[Index].Name)^,PRecBOUNDSHEET8(PBuf).Name[1],Length(FBoundsheetList[Index].Name) * 2);
    WriteBuf(BIFFRECID_BOUNDSHEET,7 + Length(FBoundsheetList[Index].Name) * 2 + 1);
  end
  else if FXLS.Version >= xvExcel50 then begin
    FBoundsheetList[Index].FilePos := FXLSStream.Pos + SizeOf(TBIFFHeader);
    PRecBOUNDSHEET7(PBuf).BOFPos := 0;
    case FBoundsheetList[Index].FBoundsheetType of
      btSheet: PRecBOUNDSHEET7(PBuf).Options := $0000;
      btChart: PRecBOUNDSHEET7(PBuf).Options := $0200;
    end;
    S := FBoundsheetList[Index].Name;
    PRecBOUNDSHEET7(PBuf).NameLen := Length(S);
    Move(Pointer(S)^,PRecBOUNDSHEET7(PBuf).Name,Length(S));
    WriteBuf(BIFFRECID_BOUNDSHEET,7 + Length(S));
  end;
end;

procedure TXLSWriteII.WREC_CODEPAGE;
begin
  WriteWord(BIFFRECID_CODEPAGE,FXLS.Codepage);
end;

procedure TXLSWriteII.WREC_COUNTRY;
begin
  if FXLS.Version < xvExcel97 then Exit;
  PRecCOUNTRY(PBuf).DefaultCountryIndex := FXLS.DefaultCountryIndex;
  PRecCOUNTRY(PBuf).WinIniCountry := FXLS.WinIniCountry;
  WriteBuf(BIFFRECID_COUNTRY,SizeOf(TRecCOUNTRY));
end;

procedure TXLSWriteII.WREC_DELMENU;
begin
  // Not used.
end;

procedure TXLSWriteII.WREC_DSF;
begin
  if FXLS.Version < xvExcel97 then Exit;
  WriteWord(BIFFRECID_DSF,$00);
end;

procedure TXLSWriteII.WREC_EXCEL9FILE;
begin
  WriteRecId(BIFFRECID_EXCEL9FILE);
end;

procedure TXLSWriteII.WREC_EOF;
begin
  WriteRecId(BIFFRECID_EOF);
end;

procedure TXLSWriteII.WREC_FONT;

procedure WriteFONT40;
var
  i,Sz: integer;
begin
  for i := 0 to FXLS.Fonts.Count - 1 do begin
    PRecFont4(PBuf).Height := FXLS.Fonts[i].Size20;
    PRecFont4(PBuf).Attributes := 0;
    if xfsItalic    in FXLS.Fonts[i].Style then PRecFont4(PBuf).Attributes := PRecFont4(PBuf).Attributes or $02;
    if xfsStrikeOut in FXLS.Fonts[i].Style then PRecFont4(PBuf).Attributes := PRecFont4(PBuf).Attributes or $08;

    PRecFont4(PBuf).Unknown := $7FFF;

    Sz := SizeOf(TRecFONT4) - 256;
    PRecFont4(PBuf).NameLen := Length(FXLS.Fonts[i].Name);
    Move(Pointer(FXLS.Fonts[i].Name)^,PRecFont4(PBuf).Name,PRecFont4(PBuf).NameLen);
    Inc(Sz,PRecFont4(PBuf).NameLen);
    if i <> 4 then
      WriteBuf(BIFFRECID_FONT,Sz);
  end;
end;

procedure WriteFONT50;
var
  i,Sz: integer;
  S: string;
begin
  for i := 0 to FXLS.Fonts.Count - 1 do begin
    PRecFont(PBuf).Height := FXLS.Fonts[i].Size20;
    PRecFont(PBuf).Attributes := 0;
    if xfsItalic    in FXLS.Fonts[i].Style then PRecFont(PBuf).Attributes := PRecFont(PBuf).Attributes or $02;
    if xfsStrikeOut in FXLS.Fonts[i].Style then PRecFont(PBuf).Attributes := PRecFont(PBuf).Attributes or $08;
    PRecFont(PBuf).ColorIndex := Integer(FXLS.Fonts[i].Color);
    if xfsBold in FXLS.Fonts[i].Style then
      PRecFont(PBuf).Bold := $02BC
    else
      PRecFont(PBuf).Bold := $0190;
    case FXLS.Fonts[i].SubSuperScript of
      xssNone:        PRecFont(PBuf).SubSuperScript := $00;
      xssSuperscript: PRecFont(PBuf).SubSuperScript := $01;
      xssSubscript:   PRecFont(PBuf).SubSuperScript := $02;
    end;
    case FXLS.Fonts[i].Underline of
      xulNone:          PRecFont(PBuf).Underline := $00;
      xulSingle:        PRecFont(PBuf).Underline := $01;
      xulDouble:        PRecFont(PBuf).Underline := $02;
      xulSingleAccount: PRecFont(PBuf).Underline := $21;
      xulDoubleAccount: PRecFont(PBuf).Underline := $22;
    end;
    PRecFont(PBuf).Reserved := 0;
    PRecFont(PBuf).CharSet := Byte(FXLS.Fonts[i].CharSet);
    PRecFont(PBuf).Family := FXLS.Fonts[i].Family;
    PRecFont(PBuf).NameLen := Length(FXLS.Fonts[i].Name);
    Sz := SizeOf(TRecFONT) - 256;
    if FXLS.Version >= xvExcel97 then begin
      WideStringToByteStr(FXLS.Fonts[i].Name,@PRecFont(PBuf).Name);
      Inc(Sz,Length(FXLS.Fonts[i].Name) * 2 + 1);
    end
    else begin
      S := FXLS.Fonts[i].Name;
      Move(Pointer(S)^,PRecFont(PBuf).Name,Length(S));
      Inc(Sz,PRecFont(PBuf).NameLen);
    end;
    if i <> 4 then
      WriteBuf(BIFFRECID_FONT,Sz);
  end;
end;

begin
  if FXLS.Version > xvExcel40 then
    WriteFONT50
  else
    WriteFONT40;
end;

procedure TXLSWriteII.WREC_FORMAT;
var
  i: integer;
  S: WideString;
begin
  // NumberFormat #0 shall never be written to the file. Makes excel sick.
  for i := 1 to FXLS.Formats.NumberFormats.Count - 1 do begin
    if FXLS.Formats.NumberFormats.ItemsByIndex[i].IsDefault then
      Continue;
    S := FXLS.Formats.NumberFormats.ItemsByIndex[i].Value;

    if FXLS.Version < xvExcel97 then begin
      PRecFORMAT7(PBuf).Index := i;
      PRecFORMAT7(PBuf).Len := Length(S);
      WideStringToByteStr(S,@PRecFORMAT7(PBuf).Data);
      WriteBuf(BIFFRECID_FORMAT,3 + Length(S) * 2 + 1);
    end
    else begin
      PRecFORMAT8(PBuf).Index := FXLS.Formats.NumberFormats.ItemsByIndex[i].IndexId;
      PRecFORMAT8(PBuf).Len := Length(S);
      WideStringToByteStr(S,@PRecFORMAT8(PBuf).Data);
      WriteBuf(BIFFRECID_FORMAT,4 + Length(S) * 2 + 1);
    end
  end;
end;

procedure TXLSWriteII.WREC_HIDEOBJ;
begin
  WriteWord(BIFFRECID_HIDEOBJ,Word(FXLS.OptionsDialog.ShowObjects));
end;

procedure TXLSWriteII.WREC_INTERFACEEND;
begin
//  WriteRecID(BIFFRECID_INTERFACEEND);
end;

procedure TXLSWriteII.WREC_INTERFACEHDR;
begin
{
  if FVersion = xvExcel97 then
    WriteWord(BIFFRECID_INTERFACEHDR,FCodepage)
  else
    WriteRecID(BIFFRECID_INTERFACEHDR);
}
end;

procedure TXLSWriteII.WREC_MSODRAWINGGROUP;
begin

end;

procedure TXLSWriteII.WREC_PASSWORD;
begin
  WriteWord(BIFFRECID_PASSWORD,$0000);
end;

procedure TXLSWriteII.WREC_PRECISION;
begin
  WriteWord(BIFFRECID_PRECISION,Word(FXLS.OptionsDialog.PrecisionAsDisplayed));
end;

procedure TXLSWriteII.WREC_PROT4REV;
begin

end;

procedure TXLSWriteII.WREC_PROT4REVPASS;
begin
  if FXLS.Version < xvExcel97 then Exit;
  WriteWord(BIFFRECID_PROT4REVPASS,$0000);
end;

procedure TXLSWriteII.WREC_PROTECT;
var
  i: integer;
begin
  for i := 0 to FXLS.Sheets.Count - 1 do begin
    if soProtected in FXLS.Sheets[i].Options then begin
      WriteWord(BIFFRECID_PROTECT,1);
      Break;
    end;
  end;
end;

procedure TXLSWriteII.WREC_PROTECT_Sheet(Value: boolean);
begin
  WriteWord(BIFFRECID_PROTECT,Word(Value));
end;

procedure TXLSWriteII.WREC_REFRESHALL;
begin
  WriteWord(BIFFRECID_REFRESHALL,Word(FXLS.RefreshAll));
end;

procedure TXLSWriteII.WREC_SST;
begin
  if FXLS.Version < xvExcel97 then Exit;
  FXLS.Sheets.WriteSST(FXLSStream);
end;

procedure TXLSWriteII.WREC_STYLE;