Delphi/FastReport_FMX_2.8.12
Delphi/FastReport_FMX_2.8.12
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
master
FastReport_FMX_2.8.12/LibD28/FMX.frxExportTXT.pas

1542 lines
41 KiB
ObjectPascal
Raw Permalink Normal View History

Init
2024-01-10 21:50:38 +01:00
{******************************************}
{ }
{ FastReport v4.0 }
{ Text advanced export filter }
{ }
{ Copyright (c) 1998-2008 }
{ by Alexander Fediachov, }
{ Fast Reports Inc. }
{ }
{******************************************}
unit frxExportTXT;
interface
{$I fmx.inc}
{$I frx.inc}
{$I fmx.inc}
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, frxClass, frxProgress, Buttons, ComCtrls, Variants, FMX.frxBaseModalForm;
type
TfrxTXTExport = class;
TfrxTXTExportDialog = class(TfrxForm)
OK: TButton;
Cancel: TButton;
Panel1: TPanel;
GroupCellProp: TGroupBox;
GroupPageRange: TGroupBox;
Pages: TLabel;
Descr: TLabel;
E_Range: TEdit;
GroupScaleSettings: TGroupBox;
ScX: TLabel;
Label2: TLabel;
ScY: TLabel;
Label9: TLabel;
E_ScaleX: TEdit;
CB_PageBreaks: TCheckBox;
GroupFramesSettings: TGroupBox;
RB_NoneFrames: TRadioButton;
RB_Simple: TRadioButton;
RB_Graph: TRadioButton;
CB_OEM: TCheckBox;
CB_EmptyLines: TCheckBox;
CB_LeadSpaces: TCheckBox;
CB_PrintAfter: TCheckBox;
Panel2: TPanel;
GroupBox1: TGroupBox;
Label1: TLabel;
Label3: TLabel;
PgHeight: TLabel;
PgWidth: TLabel;
Preview: TMemo;
EPage: TEdit;
PageUpDown: TUpDown;
LBPage: TLabel;
ToolButton1: TSpeedButton;
ToolButton2: TSpeedButton;
BtnPreview: TSpeedButton;
SaveDialog1: TSaveDialog;
UpDown1: TUpDown;
UpDown2: TUpDown;
E_ScaleY: TEdit;
procedure FormCreate(Sender: TObject);
procedure CB_OEMClick(Sender: TObject);
procedure RefreshClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormActivate(Sender: TObject);
procedure E_ScaleXChange(Sender: TObject);
procedure BtnPreviewClick(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure UpDown1Changing(Sender: TObject; var AllowChange: Boolean);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
TxtExp: TfrxTXTExport;
Flag, created, MakeInit, running: Boolean;
printer: Integer;
public
PagesCount: Integer;
Exporter: TfrxTXTExport;
PreviewActive: Boolean;
end;
PfrxTXTStyle = ^TfrxTXTStyle;
TfrxTXTStyle = packed record
Font: TFont;
VAlignment: TfrxVAlign;
HAlignment: TfrxHAlign;
FrameTyp: TfrxFrameTypes;
FrameWidth: Single;
FrameColor: TColor;
FrameStyle: TfrxFrameStyle;
FillColor: TColor;
IsText: Boolean;
end;
TfrxTXTPrinterCommand = {packed} record
Name: String;
SwitchOn: String;
SwitchOff: String;
Trigger: Boolean;
end;
TfrxTXTPrinterType = {packed} record
name: String;
CommCount: Integer;
Commands: array[0..31] of TfrxTXTPrinterCommand;
end;
{$I frxFMX_PlatformsAttribute.inc}
TfrxTXTExport = class(TfrxCustomExportFilter)
private
CurrentPage: Integer;
FirstPage: Boolean;
CurY: Integer;
RX: TList; // TObjCell
RY: TList; // TObjCell
ObjectPos: TList; // TObjPos
PageObj: TList; // TfrxView
StyleList: TList;
CY, LastY: Extended;
frExportSet: TfrxTXTExportDialog;
pgBreakList: TStringList;
expBorders, expBordersGraph, expPrintAfter, expUseSavedProps,
expPrinterDialog, expPageBreaks, expOEM, expEmptyLines,
expLeadSpaces: Boolean;
expCustomFrameSet: String;
expScaleX, expScaleY: Extended;
MaxWidth: Extended;
Scr: array of Char;
ScrWidth: Integer;
ScrHeight: Integer;
PrinterInitString: String;
Stream: TFileStream;
FStripHTMLTags: Boolean;
procedure WriteExpLn(const str: String);
procedure WriteExp(const str: String);
procedure ObjCellAdd(Vector: TList; Value: Extended);
procedure ObjPosAdd(Vector: TList; x, y, dx, dy, obj: Integer);
function CompareStyles(Style1, Style2: PfrxTXTStyle): Boolean;
function FindStyle(Style: PfrxTXTStyle): Integer;
procedure MakeStyleList;
procedure ClearLastPage;
procedure OrderObjectByCells;
procedure ExportPage;
function ChangeReturns(const Str: String): String;
function TruncReturns(const Str: String): String;
procedure AfterExport(const FileName: String);
procedure PrepareExportPage;
procedure DrawMemo(x, y: Integer; dx, dy: Integer; text: String; st: Integer);
procedure FlushScr;
procedure CreateScr(dx, dy: Integer);
procedure FreeScr;
procedure ScrType(x, y: Integer; c: Char);
function ScrGet(x, y: Integer): Char;
procedure ScrString(x, y: Integer; const s: String);
procedure FormFeed;
function MakeInitString: String;
public
PrintersCount: Integer;
PrinterTypes: array [0..15] of TfrxTXTPrinterType;
SelectedPrinterType: Integer;
PageWidth, PageHeight: Integer;
IsPreview: Boolean;
Copys: Integer;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ShowModal: TModalResult; override;
function Start: Boolean; override;
procedure Finish; override;
procedure FinishPage(Page: TfrxReportPage; Index: Integer); override;
procedure StartPage(Page: TfrxReportPage; Index: Integer); override;
procedure ExportObject(Obj: TfrxComponent); override;
class function GetDescription: String; override;
function RegisterPrinterType(const Name: String):Integer;
procedure RegisterPrinterCommand(PrinterIndex: Integer;
const Name, switch_on, switch_off: String);
procedure LoadPrinterInit(const FName: String);
procedure SavePrinterInit(const FName: String);
procedure SpoolFile(const FileName: String);
published
property ScaleWidth: Extended read expScaleX write expScaleX;
property ScaleHeight: Extended read expScaleY write expScaleY;
property Borders: Boolean read expBorders write expBorders;
property Pseudogrpahic: Boolean read expBordersGraph write expBordersGraph;
property PageBreaks: Boolean read expPageBreaks write expPageBreaks;
property OEMCodepage: Boolean read expOEM write expOEM;
property EmptyLines: Boolean read expEmptyLines write expEmptyLines;
property LeadSpaces: Boolean read expLeadSpaces write expLeadSpaces;
property PrintAfter: Boolean read expPrintAfter write expPrintAfter;
property PrinterDialog: Boolean read expPrinterDialog write expPrinterDialog;
property UseSavedProps: Boolean read expUseSavedProps write expUseSavedProps;
property InitString: String read PrinterInitString write PrinterInitString;
property CustomFrameSet: String read expCustomFrameSet write expCustomFrameSet;
property StripHTMLTags: Boolean read FStripHTMLTags write FStripHTMLTags default False;
end;
implementation
uses frxUtils, frxprinter, Printers, Winspool, frxExportTxtPrn,
frxFileUtils, frxres, frxrcExports;
{$R *.dfm}
type
PObjCell = ^TObjCell;
TObjCell = packed record
Value: Extended;
Count: Integer;
end;
PObjPos = ^TObjPos;
TObjPos = packed record
obj: Integer;
x,y: Integer;
dx, dy: Integer;
style: Integer;
end;
const
Xdivider = 7;
Ydivider = 8;
FrameSet: array [1..2] of String = (
// frameset: vertical, horizontal, up-left corner, up-right corner
// down-left corner, down-right corner, down tap, left tap,
// up tap, right tap, cross
'|-+++++++++',
#179#196#218#191#192#217#193#195#194#180#197 );
EpsonCommCnt = 12;
Epson: array [0..EpsonCommCnt - 1, 0..2] of String = (
('Reset', #27#64, ''),
('Normal', #27#120#00, ''),
('Pica', #27#120#01#27#107#00, ''),
('Elite', #27#120#01#27#107#01, ''),
('Condensed', #15, #18),
('Bold', #27#71, #27#72),
('Italic', #27#52, #27#53),
('Wide', #27#87#01, #27#87#00),
('12cpi', #27#77, #27#80),
('Linefeed 1/8"', #27#48, ''),
('Linefeed 7/72"', #27#49, ''),
('Linefeed 1/6"', #27#50, ''));
HPCommCnt = 6;
HPComm: array [0..HPCommCnt - 1, 0..2] of String = (
('Reset', #27#69, ''),
('Landscape orientation', #27#38#108#49#79, #27#38#108#48#79),
('Italic', #27#40#115#49#83, #27#40#115#48#83),
('Bold', #27#40#115#51#66, #27#40#115#48#66),
('Draft EconoMode', #27#40#115#49#81, #27#40#115#50#81),
('Condenced', #27#40#115#49#50#72#27#38#108#56#68, #27#40#115#49#48#72));
IBMCommCnt = 8;
IBMComm: array [0..IBMCommCnt - 1, 0..2] of String = (
('Reset', #27#64, ''),
('Normal', #27#120#00, ''),
('Pica', #27#48#73, ''),
('Elite', #27#56#73, ''),
('Condensed', #15, #18),
('Bold', #27#71, #27#72),
('Italic', #27#52, #27#53),
('12cpi', #27#77, #27#80));
function ComparePoints(Item1, Item2: Pointer): Integer;
begin
if PObjCell(Item1).Value > PObjCell(Item2).Value then
Result := 1
else if PObjCell(Item1).Value < PObjCell(Item2).Value then
Result := -1
else
Result := 0;
end;
function CompareObjects(Item1, Item2: Pointer): Integer;
var
m1, m2: TfrxView;
Res: Extended;
begin
m1 := TfrxView(Item1);
m2 := TfrxView(Item2);
Res := m1.Top - m2.Top;
if Res = 0 then
Res := m1.Left - m2.Left;
if Res = 0 then
if (m1 is TfrxCustomMemoView) and (m2 is TfrxCustomMemoView) then
Res := Length(TfrxMemoView(m1).Memo.Text) - Length(TfrxMemoView(m2).Memo.Text);
if Res > 0 then
Result := 1
else if Res < 0 then
Result := -1
else
Result := 0;
end;
class function TfrxTXTExport.GetDescription: String;
begin
Result := frxResources.Get('TextExport');
end;
constructor TfrxTXTExport.Create(AOwner: TComponent);
var
i: Integer;
begin
inherited Create(AOwner);
RX := TList.Create;
RY := TList.Create;
PageObj := TList.Create;
ObjectPos := TList.Create;
StyleList := TList.Create;
pgBreakList := TStringList.Create;
ShowDialog := True;
expBorders := False;
expPageBreaks := True;
expScaleX := 1.0;
expScaleY := 1.0;
expBordersGraph := False;
expOEM := False;
expEmptyLines := False;
expLeadSpaces := False;
PrinterInitString := '';
PageWidth := 0;
PageHeight := 0;
IsPreview := False;
expPrintAfter := False;
expUseSavedProps := True;
expPrinterDialog := True;
PrintersCount := 0;
SelectedPrinterType := 0;
expCustomFrameSet := '';
FilterDesc := frxGet(8801);
DefaultExt := frxGet(8802);
Copys := 1;
FStripHTMLTags := False;
/// printer registration
RegisterPrinterType('NONE');
RegisterPrinterType('EPSON ESC/P2 Matrix/Stylus)');
for i := 0 to EpsonCommCnt - 1 do
RegisterPrinterCommand(1, Epson[i, 0], Epson[i, 1], Epson[i, 2]);
RegisterPrinterType('HP PCL (LaserJet/DeskJet)');
for i := 0 to HPCommCnt - 1 do
RegisterPrinterCommand(2, HPComm[i, 0], HPComm[i, 1], HPComm[i, 2]);
RegisterPrinterType('CANON/IBM (Matrix)');
for i := 0 to IBMCommCnt - 1 do
RegisterPrinterCommand(3, IBMComm[i, 0], IBMComm[i, 1], IBMComm[i, 2]);
end;
destructor TfrxTXTExport.Destroy;
begin
ClearLastPage;
RX.Free;
RY.Free;
PageObj.Free;
ObjectPos.Free;
StyleList.Free;
pgBreakList.Free;
inherited;
end;
function TfrxTXTExport.TruncReturns(const Str: String): String;
begin
Result := StringReplace(Str, #1, '', [rfReplaceAll]);
if Copy(Result, Length(Result) - 1, 2) = #13#10 then
Delete(Result, Length(Result) - 1, 2);
end;
function TfrxTXTExport.ChangeReturns(const Str: String): String;
begin
Result := StringReplace(Str, #1, '', [rfReplaceAll]);
end;
procedure TfrxTXTExport.ClearLastPage;
var
i: Integer;
begin
PageObj.Clear;
for i := 0 to StyleList.Count - 1 do
begin
PfrxTXTStyle(StyleList[i]).Font.Free;
FreeMemory(PfrxTXTStyle(StyleList[i]));
end;
StyleList.Clear;
for i := 0 to RX.Count - 1 do FreeMem(PObjCell(RX[i]));
RX.Clear;
for i := 0 to RY.Count - 1 do FreeMem(PObjCell(RY[i]));
RY.Clear;
for i := 0 to ObjectPos.Count - 1 do FreeMem(PObjPos(ObjectPos[i]));
ObjectPos.Clear;
end;
procedure TfrxTXTExport.ObjCellAdd(Vector: TList; Value: Extended);
var
ObjCell: PObjCell;
i, cnt: Integer;
exist: Boolean;
begin
exist := False;
if Vector.Count > 0 then
begin
if Vector.Count > 100 then
cnt := Vector.Count - 100 else
cnt := 0;
for i := Vector.Count - 1 downto cnt do
if Round(PObjCell(Vector[i]).Value) = Round(Value) then
begin
exist := True;
break;
end;
end;
if not exist then
begin
GetMem(ObjCell, SizeOf(TObjCell));
ObjCell.Value := Value;
ObjCell.Count := 0;
Vector.Add(ObjCell);
end;
end;
procedure TfrxTXTExport.ObjPosAdd(Vector: TList; x, y, dx, dy, obj: Integer);
var
ObjPos: PObjPos;
begin
GetMem(ObjPos, SizeOf(TObjPos));
ObjPos.x := x;
ObjPos.y := y;
ObjPos.dx := dx;
ObjPos.dy := dy;
ObjPos.obj := Obj;
Vector.Add(ObjPos);
end;
procedure TfrxTXTExport.OrderObjectByCells;
var
obj, c, fx, fy, dx, dy, mi: integer;
m, curx, cury: Extended;
begin
for obj := 0 to PageObj.Count - 1 do
begin
fx := 0; fy := 0;
dx := 1; dy := 1;
for c := 0 to RX.Count - 1 do
if Round(PObjCell(RX[c]).Value) = Round(TfrxView(PageObj[obj]).Left) then
begin
fx := c;
m := TfrxView(PageObj[obj]).Left;
mi := c + 1;
curx := TfrxView(PageObj[obj]).Left + TfrxView(PageObj[obj]).Width;
while Round(m) < Round(curx) do
begin
m := m + PObjCell(RX[mi]).Value - PObjCell(RX[mi - 1]).Value;
inc(mi);
end;
dx := mi - c - 1;
break;
end;
for c := 0 to RY.Count - 1 do
if Round(PObjCell(RY[c]).Value) = Round(TfrxView(PageObj[obj]).Top) then
begin
fy := c;
m := TfrxView(PageObj[obj]).Top;
mi := c + 1;
cury := TfrxView(PageObj[obj]).Top + TfrxView(PageObj[obj]).Height;
while Round(m) < Round(cury) do
begin
m := m + PObjCell(RY[mi]).Value - PObjCell(RY[mi - 1]).Value;
inc(mi);
end;
dy := mi - c - 1;
break;
end;
ObjPosAdd(ObjectPos, fx, fy, dx, dy, obj);
end;
end;
function TfrxTXTExport.CompareStyles(Style1, Style2: PfrxTXTStyle): Boolean;
begin
if Style1.IsText and Style2.IsText then
begin
Result := (Style1.Font.Color = Style2.Font.Color) and
(Style1.Font.Name = Style2.Font.Name) and
(Style1.Font.Size = Style2.Font.Size) and
(Style1.Font.Style = Style2.Font.Style) and
(Style1.Font.Charset = Style2.Font.Charset) and
(Style1.VAlignment = Style2.VAlignment) and
(Style1.HAlignment = Style2.HAlignment) and
(Style1.FrameTyp = Style2.FrameTyp) and
(Style1.FrameWidth = Style2.FrameWidth) and
(Style1.FrameColor = Style2.FrameColor) and
(Style1.FrameStyle = Style2.FrameStyle) and
(Style1.FillColor = Style2.FillColor);
end
else if (not Style1.IsText) and (not Style2.IsText) then
begin
Result := (Style1.VAlignment = Style2.VAlignment) and
(Style1.HAlignment = Style2.HAlignment) and
(Style1.FrameTyp = Style2.FrameTyp) and
(Style1.FrameWidth = Style2.FrameWidth) and
(Style1.FrameColor = Style2.FrameColor) and
(Style1.FrameStyle = Style2.FrameStyle) and
(Style1.FillColor = Style2.FillColor);
end
else
Result := False;
end;
function TfrxTXTExport.FindStyle(Style: PfrxTXTStyle): Integer;
var
i: Integer;
begin
Result := -1;
for i := 0 to StyleList.Count - 1 do
if CompareStyles(Style, PfrxTXTStyle(StyleList[i])) then
Result := i;
end;
procedure TfrxTXTExport.MakeStyleList;
var
i, j, k: Integer;
obj: TfrxView;
style: PfrxTXTStyle;
begin
j := 0;
for i := 0 to ObjectPos.Count - 1 do
begin
obj := PageObj[PObjPos(ObjectPos[i]).obj];
style := AllocMem(SizeOf(TfrxTXTStyle));
if obj is TfrxCustomMemoView then
begin
style.Font := TFont.Create;
style.Font.Assign(TfrxMemoView(obj).Font);
style.VAlignment := TfrxMemoView(obj).VAlign;
style.HAlignment := TfrxMemoView(obj).HAlign;
style.IsText := True;
end
else
begin
style.Font := nil;
style.IsText := False;
end;
style.FrameTyp := obj.Frame.Typ;
style.FrameWidth := obj.Frame.Width;
style.FrameColor := obj.Frame.Color;
style.FrameStyle := obj.Frame.Style;
style.FillColor := obj.Color;
k := FindStyle(Style);
if k = -1 then
begin
StyleList.Add(style);
PObjPos(ObjectPos[i]).style := j;
j := j + 1;
end
else
begin
PObjPos(ObjectPos[i]).style := k;
Style.Font.Free;
FreeMemory(Style);
end;
end;
end;
function StrToOem(const AnsiStr: AnsiString): AnsiString;
begin
SetLength(Result, Length(AnsiStr));
if Length(Result) > 0 then
CharToOemBuffA(PAnsiChar(AnsiStr), PAnsiChar(Result), Length(Result));
end;
function MakeStr(C: Char; N: Integer): String;
begin
if N < 1 then
Result := ''
else
begin
SetLength(Result, N);
FillChar(Result[1], Length(Result), C);
end;
end;
function AddChar(C: Char; const S: String; N: Integer): String;
begin
if Length(S) < N then
Result := MakeStr(C, N - Length(S)) + S else
Result := S;
end;
function AddCharR(C: Char; const S: String; N: Integer): String;
begin
if Length(S) < N then
Result := S + MakeStr(C, N - Length(S)) else
Result := S;
end;
function LeftStr(const S: String; N: Integer): String;
begin
Result := AddCharR(' ', S, N);
end;
function RightStr(const S: String; N: Integer): String;
begin
Result := AddChar(' ', S, N);
end;
function CenterStr(const S: String; Len: Integer): String;
begin
if Length(S) < Len then
begin
Result := MakeStr(' ', (Len div 2) - (Length(S) div 2)) + S;
Result := Result + MakeStr(' ', Len - Length(Result));
end
else
Result := S;
end;
const
Delims = [' ', #9, '-'];
function WrapTxt(s: String; dx, dy: Integer): String;
var
i, j, k: Integer;
buf1, buf2: String;
begin
i := 0;
buf2 := s;
Result := '';
while (i < dy) and (Length(Buf2) > 0) do
begin
if Length(buf2) > dx then
begin
if buf2[dx + 1] = #10 then
buf1 := copy(buf2, 1, dx + 1)
else if buf2[dx + 1] = #13 then
buf1 := copy(buf2, 1, dx + 2)
else
buf1 := copy(buf2, 1, dx)
end
else
begin
Result := Result + buf2;
break;
end;
k := Pos(#13#10, buf1);
if k > 0 then
j := k + 1
else if Length(Buf1) < dx then
begin
j := Length(Buf1);
k := 1;
end
else
j := dx;
if (not (buf2[dx + 1] in Delims)) or (k > 0) then
begin
if k = 0 then
while (j > 0) and (not (buf1[j] in Delims)) do
Dec(j);
if j > 0 then
begin
buf1 := copy(buf1, 1, j);
buf2 := copy(buf2, j + 1, Length(buf2) - j)
end
else
buf2 := copy(buf2, dx + 1, Length(buf2) - dx);
end
else
buf2 := copy(buf2, dx + 2, Length(buf2) - dx - 1);
i := i + 1;
Result := Result + buf1;
if k = 0 then
Result := Result + #13#10;
end;
end;
procedure TfrxTXTExport.WriteExpLn(const str: String);
var
ln: AnsiString;
TmpB: AnsiString;
begin
if Length(str) > 0 then
begin
if Length(str) > PageWidth then
PageWidth := Length(str);
Inc(PageHeight);
TmpB := AnsiString(str);
Stream.Write(TmpB[1], Length(TmpB));
ln := #13#10;
Stream.Write(ln[1], Length(ln));
end
else if expEmptyLines then
begin
ln := #13#10;
Inc(PageHeight);
Stream.Write(ln[1], Length(ln));
end;
end;
procedure TfrxTXTExport.WriteExp(const str: String);
var
TmpB: AnsiString;
begin
TmpB := AnsiString(str);
if Length(TmpB) > 0 then
Stream.Write(TmpB[1], Length(TmpB));
end;
procedure TfrxTXTExport.CreateScr(dx, dy: Integer);
var
i, j: Integer;
begin
ScrWidth := dx;
ScrHeight := dy;
Initialize(Scr);
SetLength(Scr, ScrWidth * ScrHeight);
for i := 0 to ScrHeight - 1 do
for j := 0 to ScrWidth - 1 do
Scr[i * ScrWidth + j] := ' ';
end;
procedure TfrxTXTExport.ScrString(x, y: Integer; const s: String);
var
i: Integer;
begin
for i := 0 to Length(s) - 1 do
ScrType(x + i, y, s[i + 1]);
end;
function TfrxTXTExport.ScrGet(x, y: Integer): Char;
begin
if (x < ScrWidth) and (y < ScrHeight) and
(x >= 0) and (y >= 0) then
Result := Scr[ScrWidth * y + x] else
Result := ' ';
end;
procedure TfrxTXTExport.DrawMemo(x, y, dx, dy: Integer; text: String;
st: Integer);
var
i, sx, sy, lines: Integer;
buf: String;
style: PfrxTXTStyle;
f: String;
function AlignBuf: String;
begin
if (style.HAlignment = haLeft) then
buf := LeftStr(buf, dx - 1)
else if (style.HAlignment = haRight) then
buf := RightStr(buf, dx - 1)
else if (style.HAlignment = haCenter) then
buf := CenterStr(buf, dx - 1)
else
buf := LeftStr(buf, dx - 1);
if expOEM then
buf := String(StrToOem(AnsiString(buf)));
Result := buf;
end;
begin
style := PfrxTXTStyle(StyleList[st]);
if (Style.FrameTyp <> []) and expBorders then
begin
if Length(expCustomFrameSet) > 0 then
f := CustomFrameSet
else if expBordersGraph then
f := FrameSet[2]
else
f := FrameSet[1];
if (ScrGet(x + 1, y) in [f[1], f[3], f[4]]) then
begin
Inc(x);
Dec(dx);
end
else if (ScrGet(x - 1, y) in [f[1], f[3], f[4]]) then
begin
Dec(x);
Inc(dx);
end;
if (ftLeft in Style.FrameTyp) then
for i := 0 to dy do
if i = 0 then
ScrType(x, y + i, f[3])
else if i = dy then
ScrType(x, y + i, f[5])
else
ScrType(x, y + i, f[1]);
if (ftRight in Style.FrameTyp) then
for i := 0 to dy do
if i = 0 then
ScrType(x + dx, y + i, f[4])
else if i = dy then
ScrType(x + dx, y + i, f[6])
else
ScrType(x + dx, y + i, f[1]);
if (ftTop in Style.FrameTyp) then
for i := 0 to dx do
if i = 0 then
ScrType(x + i, y, f[3])
else if i = dx then
ScrType(x + i, y, f[4])
else
ScrType(x + i, y, f[2]);
if (ftBottom in Style.FrameTyp) then
for i := 0 to dx do
if i = 0 then
ScrType(x + i, y + dy, f[5])
else if i = dx then
ScrType(x + i, y + dy, f[6])
else
ScrType(x + i, y + dy, f[2]);
end;
text := WrapTxt(text, dx - 1, dy - 1);
text := StringReplace(text, #13#10, #13, [rfReplaceAll]);
lines := 1;
for i := 0 to Length(text) - 1 do
if text[i + 1] = #13 then
Inc(lines);
sx := x;
if (style.VAlignment = vaBottom) then
sy := y + dy - lines - 1
else if (style.VAlignment = vaCenter) then
sy := y + (dy - lines - 1) div 2
else
sy := y;
buf := '';
for i := 0 to Length(text) - 1 do
if text[i + 1] = #13 then
begin
Inc(sy);
if sy > (y + dy) then
break;
ScrString(sx + 1, sy, AlignBuf);
buf := '';
end
else
begin
buf := buf + text[i + 1];
end;
if buf <> '' then
ScrString(sx + 1, sy + 1, AlignBuf);
end;
procedure TfrxTXTExport.FlushScr;
var
i, j, cnt, maxcnt: Integer;
buf: String;
f: String;
c: Char;
function IsLine(c: Char): Boolean;
begin
Result := (c in [f[1], f[2]]);
end;
function IsConner(c: Char): Boolean;
begin
Result := (c in [f[3], f[4], f[5], f[6], f[7], f[8], f[9], f[10], f[11]]);
end;
function IsFrame(c: Char): Boolean;
begin
Result := IsLine(c) or IsConner(c);
end;
function FrameOpt(c: Char; x, y: Integer; f: String): Char;
begin
if (not IsLine(ScrGet(x - 1, y))) and
(not IsLine(ScrGet(x + 1, y))) and
(not IsLine(ScrGet(x, y - 1))) and
(IsLine(ScrGet(x, y + 1))) then
Result := f[1]
else if (not IsLine(ScrGet(x - 1, y))) and
(not IsLine(ScrGet(x + 1, y))) and
(IsLine(ScrGet(x, y - 1))) and
(not IsLine(ScrGet(x, y + 1))) then
Result := f[1]
else if (not IsLine(ScrGet(x - 1, y))) and
(IsLine(ScrGet(x + 1, y))) and
(not IsLine(ScrGet(x, y - 1))) and
(not IsLine(ScrGet(x, y + 1))) then
Result := f[2]
else if (not IsLine(ScrGet(x + 1, y))) and
(IsLine(ScrGet(x - 1, y))) and
(not IsLine(ScrGet(x, y - 1))) and
(not IsLine(ScrGet(x, y + 1))) then
Result := f[2]
else if (not IsFrame(ScrGet(x + 1, y))) and
(not IsFrame(ScrGet(x - 1, y))) and
(ScrGet(x, y + 1) = f[1]) and
(ScrGet(x, y - 1) = f[1]) then
Result := f[1]
else if (ScrGet(x + 1, y) = f[2]) and
(ScrGet(x - 1, y) = f[2]) and
(not IsFrame(ScrGet(x, y + 1))) and
(not IsFrame(ScrGet(x, y - 1))) then
Result := f[2]
else if (ScrGet(x + 1, y) = f[2]) and
(ScrGet(x - 1, y) = f[2]) and
(ScrGet(x, y + 1) = f[1]) and
(ScrGet(x, y - 1) = f[1]) then
Result := f[11]
else if (ScrGet(x + 1, y) = f[2]) and
(ScrGet(x - 1, y) = f[2]) and
(ScrGet(x, y + 1) = f[1]) and
(ScrGet(x, y - 1) <> f[1]) then
Result := f[9]
else if (ScrGet(x + 1, y) = f[2]) and
(ScrGet(x - 1, y) = f[2]) and
(ScrGet(x, y - 1) = f[1]) and
(ScrGet(x, y + 1) <> f[1]) then
Result := f[7]
else if (ScrGet(x, y - 1) = f[1]) and
(ScrGet(x, y + 1) = f[1]) and
(ScrGet(x + 1, y) = f[2]) and
(ScrGet(x - 1, y) <> f[2])then
Result := f[8]
else if (ScrGet(x, y - 1) = f[1]) and
(ScrGet(x, y + 1) = f[1]) and
(ScrGet(x - 1, y) = f[2]) and
(ScrGet(x + 1, y) <> f[2])then
Result := f[10]
else if (ScrGet(x + 1, y) = f[2]) and
(ScrGet(x - 1, y) <> f[2]) and
(ScrGet(x, y + 1) = f[1]) and
(ScrGet(x, y - 1) <> f[1]) then
Result := f[3]
else if (ScrGet(x + 1, y) = f[2]) and
(ScrGet(x - 1, y) <> f[2]) and
(ScrGet(x, y + 1) <> f[1]) and
(ScrGet(x, y - 1) = f[1]) then
Result := f[5]
else if (ScrGet(x + 1, y) <> f[2]) and
(ScrGet(x - 1, y) = f[2]) and
(ScrGet(x, y + 1) <> f[1]) and
(ScrGet(x, y - 1) = f[1]) then
Result := f[6]
else if (ScrGet(x + 1, y) <> f[2]) and
(ScrGet(x - 1, y) = f[2]) and
(ScrGet(x, y + 1) = f[1]) and
(ScrGet(x, y - 1) <> f[1]) then
Result := f[4]
else
Result := c;
end;
begin
if expBorders then
begin
if Length(expCustomFrameSet) > 0 then
f := CustomFrameSet
else if expBordersGraph then
f := FrameSet[2]
else
f := FrameSet[1];
for i := 0 to ScrHeight - 1 do
for j := 0 to ScrWidth - 1 do
begin
c := Scr[i * ScrWidth + j];
if IsConner(c) then
Scr[i * ScrWidth + j] := FrameOpt(c, j, i, f);
end;
end;
if not expLeadSpaces then
begin
maxcnt := 99999;
for i := 0 to ScrHeight - 1 do
begin
cnt := 0;
for j := 0 to ScrWidth - 1 do
if (Scr[i * ScrWidth + j] = ' ') then
Inc(cnt) else
break;
if cnt < maxcnt then
maxcnt := cnt;
end;
end
else
maxcnt := 0;
for i := 0 to ScrHeight - 1 do
begin
buf := '';
for j := 0 to ScrWidth - 1 do
buf := buf + Scr[i * ScrWidth + j];
buf := TrimRight(buf);
if (maxcnt > 0) then
buf := Copy(buf, maxcnt + 1, Length(buf) - maxcnt);
WriteExpLn(buf);
end;
end;
procedure TfrxTXTExport.FreeScr;
begin
Finalize(Scr);
ScrHeight := 0;
ScrWidth := 0;
end;
procedure TfrxTXTExport.ScrType(x,y: Integer; c: Char);
var
i: Integer;
begin
i := ScrWidth * y + x;
if (not expOEM) and (c = #160) then
c := ' ';
Scr[i] := c;
end;
procedure TfrxTXTExport.ExportPage;
var
i, x, y: Integer;
s: String;
obj: TfrxMemoView;
begin
i := 0;
CreateScr(Round(expScaleX * MaxWidth / Xdivider) + 10, Round(expScaleY * LastY / Ydivider) + 2);
for y := 1 to RY.Count - 1 do
begin
for x := 1 to RX.Count - 1 do
if i < ObjectPos.Count then
if ((PObjPos(ObjectPos[i]).y + CurY + 1) = y) and
((PObjPos(ObjectPos[i]).x + 1) = x) then
begin
Obj := TfrxMemoView(PageObj[PObjPos(ObjectPos[i]).obj]);
s := ChangeReturns(TruncReturns(Obj.Memo.Text));
DrawMemo(Round(expScaleX * obj.Left / Xdivider),
Round(expScaleY * obj.Top / Ydivider),
Round(expScaleX * obj.Width / Xdivider),
Round(expScaleY * obj.Height / Ydivider),
s, PObjPos(ObjectPos[i]).style);
Obj.Free;
Inc(i);
end;
end;
FlushScr;
FreeScr;
end;
function TfrxTXTExport.ShowModal: TModalResult;
var
preview: Boolean;
begin
if ShowDialog then
begin
preview := False;
frExportSet := TfrxTXTExportDialog.Create(nil);
frExportSet.Exporter := Self;
frExportSet.CB_PrintAfter.Visible := not SlaveExport;
if SlaveExport then
expPrintAfter := False;
if FileName = '' then
frExportSet.SaveDialog1.FileName := ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(Report.FileName)), frExportSet.SaveDialog1.DefaultExt)
else
frExportSet.SaveDialog1.FileName := FileName;
if OverwritePrompt then
with frExportSet.SaveDialog1 do
Options := Options + [ofOverwritePrompt];
frExportSet.PreviewActive := false;
frExportSet.RB_Graph.Checked := expBordersGraph;
frExportSet.RB_NoneFrames.Checked := not expBorders;
frExportSet.RB_Simple.Checked := expBorders and (not expBordersGraph);
frExportSet.CB_PageBreaks.Checked := expPageBreaks;
frExportSet.CB_OEM.Checked := expOEM;
frExportSet.CB_EmptyLines.Checked := expEmptyLines;
frExportSet.CB_LeadSpaces.Checked := expLeadSpaces;
frExportSet.UpDown1.Position := StrToInt(IntToStr(Round(expScaleX * 100)));
frExportSet.UpDown2.Position := StrToInt(IntToStr(Round(expScaleY * 100)));
frExportSet.CB_PrintAfter.Checked := expPrintAfter;
frExportSet.PreviewActive := preview;
frExportSet.PagesCount := Report.PreviewPages.Count;
Result := frExportSet.ShowModal;
PeekLastModalResult;
if Result = mrOk then
begin
PageNumbers := frExportSet.E_Range.Text;
expBorders := not frExportSet.RB_NoneFrames.Checked;
expBordersGraph := frExportSet.RB_Graph.Checked;
expPageBreaks := frExportSet.CB_PageBreaks.Checked;
expOEM := frExportSet.CB_OEM.Checked;
expEmptyLines := frExportSet.CB_EmptyLines.Checked;
expLeadSpaces := frExportSet.CB_LeadSpaces.Checked;
expScaleX := StrToInt(frExportSet.E_ScaleX.Text) / 100;
expScaleY := StrToInt(frExportSet.E_ScaleY.Text) / 100;
expPrintAfter := frExportSet.CB_PrintAfter.Checked;
if frExportSet.MakeInit then
begin
SelectedPrinterType := frExportSet.printer;
MakeInitString;
end;
if DefaultPath <> '' then
frExportSet.SaveDialog1.InitialDir := DefaultPath;
if not SlaveExport then
begin
if frExportSet.SaveDialog1.Execute then
begin
FileName := frExportSet.SaveDialog1.Filename;
end
else
Result := mrCancel;
PeekLastModalResult;
end
end;
frExportSet.Free;
end
else
Result := mrOk;
end;
function TfrxTXTExport.Start: Boolean;
begin
if SlaveExport then
begin
if Report.FileName <> '' then
FileName := ChangeFileExt(GetTemporaryFolder + ExtractFileName(Report.FileName), frxGet(8326))
else
FileName := ChangeFileExt(GetTempFile, frxGet(8326))
end;
CurrentPage := 0;
FirstPage := True;
ClearLastPage;
if not IsPreview then
WriteExp(PrinterInitString);
pgBreakList.Clear;
if FileName <> '' then
begin
if (ExtractFilePath(FileName) = '') and (DefaultPath <> '') then
FileName := DefaultPath + '\' + FileName;
Stream := TFileStream.Create(FileName, fmCreate);
Result := True
end
else
Result := False;
end;
procedure TfrxTXTExport.StartPage(Page: TfrxReportPage; Index: Integer);
begin
Inc(CurrentPage);
MaxWidth := 0;
LastY := 0;
CY := 0;
CurY := 0;
PageWidth := 0;
PageHeight := 0;
end;
procedure TfrxTXTExport.ExportObject(Obj: TfrxComponent);
var
MemoView: TfrxMemoView;
maxy: Extended;
begin
if Obj is TfrxCustomMemoView then
begin
if ((TfrxMemoView(Obj).Memo.Count > 0) or (TfrxMemoView(Obj).Frame.Typ <> [])) then
begin
MemoView := TfrxMemoView.Create(nil);
MemoView.Assign(Obj);
MemoView.Left := Obj.AbsLeft;
MemoView.Top := Obj.AbsTop + CY;
MemoView.Width := Obj.Width;
MemoView.Height := Obj.Height;
MemoView.Font.Assign(Obj.Font); // added by Samuel Herzog
if StripHTMLTags then
MemoView.Text := MemoView.WrapText(False);
PageObj.Add(MemoView);
ObjCellAdd(RX, Obj.AbsLeft);
ObjCellAdd(RX, Obj.AbsLeft + Obj.Width);
ObjCellAdd(RY, Obj.AbsTop + CY);
ObjCellAdd(RY, Obj.AbsTop + Obj.Height + CY);
end;
end;
if Obj.AbsLeft + Obj.Width > MaxWidth then
MaxWidth := Obj.AbsLeft + Obj.Width;
maxy := Obj.AbsTop + Obj.Height + CY;
if maxy > LastY then
LastY := maxy;
end;
procedure TfrxTXTExport.FinishPage(Page: TfrxReportPage; Index: Integer);
begin
PrepareExportPage;
ExportPage;
if expPageBreaks then
FormFeed;
ClearLastPage;
end;
procedure TfrxTXTExport.Finish;
begin
if (not expPageBreaks) and (not IsPreview) then
FormFeed;
Stream.Free;
AfterExport(FileName);
end;
procedure TfrxTXTExport.SpoolFile(const FileName: String);
const
BUF_SIZE = 1024;
var
f: TFileStream;
buf: String;
l: longint;
begin
frxPrinters.Printer.Title := FileName;
frxPrinters.Printer.BeginRAWDoc;
f := TFileStream.Create(FileName, fmOpenRead);
SetLength(buf, BUF_SIZE);
l := BUF_SIZE;
while l = BUF_SIZE do
begin
l := f.Read(buf[1], BUF_SIZE);
SetLength(buf, l);
frxPrinters.Printer.WriteRAWDoc(buf);
end;
f.Free;
frxPrinters.Printer.EndRAWDoc;
DeleteFile(FileName);
end;
function GetTempFName: String;
var
Path: String[64];
FileName: String[255];
begin
Path[0] := AnsiChar(Chr(GetTempPath(64, PWideChar(@Path[1]))));
GetTempFileName(@Path[1], PChar('fr'), 0, @FileName[1]);
Result := StrPas(PWideChar(@FileName[1]));
end;
procedure TfrxTXTExport.AfterExport(const FileName: String);
var
i: Integer;
fname: String;
f, ffrom: TFileStream;
begin
if expPrintAfter then
begin
if Printer.Printers.Count = 0 then Exit;
if expPrinterDialog then
with TfrxPrnInit.Create(Self) do
begin
i := ShowModal;
if i = mrOk then
Copys := UpDown1.Position;
Free;
end
else
i := mrOk;
if i = mrOk then
begin
MakeInitString;
fname := GetTempFName;
f := TFileStream.Create(fname, fmCreate);
ffrom := TFileStream.Create(FileName, fmOpenRead);
f.Write(PrinterInitString[1], Length(PrinterInitString));
f.CopyFrom(ffrom, 0);
f.Free;
ffrom.Free;
f := TFileStream.Create(FileName, fmCreate);
ffrom := TFileStream.Create(fname, fmOpenRead);
f.CopyFrom(ffrom, 0);
f.Free;
ffrom.Free;
DeleteFile(fname);
for i := 1 to Copys do
SpoolFile(FileName);
end;
end;
end;
procedure TfrxTXTExport.PrepareExportPage;
begin
RX.Sort(@ComparePoints);
RY.Sort(@ComparePoints);
PageObj.Sort(@CompareObjects);
OrderObjectByCells;
MakeStyleList;
end;
function TfrxTXTExport.MakeInitString: String;
var
i: Integer;
begin
if PrintersCount > 0 then
begin
PrinterInitString := '';
for i := 0 to PrinterTypes[SelectedPrinterType].CommCount - 1 do
if PrinterTypes[SelectedPrinterType].Commands[i].Trigger then
PrinterInitString := PrinterInitString +
PrinterTypes[SelectedPrinterType].Commands[i].SwitchOn
else
PrinterInitString := PrinterInitString +
PrinterTypes[SelectedPrinterType].Commands[i].SwitchOff;
end;
end;
procedure TfrxTXTExport.RegisterPrinterCommand(PrinterIndex: Integer;
const Name, switch_on, switch_off: String);
var
i: Integer;
begin
i := PrinterTypes[PrinterIndex].CommCount;
PrinterTypes[PrinterIndex].Commands[i].Name := Name;
PrinterTypes[PrinterIndex].Commands[i].SwitchOn := Switch_On;
PrinterTypes[PrinterIndex].Commands[i].SwitchOff := Switch_Off;
PrinterTypes[PrinterIndex].Commands[i].Trigger := False;
Inc(PrinterTypes[PrinterIndex].CommCount);
end;
function TfrxTXTExport.RegisterPrinterType(const Name: String): Integer;
begin
PrinterTypes[PrintersCount].Name := Name;
PrinterTypes[PrintersCount].CommCount := 0;
Inc(PrintersCount);
Result := PrintersCount - 1;
end;
procedure TfrxTXTExport.LoadPrinterInit(const FName: String);
var
f: TextFile;
i: Integer;
buf: String;
b: Boolean;
begin
{$I-}
AssignFile(f, FName);
Reset(f);
ReadLn(f, buf);
SelectedPrinterType := StrToInt(buf);
i := 0;
while (not eof(f)) and (i < PrinterTypes[SelectedPrinterType].CommCount) do
begin
ReadLn(f, buf);
if Pos('True', buf) > 0 then
b := True
else
b := False;
PrinterTypes[SelectedPrinterType].Commands[i].Trigger := b;
Inc(i);
end;
MakeInitString;
{$I+}
end;
procedure TfrxTXTExport.SavePrinterInit(const FName: String);
var
f: TextFile;
i: Integer;
s: String;
begin
{$I-}
AssignFile(f, FName);
Rewrite(f);
WriteLn(f, IntToStr(SelectedPrinterType));
for i := 0 to PrinterTypes[SelectedPrinterType].CommCount - 1 do
begin
if PrinterTypes[SelectedPrinterType].Commands[i].Trigger then
s := 'True' else
s := 'False';
WriteLn(f, s);
end;
CloseFile(f);
{$I+}
end;
procedure TfrxTXTExport.FormFeed;
begin
WriteExp(#12);
end;
//////////////////////////////////////////////
procedure TfrxTXTExportDialog.FormCreate(Sender: TObject);
begin
Caption := frxGet(8300);
OK.Caption := frxGet(1);
Cancel.Caption := frxGet(2);
BtnPreview.Hint := frxGet(8301);
GroupCellProp.Caption := frxGet(8302);
CB_PageBreaks.Caption := frxGet(8303);
CB_OEM.Caption := frxGet(8304);
CB_EmptyLines.Caption := frxGet(8305);
CB_LeadSpaces.Caption := frxGet(8306);
GroupPageRange.Caption := frxGet(7);
Pages.Caption := frxGet(8307);
Descr.Caption := frxGet(8308);
GroupScaleSettings.Caption := frxGet(8309);
ScX.Caption := frxGet(8310);
ScY.Caption := frxGet(8311);
GroupFramesSettings.Caption := frxGet(8312);
RB_NoneFrames.Caption := frxGet(8313);
RB_Simple.Caption := frxGet(8314);
RB_Graph.Caption := frxGet(8315);
RB_Graph.Hint := frxGet(8316);
CB_PrintAfter.Caption := frxGet(8317);
GroupBox1.Caption := frxGet(8319);
Label1.Caption := frxGet(8320);
Label3.Caption := frxGet(8321);
LBPage.Caption := frxGet(8322);
ToolButton1.Hint := frxGet(8323);
ToolButton2.Hint := frxGet(8324);
SaveDialog1.Filter := frxGet(8325);
SaveDialog1.DefaultExt := frxGet(8326);
created := False;
TxtExp := TfrxTXTExport.CreateNoRegister;
BtnPreviewClick(Sender);
Created := True;
MakeInit := False;
printer := 0;
PageUpDown.Max := PagesCount;
running := False;
{$IFDEF LINUX}
BorderStyleSizeable(Self);
{$ENDIF}
if UseRightToLeftAlignment then
FlipChildren(True);
end;
procedure TfrxTXTExportDialog.CB_OEMClick(Sender: TObject);
begin
RB_Graph.Enabled := CB_OEM.Checked;
if not RB_Simple.Checked then
RB_Simple.Checked := RB_Graph.Checked;
E_ScaleXChange(Sender);
end;
procedure TfrxTXTExportDialog.RefreshClick(Sender: TObject);
var
fname: String;
Progr: Boolean;
begin
if Flag then
begin
running := true;
fname := GetTempFName;
TxtExp.IsPreview := True;
TxtExp.ShowDialog := False;
TxtExp.Borders := not RB_NoneFrames.Checked;
TxtExp.Pseudogrpahic := RB_Graph.Checked;
TxtExp.PageBreaks := CB_PageBreaks.Checked;
TxtExp.OEMCodepage := CB_OEM.Checked;
TxtExp.EmptyLines := CB_EmptyLines.Checked;
TxtExp.LeadSpaces := CB_LeadSpaces.Checked;
TxtExp.ScaleWidth := StrToInt(E_ScaleX.Text) / 100;
TxtExp.ScaleHeight := StrToInt(E_ScaleY.Text) / 100;
progr := Exporter.ShowProgress;
Exporter.ShowProgress := False;
TxtExp.FileName := fname;
TxtExp.PageNumbers := EPage.Text;
Exporter.Report.Export(TxtExp);
Exporter.ShowProgress := progr;
if CB_OEM.Checked then
Preview.Font.Name := 'Terminal' else
Preview.Font.Name := 'Courier New';
Preview.Lines.LoadFromFile(fname);
DeleteFile(fname);
PgWidth.Caption := IntToStr(TxtExp.PageWidth);
PgHeight.Caption := IntToStr(TxtExp.PageHeight);
running := false;
end;
end;
procedure TfrxTXTExportDialog.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
TxtExp.Free;
end;
procedure TfrxTXTExportDialog.FormActivate(Sender: TObject);
begin
{ CB_OEMClick(Sender);
if PreviewActive then
BtnPreview.Down := True;
BtnPreviewClick(Sender);}
end;
procedure TfrxTXTExportDialog.E_ScaleXChange(Sender: TObject);
begin
if PreviewActive then
RefreshClick(Sender);
end;
procedure TfrxTXTExportDialog.BtnPreviewClick(Sender: TObject);
begin
if BtnPreview.Down then
begin
PreviewActive := True;
Left := Left - 177;
Width := 631;
Panel2.Visible := True;
Flag := True;
E_ScaleXChange(Sender);
end
else
begin
if created and PreviewActive then
Left := Left + 177;
Flag := False;
PreviewActive := False;
Width := 277;
Panel2.Visible := False;
end;
end;
procedure TfrxTXTExportDialog.ToolButton1Click(Sender: TObject);
begin
if Preview.Font.Size < 30 then
Preview.Font.Size := Preview.Font.Size + 1;
end;
procedure TfrxTXTExportDialog.ToolButton2Click(Sender: TObject);
begin
if Preview.Font.Size > 2 then
Preview.Font.Size := Preview.Font.Size - 1;
end;
procedure TfrxTXTExportDialog.UpDown1Changing(Sender: TObject;
var AllowChange: Boolean);
begin
if PreviewActive then
if not running then
RefreshClick(Sender)
else
AllowChange := False;
end;
procedure TfrxTXTExportDialog.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_F1 then
frxResources.Help(Self);
end;
end.
Reference in New Issue Copy Permalink