rm_wawwriters.pas

这是一个功能强大

  j: Integer;
  ABottom: Integer;
  ARight: Integer;
begin
  if Image.ScalePercentX > 0 then
    ARight := Image.Left + 1
  else
    ARight := Image.Right;

  if Image.ScalePercentY > 0 then
    ABottom := Image.Top + 1
  else
    ABottom := Image.Bottom;

  for i := Image.Top to ABottom - 1 do
    for j := Image.Left to ARight - 1 do
      if (i = Image.Top) and (j = Image.Left) then
      begin
        HtmlCells^[i * ColCount + j].Image := Image;
        HtmlCells^[i * ColCount + j].ImageNum := ImageNum;
      end
      else
      begin
        SpansPresent := True;
        HtmlCells^[i * ColCount + j].Hide := 1;
      end;
  SaveBmpToFile(Image.Picture, FileName);
end;

procedure TwawHTMLWriter.AddRange(Range: TwawXLSRange);
var
  i: Integer;
  j: Integer;
  StStr: string;
  BstIndex: Integer;
  StIndex: Integer;
begin
  with Range do
  begin
    StStr := GenStyle(Range);
    StIndex := Styles.IndexOf(StStr);
    if StIndex < 0 then
    begin
      Styles.Add(StStr);
      StIndex := Styles.Count - 1;
    end;

    StStr := GenCellStyle(Range);
    BstIndex := Styles.IndexOf(StStr);
    if BstIndex < 0 then
    begin
      Styles.Add(StStr);
      BstIndex := Styles.Count - 1;
    end;

    for i := Place.Top to Place.Bottom do
      for j := Place.Left to Place.Right do
      begin
        if (i = Place.Top) and (j = Place.Left) then
        begin
          HtmlCells^[i * ColCount + j].Range := Range;
          HtmlCells^[i * ColCount + j].StyleId := StIndex;
          HtmlCells^[i * ColCount + j].BordersStyleId := BstIndex;
        end
        else
        begin
          SpansPresent := True;
          HtmlCells^[i * ColCount + j].Hide := 1;
        end;
      end;
  end;
end;

procedure TwawHTMLWriter.SaveBmpToFile(Picture: TPicture;
  FileName: string);
var
  bm: TPicture;
begin
  if Picture.ClassName() = 'TBitmap' then
    Picture.SaveToFile(FileName)
  else
  begin
    bm := TPicture.Create;
    try
      bm.Bitmap.Width := Picture.Bitmap.Width;
      bm.Bitmap.Height := Picture.Bitmap.Height;
      bm.Bitmap.Canvas.Draw(0, 0, Picture.Bitmap);
      bm.SaveToFile(FileName);
    finally
      bm.Free;
    end;
  end;
end;

function Getfont_family(Font: TFont): string;
begin
  Result := Font.Name
end;

function Getfont_size(Font: TFont): Word;
begin
  Result := Font.Size
end;

function Getfont_weight(Font: TFont): string;
begin
  if fsBold in Font.Style then
    Result := wawFONT_BOLD
  else
    Result := wawFONT_NORMAL;
end;

function Getfont_style(Font: TFont): string;
begin
  if fsItalic in Font.Style then
    Result := wawFONT_ITALIC
  else
    Result := wawFONT_NORMAL;
end;

function GetText_decoration(Font: TFont): string;
begin
  Result := '';
  if fsUnderline in Font.Style then
    Result := wawFONT_UNDERLINE;
  if fsStrikeout in Font.Style then
  begin
    if Result <> '' then
      Result := Result + ' ';
    Result := Result + wawFONT_STRIKE;
  end;
  if Result = '' then
    Result := wawFONT_NONE;
end;

function GetColor(Color: TColor): string;
var
  r: PByte;
  g: PByte;
  b: PByte;
begin
  r := @Color;
  g := @Color;
  b := @Color;
  Inc(g, 1);
  Inc(b, 2);
  Result := Format('#%.2x%.2x%.2x', [r^, g^, b^]);
end;

function GetVAlign(Align: TwawXLSVerticalAlignmentType): string;
var
  Val: string;
begin
  if Align = wawxlVAlignJustify then
    Result := ''
  else
  begin
    Result := wawVALIGN + ':';
    case Align of
      wawxlVAlignTop: Val := wawTEXTTOP;
      wawxlVAlignCenter: Val := wawMiddle;
      wawxlVAlignBottom: Val := wawTEXTBOTTOM;
    end;
    Result := Result + Val + ';';
  end;
end;

function GetTextAlign(Align: TwawXLSHorizontalAlignmentType): string;
var
  Val: string;
begin
  if not (Align in [wawxlHAlignLeft, wawxlHAlignCenter, wawxlHAlignRight, wawxlHAlignJustify]) then
    Result := ''
  else
  begin
    Result := wawTEXTALIGN + ':';
    case Align of
      wawxlHAlignLeft: Val := wawLEFT;
      wawxlHAlignCenter: Val := wawCENTER;
      wawxlHAlignRight: Val := wawRIGHT;
      wawxlHAlignJustify: Val := wawJustify;
    end;
    Result := Result + Val + ';';
  end;
end;

function TwawHTMLWriter.GetBackgroundColor(Range: TwawXLSRange):
  string;
begin
  if Range.FillPattern = wawfpNone then
    Result := ''
  else
    Result := wawBackgroundColor + ':' + GetColor(Range.ForegroundFillPatternColor) + ';';
end;

function GetBorderId(Border: TwawXLSBorderType): string;
begin
  if (Border >= wawxlEdgeBottom) and (Border <= wawxlEdgeTop) then
    Result := aHtmlCellBorders[Integer(Border)]
  else
    Result := '';
end;

function GetLineStyle(BorderLineStyle: TwawXLSLineStyleType): string;
begin
  Result := aBorderLineStyles[Integer(BorderLineStyle)];
end;

function TwawHTMLWriter.GetBorders(Range: TwawXLSRange): string;
var
  i: Integer;
  Eq: Boolean;
  lt: TwawXLSLineStyleType;
  lc: TColor;
begin
  Result := '';
  Eq := True;
  for i := ord(wawxlEdgeBottom) to ord(wawxlEdgeTop) do
  begin
    if (i > ord(wawxlEdgeBottom)) and
      ((Range.Borders[TwawXLSBorderType(i - 1)].LineStyle <> Range.Borders[TwawXLSBorderType(i)].LineStyle) or
      (Range.Borders[TwawXLSBorderType(i - 1)].Color <> Range.Borders[TwawXLSBorderType(i)].Color)) then Eq := false;
    lt := Range.Borders[TwawXLSBorderType(i)].LineStyle;
    lc := Range.Borders[TwawXLSBorderType(i)].Color;
    if (lt <> wawlsNone) then
      Result := Result + 'border-' + GetBorderId(TwawXLSBorderType(i)) + ': ' + GetLineStyle(lt) + ' ' + GetColor(lc) + ';';
  end;
  if Eq and (lt <> wawlsNone) then
    Result := 'border:' + GetLineStyle(lt) + ' ' + GetColor(lc) + ';';
end;

function TwawHTMLWriter.GenStyle(Range: TwawXLSRange): string;
begin
  Result := Format('font-family : ''%s''; font-size : %dpt; font-weight : %s; font-style : %s;  text-decoration : %s ; color : %s',
    [Getfont_family(Range.Font),
    Getfont_size(Range.Font),
      Getfont_weight(Range.Font),
      Getfont_style(Range.Font),
      Gettext_decoration(Range.Font),
      GetColor(Range.Font.Color)]);
end;

function TwawHTMLWriter.GenCellStyle(Range: TwawXLSRange): string;
begin
  Result := Format('%s %s %s %s', [GetBorders(Range), GetBackgroundColor(Range), GetVAlign(Range.VerticalAlignment), GetTextAlign(Range.HorizontalAlignment)]);
end;

function TwawHTMLWriter.GetSheetFileName(SheetNumber: Integer):
  string;
begin
  Result := Format('%s\Sheet%d%s', [FilesDir, SheetNumber, '.htm']);
end;

procedure TwawHTMLWriter.InitStrings;
begin
  FileExt := ExtractFileExt(FFileName);
  FName := Copy(FFileName, 1, Length(FFileName) - Length(FileExt));
  FilesDir := FName + '_files';
  DirName := ExtractFileName(FilesDir);
end;

function TwawHTMLWriter.CalcTableWidth(Sheet: TwawXLSWorksheet): Integer;
var
  Col: TwawXLSCol;
  i: Integer;
  ColWidth: Integer;
begin
  Result := 0;
  for i := 0 to ColCount - 1 do
  begin
    Col := Sheet.FindCol(i);
    if Col <> nil then ColWidth := Col.PixelWidth
    else ColWidth := Sheet.GetDefaultColumnPixelWidth;
    Result := Result + ColWidth;
  end;
end;

function TwawHTMLWriter.CalcTableHeight(Sheet: TwawXLSWorksheet): Integer;
var
  Row: TwawXLSRow;
  i: Integer;
  RowHeight: Integer;
begin
  Result := 0;
  for i := 0 to RowCount - 1 do
  begin
    Row := Sheet.FindRow(i);
    if Row <> nil then RowHeight := Row.PixelHeight
    else RowHeight := Sheet.GetDefaultRowPixelHeight;
    Result := Result + RowHeight;
  end;
end;

function TwawHTMLWriter.GetTableTag(Sheet: TwawXLSWorksheet): string;
begin
  Result := Format('TABLE style="width:%dpx;height:%dpx"', [CalcTableWidth(Sheet), CalcTableHeight(Sheet)]);
end;

function TwawHTMLWriter.GetImgStyle(Image: TwawImage): string;
var
  Wstr: string;
  Hstr: string;
begin
  if Image.ScalePercentX = 0 then
    Wstr := '100%'
  else
    Wstr := Format('%dpx', [Muldiv(Image.Picture.Width, Image.ScalePercentX, 100)]);
  if Image.ScalePercentY = 0 then
    Hstr := '100%'
  else
    Hstr := Format('%dpx', [Muldiv(Image.Picture.Height, Image.ScalePercentY, 100)]);

  Result := Format('width:%s;heigth:%s;border: %s %s',
    [Wstr, Hstr, GetColor(Image.BorderLineColor), aBorderImageLineStyles[Integer(Image.BorderLineStyle)]]);
end;

procedure TwawHTMLWriter.Save(WorkBook: TwawXLSWorkbook;
  FileName: string);
var
  i: Integer;
  Writer: TwawHTMLWriter;
begin
  FFileName := FileName;
  InitStrings;
  FileStream := TFileStream.Create(FileName, fmCreate or fmShareDenyWrite);
  try
    FWorkBook := WorkBook;
    SaveHeadFiles;
  finally
    FileStream.Free;
  end;
  for i := 0 to WorkBook.SheetsCount - 1 do
  begin
    Writer := TwawHTMLWriter.Create;
    try
      Writer.SaveSheet(TwawXLSWorksheet(WorkBook.Sheets[i]), GetSheetFileName(i));
    finally
      Writer.Free;
    end;
  end;
end;

procedure TwawHTMLWriter.CheckBounds(Images: TwawImages);
var
  i: Integer;
begin
  for i := 0 to Images.Count - 1 do
  begin
    RowCount := Max(RowCount, Images[i].Bottom);
    ColCount := Max(ColCount, Images[i].Right);
  end;
end;

procedure TwawHTMLWriter.SaveSheet(Sheet: TwawXLSWorksheet;
  FileName: string);
var
  i: Integer;
  j: Integer;
  ImgFileName: string;
begin
  FileStream := TFileStream.Create(FileName, fmCreate or fmShareDenyWrite);
  try
    with Sheet do
    begin
      SpansPresent := false;
      RowCount := Dimensions.Bottom + 1;
      ColCount := Dimensions.Right + 1;
      CheckBounds(Images);
      HtmlCells := AllocMem(RowCount * ColCount * (SizeOf(TwawHtmlCell)));
      ZeroMemory(HtmlCells, RowCount * ColCount * (SizeOf(TwawHtmlCell)));
      try
        for i := 0 to Images.Count - 1 do
        begin
          ImgFileName := Format('%s_p%d.bmp', [ChangeFileExt(FileName, ''), i]);
          self.AddImage(Sheet, Images[i], ImgFileName, i);
        end;
        for i := 0 to RangesCount - 1 do
          self.AddRange(RangeByIndex[i]);

        if SpansPresent then
          MinPos := -1
        else
          MinPos := 0;
        WriteStringWithFormatToStream(FileStream, wawHTML_VERSION, 0);
        WriteOpenTagFormat(FileStream, wawHTMLTAG, 0);
        WriteOpenTagFormat(FileStream, wawHEADTAG, 0);
        WriteOpenTagFormat(FileStream, wawTITLETAG, 1);
        WriteStringWithFormatToStream(FileStream, MakeHTMLString(Sheet.Title), 2);
        WriteCloseTagFormat(FileStream, wawTITLETAG, 1);
        WriteStyles;
        WriteCloseTagFormat(FileStream, wawHEADTAG, 0);
        WriteOpenTagFormat(FileStream, wawBODYTAG, 0);
        WriteOpenTagFormat(FileStream, wawFORMTAG, 0);
        WriteOpenTagClassFormat(FileStream, GetTableTag(Sheet), 0, 0);
        for i := MinPos to RowCount - 1 do
        begin
          WriteRowTag(Sheet, i, 1);
          for j := MinPos to ColCount - 1 do
          begin
            if (i >= 0) and (j >= 0) and (HtmlCells^[i * ColCount + j].Hide = 0) then
            begin
              WriteCellTag(Sheet, i, j, 2);
              if (HtmlCells^[i * ColCount + j].Image <> nil) then
                WriteStringWithFormatToStream(FileStream, '<IMG src="' +
                  Format('%s_p%d.bmp', [ChangeFileExt(ExtractFileName(FileName), ''), HtmlCells^[i * ColCount + j].ImageNum]) +
                  Format('" style="%S"', [GetImgStyle(HtmlCells^[i * ColCount + j].Image)]) + wawTAGPOSTFIX, 2);
              if (HtmlCells^[i * ColCount + j].Range <> nil) then
                WriteStringWithFormatToStream(FileStream, '<SPAN CLASS=' +
                  Format(wawSTYLEFORMAT, [HtmlCells^[i * ColCount + j].StyleId]) + wawTAGPOSTFIX +
                  MakeHTMLString(HtmlCells^[i * ColCount + j].Range.Value) + '</SPAN>', 2);
              WriteCloseTagFormat(FileStream, wawCELLTAG, 2);
            end