rm_wawwriters.pas

这是一个功能强大

            // to determine row height find TwawXLSRow, if not found
            // simple set default height
          rw := Sheet.FindRow(i);
          if rw = nil then
          begin
            row.miyRw := XLSDefaultRowHeight;
            row.grbit := 0;
          end
          else
          begin
            row.miyRw := rw.Height;
            row.irwMac := 0; //waw
            row.res1 := 0; //waw
            row.grbit := b8_ROW_grbit_fDefault or b8_ROW_grbit_fUnsynced; //waw
            if row.miyRw = 0 then //waw
              row.grbit := row.grbit or b8_ROW_grbit_fDyZero;
            row.ixfe := $0F; //waw
          end;
          wbiff(Stream, b8_ROW, @row, sizeof(row));
          if bc = 0 then
            SecondRowOffs := Stream.Position;

            // write row cells to temporary memorystream,
            // also save cell offset from SecondRowOffs to CellsOffs
          IndexInCellsOffsArray := 0;
          for j := 0 to l.Count - 1 do
            WriteRangeToStream(ms, TwawXLSRange(l[j]), i, IndexInCellsOffsArray, dbcell.CellsOffs);

          Inc(bc);
          if (bc = XLSMaxRowsInBlock) or (i = Sheet.Dimensions.Bottom) then
          begin
            dbcell.CellsOffs[0] := Stream.Position - SecondRowOffs;
              // write from temporary memorystream to Stream
            ms.SaveToStream(Stream);
              // rows block ended - write DBCELL
              // save DBCell offset
            PCardinalArray(PChar(index) + sizeof(rb8INDEX))^[IndexInDBCELLsOffs] := Stream.Position - FBOFOffs;
            Inc(IndexInDBCELLsOffs);

            dbcell.dbRtrw := Stream.Position - FirstRowOffs;
            wbiff(Stream, b8_DBCELL, @dbcell, sizeof(rb8DBCELL) + IndexInCellsOffsArray * 2);
              // reinit vars
            ms.Clear;
            bc := 0;
          end;
        end;
      finally
        l.Free;
        ms.Free;
      end;

      // correct index record
      Stream.Position := INDEXOffs;
      wbiff(Stream, b8_INDEX, index, sizeof(rb8INDEX) + BlocksInSheet * 4);
      Stream.Seek(0, soFromEnd);
    end;
  finally
    FreeMem(index);
  end;
  WriteSheetImagesToStream(Stream, Sheet);

  ZeroMemory(@window2, sizeof(window2));
  window2.grbit := b8_WINDOW2_grbit_fPaged or // $06B6 - this value see in biffview
    b8_WINDOW2_grbit_fDspGuts or
    b8_WINDOW2_grbit_fDspZeros or
    b8_WINDOW2_grbit_fDefaultHdr or
    b8_WINDOW2_grbit_fDspGrid or
    b8_WINDOW2_grbit_fDspRwCol;
  if Sheet.IndexInWorkBook = 0 then
    window2.grbit := window2.grbit + b8_WINDOW2_grbit_fSelected;
  window2.rwTop := 0;
  window2.colLeft := 0;
  window2.icvHdr := $00000040;
  window2.wScaleSLV := 0;
  window2.wScaleNormal := 0;
  wbiff(Stream, b8_WINDOW2, @window2, sizeof(window2));

  selection := AllocMem(sizeof(rb8SELECTION) + 6);
  try
    selection.pnn := 3; // see in biffview
    selection.cref := 1;
    wbiff(Stream, b8_SELECTION, selection, sizeof(rb8SELECTION) + 6);
  finally
    FreeMem(selection);
  end;

// write data about merge ranges
  if Sheet.RangesCount > 0 then
  begin
    j := 0;
    for i := 0 to Sheet.RangesCount - 1 do
    begin
      ran := Sheet.RangeByIndex[i];
      if (ran.Place.Left <> ran.Place.Right) or
        (ran.Place.Top <> ran.Place.Bottom) then
        Inc(j);
    end;
{    if j>0 then
      begin
        merge := AllocMem(sizeof(rb8MERGE)+j*8);
        try
          pb8MERGE(merge)^.cnt := j;
          j := 0;
          for i:=0 to Sheet.RangesCount-1 do
            begin
              ran := Sheet.RangeByIndex[i];
              if(ran.Place.Left<>ran.Place.Right) or(ran.Place.Top<>ran.Place.Bottom) then
                begin
                  with pb8MERGErec(PChar(merge)+sizeof(rb8MERGE)+j*8)^ do
                    begin
                      top := ran.Place.Top;
                      bottom := ran.Place.Bottom;
                      left := ran.Place.Left;
                      right := ran.Place.Right;
                    end;
                  Inc(j);
                end;
            end;
          wbiff(Stream,b8_MERGE,merge,sizeof(rb8MERGE)+j*8);
        finally
          FreeMem(merge);
        end;
      end;}

     // shaoyy modifed
    if j > 0 then
    begin
      merge := AllocMem(sizeof(rb8MERGE) + 8);
      pb8MERGE(merge)^.cnt := 1;
       // j :=0;
      for i := 0 to Sheet.RangesCount - 1 do
      begin
        ran := Sheet.RangeByIndex[i];
        if (ran.Place.Left <> ran.Place.Right) or (ran.Place.Top <> ran.Place.Bottom) then
        begin
          with pb8MERGErec(PChar(merge) + sizeof(rb8MERGE))^ do
          begin
            top := ran.Place.Top;
            bottom := ran.Place.Bottom;
            left := ran.Place.Left;
            right := ran.Place.Right;
          end;
                //  Inc(j);
          wbiff(Stream, b8_MERGE, merge, sizeof(rb8MERGE) + 8);
        end;
      end;
      FreeMem(merge);
    end;
     //end shaoyy
  end;

  wbiff(Stream, b8_EOF, nil, 0);
end;

procedure TwawExcelWriter.BuildImagesColorsIndexes;
var
  i: Integer;
  j: Integer;
  n: Integer;
begin
  n := 0;
  for i := 0 to FWorkBook.SheetsCount - 1 do
  begin
    for j := 0 to FWorkBook.Sheets[i].Images.Count - 1 do
    begin
      FImagesRecs^[n].BorderLineColorIndex :=
        GetColorPaletteIndex(FWorkBook.Sheets[i].Images[j].BorderLineColor);
      FImagesRecs^[n].ForegroundFillPatternColorIndex := GetColorPaletteIndex($FFFFFF);
      FImagesRecs^[n].BackgroundFillPatternColorIndex := GetColorPaletteIndex($FFFFFF);
      inc(n);
    end;
  end;
end;

procedure TwawExcelWriter.WriteSheetImagesToStream(Stream: TStream;
  Sheet: TwawXLSWorksheet);
var
  ms: TMemoryStream;
  mf: TMetafile;
  mfc: TMetafileCanvas;
  obj: pb8OBJ;
  img: TwawImage;
  pir: pXLSImageRec;
  imdata: rb8IMDATA;
  i: Integer;
  n: Integer;
  k: Integer;
  w: Integer;
  objpicture: pb8OBJPICTURE;
const
  aBorderLineStyles: array[TwawXLSImageBorderLineStyle] of Byte =
  ($00, $01, $02, $03, $04, $05, $06, $07, $08);
  aBorderLineWeight: array[TwawXLSImageBorderLineWeight] of Byte =
  ($00, $01, $02, $03);
  function GetColWidth(ColIndex: Integer): Integer;
  var
    c: TwawXLSCol;
  begin
    c := Sheet.FindCol(ColIndex);
    if c = nil then
      Result := Sheet.GetDefaultColumnPixelWidth
    else
      Result := c.PixelWidth;
  end;
  function GetRowHeight(RowIndex: Integer): Integer;
  var
    r: TwawXLSRow;
  begin
    r := Sheet.FindRow(RowIndex);
    if r = nil then
      Result := Sheet.GetDefaultRowPixelHeight
    else
      Result := r.PixelHeight;
  end;
begin
  obj := AllocMem(sizeof(rb8OBJ) + sizeof(rb8OBJPICTURE));
  objpicture := pb8OBJPICTURE(PChar(obj) + sizeof(rb8OBJ));
  ms := TMemoryStream.Create;
  try
    n := 0;
    w := 0;
    for i := 0 to Sheet.IndexInWorkBook - 1 do
      n := n + Sheet.WorkBook.Sheets[i].Images.Count;
    for i := 0 to Sheet.Images.Count - 1 do
    begin
      img := Sheet.Images[i];
      pir := Addr(FImagesRecs^[n]);
      ZeroMemory(obj, sizeof(rb8OBJ) + sizeof(rb8OBJPICTURE));
      pb8OBJ(obj)^.cObj := Sheet.Images.Count;
      pb8OBJ(obj)^.OT := b8_OBJ_OT_PictureObject;
      pb8OBJ(obj)^.id := i + 1;
      pb8OBJ(obj)^.grbit := $0614;
      pb8OBJ(obj)^.colL := img.Left;
      pb8OBJ(obj)^.dxL := img.LeftCO;
      pb8OBJ(obj)^.rwT := img.Top;
      pb8OBJ(obj)^.dyT := img.TopCO;
      if img.ScalePercentX > 0 then
      begin
        pb8OBJ(obj)^.colR := img.Left;
        k := MulDiv(img.Picture.Width, img.ScalePercentX, 100) +
          MulDiv(GetColWidth(pb8OBJ(obj)^.colR), img.LeftCO, $400);
        while k > 0 do
        begin
          w := GetColWidth(pb8OBJ(obj)^.colR);
          if w = 0 then break;
          k := k - w;
          Inc(pb8OBJ(obj)^.colR);
        end;
        if k < 0 then
        begin
          Dec(pb8OBJ(obj)^.colR);
          pb8OBJ(obj)^.dxR := MulDiv(k + w, $400, w);
        end
        else
          pb8OBJ(obj)^.dxR := 0;
      end
      else
      begin
        pb8OBJ(obj)^.colR := img.Right;
        pb8OBJ(obj)^.dxR := img.RightCO;
      end;
      if img.ScalePercentY > 0 then
      begin
        pb8OBJ(obj)^.rwB := img.Top;
        k := MulDiv(img.Picture.Height, img.ScalePercentY, 100) +
          MulDiv(GetRowHeight(pb8OBJ(obj)^.rwB), img.TopCO, $100);
        while k > 0 do
        begin
          w := GetRowHeight(pb8OBJ(obj)^.rwB);
          if w = 0 then break;
          k := k - w;
          Inc(pb8OBJ(obj)^.rwB);
        end;
        if k < 0 then
        begin
          Dec(pb8OBJ(obj)^.rwB);
          pb8OBJ(obj)^.dyB := MulDiv(k + w, $100, w);
        end
        else
          pb8OBJ(obj)^.dyB := 0;
      end
      else
      begin
        pb8OBJ(obj)^.rwB := img.Bottom;
        pb8OBJ(obj)^.dyB := img.BottomCO;
      end;
      pb8OBJ(obj)^.cbMacro := 0;
      pb8OBJPICTURE(objpicture)^.icvBack := pir.BackgroundFillPatternColorIndex;
      pb8OBJPICTURE(objpicture)^.icvFore := pir.ForegroundFillPatternColorIndex;
      pb8OBJPICTURE(objpicture)^.fls := 1;
      pb8OBJPICTURE(objpicture)^.fAutoFill := 0;
      pb8OBJPICTURE(objpicture)^.icv := pir.BorderLineColorIndex;
      pb8OBJPICTURE(objpicture)^.lns := aBorderLineStyles[img.BorderLineStyle];
      pb8OBJPICTURE(objpicture)^.lnw := aBorderLineWeight[img.BorderLineWeight];
      pb8OBJPICTURE(objpicture)^.fAutoBorder := b8_XF_Border_None;
      pb8OBJPICTURE(objpicture)^.frs := 0;
      pb8OBJPICTURE(objpicture)^.cf := 2;
      pb8OBJPICTURE(objpicture)^.Reserved1 := 0;
      pb8OBJPICTURE(objpicture)^.cbPictFmla := 0;
      pb8OBJPICTURE(objpicture)^.Reserved2 := 0;
      pb8OBJPICTURE(objpicture)^.grbit := 0;
      pb8OBJPICTURE(objpicture)^.Reserved3 := 0;
      wbiff(Stream, b8_OBJ, obj, sizeof(rb8OBJ) + sizeof(rb8OBJPICTURE));

      ms.Clear;
      imdata.cf := 2;
      imdata.env := 1;
      imdata.lcb := 0;
      ms.Write(imdata, sizeof(rb8IMDATA));
      mf := TMetafile.Create;
      try
        mf.Height := img.Picture.Height;
        mf.Width := img.Picture.Width;
        mfc := TMetafileCanvas.Create(mf, 0);
        mfc.CopyMode := cmSrcCopy;
        mfc.Draw(0, 0, img.Picture.Graphic);
        mfc.Free;
        mf.SaveToStream(ms);
      finally
        mf.Free;
      end;
      imdata.lcb := ms.Size - sizeof(rb8IMDATA);
      ms.Position := 4;
      ms.Write(PChar(imdata.lcb), sizeof(Cardinal));
      wbiff(Stream, b8_IMDATA, ms.Memory, ms.Size);
      Inc(n);
    end;
  finally
    ms.Free;
    FreeMem(obj);
  end;
end;

procedure TwawExcelWriter.SaveAsBIFFToStream(WorkBook: TwawXLSWorkbook;
  Stream: TStream);
var
  sstsizeoffset: Integer;
  ltitleoffset: Integer;
  sstblockoffset: Integer;
  lsstbuf: Integer;
  sstsize: Integer;
  extsstsize: Integer;
  i: Integer;
  j: Integer;
  k: Integer;
  m: Integer;
  ltitle: Integer;
  RangesCount: Integer;
  s: string;
  l: TList;
  sl: TStringList;
  sh: TwawXLSWorksheet;
  bof: rb8BOF;
  mms: rb8MMS;
  codepage: rb8CODEPAGE;
  interfachdr: rb8INTERFACHDR;
  fngroupcount: rb8FNGROUPCOUNT;
  windowprotect: rb8WINDOWPROTECT;
  protect: rb8PROTECT;
  password: rb8PASSWORD;
  backup: rb8BACKUP;
  hideobj: rb8HIDEOBJ;
  s1904: rb81904;
  precision: rb8PRECISION;
  bookbool: rb8BOOKBOOL;
  writeaccess: rb8WRITEACCESS;
  doublestreamfile: rb8DOUBLESTREAMFILE;
  prot4rev: rb8PROT4REV;
  prot4revpass: rb8PROT4REVPASS;
  window1: rb8WINDOW1;
  refreshall: rb8REFRESHALL;
  useselfs: rb8USESELFS;
  boundsheet: pb8BOUNDSHEET;
  country: rb8COUNTRY;
  palette: rb8PALETTE;
  sst: PChar;
  sstbuf: PChar;
  extsst: pb8EXTSST;
  supbook: pb8SUPBOOK;
  externsheet: pb8EXTERNSHEET;
  xti: pb8XTI;
  sz: Word;
  buf: Pointer;
  P: Pointer;
  procedure AddDefXF(HexString: string);
  var
    s: string;
    buf: Pointer;
  begin
    s := HexStringToString(HexString);
    UniqueString(s);
    GetMem(buf, Length(s));
    CopyMemory(buf, @s[1], Length(s));
    l.Add(buf);
  end;
begin
  FWorkBook := WorkBook;
  RangesCount := 0;
  k := 0;
  for i := 0 to FWorkBook.SheetsCount - 1 do
  begin
    RangesCount := RangesCount + FWorkBook.Sheets[i].RangesCount;
    k := k + FWorkBook.Sheets[i].Images.Count;
  end;
  GetMem(FRangesRecs, RangesCount * sizeof(rXLSRangeRec));
  GetMem(FSheetsRecs, FWorkBook.SheetsCount * sizeof(rXLSSheetRec));
  GetMem(FImagesRecs, k * sizeof(rXLSImageRec));

  try
  // set palette to default values
    CopyMemory(@FColorPalette[0], @aDefaultC