{******************************************} { } { 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.