?? qrwebfilt.pas
字號:
unit QRWebFilt;
////////////////////////////////////////////////////////////////////////////
// Unit : QRWebFilt.pas
//
// TQRGAbstractExportFilter -> TQRGHTMLDocumentFilter
//
// The new HTML Export document filter class -
// No lines, columns or text entries.
//
// (c) 2001 QBS Software
// Upgraded to be multi-page 29th September 2001
// Right align bug fixed 11th October
// Center align bug fixed 14th October
// Stuff spaces with ..
// Change text coords to pixels. Add VertAdjust to HRule ..
// Suppress 'next' on final page
// Add 'FirstLastLinks', 'FinalPage' property
// 25/11/02 add proportional control
// 24th Feb 2002 Added JPEG file saves
// 3rd March 2002 Added concat, linkfontname
// 21/12/2003 QR 4 added TQRHTMLFilt component
////////////////////////////////////////////////////////////////////////////
{$define VER36}
interface
uses windows, classes, controls, stdctrls,sysutils, graphics, buttons,
forms, extctrls, dialogs, printers, db, DBtables, ComCtrls, qrexport,
QRPrntr, Quickrpt, QR4Const, qrctrls, grimgctrl, jpeg;
TQRGAbstractExportFilter = class(TQRExportFilter)
private
FStream : TStream;
FCharWidth,
FCharHeight,
FPaperWidth,
FPaperHeight : extended;
FLineCount,
FColCount : integer;
FPageProcessed : boolean;
FFont : TFont;
FActiveFont : TFont;
protected
function GetText(X, Y : extended; var Font : TFont) : string;
function GetFilterName : string; override;
function GetDescription : string; override;
function GetExtension : string; override;
procedure WriteToStream(const AText : string);
procedure WriteLnToStream(const AText : string);
procedure CreateStream(Filename : string); virtual;
procedure CloseStream; virtual;
procedure ProcessPage; virtual;
procedure StorePage; virtual;
property Stream : TStream read FStream write FStream;
property PageProcessed : boolean read FPageProcessed write FPageProcessed;
property CharWidth : extended read FCharWidth write FCharWidth;
property CharHeight : extended read FCharHeight write FCharHeight;
property PaperWidth : extended read FPaperWidth write FPaperWidth;
property PaperHeight : extended read FPaperHeight write FPaperHeight;
property LineCount : integer read FLineCount write FLineCount;
property ColCount : integer read FColCount write FColCount;
public
constructor Create( filename : string ); override;
procedure Start(PaperWidth, PaperHeight : integer; Font : TFont); override;
procedure Finish; override;
procedure EndPage; override;
procedure NewPage; override;
procedure AcceptGraphic( Xoff, Yoff : extended; GControl : TControl); override;
procedure TextOut(X, Y : extended; Font : TFont; BGColor : TColor;
Alignment : TAlignment; Text : string); override;
end;
TQRGHTMLDocumentFilter = class(TQRGAbstractExportFilter)
private
FFreeStream : boolean;
FPageLength : integer;
FBodyColor : TColor;
FBackgroundPic : String;
FFirstReport : boolean;
FReportNumber : integer;
FExtraBody : String;
FPageNumber : longint;
FNextPicnum : longint;
FPageMaxY : integer;
HTMFirstPage : boolean;
HTMLastPage : boolean;
function getTransparentTextBG : boolean;
procedure setTransparentTextBG( value : boolean);
function getPictureDir : string;
procedure setPictureDir( value : string);
function getMultiPage : boolean;
procedure setMultiPage( value : boolean);
function getFinalPage : integer;
procedure setFinalPage( value : integer);
function getFirstLastLinks :boolean;
procedure setFirstLastLinks( value : boolean);
function getPageLinks :boolean;
procedure setPageLinks( value : boolean);
function getConcatenate : boolean;
procedure setConcatenate( value : boolean);
function getConcatCount : integer;
procedure setConcatCount( value : integer);
procedure setLinkFontHeight( value : integer);
function getLinkFontHeight : integer;
function getLinkFontName : string;
procedure setLinkFontName( value : string);
protected
function GetFilterName : string; override;
function GetDescription : string; override;
function GetExtension : string; override;
function GetStreaming : boolean; override;
procedure CreateStream(Filename : string); override;
procedure CloseStream; override;
public
LinkPrefix : string;
constructor Create( filename : string ); override;
procedure StorePage; override;
procedure TextOut(X, Y : extended; Font : TFont; BGColor : TColor;
Alignment : TAlignment; Text : string); override;
procedure ProcessPage; override;
procedure Start(PaperWidth, PaperHeight : integer; Font : TFont); override;
procedure Finish; override;
procedure SetHTMLBody( BodyCol : TColor; BGPic, BExtra : string );
property TransparentTextBG : boolean read getTransparentTextBG write setTransparentTextBG;
procedure NewPage; override;
procedure EndPage; override;
procedure EndConcat;
procedure AcceptGraphic( Xoff, Yoff : extended; GControl : TControl); override;
property MultiPage : boolean read getMultiPage write setMultiPage;
property PageLinks : boolean read getPageLinks write setPageLinks;
property PageLength : integer read FPageLength write FPageLength;
property FinalPage : integer read getFinalPage write setFinalPage;
property FirstLastLinks : boolean read getFirstLastLinks write setFirstLastLinks;
property Stream;
property FreeStream : boolean read FFreeStream write FFreeStream;
property Concat : boolean read getConcatenate write setConcatenate;
property ConcatCount : integer read getConcatCount write setConcatCount;
property LinkFontSize : integer read getLinkFontHeight write setLinkFontHeight;
property LinkFontName : string read getLinkFontName write setLinkFontName;
end;
TQRHTMLFilter = class(TComponent)
protected
private
FImageLinkPrefix : string;
FPagelinkPrefix : string;
function getTransparentTextBG : boolean;
procedure setTransparentTextBG( value : boolean);
function getPictureDir : string;
procedure setPictureDir( value : string);
function getMultiPage : boolean;
procedure setMultiPage( value : boolean);
function getFinalPage : integer;
procedure setFinalPage( value : integer);
function getFirstLastLinks :boolean;
procedure setFirstLastLinks( value : boolean);
function getPageLinks :boolean;
procedure setPageLinks( value : boolean);
function getConcatenate : boolean;
procedure setConcatenate( value : boolean);
function getConcatCount : integer;
procedure setConcatCount( value : integer);
procedure setLinkFontHeight( value : integer);
function getLinkFontHeight : integer;
function getLinkFontName : string;
procedure setLinkFontName( value : string);
function getPageLength : integer;
procedure setPageLength( value : integer);
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
published
property ImageLinkPrefix : string read FImageLinkPrefix write FImageLinkPrefix;
property PagelinkPrefix : string read FPagelinkPrefix write FPagelinkPrefix;
property PictureDir : string read getPictureDir write setPictureDir;
property MultiPage : boolean read getMultiPage write setMultiPage;
property PageLinks : boolean read getPageLinks write setPageLinks;
//property PageLength : integer read getPageLength write setPageLength;
property FinalPage : integer read getFinalPage write setFinalPage;
property FirstLastLinks : boolean read getFirstLastLinks write setFirstLastLinks;
property Concat : boolean read getConcatenate write setConcatenate;
property ConcatCount : integer read getConcatCount write setConcatCount;
property LinkFontSize : integer read getLinkFontHeight write setLinkFontHeight;
property LinkFontName : string read getLinkFontName write setLinkFontName;
end;
function basename( fname : string ) : string;
implementation
var
HTMTransparentTextBG : boolean;
HTMFinalPage : integer;
HTMPageLength : integer;
HTMMultiPage : boolean;
HTMPageLinks : boolean;
HTMConcatenate : boolean;
HTMConcatCount : integer;
HTMFirstLastLinks : boolean;
HTMPictureDir : string;
HTMLinkFontName : string;
HTMLinkFontHeight : integer;
constructor TQRHTMLFilter.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
QRExportFilterLibrary.AddFilter(TQRGHTMLDocumentFilter);
end;
destructor TQRHTMLFilter.Destroy;
begin
QRExportFilterLibrary.RemoveFilter(TQRGHTMLDocumentFilter);
inherited Destroy;
end;
function TQRHTMLFilter.getTransparentTextBG : boolean;
begin
result := HTMTransparentTextBG;
end;
procedure TQRHTMLFilter.setTransparentTextBG( value : boolean);
begin
HTMTransparentTextBG := value;
end;
function TQRHTMLFilter.getPictureDir : string;
begin
result := HTMPictureDir;
end;
procedure TQRHTMLFilter.setPictureDir( value : string);
begin
HTMPictureDir := value;
end;
function TQRHTMLFilter.getMultiPage : boolean;
begin
result := HTMMultiPage;
end;
procedure TQRHTMLFilter.setMultiPage( value : boolean);
begin
HTMMultiPage := value;
end;
function TQRHTMLFilter.getPageLength : integer;
begin
result := HTMPageLength;
end;
procedure TQRHTMLFilter.setPageLength( value : integer);
begin
HTMPageLength := value;
end;
function TQRHTMLFilter.getFinalPage : integer;
begin
result := HTMFinalPage;
end;
procedure TQRHTMLFilter.setFinalPage( value : integer);
begin
HTMFinalPage := value;
end;
function TQRHTMLFilter.getFirstLastLinks :boolean;
begin
result := HTMFirstLastLinks;
end;
procedure TQRHTMLFilter.setFirstLastLinks( value : boolean);
begin
HTMFirstLastLinks := value;
end;
function TQRHTMLFilter.getPageLinks :boolean;
begin
result := HTMPageLinks;
end;
procedure TQRHTMLFilter.setPageLinks( value : boolean);
begin
HTMPageLinks := value;
end;
function TQRHTMLFilter.getConcatenate : boolean;
begin
result := HTMConcatenate;
end;
procedure TQRHTMLFilter.setConcatenate( value : boolean);
begin
HTMConcatenate := value;
end;
function TQRHTMLFilter.getConcatCount : integer;
begin
result := HTMConcatCount;
end;
procedure TQRHTMLFilter.setConcatCount( value : integer);
begin
HTMConcatCount := value;
end;
procedure TQRHTMLFilter.setLinkFontHeight( value : integer);
begin
HTMLinkFontHeight := value;
end;
function TQRHTMLFilter.getLinkFontHeight : integer;
begin
result := HTMLinkFontHeight;
end;
function TQRHTMLFilter.getLinkFontName : string;
begin
result := HTMLinkFontName;
end;
procedure TQRHTMLFilter.setLinkFontName( value : string);
begin
HTMLinkFontName := value;
end;
{TQRGAbstractExportFilter}
constructor TQRGAbstractExportFilter.Create( filename : string );
begin
inherited Create( filename);
end;
procedure TQRGAbstractExportFilter.AcceptGraphic( Xoff, Yoff : extended; GControl : TControl);
begin
end;
function TQRGAbstractExportFilter.GetFilterName : string;
begin
result := 'QRAbstract'; // Do not translate
end;
function TQRGAbstractExportFilter.GetDescription : string;
begin
Result := '';
end;
function TQRGAbstractExportFilter.GetExtension : string;
begin
Result := '';
end;
procedure TQRGAbstractExportFilter.Start(PaperWidth, PaperHeight : integer; Font : TFont);
begin
CreateStream(Filename);
FFont := TFont.Create;
FActiveFont := TFont.Create;
FFont.Assign(Font);
CharHeight := Font.Size * (254 / 72);
CharWidth := Font.Size * (254 / 72);
FPaperHeight := PaperHeight;
FPaperWidth := PaperWidth;
LineCount := round(PaperHeight / CharHeight);
FPageProcessed := false;
inherited Start(PaperWidth, PaperHeight, Font);
end;
procedure TQRGAbstractExportFilter.CreateStream(Filename : string);
begin
FStream := TFileStream.Create(Filename, fmCreate);
end;
procedure TQRGAbstractExportFilter.CloseStream;
begin
FStream.Free;
end;
procedure TQRGAbstractExportFilter.WriteToStream(const AText : string);
begin
Stream.Write(AText[1], length(AText));
end;
procedure TQRGAbstractExportFilter.WriteLnToStream(const AText : string);
begin
WriteToStream(AText + #13 + #10);
end;
procedure TQRGAbstractExportFilter.Finish;
begin
FFont.Free;
FActiveFont.Free;
CloseStream;
inherited Finish; // doesn't do owt
end;
procedure TQRGAbstractExportFilter.NewPage;
begin
FPageProcessed := False;
FActiveFont.Free;
FActiveFont := TFont.Create;
inherited NewPage;
end;
procedure TQRGAbstractExportFilter.EndPage;
begin
ProcessPage;
inherited EndPage;
end;
procedure TQRGAbstractExportFilter.ProcessPage;
begin
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -