595 lines
15 KiB
ObjectPascal
595 lines
15 KiB
ObjectPascal
|
|
{******************************************}
|
|
{ }
|
|
{ FastReport v4.0 }
|
|
{ Simple text export }
|
|
{ }
|
|
{ Copyright (c) 1998-2008 }
|
|
{ by Alexander Fediachov, }
|
|
{ Fast Reports Inc. }
|
|
{ }
|
|
{******************************************}
|
|
|
|
unit FMX.frxExportText;
|
|
|
|
interface
|
|
|
|
{$I frx.inc}
|
|
{$I fmx.inc}
|
|
|
|
uses
|
|
System.SysUtils, System.Classes, FMX.Controls, FMX.Forms, FMX.Dialogs,
|
|
FMX.frxClass, FMX.frxExportMatrix, FMX.Edit, FMX.Types, System.UITypes,
|
|
System.Types, System.Variants, FMX.frxBaseModalForm
|
|
{$IFDEF DELPHI18}
|
|
,FMX.StdCtrls
|
|
{$ENDIF};
|
|
|
|
type
|
|
TfrxSimpleTextExportDialog = class(TfrxForm)
|
|
OkB: TButton;
|
|
CancelB: TButton;
|
|
SaveDialog1: TSaveDialog;
|
|
GroupPageRange: TGroupBox;
|
|
DescrL: TLabel;
|
|
AllRB: TRadioButton;
|
|
CurPageRB: TRadioButton;
|
|
PageNumbersRB: TRadioButton;
|
|
PageNumbersE: TEdit;
|
|
GroupQuality: TGroupBox;
|
|
PageBreaksCB: TCheckBox;
|
|
OpenCB: TCheckBox;
|
|
FramesCB: TCheckBox;
|
|
EmptyLinesCB: TCheckBox;
|
|
OEMCB: TCheckBox;
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure PageNumbersEChange(Sender: TObject);
|
|
procedure PageNumbersEKeyPress(Sender: TObject; var Key: Char);
|
|
procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
|
|
end;
|
|
|
|
{$I frxFMX_PlatformsAttribute.inc}
|
|
TfrxSimpleTextExport = class(TfrxCustomExportFilter)
|
|
private
|
|
FPageBreaks: Boolean;
|
|
FMatrix: TfrxIEMatrix;
|
|
FOpenAfterExport: Boolean;
|
|
Exp: TStream;
|
|
FPage: TfrxReportPage;
|
|
FFrames: Boolean;
|
|
pX: Extended;
|
|
pY: Extended;
|
|
pT: Extended;
|
|
FEmptyLines: Boolean;
|
|
FOEM: Boolean;
|
|
FDeleteEmptyColumns: Boolean;
|
|
procedure ExportPage(Stream: TStream);
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
class function GetDescription: String; 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;
|
|
published
|
|
property PageBreaks: Boolean read FPageBreaks write FPageBreaks default True;
|
|
property Frames: Boolean read FFrames write FFrames;
|
|
property EmptyLines: Boolean read FEmptyLines write FEmptyLines;
|
|
property OEMCodepage: Boolean read FOEM write FOEM;
|
|
property OpenAfterExport: Boolean read FOpenAfterExport write FOpenAfterExport default False;
|
|
property OverwritePrompt;
|
|
property DeleteEmptyColumns: Boolean read FDeleteEmptyColumns write FDeleteEmptyColumns;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
uses FMX.frxUtils, {frxFileUtils,} FMX.frxUnicodeUtils, FMX.frxRes, FMX.frxFMX, FMX.frxrcExports
|
|
{$IFDEF MSWINDOWS}
|
|
, Winapi.ShellAPI
|
|
{$ENDIF}
|
|
{$IFDEF LINUX}
|
|
,FMUX.Api
|
|
{$ENDIF};
|
|
|
|
{$R *.fmx}
|
|
|
|
function Trim(const S: AnsiString): AnsiString;
|
|
var
|
|
I, L: Integer;
|
|
begin
|
|
L := Length(S);
|
|
I := 1;
|
|
while (I <= L) and (S[I] <= ' ') do Inc(I);
|
|
if I > L then Result := '' else
|
|
begin
|
|
while S[L] <= ' ' do Dec(L);
|
|
Result := Copy(S, I, L - I + 1);
|
|
end;
|
|
end;
|
|
|
|
function TrimRight(const S: AnsiString): AnsiString;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := Length(S);
|
|
while (I > 0) and (S[I] <= ' ') do Dec(I);
|
|
Result := Copy(S, 1, I);
|
|
end;
|
|
|
|
{ TfrxSimpleTextExport }
|
|
|
|
constructor TfrxSimpleTextExport.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FPageBreaks := True;
|
|
FFrames := False;
|
|
FEmptyLines := False;
|
|
FOEM := False;
|
|
FDeleteEmptyColumns := True;
|
|
FilterDesc := frxGet(8801);
|
|
DefaultExt := frxGet(8802);
|
|
end;
|
|
|
|
class function TfrxSimpleTextExport.GetDescription: String;
|
|
begin
|
|
Result := frxResources.Get('SimpleTextExport');
|
|
end;
|
|
|
|
procedure TfrxSimpleTextExport.ExportPage(Stream: TStream);
|
|
var
|
|
x, y, i: Integer;
|
|
FScreen: array of AnsiChar;
|
|
FScreenWidth: Integer;
|
|
FScreenHeight: Integer;
|
|
Obj: TfrxIEMObject;
|
|
ObjBounds: TfrxRect;
|
|
ObjWidth, ObjHeight: Extended;
|
|
c: AnsiChar;
|
|
s: AnsiString;
|
|
|
|
procedure InitObjBounds(Obj: TfrxIEMObject);
|
|
begin
|
|
ObjBounds := FMatrix.GetObjectBounds(Obj);
|
|
ObjWidth := ObjBounds.Right - ObjBounds.Left;
|
|
ObjHeight := ObjBounds.Bottom - ObjBounds.Top;
|
|
end;
|
|
|
|
function MakeStr(C: AnsiChar; N: Integer): AnsiString;
|
|
begin
|
|
if N < 1 then
|
|
Result := ''
|
|
else
|
|
begin
|
|
SetLength(Result, N);
|
|
FillChar(Result[1], Length(Result), C);
|
|
end;
|
|
end;
|
|
|
|
function AddChar(C: AnsiChar; const S: AnsiString; N: Integer): AnsiString;
|
|
begin
|
|
if Length(S) < N then
|
|
Result := MakeStr(C, N - Length(S)) + S else
|
|
Result := S;
|
|
end;
|
|
|
|
function AddCharR(C: AnsiChar; const S: AnsiString; N: Integer): AnsiString;
|
|
begin
|
|
if Length(S) < N then
|
|
Result := S + MakeStr(C, N - Length(S)) else
|
|
Result := S;
|
|
end;
|
|
|
|
function LeftStr(const S: AnsiString; N: Integer): AnsiString;
|
|
begin
|
|
Result := AddCharR(' ', S, N);
|
|
end;
|
|
|
|
function RightStr(const S: AnsiString; N: Integer): AnsiString;
|
|
begin
|
|
Result := AddChar(' ', S, N);
|
|
end;
|
|
|
|
function CenterStr(const S: AnsiString; Len: Integer): AnsiString;
|
|
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;
|
|
|
|
function AlignStr(const Buf: AnsiString; const style: TfrxIEMStyle; const Width: Integer): AnsiString;
|
|
begin
|
|
if (style.HAlign = haRight) then
|
|
Result := RightStr(buf, Width - 1)
|
|
else if (style.HAlign = haCenter) then
|
|
Result := CenterStr(buf, Width - 1)
|
|
else
|
|
Result := LeftStr(buf, Width - 1);
|
|
end;
|
|
|
|
procedure ScreenCreate;
|
|
begin
|
|
Initialize(FScreen);
|
|
SetLength(FScreen, FScreenWidth * FScreenHeight);
|
|
FillChar(FScreen[0], Length(FScreen), #32);
|
|
end;
|
|
|
|
procedure ScreenType(const x,y: Integer; const c: AnsiChar);
|
|
begin
|
|
FScreen[FScreenWidth * y + x] := c;
|
|
end;
|
|
|
|
procedure ScreenString(const x, y: Integer; const s: AnsiString);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to Length(s) - 1 do
|
|
ScreenType(x + i, y, s[i + 1]);
|
|
end;
|
|
|
|
procedure ScreenMemo(const Obj: TfrxIEMObject);
|
|
var
|
|
i: Integer;
|
|
curx, cury: Integer;
|
|
s: AnsiString;
|
|
|
|
function StrToOem(const AnsiStr: AnsiString): AnsiString;
|
|
begin
|
|
Result := AnsiStr;// todo
|
|
{SetLength(Result, Length(AnsiStr));
|
|
if Length(Result) > 0 then
|
|
CharToOemBuffA(PAnsiChar(AnsiStr), PAnsiChar(Result), Length(Result)); }
|
|
end;
|
|
|
|
begin
|
|
curx := Round(ObjBounds.Left / pX);
|
|
cury := Round(ObjBounds.Top / pY);
|
|
for i := 0 to Obj.Memo.Count - 1 do
|
|
begin
|
|
if FOEM then
|
|
s := StrToOem(AnsiString(Obj.Memo[i]))
|
|
else // todo use LocaleCharsFromUnicode
|
|
s := AnsiString(Obj.Memo[i]);
|
|
ScreenString(curx, cury + i, AlignStr(s, Obj.Style, Round(ObjWidth / pX) - 1));
|
|
end;
|
|
if FFrames then
|
|
begin
|
|
if (ftLeft in Obj.Style.FrameTyp) then
|
|
for i := 0 to Round(ObjHeight / pY) - 1 do
|
|
ScreenType(curx - 1, cury + i, '|');
|
|
if (ftRight in Obj.Style.FrameTyp) then
|
|
for i := 0 to Round(ObjHeight / pY) - 1 do
|
|
ScreenType(curx + Round(ObjWidth / pX) - 2, cury + i, '|');
|
|
if (ftTop in Obj.Style.FrameTyp) then
|
|
for i := 0 to Round(ObjWidth / pX) - 1 do
|
|
ScreenType(curx - 1 + i, cury - 1, '-');
|
|
if (ftBottom in Obj.Style.FrameTyp) then
|
|
for i := 0 to Round(ObjWidth / pX) - 1 do
|
|
ScreenType(curx - 1 + i, cury + Round(ObjHeight / pY) - 1, '-');
|
|
end;
|
|
end;
|
|
|
|
function ScreenGet(const x, y: Integer): AnsiChar;
|
|
begin
|
|
if (x < FScreenWidth) and (y < FScreenHeight) and
|
|
(x >= 0) and (y >= 0) then
|
|
Result := FScreen[FScreenWidth * y + x] else
|
|
Result := ' ';
|
|
end;
|
|
|
|
function GetMaxPX(const Obj: TfrxIEMObject): Extended;
|
|
var
|
|
i : Integer;
|
|
begin
|
|
Result := 0;
|
|
for i := 0 to Obj.Memo.Count - 1 do
|
|
if Length(Obj.Memo[i]) > Result then
|
|
Result := Length(Obj.Memo[i]);
|
|
if (Result > 0) then //and (Obj.Width )
|
|
Result := 6 * ObjWidth / (Result * Obj.Style.Font.Size);
|
|
if Result < 1 then
|
|
Result := 1;
|
|
end;
|
|
|
|
function GetMaxPY(const Obj: TfrxIEMObject): Extended;
|
|
begin
|
|
if Obj.Memo.Count > 0 then
|
|
Result := 5 * ObjHeight / (Obj.Memo.Count * Obj.Style.Font.Size)
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function ColumnEmpty(const x: Integer): Boolean;
|
|
var
|
|
y: Integer;
|
|
begin
|
|
Result := True;
|
|
for y := 0 to FScreenHeight - 1 do
|
|
if FScreen[FScreenWidth * y + x] <> #32 then
|
|
begin
|
|
Result := False;
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
procedure DeleteColumn(const x: Integer);
|
|
var
|
|
i, j: Integer;
|
|
begin
|
|
for i := 0 to FScreenHeight - 1 do
|
|
begin
|
|
for j := x to FScreenWidth - 2 do
|
|
FScreen[FScreenWidth * i + j] := FScreen[FScreenWidth * i + j + 1];
|
|
FScreen[FScreenWidth * i + FScreenWidth - 1] := #32;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
FMatrix.Prepare;
|
|
|
|
for i := 0 to FMatrix.ObjectsCount - 1 do
|
|
begin
|
|
Obj := FMatrix.GetObjectById(i);
|
|
InitObjBounds(Obj);
|
|
|
|
pT := GetMaxPX(Obj);
|
|
|
|
if (pT < pX) and (pT <> 0) then
|
|
pX := pT;
|
|
|
|
pT := GetMaxPY(Obj);
|
|
|
|
if (pT < pY) and (pT <> 0) then
|
|
pY := pT;
|
|
end;
|
|
|
|
FScreenWidth := Round(FPage.Width / pX);
|
|
FScreenHeight := Round(FPage.Height / pY);
|
|
ScreenCreate;
|
|
|
|
for y := 0 to FMatrix.Height - 2 do
|
|
begin
|
|
for x := 0 to FMatrix.Width - 1 do
|
|
begin
|
|
i := FMatrix.GetCell(x, y);
|
|
if (i <> -1) then
|
|
begin
|
|
Obj := FMatrix.GetObjectById(i);
|
|
InitObjBounds(Obj);
|
|
ScreenMemo(Obj);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
x := 0;
|
|
i := 2;
|
|
y := FScreenWidth;
|
|
while x < y - 1 do
|
|
if DeleteEmptyColumns and ColumnEmpty(x) then
|
|
if i = 0 then
|
|
begin
|
|
DeleteColumn(x);
|
|
Dec(y);
|
|
end
|
|
else
|
|
begin
|
|
Dec(i);
|
|
Inc(x);
|
|
end
|
|
else
|
|
begin
|
|
Inc(x);
|
|
i := 2;
|
|
end;
|
|
|
|
for y := 0 to FScreenHeight - 1 do
|
|
begin
|
|
s := '';
|
|
for x := 0 to FScreenWidth - 1 do
|
|
begin
|
|
c := ScreenGet(x, y);
|
|
s := s + c;
|
|
end;
|
|
s := TrimRight(s);
|
|
if (Length(Trim(s)) > 0) or FEmptyLines then
|
|
begin
|
|
s := s + #13#10;
|
|
Stream.Write(s[1], Length(s));
|
|
end;
|
|
end;
|
|
if FPageBreaks then
|
|
Stream.Write(AnsiString(#12), 1);
|
|
end;
|
|
|
|
function TfrxSimpleTextExport.ShowModal: TModalResult;
|
|
begin
|
|
if not Assigned(Stream) then
|
|
begin
|
|
with TfrxSimpleTextExportDialog.Create(nil) do
|
|
begin
|
|
OpenCB.Visible := not SlaveExport;
|
|
if OverwritePrompt then
|
|
SaveDialog1.Options := SaveDialog1.Options + [TOpenOption.ofOverwritePrompt];
|
|
if SlaveExport then
|
|
FOpenAfterExport := False;
|
|
|
|
if (FileName = '') and (not SlaveExport) then
|
|
SaveDialog1.FileName := ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(Report.FileName)), SaveDialog1.DefaultExt)
|
|
else
|
|
SaveDialog1.FileName := FileName;
|
|
|
|
PageBreaksCB.IsChecked := FPageBreaks;
|
|
OpenCB.IsChecked := FOpenAfterExport;
|
|
FramesCB.IsChecked := FFrames;
|
|
EmptyLinesCB.IsChecked := FEmptyLines;
|
|
OEMCB.IsChecked := FOEM;
|
|
|
|
if PageNumbers <> '' then
|
|
begin
|
|
PageNumbersE.Text := PageNumbers;
|
|
PageNumbersRB.IsChecked := True;
|
|
end;
|
|
|
|
Result := ShowModal;
|
|
PeekLastModalResult;
|
|
if Result = mrOk then
|
|
begin
|
|
PageNumbers := '';
|
|
CurPage := False;
|
|
if CurPageRB.IsChecked then
|
|
CurPage := True
|
|
else if PageNumbersRB.IsChecked then
|
|
PageNumbers := PageNumbersE.Text;
|
|
|
|
FPageBreaks := PageBreaksCB.IsChecked;
|
|
FOpenAfterExport := OpenCB.IsChecked;
|
|
FFrames := FramesCB.IsChecked;
|
|
FEmptyLines := EmptyLinesCB.IsChecked;
|
|
FOEM := OEMCB.IsChecked;
|
|
|
|
if not SlaveExport then
|
|
begin
|
|
if DefaultPath <> '' then
|
|
SaveDialog1.InitialDir := DefaultPath;
|
|
if SaveDialog1.Execute then
|
|
FileName := SaveDialog1.FileName
|
|
else
|
|
Result := mrCancel;
|
|
PeekLastModalResult;
|
|
end
|
|
end;
|
|
Free;
|
|
end;
|
|
end else
|
|
Result := mrOk;
|
|
end;
|
|
|
|
function TfrxSimpleTextExport.Start: Boolean;
|
|
begin
|
|
if (FileName <> '') or Assigned(Stream) then
|
|
begin
|
|
if (ExtractFilePath(FileName) = '') and (DefaultPath <> '') then
|
|
FileName := DefaultPath + '\' + FileName;
|
|
FMatrix := TfrxIEMatrix.Create(UseFileCache, Report.EngineOptions.TempDir);
|
|
FMatrix.Background := False;
|
|
FMatrix.BackgroundImage := False;
|
|
FMatrix.Printable := ExportNotPrintable;
|
|
FMatrix.RichText := True;
|
|
FMatrix.PlainRich := True;
|
|
FMatrix.AreaFill := False;
|
|
FMatrix.CropAreaFill := True;
|
|
FMatrix.Inaccuracy := 0.5;
|
|
FMatrix.DeleteHTMLTags := True;
|
|
FMatrix.Images := False;
|
|
FMatrix.WrapText := True;
|
|
FMatrix.ShowProgress := False;
|
|
FMatrix.FramesOptimization := True;
|
|
try
|
|
if Assigned(Stream) then
|
|
Exp := Stream
|
|
else
|
|
Exp := TFileStream.Create(FileName, fmCreate);
|
|
Result := True;
|
|
except
|
|
Result := False;
|
|
end;
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
procedure TfrxSimpleTextExport.StartPage(Page: TfrxReportPage; Index: Integer);
|
|
begin
|
|
FMatrix.Clear;
|
|
pX := 65535;
|
|
pY := 65535;
|
|
end;
|
|
|
|
procedure TfrxSimpleTextExport.ExportObject(Obj: TfrxComponent);
|
|
begin
|
|
if Obj is TfrxView then
|
|
FMatrix.AddObject(TfrxView(Obj));
|
|
end;
|
|
|
|
procedure TfrxSimpleTextExport.FinishPage(Page: TfrxReportPage; Index: Integer);
|
|
begin
|
|
FPage := Page;
|
|
ExportPage(Exp);
|
|
end;
|
|
|
|
procedure TfrxSimpleTextExport.Finish;
|
|
begin
|
|
FMatrix.Free;
|
|
if not Assigned(Stream) then
|
|
Exp.Free;
|
|
if FOpenAfterExport and (not Assigned(Stream)) then
|
|
{$IFDEF MSWINDOWS}
|
|
ShellExecute(0, 'open', PChar(FileName), '', '', 5);
|
|
{$ENDIF}
|
|
{$IFDEF LINUX}
|
|
FmuxOpenFile(PChar(FileName));
|
|
{$ENDIF}
|
|
{$IFDEF MACOS}
|
|
ShellExecute(FileName);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{ TfrxSimpleTextExportDialog }
|
|
|
|
procedure TfrxSimpleTextExportDialog.FormCreate(Sender: TObject);
|
|
begin
|
|
Caption := frxGet(8800);
|
|
OkB.Text := frxGet(1);
|
|
CancelB.Text := frxGet(2);
|
|
GroupPageRange.Text := frxGet(7);
|
|
AllRB.Text := frxGet(3);
|
|
CurPageRB.Text := frxGet(4);
|
|
PageNumbersRB.Text := frxGet(5);
|
|
DescrL.Text := frxGet(9);
|
|
GroupQuality.Text := frxGet(8302);
|
|
PageBreaksCB.Text := frxGet(6);
|
|
FramesCB.Text := frxGet(8312);
|
|
EmptyLinesCB.Text := frxGet(8305);
|
|
OEMCB.Text := frxGet(8304);
|
|
OpenCB.Text := frxGet(8706);
|
|
SaveDialog1.Filter := frxGet(8801);
|
|
SaveDialog1.DefaultExt := frxGet(8802);
|
|
{$IFDEF LINUX}
|
|
BorderStyleSizeable(Self);
|
|
{$ENDIF}
|
|
//if UseRightToLeftAlignment then
|
|
// FlipChildren(True);
|
|
end;
|
|
|
|
procedure TfrxSimpleTextExportDialog.PageNumbersEChange(Sender: TObject);
|
|
begin
|
|
PageNumbersRB.IsChecked := True;
|
|
end;
|
|
|
|
procedure TfrxSimpleTextExportDialog.PageNumbersEKeyPress(Sender: TObject;
|
|
var Key: Char);
|
|
begin
|
|
case key of
|
|
'0'..'9':;
|
|
#8, '-', ',':;
|
|
else
|
|
key := #0;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxSimpleTextExportDialog.FormKeyDown(Sender: TObject; var Key: Word;
|
|
var KeyChar: WideChar; Shift: TShiftState);
|
|
begin
|
|
//todo
|
|
{if Key = VK_F1 then
|
|
frxResources.Help(Self);}
|
|
end;
|
|
|
|
end.
|