Delphi/FastReport_2022_VCL
Delphi/FastReport_2022_VCL
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
master
FastReport_2022_VCL/LibD28/frxDMPExport.pas
Daso e6303fc1c0 Inicijalizacija
2024-01-01 16:13:08 +01:00

1085 lines
30 KiB
ObjectPascal
Raw Permalink Blame History

{******************************************}
{ }
{ FastReport VCL }
{ Dot-matrix export filter }
{ }
{ Copyright (c) 1998-2021 }
{ by Fast Reports Inc. }
{ }
{******************************************}
unit frxDMPExport;
interface
{$I frx.inc}
uses
{$IFNDEF Linux}
Windows,
{$ELSE}
LCLType, LCLIntf, LCLProc,
{$ENDIF}
Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, frxClass, Buttons, ComCtrls, frxDMPClass, frxXML
{$IFDEF FPC}
, LResources
{$ENDIF}
{$IFDEF Delphi6}
, Variants
{$ENDIF};
type
TfrxTranslateEvent = procedure(Sender: TObject; var s: AnsiString) of object;
{$IFDEF DELPHI16}
/// <summary>
/// The TfrxDotMatrixExport component allows reports to print on a dot-matrix
/// printer. Only reports designed specificly for the DMP mode, can be
/// printed.
/// </summary>
[ComponentPlatformsAttribute(pidWin32 or pidWin64)]
{$ENDIF}
TfrxDotMatrixExport = class(TfrxCustomExportFilter)
private
FBufWidth: Integer;
FBufHeight: Integer;
FCharBuf: array of AnsiChar;
FCopies: Integer;
FCustomFrameSet: AnsiString;
FEscModel: Integer;
FFrameBuf: array of Byte;
FGraphicFrames: Boolean;
FMaxHeight: Integer;
FOEMConvert: Boolean;
FPageBreaks: Boolean;
FPageStyle: Integer;
FPrinterInitString: AnsiString;
FSaveToFile: Boolean;
FStream: TStream;
FStyleBuf: array of Integer;
FUseIniSettings: Boolean;
FOnTranslate: TfrxTranslateEvent;
function GetTempFName: String;
function IntToStyle(i: Integer): TfrxDMPFontStyles;
function StyleChange(OldStyle, NewStyle: Integer): String;
function StyleOff(Style: Integer): String;
function StyleOn(Style: Integer): String;
function StyleToInt(Style: TfrxDMPFontStyles): Integer;
procedure CreateBuf(Width, Height: Integer);
procedure DrawFrame(x, y, dx, dy: Integer; Style: Integer);
procedure DrawMemo(x, y, dx, dy: Integer; Memo: TfrxDMPMemoView);
procedure FlushBuf;
procedure FormFeed;
procedure FreeBuf;
procedure Landscape;
procedure Portrait;
procedure Reset;
procedure SetFrame(x, y: Integer; typ: Byte);
procedure SetString(x, y: Integer; s: AnsiString);
procedure SetStyle(x, y, Style: Integer);
procedure SpoolFile(const FileName: String);
procedure WriteStrLn(const str: AnsiString);
procedure WriteStr(const str: AnsiString);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ShowModal: TModalResult; override;
function Start: Boolean; override;
procedure ExportObject(Obj: TfrxComponent); override;
procedure Finish; override;
procedure FinishPage(Page: TfrxReportPage; Index: Integer); override;
procedure StartPage(Page: TfrxReportPage; Index: Integer); override;
published
/// <summary>
/// Set of symbols used for drawing frame elements. By default this
/// property is empty and frames are printed using +-| symbols or
/// pseudographic symbols. <br />Each frame element is represented by the
/// cross containing 4 lines. Each line has its own weight index: <br />1
/// <br />8 <br />4 <br />The CustomFrameSet property should contain 15
/// symbols. For example, symbol CustomFrameSet[1] represents line number
/// 1, symbol CustomFrameSet[2] represents line number 2, symbol
/// CustomFrameSet[3] represents a combination of line 1 and 2, etc.
/// </summary>
property CustomFrameSet: AnsiString read FCustomFrameSet write FCustomFrameSet;
property EscModel: Integer read FEscModel write FEscModel;
/// <summary>
/// Determines if pseudographic frames are used or not.
/// </summary>
property GraphicFrames: Boolean read FGraphicFrames write FGraphicFrames;
/// <summary>
/// The printer init string.
/// </summary>
property InitString: AnsiString read FPrinterInitString write FPrinterInitString;
/// <summary>
/// Determines whether to convert all strings to OEM character set or
/// not. Default value is True.
/// </summary>
property OEMConvert: Boolean read FOEMConvert write FOEMConvert default True;
/// <summary>
/// Use page break symbol.
/// </summary>
property PageBreaks: Boolean read FPageBreaks write FPageBreaks default True;
/// <summary>
/// Determines whether to save export to file or to print it. If this
/// property is True, you should also set the FileName property.
/// </summary>
property SaveToFile: Boolean read FSaveToFile write FSaveToFile;
/// <summary>
/// Store settings in the report ini-file.
/// </summary>
property UseIniSettings: Boolean read FUseIniSettings write FUseIniSettings;
property OnTranslate: TfrxTranslateEvent read FOnTranslate write FOnTranslate;
end;
TfrxDMPExportDialog = class(TForm)
OK: TButton;
Cancel: TButton;
SaveDialog1: TSaveDialog;
Image1: TImage;
PrinterL: TGroupBox;
PrinterCB: TComboBox;
EscL: TGroupBox;
EscCB: TComboBox;
CopiesL: TGroupBox;
CopiesNL: TLabel;
CopiesE: TEdit;
CopiesUD: TUpDown;
PagesL: TGroupBox;
DescrL: TLabel;
AllRB: TRadioButton;
CurPageRB: TRadioButton;
PageNumbersRB: TRadioButton;
RangeE: TEdit;
OptionsL: TGroupBox;
SaveToFileCB: TCheckBox;
PageBreaksCB: TCheckBox;
OemCB: TCheckBox;
PseudoCB: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure PrinterCBDrawItem(Control: TWinControl; Index: Integer;
ARect: TRect; State: TOwnerDrawState);
procedure PrinterCBClick(Sender: TObject);
procedure FormHide(Sender: TObject);
procedure RangeEEnter(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
OldIndex: Integer;
end;
const
cmdName = 1;
cmdReset = 2;
cmdFormFeed = 3;
cmdLandscape = 4;
cmdPortrait = 5;
cmdBoldOn = 6;
cmdBoldOff = 7;
cmdItalicOn = 8;
cmdItalicOff = 9;
cmdUnderlineOn = 10;
cmdUnderlineOff = 11;
cmdSuperscriptOn = 12;
cmdSuperscriptOff = 13;
cmdSubscriptOn = 14;
cmdSubscriptOff = 15;
cmdCondensedOn = 16;
cmdCondensedOff = 17;
cmdWideOn = 18;
cmdWideOff = 19;
cmd12cpiOn = 20;
cmd12cpiOff = 21;
cmd15cpiOn = 22;
cmd15cpiOff = 23;
CommandCount = 23;
CommandNames: array[1..CommandCount] of String = (
'Name', 'Reset', 'FormFeed', 'Landscape', 'Portrait',
'BoldOn', 'BoldOff', 'ItalicOn', 'ItalicOff', 'UnderlineOn', 'UnderlineOff',
'SuperscriptOn', 'SuperscriptOff', 'SubscriptOn', 'SubscriptOff',
'CondensedOn', 'CondensedOff', 'WideOn', 'WideOff',
'cpi12On', 'cpi12Off', 'cpi15On', 'cpi15Off');
type
TfrxDMPrinter = class(TCollectionItem)
public
Commands: array[1..CommandCount] of String;
procedure Assign(Source: TPersistent); override;
end;
TfrxDMPrinters = class(TCollection)
private
function GetItem(Index: Integer): TfrxDMPrinter;
public
constructor Create;
function Add: TfrxDMPrinter;
procedure ReadDefaultPrinters;
procedure ReadExtPrinters;
procedure ReadPrinters(x: TfrxXMLDocument);
property Items[Index: Integer]: TfrxDMPrinter read GetItem; default;
end;
var
frxDMPrinters: TfrxDMPrinters;
implementation
uses frxUtils, frxPrinter, Printers, frxRes, IniFiles{$IFNDEF FPC}, Winspool{$ENDIF};
{$R *.dfm}
const
FrameSet: array[1..2] of AnsiString = (
' + |++ +-+++++',
#32#32#192#32#179#218#195#32#217#196#193#191#180#194#197);
DefaultPrinters: String =
'<?xml version="1.0" encoding="utf-8"?>' +
'<printers>' +
' <printer id="0" Name="None" FormFeed="0C"/>' +
' <printer id="1" Name="Epson Generic" Inherit="0" Reset="1B40" ' +
'BoldOn="1B45" BoldOff="1B46" ItalicOn="1B34" ItalicOff="1B35" ' +
'UnderlineOn="1B2D01" UnderlineOff="1B2D00" SuperscriptOn="#27#83#01" SuperscriptOff="#27#84" ' +
'SubscriptOn="#27#83#00" SubscriptOff="#27#84" CondensedOn="0F" CondensedOff="12" ' +
'WideOn="1B5701" WideOff="1B5700" cpi12On="1B4D" cpi12Off="1B50" cpi15On="1B67" cpi15Off="1B50"/>' +
' <printer id="2" Name="HP Generic" Inherit="0" Reset="1B45" ' +
'Portrait="1B266C304F" Landscape="1B266C314F" BoldOn="1B28733342" ' +
'BoldOff="1B28733042" ItalicOn="1B28733153" ItalicOff="1B28733053" ' +
'UnderlineOn="1B26643144" UnderlineOff="1B266440" ' +
'SuperscriptOn="#27#38#97#45#46#53#82" SuperscriptOff="#27#38#97#43#46#53#82" ' +
'SubscriptOn="#27#38#97#43#46#53#82" SubscriptOff="#27#38#97#45#46#53#82" ' +
'CondensedOn="1B2873313648" CondensedOff="1B2873313048" ' +
'WideOn="1B28733548" WideOff="1B2873313048" cpi12On="1B266B313048" ' +
'cpi12Off="1B266B313248" cpi15On="" cpi15Off=""/>' +
' <printer id="3" Name="IBM Generic" Inherit="1" Reset="" cpi12On="1B3A" ' +
'cpi12Off="12" cpi15On="1B67" cpi15Off="12"/>' +
'</printers>';
type
TWordSet = set of 0..15;
PWordSet = ^TWordSet;
PfrxDMPFontStyles = ^TfrxDMPFontStyles;
{ TfrxDMPrinter }
procedure TfrxDMPrinter.Assign(Source: TPersistent);
begin
if Source is TfrxDMPrinter then
Commands := TfrxDMPrinter(Source).Commands;
end;
{ TfrxDMPrinters }
constructor TfrxDMPrinters.Create;
begin
inherited Create(TfrxDMPrinter);
end;
function TfrxDMPrinters.Add: TfrxDMPrinter;
begin
Result := TfrxDMPrinter(inherited Add);
end;
function TfrxDMPrinters.GetItem(Index: Integer): TfrxDMPrinter;
begin
Result := TfrxDMPrinter(inherited Items[Index]);
end;
procedure TfrxDMPrinters.ReadDefaultPrinters;
var
x: TfrxXMLDocument;
s: TStringStream;
begin
x := TfrxXMLDocument.Create;
s := TStringStream.Create(DefaultPrinters{$IFDEF Delphi12}, TEncoding.UTF8{$ENDIF});
try
x.LoadFromStream(s);
ReadPrinters(x);
finally
s.Free;
x.Free;
end;
end;
procedure TfrxDMPrinters.ReadExtPrinters;
var
x: TfrxXMLDocument;
begin
if not FileExists(ExtractFilePath(Application.ExeName) + 'printers.xml') then
Exit;
x := TfrxXMLDocument.Create;
try
x.LoadFromFile(ExtractFilePath(Application.ExeName) + 'printers.xml');
ReadPrinters(x);
except
ShowMessage('Error in file printers.xml');
end;
x.Free;
end;
procedure TfrxDMPrinters.ReadPrinters(x: TfrxXMLDocument);
var
i, j: Integer;
xi: TfrxXMLItem;
Item: TfrxDMPrinter;
function ConvertProp(s: String): String;
var
i: Integer;
s1: String;
begin
Result := '';
s1 := '';
if Pos('#', s) = 1 then
begin
s := s + '#';
for i := 2 to Length(s) do
if s[i] = '#' then
begin
Result := Result + Chr(StrToInt(s1));
s1 := '';
end
else
s1 := s1 + s[i];
end
else
begin
for i := 1 to Length(s) do
begin
s1 := s1 + s[i];
if i mod 2 = 0 then
begin
Result := Result + Chr(StrToInt('$' + s1));
s1 := '';
end;
end;
end;
end;
begin
Clear;
for i := 0 to x.Root.Count - 1 do
begin
Item := Add;
xi := x.Root[i];
if xi.Prop['Inherit'] <> '' then
Item.Assign(Items[StrToInt(xi.Prop['Inherit'])]);
for j := 1 to CommandCount do
if xi.PropExists(CommandNames[j]) then
if j = 1 then
Item.Commands[j] := xi.Prop[CommandNames[j]] else
Item.Commands[j] := ConvertProp(xi.Prop[CommandNames[j]]);
end;
end;
{ TfrxDotMatrixExport }
constructor TfrxDotMatrixExport.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
frxDotMatrixExport := Self;
FCopies := 1;
FOEMConvert := True;
FPageBreaks := True;
FUseIniSettings := True;
end;
destructor TfrxDotMatrixExport.Destroy;
begin
FreeBuf;
frxDotMatrixExport := nil;
inherited;
end;
function TfrxDotMatrixExport.GetTempFName: String;
var
Path: String;
FileName: String;
begin
Path := Report.EngineOptions.TempDir;
if Path = '' then
begin
Path := GetTemporaryFolder();
end
else
Path := Path + #0;
SetLength(FileName, MAX_PATH);
GetTempFileName(@Path[1], PChar('fr'), 0, @FileName[1]);
{$IFDEF Delphi12}
Result := StrPas(PWideChar(@FileName[1]));
{$ELSE}
Result := StrPas(PChar(@FileName[1]));
{$ENDIF}
end;
function TfrxDotMatrixExport.IntToStyle(i: Integer): TfrxDMPFontStyles;
begin
Result := TfrxDMPFontStyles(PfrxDMPFontStyles(@i)^);
end;
function TfrxDotMatrixExport.StyleToInt(Style: TfrxDMPFontStyles): Integer;
begin
Result := Word(PWordSet(@Style)^);
end;
{$HINTS OFF}
procedure TfrxDotMatrixExport.SpoolFile(const FileName: String);
const
BUF_SIZE = 1024;
var
f: TFileStream;
buf: AnsiString;
l: longint;
begin
if Report.ReportOptions.Name <> '' then
frxPrinters.Printer.Title := Report.ReportOptions.Name else
frxPrinters.Printer.Title := Report.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;
end;
{$HINTS ON}
procedure TfrxDotMatrixExport.FormFeed;
begin
WriteStr(AnsiString(frxDMPrinters[FEscModel].Commands[cmdFormFeed]));
end;
procedure TfrxDotMatrixExport.Landscape;
begin
WriteStr(AnsiString(frxDMPrinters[FEscModel].Commands[cmdLandscape]));
end;
procedure TfrxDotMatrixExport.Portrait;
begin
WriteStr(AnsiString(frxDMPrinters[FEscModel].Commands[cmdPortrait]));
end;
procedure TfrxDotMatrixExport.Reset;
begin
WriteStr(AnsiString(frxDMPrinters[FEscModel].Commands[cmdReset]));
end;
function TfrxDotMatrixExport.StyleOff(Style: Integer): String;
var
st: TfrxDMPFontStyles;
begin
st := IntToStyle(Style);
Result := '';
if fsxBold in st then
Result := Result + frxDMPrinters[FEscModel].Commands[cmdBoldOff];
if fsxItalic in st then
Result := Result + frxDMPrinters[FEscModel].Commands[cmdItalicOff];
if fsxUnderline in st then
Result := Result + frxDMPrinters[FEscModel].Commands[cmdUnderlineOff];
if fsxSuperScript in st then
Result := Result + frxDMPrinters[FEscModel].Commands[cmdSuperscriptOff];
if fsxSubScript in st then
Result := Result + frxDMPrinters[FEscModel].Commands[cmdSubscriptOff];
if fsxCondensed in st then
Result := Result + frxDMPrinters[FEscModel].Commands[cmdCondensedOff];
if fsxWide in st then
Result := Result + frxDMPrinters[FEscModel].Commands[cmdWideOff];
if fsx12cpi in st then
Result := Result + frxDMPrinters[FEscModel].Commands[cmd12cpiOff];
if fsx15cpi in st then
Result := Result + frxDMPrinters[FEscModel].Commands[cmd15cpiOff];
end;
function TfrxDotMatrixExport.StyleOn(Style: Integer): String;
var
st: TfrxDMPFontStyles;
begin
st := IntToStyle(Style);
Result := '';
if fsxBold in st then
Result := Result + frxDMPrinters[FEscModel].Commands[cmdBoldOn];
if fsxItalic in st then
Result := Result + frxDMPrinters[FEscModel].Commands[cmdItalicOn];
if fsxUnderline in st then
Result := Result + frxDMPrinters[FEscModel].Commands[cmdUnderlineOn];
if fsxSuperScript in st then
Result := Result + frxDMPrinters[FEscModel].Commands[cmdSuperscriptOn];
if fsxSubScript in st then
Result := Result + frxDMPrinters[FEscModel].Commands[cmdSubscriptOn];
if fsxCondensed in st then
Result := Result + frxDMPrinters[FEscModel].Commands[cmdCondensedOn];
if fsxWide in st then
Result := Result + frxDMPrinters[FEscModel].Commands[cmdWideOn];
if fsx12cpi in st then
Result := Result + frxDMPrinters[FEscModel].Commands[cmd12cpiOn];
if fsx15cpi in st then
Result := Result + frxDMPrinters[FEscModel].Commands[cmd15cpiOn];
end;
function TfrxDotMatrixExport.StyleChange(OldStyle, NewStyle: Integer): String;
begin
Result := StyleOff(OldStyle) + StyleOn(NewStyle);
end;
procedure TfrxDotMatrixExport.SetFrame(x, y: Integer; typ: Byte);
begin
if (x < 0) or (y < 0) or (x >= FBufWidth) or (y >= FBufHeight) then Exit;
FFrameBuf[FBufWidth * y + x] := FFrameBuf[FBufWidth * y + x] or typ;
end;
procedure TfrxDotMatrixExport.SetString(x, y: Integer; s: AnsiString);
var
i, j: Integer;
c: AnsiChar;
begin
if (x < 0) or (y < 0) or (y >= FBufHeight) then Exit;
if Assigned(FOnTranslate) then
FOnTranslate(Self, s);
for i := 1 to Length(s) do
begin
if x + i - 1 >= FBufWidth then break;
c := s[i];
j := FBufWidth * y + x + i - 1;
FCharBuf[j] := c;
end;
end;
procedure TfrxDotMatrixExport.SetStyle(x, y, Style: Integer);
begin
if (x < 0) or (y < 0) or (x >= FBufWidth) or (y >= FBufHeight) then Exit;
FStyleBuf[FBufWidth * y + x] := Style;
end;
procedure TfrxDotMatrixExport.WriteStr(const str: AnsiString);
begin
if Length(str) > 0 then
FStream.Write(str[1], Length(str))
end;
procedure TfrxDotMatrixExport.WriteStrLn(const str: AnsiString);
begin
WriteStr(str);
WriteStr(#13#10);
end;
procedure TfrxDotMatrixExport.DrawFrame(x, y, dx, dy: Integer; Style: Integer);
var
i, j: Integer;
begin
if dx = 1 then
begin
SetFrame(x, y, 4);
for i := y + 1 to y + dy - 2 do
SetFrame(x, i, 5);
SetFrame(x, y + dy - 1, 1);
end
else
begin
SetFrame(x, y, 2);
for i := x + 1 to x + dx - 2 do
SetFrame(i, y, 10);
SetFrame(x + dx - 1, y, 8);
end;
for i := x to x + dx - 1 do
for j := y to y + dy - 1 do
SetStyle(i, j, Style);
if y + dy > FMaxHeight then
FMaxHeight := y + dy;
end;
procedure TfrxDotMatrixExport.DrawMemo(x, y, dx, dy: Integer; Memo: TfrxDMPMemoView);
var
i, sx, sy: Integer;
Lines: TStringList;
Text: String;
Style: Integer;
function StrToOem(AnsiStr: AnsiString): AnsiString;
var
i: Integer;
begin
SetLength(Result, Length(AnsiStr));
if Length(Result) > 0 then
begin
for i := 1 to Length(AnsiStr) do
if AnsiStr[i] = #160 then
AnsiStr[i] := #32;
{$IFDEF Linux}
Result := AnsiStr;
{$ELSE}
CharToOemBuffA(PAnsiChar(AnsiStr), PAnsiChar(Result), Length(Result));
{$ENDIF}
end;
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 AlignBuf(const buf: AnsiString): AnsiString;
begin
if (Memo.HAlign = haLeft) then
Result := LeftStr(buf, dx)
else if (Memo.HAlign = haRight) then
Result := RightStr(buf, dx)
else if (Memo.HAlign = haCenter) then
Result := CenterStr(buf, dx)
else
Result := LeftStr(buf, dx);
end;
begin
Lines := TStringList.Create;
if not Memo.WordWrap and Memo.TruncOutboundText then
Text := Memo.GetoutBoundText
else
Text := Memo.WrapText(True);
if FOEMConvert then
Text := String(StrToOem(AnsiString(Text)));
Lines.Text := Text;
if dy > Lines.Count then
begin
if (Memo.VAlign = vaBottom) then
sy := y + dy - Lines.Count
else if (Memo.VAlign = vaCenter) then
sy := y + (dy - Lines.Count) div 2
else
sy := y
end
else
sy := y;
for i := 0 to Lines.Count - 1 do
begin
if i > dy - 1 then
break;
SetString(x, sy + i, AlignBuf(AnsiString(Lines[i])));
end;
Lines.Free;
Style := StyleToInt(Memo.FontStyle);
for sx := x to x + dx - 1 do
for sy := y to y + dy - 1 do
SetStyle(sx, sy, Style);
if y + dy > FMaxHeight then
FMaxHeight := y + dy;
end;
procedure TfrxDotMatrixExport.CreateBuf(Width, Height: Integer);
var
i, j: Integer;
begin
FBufWidth := Width;
FBufHeight := Height;
SetLength(FCharBuf, FBufWidth * FBufHeight);
SetLength(FStyleBuf, FBufWidth * FBufHeight);
SetLength(FFrameBuf, FBufWidth * FBufHeight);
for i := 0 to FBufHeight - 1 do
for j := 0 to FBufWidth - 1 do
begin
FCharBuf[i * FBufWidth + j] := ' ';
FStyleBuf[i * FBufWidth + j] := FPageStyle;
FFrameBuf[i * FBufWidth + j] := 0;
end;
end;
procedure TfrxDotMatrixExport.FreeBuf;
begin
FFrameBuf := nil;
FStyleBuf := nil;
FCharBuf := nil;
FBufHeight := 0;
FBufWidth := 0;
end;
procedure TfrxDotMatrixExport.FlushBuf;
var
i, j, Style, CurrentStyle: Integer;
buf: AnsiString;
Frames: AnsiString;
function Trim_Right(const s: AnsiString): AnsiString;
var
i: Integer;
begin
Result := s;
for i := Length(Result) downto 1 do
if Result[i] <> ' ' then
break;
SetLength(Result, i);
end;
begin
if Length(CustomFrameSet) = 15 then
Frames := CustomFrameSet
else if FGraphicFrames then
Frames := FrameSet[2]
else
Frames := FrameSet[1];
CurrentStyle := FPageStyle;
for i := 0 to FMaxHeight - 1 do
begin
buf := AnsiString(StyleOn(CurrentStyle));
for j := 0 to FBufWidth - 1 do
begin
Style := FStyleBuf[i * FBufWidth + j];
if Style <> CurrentStyle then
begin
buf := buf + AnsiString(StyleChange(CurrentStyle, Style));
CurrentStyle := Style;
end;
if FFrameBuf[i * FBufWidth + j] <> 0 then
buf := buf + Frames[FFrameBuf[i * FBufWidth + j]] else
buf := buf + FCharBuf[i * FBufWidth + j];
end;
buf := Trim_Right(buf) + AnsiString(StyleOff(CurrentStyle));
WriteStrLn(buf);
end;
end;
function TfrxDotMatrixExport.ShowModal: TModalResult;
var
Ini: TCustomIniFile;
begin
Ini := Report.GetIniFile;
with TfrxDMPExportDialog.Create(nil) do
begin
if FUseIniSettings then
begin
FPageBreaks := Ini.ReadBool('DMP', 'PageBreaks', True);
FOEMConvert := Ini.ReadBool('DMP', 'OEM', True);
FGraphicFrames := Ini.ReadBool('DMP', 'GraphFrame', False);
FEscModel := Ini.ReadInteger('DMP', 'PrinterType', 0);
end;
if FEscModel >= frxDMPrinters.Count then
FEscModel := 0;
PageBreaksCB.Checked := FPageBreaks;
OemCB.Checked := FOEMConvert;
PseudoCB.Checked := FGraphicFrames;
SaveToFileCB.Checked := FSaveToFile;
EscCB.ItemIndex := FEscModel;
CopiesUD.Position := Report.PrintOptions.Copies;
RangeE.Text := PageNumbers;
Result := ShowModal;
if Result = mrOk then
begin
FSaveToFile := SaveToFileCB.Checked;
if FSaveToFile then
if SaveDialog1.Execute then
FileName := SaveDialog1.Filename else
Result := mrCancel;
CurPage := False;
if PageNumbersRB.Checked then
PageNumbers := RangeE.Text
else if CurPageRB.Checked then
CurPage := True
else
PageNumbers := '';
FCopies := StrToInt(CopiesE.Text);
FPageBreaks := PageBreaksCB.Checked;
FOEMConvert := OemCB.Checked;
FGraphicFrames := PseudoCB.Checked;
FEscModel := EscCB.ItemIndex;
Ini.WriteBool('DMP', 'OEM', FOEMConvert);
Ini.WriteBool('DMP', 'GraphFrame', FGraphicFrames);
Ini.WriteBool('DMP', 'PageBreaks', FPageBreaks);
Ini.WriteInteger('DMP', 'PrinterType', FEscModel);
end;
Free;
end;
Ini.Free;
end;
function TfrxDotMatrixExport.Start: Boolean;
begin
if not ShowDialog then
FCopies := Report.PrintOptions.Copies;
if Assigned(Stream) then
FStream := Stream
else
begin
if not FSaveToFile then
FileName := GetTempFName;
if FileName <> '' then
FStream := TFileStream.Create(FileName, fmCreate)
else
FStream := nil;
end;
if Assigned(FStream) then
begin
Reset;
WriteStr(FPrinterInitString);
WriteStr(AnsiString(Report.ReportOptions.InitString));
Result := True
end
else
Result := False;
end;
procedure TfrxDotMatrixExport.StartPage(Page: TfrxReportPage; Index: Integer);
begin
FMaxHeight := 0;
FPageStyle := StyleToInt(TfrxDMPPage(Page).FontStyle);
CreateBuf(Round(Page.Width / fr1CharX) + 1, Round(Page.Height / fr1CharY) + 1);
if Page.Orientation = poLandscape then
Landscape else
Portrait;
end;
procedure TfrxDotMatrixExport.ExportObject(Obj: TfrxComponent);
var
Style: Integer;
Memo: TfrxDMPMemoView;
begin
if (Obj is TfrxView) and not TfrxView(Obj).Printable then Exit;
if Obj is TfrxDMPMemoView then
begin
Memo := TfrxDMPMemoView(Obj);
Style := StyleToInt(Memo.FontStyle);
DrawMemo(Round(Memo.AbsLeft / fr1CharX), Round(Memo.AbsTop / fr1CharY),
Round(Memo.Width / fr1CharX), Round(Memo.Height / fr1CharY), Memo);
if (ftLeft in Memo.Frame.Typ) then
DrawFrame(Round(Memo.AbsLeft / fr1CharX) - 1,
Round(Memo.AbsTop / fr1CharY) - 1, 1, Round(Memo.Height / fr1CharY) + 2, Style);
if (ftRight in Memo.Frame.Typ) then
DrawFrame(Round((Memo.AbsLeft + Memo.Width) / fr1CharX),
Round(Memo.AbsTop / fr1CharY) - 1, 1, Round(Memo.Height / fr1CharY) + 2, Style);
if (ftTop in Memo.Frame.Typ) then
DrawFrame(Round(Memo.AbsLeft / fr1CharX) - 1,
Round(Memo.AbsTop / fr1CharY) - 1, Round(Memo.Width / fr1CharX) + 2, 1, Style);
if (ftBottom in Memo.Frame.Typ) then
DrawFrame(Round(Memo.AbsLeft / fr1CharX) - 1,
Round((Memo.AbsTop + Memo.Height) / fr1CharY),
Round(Memo.Width / fr1CharX) + 2, 1, Style);
end
else if Obj is TfrxDMPLineView then
begin
Style := StyleToInt(TfrxDMPLineView(Obj).FontStyle);
if Obj.Width = 0 then
DrawFrame(Trunc(Obj.AbsLeft / fr1CharX), Trunc(Obj.AbsTop / fr1CharY),
1, Round(Obj.Height / fr1CharY) + 1, Style)
else if Obj.Height = 0 then
begin
if TfrxDMPLineView(Obj).Align = baWidth then
DrawFrame(Trunc(Obj.AbsLeft / fr1CharX) - 1, Trunc(Obj.AbsTop / fr1CharY),
Round(Obj.Width / fr1CharX) + 3, 1, Style)
else if TfrxDMPLineView(Obj).Align = baLeft then
DrawFrame(Trunc(Obj.AbsLeft / fr1CharX) - 1, Trunc(Obj.AbsTop / fr1CharY),
Round(Obj.Width / fr1CharX) + 1, 1, Style)
else if TfrxDMPLineView(Obj).Align = baRight then
DrawFrame(Trunc(Obj.AbsLeft / fr1CharX), Trunc(Obj.AbsTop / fr1CharY),
Round(Obj.Width / fr1CharX) + 2, 1, Style)
else
DrawFrame(Trunc(Obj.AbsLeft / fr1CharX), Trunc(Obj.AbsTop / fr1CharY),
Round(Obj.Width / fr1CharX) + 1, 1, Style);
end;
end
else if Obj is TfrxDMPCommand then
begin
SetString(Round(Obj.AbsLeft / fr1CharX), Round(Obj.AbsTop / fr1CharY),
AnsiString(TfrxDMPCommand(Obj).ToChr));
end;
end;
procedure TfrxDotMatrixExport.FinishPage(Page: TfrxReportPage; Index: Integer);
begin
FlushBuf;
FreeBuf;
if FPageBreaks then
FormFeed;
end;
procedure TfrxDotMatrixExport.Finish;
var
i: Integer;
fname: String;
f, ffrom: TFileStream;
begin
if FStream <> Stream then
begin
FStream.Free;
if not frxPrinters.HasPhysicalPrinters then Exit;
if not FSaveToFile then
begin
fname := GetTempFName;
f := TFileStream.Create(fname, fmCreate);
ffrom := TFileStream.Create(FileName, fmOpenRead);
f.Write(FPrinterInitString[1], Length(FPrinterInitString));
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 FCopies do
SpoolFile(FileName);
DeleteFile(FileName);
end;
end;
end;
{ TfrxTXTExportDialog }
procedure TfrxDMPExportDialog.FormCreate(Sender: TObject);
var
i: Integer;
begin
rePadding(Self);
Caption := frxGet(500);
PrinterL.Caption := frxGet(501);
PagesL.Caption := frxGet(502);
CopiesL.Caption := frxGet(503);
CopiesNL.Caption := frxGet(504);
DescrL.Caption := frxGet(9);
OptionsL.Caption := frxGet(505);
EscL.Caption := frxGet(506);
OK.Caption := frxGet(1);
Cancel.Caption := frxGet(2);
SaveToFileCB.Caption := frxGet(507);
AllRB.Caption := frxGet(3);
CurPageRB.Caption := frxGet(4);
PageNumbersRB.Caption := frxGet(5);
PageBreaksCB.Caption := frxGet(6);
OemCB.Caption := frxGet(508);
PseudoCB.Caption := frxGet(509);
SaveDialog1.Filter := frxGet(510);
PrinterCB.Items := frxPrinters.Printers;
PrinterCB.ItemIndex := frxPrinters.PrinterIndex;
OldIndex := frxPrinters.PrinterIndex;
for i := 0 to frxDMPrinters.Count - 1 do
EscCB.Items.Add(frxDMPrinters[i].Commands[cmdName]);
SetWindowLong(CopiesE.Handle, GWL_STYLE, GetWindowLong(CopiesE.Handle, GWL_STYLE) or ES_NUMBER);
if UseRightToLeftAlignment then
FlipChildren(True);
end;
procedure TfrxDMPExportDialog.FormHide(Sender: TObject);
begin
if ModalResult <> mrOk then
frxPrinters.PrinterIndex := OldIndex;
end;
procedure TfrxDMPExportDialog.PrinterCBClick(Sender: TObject);
begin
frxPrinters.PrinterIndex := PrinterCB.ItemIndex;
end;
procedure TfrxDMPExportDialog.PrinterCBDrawItem(Control: TWinControl;
Index: Integer; ARect: TRect; State: TOwnerDrawState);
var
r: TRect;
begin
r := ARect;
r.Right := r.Left + 18;
r.Bottom := r.Top + 16;
OffsetRect(r, 2, 0);
with PrinterCB.Canvas do
begin
FillRect(ARect);
BrushCopy(r, Image1.Picture.Bitmap, Rect(0, 0, 18, 16), clOlive);
TextOut(ARect.Left + 24, ARect.Top + 1, PrinterCB.Items[Index]);
end;
end;
procedure TfrxDMPExportDialog.RangeEEnter(Sender: TObject);
begin
PageNumbersRB.Checked := True;
end;
procedure TfrxDMPExportDialog.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_F1 then
frxResources.Help(Self);
end;
initialization
frxDMPrinters := TfrxDMPrinters.Create;
frxDMPrinters.ReadDefaultPrinters;
frxDMPrinters.ReadExtPrinters;
finalization
frxDMPrinters.Free;
end.
Reference in New Issue View Git Blame Copy Permalink