rm_e_htm.pas

这是一个功能强大

      lBorderInfo := '';
      lBackGroundInfo := '';
      if lDataRec.ObjType = rmemPicture then
        lImageSource := _ExportPicture(lDataRec);

      S := '';
      if ExportFrames and (lDataRec.Obj.FillColor <> clNone) then
        lBackGroundInfo := '; background-color: #' + RMColorBGRToRGB(lDataRec.Obj.FillColor);

      S := '<DIV STYLE="font: 0pt' + lBackGroundInfo + '; ' +
        'position: absolute; ' +
        'top: ' + IntToStr(lDataRec.Top) + 'px; ' +
        'left: ' + IntToStr(lDataRec.Left) + 'px; ' +
        'width: ' + IntToStr(lDataRec.Width) + 'px; ' +
        'height: ' + IntToStr(lDataRec.Height + 1) + 'px';

      if ExportFrames and ((lDataRec.Obj.ClassName = TRMMemoView.ClassName) or
        (lDataRec.Obj.ClassName = TRMCalcMemoView.ClassName)) then
      begin
        lBorderInfo := _GetBorderInfo;
        S := S + lBorderInfo + ';">';
      end
      else
        S := S + ';">';
      S := S + lImageSource + '</DIV>' + CRLF;

      if (lBackGroundInfo <> '') or (lBorderInfo <> '') or (lImageSource <> '') then
        WriteToStream(ExportStream, S);
    end;
  end;

  procedure _EncodeText;
  var
    i: Integer;
    lDataRec: TRMIEMData;
  begin
    for i := 0 to FDataList.Count - 1 do
    begin
      Application.ProcessMessages;
      lDataRec := FDataList[I];
      if lDataRec.ObjType = rmemText then
        _ExportText(lDataRec);
    end;
  end;

begin
  if (not SingleFile) and (FPageNo <> 0) then
  begin
    ExportStream := TFileStream.Create(FRepFileNames[FPageNo], fmCreate);
    WriteHeader;
  end;
  if FPageNo = 0 then WriteHeader;

  _EncodeData;
  _EncodeText;
  WriteFooter;
  if (not SingleFile) and (FPageNo < ParentReport.EndPages.Count - 1) then
  begin
    FreeAndNil(ExportStream);
  end;
end;

function TRMHTMExport.SaveBitmapAs(aBmp: TBitmap; aImgFormat: TRMEFImageFormat
{$IFDEF JPEG}; aJPEGQuality: TJPEGQualityRange{$ENDIF}; const aBaseName: string): string;
var
  lFileExt: string;
  lStream, lEncodeStream: TMemoryStream;
  lPicture: TPicture;
begin
  Result := aBaseName;
  if FCreateMHTFile then
    Result := ExtractFileName(Result);

  lStream := TMemoryStream.Create;
  lEncodeStream := TMemoryStream.Create;
  lPicture := TPicture.Create;
  try
    SaveBitmapToPicture(aBmp, aImgFormat{$IFDEF JPEG}, aJPEGQuality{$ENDIF}, lPicture);
    lFileExt := '.bmp';
    case aImgFormat of
      ifBMP:
        begin
        end;
      ifGIF:
        begin
{$IFDEF RXGIF}
          lFileExt := '.gif';
{$ELSE}
{$IFDEF JPEG}
          lFileExt := '.jpg';
{$ENDIF}
{$ENDIF}
        end;
      ifJPG:
        begin
{$IFDEF JPEG}
          lFileExt := '.jpg';
{$ENDIF}
        end;
    end;

    Result := Result + lFileExt;
    if FCreateMHTFile then
      lPicture.Graphic.SaveToStream(lStream)
    else
      lPicture.SaveToFile(Result);

    if FCreateMHTFile and (lStream.Size > 0) then
    begin
      WriteToStream(FImagesStream, '--===Test MHT by Town===' + CRLF);
      WriteToStream(FImagesStream, 'Content-Type: image/' + lFileExt + CRLF);
      WriteToStream(FImagesStream, 'Content-Transfer-Encoding: base64' + CRLF);
      WriteToStream(FImagesStream, 'Content-Location:' + Result + CRLF);
      WriteToStream(FImagesStream, '' + CRLF);
      lStream.Position := 0;
      MimeEncodeStream(lStream, lEncodeStream);
      lEncodeStream.Position := 0;
      FImagesStream.CopyFrom(lEncodeStream, lEncodeStream.Size);
      WriteToStream(FImagesStream, '' + CRLF);
    end;
  finally
    lPicture.Free;
    lStream.Free;
    lEncodeStream.Free;
  end;
end;

function TRMHTMExport.GetNativeText(const aText: string): string;
begin
  Result := StringReplace(aText, ' ', '&nbsp;', [rfReplaceAll]);
end;

function TRMHTMExport.GetOffsetFromTop: Integer;
begin
  Result := Round(FPageHeight + cPageEndLineWidth) * (FPageNo) * Ord(SingleFile);
end;

function TRMHTMExport.ShowModal: Word;
begin
  if not ShowDialog then
    Result := mrOk
  else
  begin
    with TRMHTMLExportForm.Create(nil) do
    try
      Exportfilter := Self;
      Application.ProcessMessages;
      Result := ShowModal;
    finally
      Free;
    end;
  end;

  if FCreateMHTFile then
    FileName := ChangeFileExt(FileName, '.mht')
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMHTMLExportForm}

procedure TRMHTMLExportForm.Localize;
begin
  Font.Name := RMLoadStr(SRMDefaultFontName);
  Font.Size := StrToInt(RMLoadStr(SRMDefaultFontSize));
  Font.Charset := StrToInt(RMLoadStr(SCharset));

  RMSetStrProp(Self, 'Caption', rmRes + 1830);
  RMSetStrProp(chkExportFrames, 'Caption', rmRes + 1803);
  RMSetStrProp(chkExportImages, 'Caption', rmRes + 1821);
  RMSetStrProp(lblExportImageFormat, 'Caption', rmRes + 1816);
  RMSetStrProp(lblJPEGQuality, 'Caption', rmRes + 1814);

  RMSetStrProp(lblImageFolder, 'Caption', rmRes + 1818);
  RMSetStrProp(chkSepFilePerPage, 'Caption', rmRes + 1819);
  RMSetStrProp(chkShowNavigator, 'Caption', rmRes + 1823);
  RMSetStrProp(lblHoverForeColor, 'Caption', rmRes + 1824);
  RMSetStrProp(lblBackGroundColor, 'Caption', rmRes + 1825);
  RMSetStrProp(lblHoverBackColor, 'Caption', rmRes + 1826);
  RMSetStrProp(lblLinkCaptions, 'Caption', rmRes + 1827);
  RMSetStrProp(btnSetFont, 'Caption', SFont);
  RMSetStrProp(lblFirst, 'Caption', rmRes + 1828);
  RMSetStrProp(lblPrevious, 'Caption', rmRes + 1829);
  RMSetStrProp(lblNext, 'Caption', rmRes + 1799);
  RMSetStrProp(lblLast, 'Caption', rmRes + 1798);
  RMSetStrProp(lblUseGraphicLinksFirst, 'Caption', rmRes + 1828);
  RMSetStrProp(lblUseGraphicLinksPrevious, 'Caption', rmRes + 1829);
  RMSetStrProp(lblUseGraphicLinksNext, 'Caption', rmRes + 1799);
  RMSetStrProp(lblUseGraphicLinksLast, 'Caption', rmRes + 1798);
  RMSetStrProp(lblImageSource, 'Caption', rmRes + 1797);
  RMSetStrProp(rbtnUseTextLinks, 'Caption', rmRes + 1792);
  RMSetStrProp(rbtnUseGraphicLinks, 'Caption', rmRes + 1791);

  RMSetStrProp(TabSheet1, 'Caption', rmRes + 2);
  RMSetStrProp(TabSheet2, 'Caption', rmRes + 1787);
  RMSetStrProp(chkSingleFile, 'Caption', rmRes + 1786);
  RMSetStrProp(chkCreateMHTFile, 'Caption', rmRes + 1780);

  btnOk.Caption := RMLoadStr(SOK);
  btnCancel.Caption := RMLoadStr(SCancel);
end;

procedure TRMHTMLExportForm.btnImagesClick(Sender: TObject);
var
  S: string;
begin
  S := ExtractFilePath(THackFilter(FExportFilter).FileName);
  if RMSelectDirectory('', S, S) then
    edImageDirectory.Text := S;
end;

procedure TRMHTMLExportForm.chkShowNavigatorClick(Sender: TObject);
begin
  RMSetControlsEnable(gbShowNavigator, chkShowNavigator.Checked);
  rbtnUseTextLinks.Enabled := chkShowNavigator.Checked;
  rbtnUseGraphicLinks.Enabled := chkShowNavigator.Checked;
end;

procedure TRMHTMLExportForm.rbtnUseTextLinksClick(Sender: TObject);
begin
  pcShowNavigator.ActivePage := pcShowNavigator.Pages[(Sender as TRadioButton).Tag];
end;

procedure TRMHTMLExportForm.btnSetFontClick(Sender: TObject);
begin
  if FontDialog.Execute then
  begin
    edFirst.Font.Name := FontDialog.Font.Name;
    edFirst.Font.Color := FontDialog.Font.Color;
    edFirst.Font.Style := FontDialog.Font.Style;
    edPrevious.Font.Name := FontDialog.Font.Name;
    edPrevious.Font.Color := FontDialog.Font.Color;
    edPrevious.Font.Style := FontDialog.Font.Style;
    edNext.Font.Name := FontDialog.Font.Name;
    edNext.Font.Color := FontDialog.Font.Color;
    edNext.Font.Style := FontDialog.Font.Style;
    edLast.Font.Name := FontDialog.Font.Name;
    edLast.Font.Color := FontDialog.Font.Color;
    edLast.Font.Style := FontDialog.Font.Style;
  end;
end;

procedure TRMHTMLExportForm.btnOKClick(Sender: TObject);
begin
  with TRMHTMExport(ExportFilter) do
  begin
    ExportFrames := chkExportFrames.Checked;
    ExportImages := chkExportImages.Checked;
    ExportImageFormat := TRMEFImageFormat
      (cmbImageFormat.Items.Objects[cmbImageFormat.ItemIndex]);
{$IFDEF JPEG}
    JPEGQuality := StrToInt(edJPEGQuality.Text);
{$ENDIF}
    PixelFormat := TPixelFormat(cmbPixelFormat.ItemIndex);

    SingleFile := chkSingleFile.Checked;
    SeparateFilePerPage := chkSepFilePerPage.Checked;
    ShowNavigator := chkShowNavigator.Checked;

    LinkHoverForeColor := shpHoverForeColor.Brush.Color;
    LinkHoverBackColor := shpHoverBackColor.Brush.Color;
    LinkBackColor := shpBackGroundColor.Brush.Color;

    UseTextLinks := rbtnUseTextLinks.Checked;
    LinkTextFirst := edFirst.Text;
    LinkTextPrev := edPrevious.Text;
    LinkTextNext := edNext.Text;
    LinkTextLast := edLast.Text;
    LinkImgSRCFirst := edUseGraphicLinksFirst.Text;
    LinkImgSRCPrev := edUseGraphicLinksPrevious.Text;
    LinkImgSRCNext := edUseGraphicLinksNext.Text;
    LinkImgSRCLast := edUseGraphicLinksLast.Text;
    LinkFont := FontDialog.Font;

    ImageDir := edImageDirectory.Text;
    CreateMHTFile := chkCreateMHTFile.Checked;
  end;
end;

procedure TRMHTMLExportForm.shpHoverForeColorMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  MousePoint.x := X;
  MousePoint.y := Y;
end;

procedure TRMHTMLExportForm.shpHoverForeColorMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  ColorDialog.Color := shpHoverBackColor.Brush.Color;
  if (((X = MousePoint.x) and (Y = MousePoint.y))
    and (Button = mbleft)) then
    if ColorDialog.Execute then
      (Sender as TShape).Brush.Color := ColorDialog.Color;
end;

procedure TRMHTMLExportForm.rbtnUseGraphicLinksClick(Sender: TObject);
begin
  pcShowNavigator.ActivePage := pcShowNavigator.Pages[(Sender as TRadioButton).Tag];
end;

procedure TRMHTMLExportForm.chkExportImagesClick(Sender: TObject);
begin
  RMSetControlsEnable(gbExportImages, chkExportImages.Checked);
  cmbImageFormatChange(Sender);
end;

procedure TRMHTMLExportForm.cmbImageFormatChange(Sender: TObject);
begin
  if chkExportImages.Checked and (cmbImageFormat.Text = ImageFormats[ifJPG]) then
  begin
    lblJPEGQuality.Enabled := True;
    edJPEGQuality.Enabled := True;
    edJPEGQuality.Color := clWindow;
  end
  else
  begin
    lblJPEGQuality.Enabled := False;
    edJPEGQuality.Enabled := False;
    edJPEGQuality.Color := clInactiveBorder;
  end;
end;

procedure TRMHTMLExportForm.edJPEGQualityKeyPress(Sender: TObject;
  var Key: Char);
begin
  if not (Key in ['0'..'9', #8]) then
    Key := #0;
end;

procedure TRMHTMLExportForm.FormCreate(Sender: TObject);
begin
  PageControl1.ActivePage := TabSheet1;
  Localize;
  cmbImageFormat.Items.Clear;
{$IFDEF RXGIF}
  cmbImageFormat.Items.AddObject(ImageFormats[ifGIF], TObject(ifGIF));
{$ENDIF}
{$IFDEF JPEG}
  cmbImageFormat.Items.AddObject(ImageFormats[ifJPG], TObject(ifJPG));
{$ENDIF}
  cmbImageFormat.Items.AddObject(ImageFormats[ifBMP], TObject(ifBMP));
  cmbImageFormat.ItemIndex := 0;
  pcShowNavigator.ActivePage := tsUseTextLinks;
end;

procedure TRMHTMLExportForm.FormShow(Sender: TObject);
begin
  with TRMHTMExport(ExportFilter) do
  begin
    chkExportFrames.Checked := ExportFrames;
    chkExportImages.Checked := ExportImages;
    cmbImageFormat.ItemIndex := cmbImageFormat.Items.IndexOfObject(TObject(Ord(ExportImageFormat)));
    if cmbImageFormat.ItemIndex < 0 then
      cmbImageFormat.ItemIndex := 0;
{$IFDEF JPEG}
    UpDown1.Position := JPEGQuality;
{$ENDIF}
    cmbPixelFormat.ItemIndex := Integer(PixelFormat);
    chkSepFilePerPage.Checked := SeparateFilePerPage;
    chkShowNavigator.Checked := ShowNavigator;
    chkSingleFile.Checked := SingleFile;

    shpHoverForeColor.Brush.Color := LinkHoverForeColor;
    shpHoverBackColor.Brush.Color := LinkHoverBackColor;
    shpBackGroundColor.Brush.Color := LinkBackColor;

    rbtnUseTextLinks.Checked := UseTextLinks;
    rbtnUseGraphicLinks.Checked := not UseTextLinks;

    edFirst.Text := LinkTextFirst;
    edPrevious.Text := LinkTextPrev;
    edNext.Text := LinkTextNext;
    edLast.Text := LinkTextLast;

    edUseGraphicLinksFirst.Text := LinkImgSRCFirst;
    edUseGraphicLinksPrevious.Text := LinkImgSRCPrev;
    edUseGraphicLinksNext.Text := LinkImgSRCNext;
    edUseGraphicLinksLast.Text := LinkImgSRCLast;

    FontDialog.Font := LinkFont;

    edFirst.Font.Name := FontDialog.Font.Name;
    edFirst.Font.Color := FontDialog.Font.Color;
    edPrevious.Font.Name := FontDialog.Font.Name;
    edPrevious.Font.Color := FontDialog.Font.Color;
    edNext.Font.Name := FontDialog.Font.Name;
    edNext.Font.Color := FontDialog.Font.Color;
    edLast.Font.Name := FontDialog.Font.Name;
    edLast.Font.Color := FontDialog.Font.Color;

    edImageDirectory.Text := ImageDir;
    chkCreateMHTFile.Checked := CreateMHTFile;
  end;
  chkExportImagesClick(Sender);
  chkSingleFileClick(Sender);
end;

procedure TRMHTMLExportForm.chkSingleFileClick(Sender: TObject);
begin
  RMSetControlsEnable(gbShowNavigator, (not chkSingleFile.Checked and chkShowNavigator.Checked));
  chkShowNavigator.Enabled := not chkSingleFile.Checked;
end;

procedure TRMHTMLExportForm.chkCreateMHTFileClick(Sender: TObject);
begin
  edImageDirectory.Enabled := not chkCreateMHTFile.Checked;
  btnImages.Enabled := not chkCreateMHTFile.Checked;
end;

end.