xlswriteii2.pas

一个经典的读写Excel的控件

const DefaultSTYLE: array[0..5] of longword =
($FF038010,$FF068011,$FF048012,$FF078013,$FF008000,$FF058014);
var
  i: integer;
begin
  if FXLS.WriteDefaultData then begin
    for i := 0 to High(DefaultSTYLE) do
      WritePointer(BIFFRECID_STYLE,@DefaultSTYLE[i],SizeOf(DefaultSTYLE[i]));
  end
  else begin
    for i := 0 to FXLS.Styles.Count - 1 do begin
      Move(FXLS.Styles[i]^,PBuf^,SizeOf(TRecSTYLE));
      WriteBuf(BIFFRECID_STYLE,SizeOf(TRecSTYLE));
    end;
  end;
end;

{
procedure TXLSWriteII.WREC_TABID;
var
  i: integer;
begin
  if FXLS.Version < xvExcel97 then Exit;
  for i := 0 to FXLS.Sheets.Count - 1 do
    PWordArray(PBuf)[i] := i + 1;
  WriteBuf(BIFFRECID_TABID,FXLS.Sheets.Count * 2);
end;
}

procedure TXLSWriteII.WREC_OBPROJ;
begin
  if FXLS.PreserveMacros then
    FXLSStream.WriteHeader(BIFFRECID_OBPROJ,0);
end;                                                           

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

procedure TXLSWriteII.WREC_WINDOW1;
begin
  PRecWINDOW1(PBuf).Left := FXLS.Workbook.Left;
  PRecWINDOW1(PBuf).Top := FXLS.Workbook.Top;
  PRecWINDOW1(PBuf).Width := FXLS.Workbook.Width;
  PRecWINDOW1(PBuf).Height := FXLS.Workbook.Height;
  PRecWINDOW1(PBuf).Options := 0;
  if woHidden in FXLS.Workbook.Options then   PRecWINDOW1(PBuf).Options := PRecWINDOW1(PBuf).Options or $01;
  if woIconized in FXLS.Workbook.Options then PRecWINDOW1(PBuf).Options := PRecWINDOW1(PBuf).Options or $02;
  if woHScroll in FXLS.Workbook.Options then  PRecWINDOW1(PBuf).Options := PRecWINDOW1(PBuf).Options or $08;
  if woVScroll in FXLS.Workbook.Options then  PRecWINDOW1(PBuf).Options := PRecWINDOW1(PBuf).Options or $10;
  if woTabs in FXLS.Workbook.Options then     PRecWINDOW1(PBuf).Options := PRecWINDOW1(PBuf).Options or $20 ;
//  PRecWINDOW1(PBuf).TabIndex := FXLS.Workbook.SelectedTab + FXLS.FileCharts.Count;
  PRecWINDOW1(PBuf).FirstDispTabIndex := 0;
  PRecWINDOW1(PBuf).SelectedTabs := 1;
  PRecWINDOW1(PBuf).TabRatio := $0258;
  WriteBuf(BIFFRECID_WINDOW1,SizeOf(TRecWINDOW1));
end;

procedure TXLSWriteII.WREC_WINDOWPROTECT;
begin
  WriteWord(BIFFRECID_WINDOWPROTECT,Word(FXLS.BookProtected));
end;

procedure TXLSWriteII.WREC_FNGROUPCOUNT;
begin
//  WriteWord(BIFFRECID_FNGROUPCOUNT,$000E);
end;

procedure TXLSWriteII.WREC_WRITEACCESS;
var
  sz: byte;
  S: string;
begin
  if FXLS.Version < xvExcel40 then
    sz := 31
  else
    sz :=112;
  S := Copy(FXLS.UserName,1,sz);
  if FXLS.Version <= xvExcel50 then
    S := Char(Length(S)) + S;
  FillChar(PBuf^,sz,$20);
  Move(Pointer(S)^,PBuf^,Length(S));
  WriteBuf(BIFFRECID_WRITEACCESS,sz);
end;

procedure TXLSWriteII.WREC_XF;
var
  i: integer;
begin
  if FXLS.Version >= xvExcel97 then begin
    for i := 0 to FXLS.Formats.Count - 1 do begin
      FXLS.Formats[i].ToXF8(PBuf);
      WriteBuf(BIFFRECID_XF,SizeOf(TRecXF8));
    end;
  end
  else if FXLS.Version >= xvExcel50 then begin
    for i := 0 to FXLS.Formats.Count - 1 do begin
      FXLS.Formats[i].ToXF7(PBuf);
      WriteBuf(BIFFRECID_XF,SizeOf(TRecXF7));
    end;
  end
  else if FXLS.Version >= xvExcel40 then begin
    for i := 0 to FXLS.Formats.Count - 1 do begin
      FXLS.Formats[i].ToXF4(PBuf);
      WriteBuf(BIFFRECID_XF_40,SizeOf(TRecXF4));
    end;
  end;
end;

procedure TXLSWriteII.WREC_PALETTE;
var
  V,I: integer;
  W: word;
begin
  if FXLS.Version = xvExcel50 then begin
    FXLSStream.WriteHeader(BIFFRECID_PALETTE,2 + SizeOf(longword) * 56);
    W := 56;
    FXLSStream.Write(W,SizeOf(word));
    for i := 8 to 63 do begin
      V := ExcelColorPalette[i];
      FXLSStream.Write(V,SizeOf(longword));
    end;
  end;
end;

// Sheet prefix

procedure TXLSWriteII.WREC_CALCCOUNT;
begin
//  WriteWord(BIFFRECID_CALCCOUNT,FXLS.Sheets[FCurrSheet].CalcCount);
end;

procedure TXLSWriteII.WREC_CALCMODE;
begin
  case FXLS.OptionsDialog.CalcMode of
    cmManual:       WriteWord(BIFFRECID_CALCMODE,$0000);
    cmAutomatic:    WriteWord(BIFFRECID_CALCMODE,$0001);
    cmAutoExTables: WriteWord(BIFFRECID_CALCMODE,$FFFF);
  end;
end;

procedure TXLSWriteII.WREC_COLINFO;
begin
  FXLS.Sheets[FCurrSheet].Columns.SaveToStream(FXLSStream,PBuf);
end;

procedure TXLSWriteII.WREC_DEFAULTROWHEIGHT;
begin
  if FXLS.Sheets[FCurrSheet].DefaultRowHeight > 0 then begin
    PRecDEFAULTROWHEIGHT(PBuf).Options := 1;
    PRecDEFAULTROWHEIGHT(PBuf).Height := FXLS.Sheets[FCurrSheet].DefaultRowHeight;
  end
  else begin
    PRecDEFAULTROWHEIGHT(PBuf).Options := 0;
    PRecDEFAULTROWHEIGHT(PBuf).Height := 255;
  end;
  WriteBuf(BIFFRECID_DEFAULTROWHEIGHT,SizeOf(TRecDEFAULTROWHEIGHT));
end;

procedure TXLSWriteII.WREC_DEFCOLWIDTH;
begin
  if FXLS.Sheets[FCurrSheet].DefaultColWidth > 0 then
    WriteWord(BIFFRECID_DEFCOLWIDTH,FXLS.Sheets[FCurrSheet].DefaultColWidth)
end;

procedure TXLSWriteII.WREC_DELTA;
begin
//  WritePointer(BIFFRECID_DELTA,@FXLS.Sheets[FCurrSheet].Delta,SizeOf(double));
end;

procedure TXLSWriteII.WREC_DIMENSIONS;
begin
  if FXLS.Version >= xvExcel97 then
    WriteBuf(BIFFRECID_DIMENSIONS,SizeOf(TRecDIMENSIONS8))
  else
    WriteBuf(BIFFRECID_DIMENSIONS,SizeOf(TRecDIMENSIONS7));
end;

procedure TXLSWriteII.WREC_ROW;
var
  i: integer;
begin
  for i := 0 to FXLS.Sheets[FCurrSheet].Rows.Count - 1 do begin
    FXLS.Sheets[FCurrSheet].Rows.GetRecROW(i,PRecROW(PBuf));
    WriteBuf(BIFFRECID_ROW,SizeOf(TRecROW));
  end;
end;

procedure TXLSWriteII.WREC_FOOTER;
var
  L: integer;
  S: string;
begin
  if FXLS.Version >= xvExcel97 then begin
    if FXLS.Sheets[FCurrSheet].PrintSettings.Footer <> '' then begin
      L := Length(FXLS.Sheets[FCurrSheet].PrintSettings.Footer);
      FXLSStream.WriteHeader(BIFFRECID_FOOTER,2 + 1 + L * 2);
      FXLSStream.WWord(L);
      WideStringToByteStr(FXLS.Sheets[FCurrSheet].PrintSettings.Footer,PBuf);
      FXLSStream.Write(PBuf^,1 + L * 2);
    end
    else
      WriteBuf(BIFFRECID_FOOTER,0);
  end
  else begin
    S := FXLS.Sheets[FCurrSheet].PrintSettings.Footer;
    PRecSTRING1Byte(PBuf).Len := Length(S);
    Move(Pointer(S)^,PRecSTRING1Byte(PBuf).Data,Length(S));
    WriteBuf(BIFFRECID_FOOTER,2 + Length(S));
  end;
end;

procedure TXLSWriteII.WREC_GRIDSET;
begin
//  WriteWord(BIFFRECID_GRIDSET,FXLS.Sheets[FCurrSheet].Gridset);
end;

procedure TXLSWriteII.WREC_GUTS;
begin
{
  PRecGUTS(PBuf).SizeRow := FXLS.Sheets[FCurrSheet].RowGutter;
  PRecGUTS(PBuf).SizeCol := FXLS.Sheets[FCurrSheet].ColGutter;
  PRecGUTS(PBuf).LevelRow := FXLS.Sheets[FCurrSheet].RowOutlineGutter;
  PRecGUTS(PBuf).LevelCol := FXLS.Sheets[FCurrSheet].ColOutlineGutter;
  WriteBuf(BIFFRECID_GUTS,SizeOf(TRecGUTS));
}  
end;

procedure TXLSWriteII.WREC_HCENTER;
begin
  WriteBoolean(BIFFRECID_HCENTER,psoHorizCenter in FXLS.Sheets[FCurrSheet].PrintSettings.Options);
end;

procedure TXLSWriteII.WREC_HEADER;
var
  L:integer;
  S: string;
begin
  if FXLS.Sheets[FCurrSheet].PrintSettings.Header = '' then
    WriteRecId(BIFFRECID_HEADER)
  else if FXLS.Version >= xvExcel97 then begin
    if FXLS.Sheets[FCurrSheet].PrintSettings.Header <> '' then begin
      L := Length(FXLS.Sheets[FCurrSheet].PrintSettings.Header);
      FXLSStream.WriteHeader(BIFFRECID_HEADER,2 + 1 + L * 2);
      FXLSStream.WWord(L);
      WideStringToByteStr(FXLS.Sheets[FCurrSheet].PrintSettings.Header,PBuf);
      FXLSStream.Write(PBuf^,1 + L * 2);
    end
    else
      WriteBuf(BIFFRECID_HEADER,0);
  end
  else begin
    S := FXLS.Sheets[FCurrSheet].PrintSettings.Header;
    PRecSTRING1Byte(PBuf).Len := Length(S);
    Move(Pointer(S)^,PRecSTRING1Byte(PBuf).Data,Length(S));
    WriteBuf(BIFFRECID_HEADER,2 + Length(S));
  end;
end;

procedure TXLSWriteII.WREC_ITERATION;
begin
  WriteBoolean(BIFFRECID_ITERATION,soIteration in FXLS.Sheets[FCurrSheet].Options);
end;

procedure TXLSWriteII.WREC_PLS;
var
  P: PDeviceModeW;
begin
  if FXLS.HasDEVMODE and (FXLS.Version >= xvExcel97) then begin
    P := FXLS.GetDEVMODE;
    FXLSStream.WriteHeader(BIFFRECID_PLS,P.dmSize + P.dmDriverExtra + 2);
    FXLSStream.WWord(0);
    FXLSStream.Write(P^,P.dmSize + P.dmDriverExtra);
  end;
end;

procedure TXLSWriteII.WREC_PRINTGRIDLINES;
begin
  WriteBoolean(BIFFRECID_PRINTGRIDLINES,psoGridlines in FXLS.Sheets[FCurrSheet].PrintSettings.Options);
end;

procedure TXLSWriteII.WREC_PRINTHEADERS;
begin
  WriteBoolean(BIFFRECID_PRINTHEADERS,psoRowColHeading in FXLS.Sheets[FCurrSheet].PrintSettings.Options);
end;

procedure TXLSWriteII.WREC_REFMODE;
begin
  WriteBoolean(BIFFRECID_REFMODE,not (soR1C1Mode in FXLS.Sheets[FCurrSheet].Options));
end;

procedure TXLSWriteII.WREC_SAVERECALC;
begin
//  WriteBoolean(BIFFRECID_SAVERECALC,FXLS.SaveRecalc);
end;

procedure TXLSWriteII.WREC_MARGINS;
begin
  with FXLS.Sheets[FCurrSheet].PrintSettings do begin
    if MarginLeft >= 0 then begin
      PRecMARGIN(PBuf).Value := MarginLeft;
      WriteBuf(BIFFRECID_LEFTMARGIN,SizeOf(TRecMARGIN));
    end;
    if MarginRight >= 0 then begin
      PRecMARGIN(PBuf).Value := MarginRight;
      WriteBuf(BIFFRECID_RIGHTMARGIN,SizeOf(TRecMARGIN));
    end;
    if MarginTop >= 0 then begin
      PRecMARGIN(PBuf).Value := MarginTop;
      WriteBuf(BIFFRECID_TOPMARGIN,SizeOf(TRecMARGIN));
    end;
    if MarginBottom >= 0 then begin
      PRecMARGIN(PBuf).Value := MarginBottom;
      WriteBuf(BIFFRECID_BOTTOMMARGIN,SizeOf(TRecMARGIN));
    end;
  end;
end;

procedure TXLSWriteII.WREC_SETUP;
begin
  with FXLS.Sheets[FCurrSheet].PrintSettings do begin
    PRecSETUP(PBuf).PaperSize := Integer(FXLS.Sheets[FCurrSheet].PrintSettings.PaperSize);
    PRecSETUP(PBuf).Scale := ScalingFactor;
    PRecSETUP(PBuf).PageStart := StartingPage;
    PRecSETUP(PBuf).FitWidth := 1;
    PRecSETUP(PBuf).FitHeight := 1;
    PRecSETUP(PBuf).Options := $0000;
    if psoLeftToRight in Options then
      PRecSETUP(PBuf).Options := PRecSETUP(PBuf).Options or $0001;
    if psoPortrait in Options then
      PRecSETUP(PBuf).Options := PRecSETUP(PBuf).Options or $0002;
    if psoNoColor in Options then
      PRecSETUP(PBuf).Options := PRecSETUP(PBuf).Options or $0008;
    if psoDraftQuality in Options then
      PRecSETUP(PBuf).Options := PRecSETUP(PBuf).Options or $0010;
    if psoNotes in Options then
      PRecSETUP(PBuf).Options := PRecSETUP(PBuf).Options or $0020;
    PRecSETUP(PBuf).Resolution := 600;
    PRecSETUP(PBuf).VertResolution := 600;
    PRecSETUP(PBuf).HeaderMargin := HeaderMargin;
    PRecSETUP(PBuf).FooterMargin := FooterMargin;
    PRecSETUP(PBuf).Copies := Copies;
    WriteBuf(BIFFRECID_SETUP,SizeOf(TRecSETUP));
  end;
end;

procedure TXLSWriteII.WREC_VCENTER;
begin
  WriteBoolean(BIFFRECID_VCENTER,psoVertCenter in FXLS.Sheets[FCurrSheet].PrintSettings.Options);
end;

procedure TXLSWriteII.WREC_WSBOOL;
var
  W: word;
begin
  W := 0;
  with FXLS.Sheets[FCurrSheet] do begin
    if woShowAutoBreaks in WorkspaceOptions then W := W or $0001;
    if woApplyStyles    in WorkspaceOptions then W := W or $0020;
    if woRowSumsBelow   in WorkspaceOptions then W := W or $0040;
    if woFitToPage      in WorkspaceOptions then W := W or $0100;
    if woOutlineSymbols in WorkspaceOptions then W := W or $0600;
  end;
  WriteWord(BIFFRECID_WSBOOL,W);