BSOne.SFC/Tocsg.Module/PrinterTest/DPrtTestMain.pas

146 lines
3.2 KiB
Plaintext

unit DPrtTestMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Buttons, Vcl.ExtCtrls;
type
TDlgPrtTestMain = class(TForm)
pnTop: TPanel;
mmText: TMemo;
btnDoPrint: TSpeedButton;
cbPrinter: TComboBox;
Label1: TLabel;
Label2: TLabel;
cbPaper: TComboBox;
PrintDialog: TPrintDialog;
PrinterSetupDialog1: TPrinterSetupDialog;
procedure btnDoPrintClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Constructor Create(aOwner: TComponent); override;
procedure RefreshPrinter;
end;
var
DlgPrtTestMain: TDlgPrtTestMain;
implementation
uses
Vcl.Printers;
{$R *.dfm}
function GetDefPrinterName: String;
var
arrStr: array [0 .. 255] of Char;
begin
GetProfileStringW('Windows', 'device', '', arrStr, 255);
Result := StrPas(arrStr);
end;
procedure TDlgPrtTestMain.btnDoPrintClick(Sender: TObject);
var
hDev: THandle;
DevMode: PDeviceMode;
arrDevice, arrDriver, arrPort: array[0..255] of Char;
i: Integer;
begin
if MessageBox(Handle, PChar('출력 하시겠습니까?'),
PChar(Caption), MB_ICONQUESTION or MB_YESNO) = IDNO then exit;
if cbPrinter.ItemIndex = -1 then
exit;
Printer.PrinterIndex := cbPrinter.ItemIndex;
Printer.Title := 'PrinterTest';
hDev := 0;
Printer.GetPrinter(arrDevice, arrDriver, arrPort, hDev);
if hDev = 0 then
exit;
// Printer.Copies := 1; // DevMode.dmCopies
DevMode := GlobalLock(hDev);
try
DevMode.dmPaperSize := DMPAPER_A4;
DevMode.dmColor := DMCOLOR_MONOCHROME;
DevMode.dmCopies := 1;
// DevMode.
Printer.SetPrinter(arrDevice, arrDriver, arrPort, hDev);
finally
GlobalUnlock(hDev);
end;
// 용지 가로, 세로 돌릴려면 Printer.BeginDoc 전에 해야한다..
// 일부 프로그램에서 오류남 23_0623 08:45:27 kku
try
// if png.Width > png.Height then
// Printer.Orientation := poLandscape
// else
// Printer.Orientation := poPortrait;
except
// on E: Exception do
// ETgException.TraceException(Self, E, 'Fail .. Set Printer.Orientation');
end;
Printer.BeginDoc;
try
if not Printer.Printing or Printer.Aborted then
exit;
// Printer.NewPage;
Printer.Canvas.Font.Assign(mmText.Font);
for i := 0 to mmText.Lines.Count - 1 do
begin
if not Printer.Printing or Printer.Aborted then
exit;
Printer.Canvas.TextOut(500, 500 + (i * 200), mmText.Lines[i]);
end;
finally
if Printer.Printing then
Printer.EndDoc;
end;
MessageBox(Handle, PChar('출력이 완료 되었습니다.'), PChar(Caption), MB_ICONINFORMATION or MB_OK);
end;
Constructor TDlgPrtTestMain.Create(aOwner: TComponent);
begin
Inherited Create(aOwner);
RefreshPrinter;
end;
procedure TDlgPrtTestMain.RefreshPrinter;
var
i: Integer;
sDefPrt: String;
begin
cbPrinter.Clear;
sDefPrt := GetDefPrinterName;
i := Pos(',', sDefPrt);
if i > 0 then
Delete(sDefPrt, i, Length(sDefPrt) - i + 1);
for i := 0 to Printer.Printers.Count - 1 do
begin
cbPrinter.Items.Add(Printer.Printers[i]);
if sDefPrt = Printer.Printers[i] then
cbPrinter.ItemIndex := i;
end;
// Printer.
end;
end.