rm_e_htm.pas

进销存·完整的·有数据库的·非常完整·只得参考

        IntToStr(TextRec^.FontInfo.Size) + 'pt ' +
        TextRec^.FontInfo.Name +
        TextDecor + '; ' +
        'color: #' + RMColorBGRToRGB(TextRec^.FontInfo.Color) + '">';

   // replace all instances of spaces with " " and store HTML text
      EncodedText := EncodedText + GetNativeText(TextRec^.Text) + '</DIV>' + CRLF;
      WriteToStream(Stream, EncodedText);
    end;
  end;

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

  Encodedata;
  EncodeText;
  WriteFooter;
  if (not SingleFile) and SeparateFilePerPage and (FPageNo <> 0) then
  begin
    Stream.Free;
    Stream := nil;
  end;
  inherited;
end;

function TRMHTMExport.SaveBitmapAs(Bmp: TBitmap; ImgFormat: TRMEFImageFormat
{$IFDEF JPEG}; JPEGQuality: TJPEGQualityRange{$ENDIF}; const BaseName: string): string;
var
  DestStream: TStream;
  Img: TGraphic;
  lFileExt: string;
  tmpStream, tmpEncodeStream: TMemoryStream;

  procedure SaveJpgGif(const AFileName: string);
  begin
    if FCreateMHTFile then
    begin
      try
        Img.Assign(Bmp);
        Img.SaveToStream(tmpStream);
      finally
        Img.Free;
        Img := nil;
      end;
    end
    else
    begin
      DestStream := TFileStream.Create(AFileName, fmCreate);
      try
        Img.Assign(Bmp);
        Img.SaveToStream(DestStream);
      finally
        DestStream.Free;
        Img.Free;
        Img := nil;
      end;
    end;
  end;

begin
  Result := BaseName;
  if FCreateMHTFile then
    Result := ExtractFileName(Result);
  tmpStream := TMemoryStream.Create;
  tmpEncodeStream := TMemoryStream.Create;
  Img := nil;
  try
    case ImgFormat of
      ifBMP:
        begin
          lFileExt := 'bmp';
          Result := Result + '.bmp';
          if FCreateMHTFile then
            Bmp.SaveToStream(tmpStream)
          else
            Bmp.SaveToFile(Result);
        end;
      ifGIF:
        begin
{$IFDEF RXGIF}
          lFileExt := 'gif';
          Result := Result + '.gif';
          Img := TGIFImage.Create;
{$ELSE}
{$IFDEF JPEG}
          lFileExt := 'jpg';
          Result := Result + '.jpg';
          Img := TJPEGImage.Create;
{$ELSE}
          lFileExt := 'bmp';
          Result := Result + '.bmp';
          if FCreateMHTFile then
            Bmp.SaveToStream(tmpStream)
          else
            Bmp.SaveToFile(Result);
{$ENDIF}
{$ENDIF}
          SaveJpgGif(Result);
        end;
      ifJPG:
        begin
{$IFDEF JPEG}
          lFileExt := 'jpg';
          Result := Result + '.jpg';
          Img := TJPEGImage.Create;
          TJPEGImage(Img).CompressionQuality := JPEGQuality;
          SaveJpgGif(Result);
{$ELSE}
          lFileExt := 'bmp';
          Result := Result + '.bmp';
          if FCreateMHTFile then
            Bmp.SaveToStream(tmpStream)
          else
            Bmp.SaveToFile(Result);
{$ENDIF}
        end;
    end;

    if FCreateMHTFile and (tmpStream.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);
      tmpStream.Position := 0;
      MimeEncodeStream(tmpStream, tmpEncodeStream);
      tmpEncodeStream.Position := 0;
      FImagesStream.CopyFrom(tmpEncodeStream, tmpEncodeStream.Size);
      WriteToStream(FImagesStream, '' + CRLF);
    end;
  finally
    tmpStream.Free;
    tmpEncodeStream.Free;
    if Img <> nil then
    	Img.Free;
  end;
end;

procedure TRMHTMExport.WriteToStream(aStream: TStream; AText: string);
begin
  aStream.Write(Pointer(AText)^, Length(AText));
end;

function TRMHTMExport.GetNativeText(const Text: string): string;
begin
  Result := RMReplaceString(Text, ' ', '&nbsp;');
end;

function TRMHTMExport.GetOffsetFromTop: Integer;
begin
//  Result := Round(FPageHeight + cPageEndLineWidth) * (FPageNo) * Ord(not SeparateFilePerPage);
  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(CurReport.FileName);
  if RMSelectDirectory('', S, S) then
    edImageDirectory.Text := S;
end;

procedure TRMHTMLExportForm.chkShowNavigatorClick(Sender: TObject);
begin
  RMSetControlsEnable(gbShowNavigator, chkShowNavigator.Checked);
  chkShowNavigator.Enabled := True;
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 ExportFilter as TRMHTMExport do
  begin
    ExportFrames := chkExportFrames.Checked;
    ExportImages := chkExportImages.Checked;
    ExportImageFormat := TRMEFImageFormat
      (cbImageFormat.Items.Objects[cbImageFormat.ItemIndex]);
{$IFDEF JPEG}
    JPEGQuality := StrToInt(edJPEGQuality.Text);
{$ENDIF}

    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);
  cbImageFormatChange(Sender);
end;

procedure TRMHTMLExportForm.cbImageFormatChange(Sender: TObject);
begin
  if chkExportImages.Checked and (cbImageFormat.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;
  cbImageFormat.Items.Clear;
{$IFDEF RXGIF}
  cbImageFormat.Items.AddObject(ImageFormats[ifGIF], TObject(ifGIF));
{$ENDIF}
{$IFDEF JPEG}
  cbImageFormat.Items.AddObject(ImageFormats[ifJPG], TObject(ifJPG));
{$ENDIF}
  cbImageFormat.Items.AddObject(ImageFormats[ifBMP], TObject(ifBMP));
  cbImageFormat.ItemIndex := 0;
  pcShowNavigator.ActivePage := tsUseTextLinks;
end;

procedure TRMHTMLExportForm.FormShow(Sender: TObject);
begin
  with ExportFilter as TRMHTMExport do
  begin
    chkExportFrames.Checked := ExportFrames;
    chkExportImages.Checked := ExportImages;
    cbImageFormat.ItemIndex := cbImageFormat.Items.IndexOfObject(TObject(Ord(ExportImageFormat)));
{$IFDEF JPEG}
    UpDown1.Position := JPEGQuality;
{$ENDIF}
    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.