rm_wawwriters.pas

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

  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
             else
              if(i = MinPos)and(j >= 0) then