xlswriteii2.pas

一个经典的读写Excel的控件

end;

procedure TXLSWriteII.WREC_HORIZONTALPAGEBREAKS;
var
  i: integer;
begin
  if FXLS.Sheets[FCurrSheet].PrintSettings.HorizPagebreaks.Count <= 0 then
    Exit;
  if FXLS.Version >= xvExcel97 then begin
    with FXLS.Sheets[FCurrSheet].PrintSettings do begin
      PRecHORIZONTALPAGEBREAKS(PBuf).Count := HorizPagebreaks.Count;
      for i := 0 to HorizPagebreaks.Count - 1 do begin
        PRecHORIZONTALPAGEBREAKS(PBuf).Breaks[i].Val1 := HorizPagebreaks[i].Row + 1;
        PRecHORIZONTALPAGEBREAKS(PBuf).Breaks[i].Val2 := HorizPagebreaks[i].Col1 + 1;
        PRecHORIZONTALPAGEBREAKS(PBuf).Breaks[i].Val3 := HorizPagebreaks[i].Col2 + 1;
      end;
      WriteBuf(BIFFRECID_HORIZONTALPAGEBREAKS,2 + SizeOf(TPageBreak) * HorizPagebreaks.Count);
    end;
  end
  else begin
    with FXLS.Sheets[FCurrSheet].PrintSettings do begin
      PWordArray(PBuf)[0] := HorizPagebreaks.Count;
      for i := 0 to HorizPagebreaks.Count - 1 do
        PWordArray(PBuf)[i + 1] := HorizPagebreaks[i].Row + 1;
      WriteBuf(BIFFRECID_HORIZONTALPAGEBREAKS,2 + 2 * HorizPagebreaks.Count);
    end;
  end;
end;

procedure TXLSWriteII.WREC_VERTICALPAGEBREAKS;
var
  i: integer;
begin
  if FXLS.Sheets[FCurrSheet].PrintSettings.VertPagebreaks.Count <= 0 then
    Exit;
  if FXLS.Version >= xvExcel97 then begin
    with FXLS.Sheets[FCurrSheet].PrintSettings do begin
      PRecVERTICALPAGEBREAKS(PBuf).Count := VertPagebreaks.Count;
      for i := 0 to VertPagebreaks.Count - 1 do begin
        PRecVERTICALPAGEBREAKS(PBuf).Breaks[i].Val1 := VertPagebreaks[i].Col + 1;
        PRecVERTICALPAGEBREAKS(PBuf).Breaks[i].Val2 := VertPagebreaks[i].Row1 + 1;
        PRecVERTICALPAGEBREAKS(PBuf).Breaks[i].Val3 := VertPagebreaks[i].Row2 + 1;
      end;
      WriteBuf(BIFFRECID_VERTICALPAGEBREAKS,2 + SizeOf(TPageBreak) * VertPagebreaks.Count);
    end;
  end
  else begin
    with FXLS.Sheets[FCurrSheet].PrintSettings do begin
      PWordArray(PBuf)[0] := VertPagebreaks.Count;
      for i := 0 to VertPagebreaks.Count - 1 do
        PWordArray(PBuf)[i + 1] := VertPagebreaks[i].Col + 1;
      WriteBuf(BIFFRECID_VERTICALPAGEBREAKS,2 + 2 * VertPagebreaks.Count);
    end;
  end;
end;

// Sheet suffix

procedure TXLSWriteII.WREC_MSODRAWING;

{
procedure SetPictSize(Pict: TSheetPicture);
var
  W,H,T: integer;
  CellW,CellH: integer;
  CurrFI: integer;
  PixCellWidth: integer;
  PixCellHeight: integer;
  C2,R2: integer;
  C: TCell;
  Canvas: TCanvas;
begin
  Canvas := TCanvas.Create;
  try
    Canvas.Handle := GetDC(0);
    FXLS.Font.CopyToTFont(Canvas.Font);
    CurrFI := 0;
    C2 := Pict.Col;
    R2 := Pict.Row;
    PixCellWidth := FXLS.Sheets[FCurrSheet].DefaultColWidth * Canvas.TextWidth('0') + 4;
    if FXLS.Sheets[FCurrSheet].DefaultRowHeight > 0 then
      PixCellHeight := Round((FXLS.Sheets[FCurrSheet].DefaultRowHeight / 20) * (Canvas.Font.Size / -Canvas.Font.Height)) + 4
    else
      PixCellHeight := -Canvas.Font.Height + 4;
    if (Pict.XLSPicture.Width <= 0) or (Pict.XLSPicture.Height <= 0) then begin
      W := Round(Pict.XLSPicture.BMP.Width * (Pict.Zoom / 100));
      H := Round(Pict.XLSPicture.BMP.Height * (Pict.Zoom / 100));
    end
    else begin
      W := Round(Pict.XLSPicture.Width * (Pict.Zoom / 100));
      H := Round(Pict.XLSPicture.Height * (Pict.Zoom / 100));
    end;

    repeat
      C := FXLS.Sheets[FCurrSheet].Cell[C2,Pict.Row];
      if (C <> Nil) and (C.FormatIndex >= 0) and (FXLS.Formats[C.FormatIndex].FontIndex <> CurrFI) then begin
        CurrFI := FXLS.Formats[C.FormatIndex].FontIndex;
        FXLS.Fonts[CurrFI].CopyToTFont(Canvas.Font);
      end;
      T := FXLS.Sheets[FCurrSheet].ColumnFormats.ColWidth(C2);
      if T >= 0 then
        CellW := Round(T * (Canvas.TextWidth('0') / 256))
      else
        CellW := PixCellWidth;
      Inc(C2);
      Dec(W,CellW);
    until (W < 0);
    if W < 0 then begin
      Dec(C2);
      Pict.Col2Offset := Round(1024 * ((CellW - -W) / CellW));
    end;
    Pict.Col2 := C2;

    repeat
      C := FXLS.Sheets[FCurrSheet].Cell[Pict.Col,R2];
      if (C <> Nil) and (C.FormatIndex >= 0) and (FXLS.Formats[C.FormatIndex].FontIndex <> CurrFI) then begin
        CurrFI := FXLS.Formats[C.FormatIndex].FontIndex;
        FXLS.Fonts[CurrFI].CopyToTFont(Canvas.Font);
      end;
//      T := FXLS.Sheets[FCurrSheet].ColumnFormats.ColWidth(C2);
      T := -1;
      if T >= 0 then
        CellH := Round((T / 20) * (Canvas.Font.Size / -Canvas.Font.Height)) + 4
      else
        CellH := PixCellHeight;
      Inc(R2);
      Dec(H,CellH);
    until (H < 0);
    if H < 0 then begin
      Dec(R2);
      Pict.Row2Offset := Round(256 * ((CellH - -H) / CellH));
    end;
    Pict.Row2 := R2;
  finally
    Canvas.Free;
  end;
end;
}

begin
  if FXLS.Version < xvExcel97 then Exit;

  if FXLS.Sheets[FCurrSheet].EscherDrawing.ShapeCount > 0 then
    FXLS.Sheets[FCurrSheet].EscherDrawing.SaveToStream(FXLSStream,PBuf);
end;

procedure TXLSWriteII.WREC_NOTE;
begin
//  Written by escher
end;

procedure TXLSWriteII.WREC_MSODRAWINGSELECTION;
begin
  // Don't need to write this.
end;

procedure TXLSWriteII.WREC_SELECTION;
begin
  if FXLS.Sheets[FCurrSheet].Pane.PaneType <> ptNone then begin
    PRecSELECTION(PBuf).Pane := 3;
    PRecSELECTION(PBuf).ActiveRow := 0;
    PRecSELECTION(PBuf).ActiveCol := 0;
    PRecSELECTION(PBuf).ActiveRef := 0;
    PRecSELECTION(PBuf).Refs := 1;
    PRecSELECTION(PBuf).Row1 := 0;
    PRecSELECTION(PBuf).Row2 := 0;
    PRecSELECTION(PBuf).Col1 := 0;
    PRecSELECTION(PBuf).Col2 := 0;
    WriteBuf(BIFFRECID_SELECTION,SizeOf(TRecSELECTION));
  end;
end;

procedure TXLSWriteII.WREC_DVAL;
begin
  if FXLS.Sheets[FCurrSheet].Validations.Count > 0 then
    FXLS.Sheets[FCurrSheet].Validations.SaveToStream(FXLSStream,PBuf);
end;

procedure TXLSWriteII.WREC_WINDOW2;
begin
  PRecWINDOW2_7(PBuf).Options := $0020 + $0080 + $0400;
  with FXLS.Sheets[FCurrSheet] do begin
    if soShowFormulas in Options   then PRecWINDOW2_7(PBuf).Options := PRecWINDOW2_7(PBuf).Options or $0001;
    if soGridlines in Options      then PRecWINDOW2_7(PBuf).Options := PRecWINDOW2_7(PBuf).Options or $0002;
    if soRowColHeadings in Options then PRecWINDOW2_7(PBuf).Options := PRecWINDOW2_7(PBuf).Options or $0004;
    if soFrozenPanes in Options    then PRecWINDOW2_7(PBuf).Options := PRecWINDOW2_7(PBuf).Options or $0008;
    if soShowZeros in Options      then PRecWINDOW2_7(PBuf).Options := PRecWINDOW2_7(PBuf).Options or $0010;
    if FCurrSheet = 0              then PRecWINDOW2_7(PBuf).Options := PRecWINDOW2_7(PBuf).Options or $0200;

    if FXLS.Version < xvExcel97 then begin
      PRecWINDOW2_7(PBuf).TopRow := 0;
      PRecWINDOW2_7(PBuf).LeftCol := 0;
      PRecWINDOW2_7(PBuf).HeaderColorIndex := 0;
      WriteBuf(BIFFRECID_WINDOW2,SizeOf(TRecWINDOW2_7));
    end
    else begin
      PRecWINDOW2_8(PBuf).TopRow := 0;
      PRecWINDOW2_8(PBuf).LeftCol := 0;
      PRecWINDOW2_8(PBuf).HeaderColorIndex := $40;
      PRecWINDOW2_8(PBuf).ZoomPreview := ZoomPreview;
      PRecWINDOW2_8(PBuf).Zoom := 100;
      WriteBuf(BIFFRECID_WINDOW2,SizeOf(TRecWINDOW2_8));
    end;
  end;
end;

procedure TXLSWriteII.WREC_SCL;
begin
  if (FXLS.Sheets[FCurrSheet].Zoom > 0) and (FXLS.Sheets[FCurrSheet].Zoom <> 100) then begin
    PRecSCL(PBuf).Numerator := FXLS.Sheets[FCurrSheet].Zoom;
    PRecSCL(PBuf).Denominator := 100;
    WriteBuf(BIFFRECID_SCL,SizeOf(TRecSCL));
  end;
end;

procedure TXLSWriteII.WREC_PANE;

procedure WriteSelection(P,C,R: integer);
begin
  PRecSELECTION(PBuf).Pane := P;
  PRecSELECTION(PBuf).ActiveRow := R;
  PRecSELECTION(PBuf).ActiveCol := C;
  PRecSELECTION(PBuf).ActiveRef := 0;
  PRecSELECTION(PBuf).Refs := 1;
  PRecSELECTION(PBuf).Row1 := R;
  PRecSELECTION(PBuf).Row2 := R;
  PRecSELECTION(PBuf).Col1 := C;
  PRecSELECTION(PBuf).Col2 := C;
  WriteBuf(BIFFRECID_SELECTION,SizeOf(TRecSELECTION));
end;

begin
  if FXLS.Sheets[FCurrSheet].Pane.PaneType > ptNone then begin
    if (FXLS.Sheets[FCurrSheet].Pane.SplitColX <= 0) and (FXLS.Sheets[FCurrSheet].Pane.SplitRowY <= 0) then
      Exit;
    if (FXLS.Sheets[FCurrSheet].Pane.SplitColX > 0) and (FXLS.Sheets[FCurrSheet].Pane.SplitRowY > 0) then
      PRecPANE(PBuf).PaneNumber := 0
    else if (FXLS.Sheets[FCurrSheet].Pane.SplitColX > 0) and (FXLS.Sheets[FCurrSheet].Pane.SplitRowY = 0) then
      PRecPANE(PBuf).PaneNumber := 1
    else
      PRecPANE(PBuf).PaneNumber := 2;

    PRecPANE(PBuf).X := FXLS.Sheets[FCurrSheet].Pane.SplitColX;
    PRecPANE(PBuf).Y := FXLS.Sheets[FCurrSheet].Pane.SplitRowY;
    PRecPANE(PBuf).LeftCol := FXLS.Sheets[FCurrSheet].Pane.LeftCol;
    PRecPANE(PBuf).TopRow := FXLS.Sheets[FCurrSheet].Pane.TopRow;

    WriteBuf(BIFFRECID_PANE,SizeOf(TRecPANE));

    if (FXLS.Sheets[FCurrSheet].Pane.SplitColX > 0) and (FXLS.Sheets[FCurrSheet].Pane.SplitRowY > 0) then begin
      if FXLS.Sheets[FCurrSheet].Pane.Selections.Count = 4 then
        FXLS.Sheets[FCurrSheet].Pane.Selections.WriteAllRecs(FXLSStream)
      else begin
        WriteSelection(3,0,0);
        WriteSelection(2,0,FXLS.Sheets[FCurrSheet].Pane.TopRow);
        WriteSelection(1,FXLS.Sheets[FCurrSheet].Pane.LeftCol,0);
        WriteSelection(0,FXLS.Sheets[FCurrSheet].Pane.LeftCol,FXLS.Sheets[FCurrSheet].Pane.TopRow);
      end;
    end
    else if (FXLS.Sheets[FCurrSheet].Pane.SplitColX > 0) and (FXLS.Sheets[FCurrSheet].Pane.SplitRowY = 0) then begin
      if FXLS.Sheets[FCurrSheet].Pane.Selections.Count = 2 then
        FXLS.Sheets[FCurrSheet].Pane.Selections.WriteAllRecs(FXLSStream)
      else begin
        WriteSelection(3,0,FXLS.Sheets[FCurrSheet].Pane.TopRow);
        WriteSelection(1,FXLS.Sheets[FCurrSheet].Pane.LeftCol,0);
      end;
    end
    else begin
      if FXLS.Sheets[FCurrSheet].Pane.Selections.Count = 2 then
        FXLS.Sheets[FCurrSheet].Pane.Selections.WriteAllRecs(FXLSStream)
      else begin
        WriteSelection(3,0,0);
        WriteSelection(2,0,FXLS.Sheets[FCurrSheet].Pane.TopRow);
      end;
    end;
  end;
end;

procedure TXLSWriteII.WREC_HLINK;
begin
  if FXLS.Version < xvExcel97 then Exit;
  FXLS.Sheets[FCurrSheet].Hyperlinks.SaveToStream(FXLSStream,PBuf);
end;

procedure TXLSWriteII.WREC_MERGECELLS;
begin
  if FXLS.Version < xvExcel97 then Exit;
  FXLS.Sheets[FCurrSheet].StreamWriteMergedCells(FXLS.Version,FXLSStream);
end;

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

{ TBoundsheetList }

procedure TBoundsheetList.AddChart(Index: integer; Name: WideString);
var
  BD: TBoundsheetData;
begin
  BD := TBoundsheetData.Create;
  BD.FBoundsheetType := btChart;
  BD.FIndex := Index;
  BD.FName := Name;
  inherited Add(BD); 
end;

procedure TBoundsheetList.AddSheet(Index: integer; Name: WideString);
var
  BD: TBoundsheetData;
begin
  BD := TBoundsheetData.Create;
  BD.FBoundsheetType := btSheet;
  BD.FIndex := Index;
  BD.FName := Name;
  inherited Add(BD); 
end;

function TBoundsheetList.GetCharts(Index: integer): TBoundsheetData;
var
  i: integer;
begin
  for i := 0 to Count - 1 do begin
    if (Items[i].FBoundsheetType = btChart) and (Items[i].FIndex = Index) then begin
      Result := Items[i];
      Exit;
    end;
  end;
  Result := Nil;
end;

function TBoundsheetList.GetItems(Index: integer): TBoundsheetData;
begin
  Result := TBoundsheetData(inherited Items[Index]);
end;

function TBoundsheetList.GetSheets(Index: integer): TBoundsheetData;
var
  i: integer;
begin
  for i := 0 to Count - 1 do begin
    if (Items[i].FBoundsheetType = btSheet) and (Items[i].FIndex = Index) then begin
      Result := Items[i];
      Exit;
    end;
  end;
  Result := Nil;
end;

{ TBoundsheetData }

procedure TBoundsheetData.WritePos(Stream: TXLSStream);
var
  Pos: longint;
begin
  Pos := Stream.Pos;
  Stream.Seek(FFilePos,0);
  Stream.Write(Pos,SizeOf(longint));
  Stream.Seek(0,2);
end;

end.