rm_wawwriters.pas

胜天进销存源码,国产优秀的进销存

              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],@aDefaultColorPalette[0],XLSMaxColorsInPalette*sizeof(TColor));
  FPaletteModified := false;
  FUsedColors.Clear;

  FBOFOffs := Stream.Position;
  ZeroMemory(@bof,sizeof(bof));
  bof.vers := b8_BOF_vers;                  //$06