rm_e_htm.pas

来自「report machine 2.3 功能强大」· PAS 代码 · 共 1,005 行 · 第 1/3 页

{$IFDEF JPEG}; JPEGQuality: TJPEGQualityRange{$ENDIF}; const BaseName: string): string;
var
  DestStream: TStream;
  Img: TGraphic;

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

begin
  Result := BaseName;
  case ImgFormat of
    ifBMP:
      begin
        Result := Result + '.bmp';
        Bmp.SaveToFile(Result);
      end;
    ifGIF:
      begin
{$IFDEF RXGIF}
        Result := Result + '.gif';
        Img := TGIFImage.Create;
{$ELSE}
{$IFDEF JPEG}
        Result := Result + '.jpg';
        Img := TJPEGImage.Create;
{$ELSE}
        Result := Result + '.bmp';
        Bmp.SaveToFile(Result);
{$ENDIF}
{$ENDIF}
        SaveJpgGif(Result);
      end;
    ifJPG:
      begin
{$IFDEF JPEG}
        Result := Result + '.jpg';
        Img := TJPEGImage.Create;
        TJPEGImage(Img).CompressionQuality := JPEGQuality;
        SaveJpgGif(Result);
{$ELSE}
        Result := Result + '.bmp';
        Bmp.SaveToFile(Result);
{$ENDIF}
      end;
  end;
end;

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

function TRMHTMExport.GetNativeText(const Text: string): string;
begin
  Result := RMReplaceString(Text, ' ', ' ');
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;
end;

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

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

  Caption := RMLoadStr(rmRes + 1830);
  chkExportFrames.Caption := RMLoadStr(rmRes + 1803);
  chkExportImages.Caption := RMLoadStr(rmRes + 1821);
  lblExportImageFormat.Caption := RMLoadStr(rmRes + 1816);
  lblJPEGQuality.Caption := RMLoadStr(rmRes + 1814);

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

  TabSheet1.Caption := RMLoadStr(rmRes + 2);
  TabSheet2.Caption := RMLoadStr(rmRes + 1787);
  chkSingleFile.Caption := RMLoadStr(rmRes + 1786);

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

procedure TRMHTMLExportForm.btnImagesClick(Sender: TObject);
var
  S: string;
begin
  S := ExtractFilePath(CurReport.FileName);
{$IFDEF Delphi3}
  if SelectDirectory(S, [sdAllowCreate, sdPerformCreate, sdPrompt], 0) then
{$ELSE}
  if SelectDirectory('', S, S) then
{$ENDIF}
    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;
  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;
  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;

end.