私はWindowsのプリントスプーラーAPIのラッパークラスを作成しました。これはほとんど機能します。
動作しないのは、プリンタ設定を適用することだけです。
まず、DocumentProperties()を呼び出して、プリンター設定を正常に取得して操作します。
次に、 ResetDC()を使用してこれらの設定を適用しようとしましたが、何も起こりません。この関数は有効なハンドルを取り、同じ有効なハンドルを返します。つまり、設定を適用する必要があります。しかし、何も起こらなかったようです。印刷出力は、プリンタ設定の変更による影響を受けません。
私は、レベル9でSetPrinter()を使用しようとしましたが、これも効果がありません。
このタスクはかなり緊急になっています。助言がありますか?
Delphi XE2、Windows764ビットを使用します。
さて、大きなOOラッパーの大部分をすべてスキップします。これが要約された手続き型バージョンです。(XPSファイルを指定する必要があることに注意してください。)
プリンター設定の変更が適用されており(Info2_Apply()を使用している場合)、MSWordで確認できます。印刷時に無視されているだけです。それが謎です。
私は非常に多くのことを試したので、オプションが不足しています。助けていただければ幸いです。
私はついにオプションを使い果たしました。
これが私のテストコードの最後のバージョンです。それは自己完結型であり、あなたが必要とするよりも多くの機能を含んでいます-私が考えることができる何かを必死に試みた結果です。
他の誰かがプリンタ設定を機能させることができる場合は、私に知らせてください。
以下を使用して、コンボボックスにプリンタ名を入力します。
uses
Printers
ComboBox1.Items.Assign(Printer.Printers);
印刷手順(私のテストコード):
uses
Winapi.WinSpool
procedure PrintXPS(PrinterName, FileNameXPS: string; ParentFormHandle: THandle = 0);
// Printer handle
procedure Printer_Open(out Printer: THandle; Defaults: PPrinterDefaultsW = nil);
begin
if not OpenPrinterW(PWideChar(PrinterName), Printer, Defaults) then
RaiseLastOSError;
end;
procedure Printer_Close(Printer: THandle);
begin
if not ClosePrinter(Printer) then
RaiseLastOSError;
end;
// Printer defaults
procedure Defaults_Obtain(out DefaultsHandle: THandle; out Defaults: PPrinterDefaultsW);
begin
DefaultsHandle := GlobalAlloc(GHND, SizeOf(TPrinterDefaultsW));
if DefaultsHandle = 0 then
RaiseLastOSError;
Defaults := GlobalLock(DefaultsHandle);
if Defaults = nil then
RaiseLastOSError;
end;
// Print settings
procedure Settings_Obtain(Printer: THandle; out SettingsHandle: THandle; out Settings: PDeviceModeW);
var
DeviceModeSize: integer;
begin
DeviceModeSize := DocumentProperties(0, Printer, PWideChar(PrinterName), nil, nil, 0);
if DeviceModeSize < 0 then
RaiseLastOSError;
// Allocate memory
SettingsHandle := GlobalAlloc(GHND, DeviceModeSize);
if SettingsHandle = 0 then
RaiseLastOSError;
// Lock memory
Settings := GlobalLock(SettingsHandle);
if Settings = nil then
RaiseLastOSError;
// Populate memory
if DocumentProperties(ParentFormHandle, Printer, PWideChar(PrinterName), Settings, Settings, DM_OUT_BUFFER) < 0 then
RaiseLastOSError;
end;
procedure Settings_Show(Printer: THandle; var Settings: PDeviceModeW; Options: Cardinal);
var
Return: integer;
begin
Return := DocumentProperties(ParentFormHandle, Printer, PWideChar(PrinterName), Settings, Settings, Options);
if Return < 0 then
RaiseLastOSError;
end;
// DC
function ObtainDC(Printer: THandle; DeviceMode: PDeviceModeW): HDC;
begin
Result := CreateDC(nil, PWideChar(PrinterName), nil, DeviceMode);
if Result = 0 then
RaiseLastOSError;
end;
procedure ApplyDC(DC: HDC; DeviceMode: PDeviceModeW);
begin
if ResetDC(DC, DeviceMode^) = 0 then
RaiseLastOSError;
end;
// PRINTER_INFO_2
procedure Info2_Obtain(Printer: THandle; out Info2Handle: THandle; out Info2: PPrinterInfo2W);
var
InfoSize: Cardinal;
begin
GetPrinterW(Printer, 2, nil, 0, @InfoSize);
// Get printer info memory
Info2Handle := GlobalAlloc(GHND, InfoSize);
if Info2Handle = 0 then
RaiseLastOSError;
// Lock printer info memory
Info2 := GlobalLock(Info2Handle);
if Info2 = nil then
RaiseLastOSError;
// Get printer info data
if not GetPrinterW(Printer, 2, Info2, InfoSize, @InfoSize) then
RaiseLastOSError;
end;
procedure Info2_Apply(Printer: THandle; Info2: PPrinterInfo2W);
begin
if not SetPrinterW(Printer, 2, Info2, 0) then
RaiseLastOSError;
end;
// PRINTER_INFO_8
procedure Info8_Fetch(Printer: THandle; Settings: PDeviceModeW);
var
lBuffer: PPrinterInfo8W;
lBufferSize: Cardinal;
begin
GetPrinterW(Printer, 8, nil, 0, @lBufferSize);
GetMem(lBuffer, lBufferSize);
try
FillChar(lBuffer^, lBufferSize, 0);
// Make the call
lBuffer.pDevMode := Settings;
if not GetPrinterW(Printer, 8, lBuffer, lBufferSize, @lBufferSize) then
RaiseLastOSError;
finally
FreeMem(lBuffer, lBufferSize);
end;
end;
procedure Info8_Apply(Printer: THandle; Settings: PDeviceModeW);
var
lPrinterInfo8: TPrinterInfo8W;
begin
lPrinterInfo8.pDevMode := Settings;
if not SetPrinterW(Printer, 8, @lPrinterInfo8, 0) then
RaiseLastOSError;
end;
// PRINTER_INFO_9
procedure Info9_Fetch(Printer: THandle; Settings: PDeviceModeW);
var
lBuffer: PPrinterInfo9W;
lBufferSize: Cardinal;
begin
GetPrinterW(Printer, 9, nil, 0, @lBufferSize);
GetMem(lBuffer, lBufferSize);
try
FillChar(lBuffer^, lBufferSize, 0);
// Make the call
lBuffer.pDevMode := Settings;
if not GetPrinterW(Printer, 9, lBuffer, lBufferSize, @lBufferSize) then
RaiseLastOSError;
finally
FreeMem(lBuffer, lBufferSize);
end;
end;
procedure Info9_Apply(Printer: THandle; Settings: PDeviceModeW);
var
lPrinterInfo9: TPrinterInfo9W;
begin
lPrinterInfo9.pDevMode := Settings;
if not SetPrinterW(Printer, 9, @lPrinterInfo9, 0) then
RaiseLastOSError;
end;
// Print jobs
function JobCreate(Printer: THandle; FileName: string): Cardinal;
var
lBufferSize: Cardinal;
lAddJobInfo: PAddJobInfo1W;
begin
// Create job
AddJobW(Printer, 1, nil, 0, lBufferSize);
GetMem(lAddJobInfo, lBufferSize);
try
if not AddJobW(Printer, 1, lAddJobInfo, lBufferSize, lBufferSize) then
RaiseLastOSError;
Result := lAddJobInfo.JobId;
// Copy the file into place
CopyFile(PWideChar(FileName), lAddJobInfo.Path, True);
finally
FreeMem(lAddJobInfo, lBufferSize);
end;
end;
procedure JobStart(Printer: THandle; JobID: Cardinal);
begin
if not ScheduleJob(Printer, JobID) then
RaiseLastOSError;
end;
// General cleanup
procedure ReleaseHandle(Handle: THandle);
begin
if not GlobalUnlock(Handle) then
;//RaiseLastOSError;
if GlobalFree(Handle) <> 0 then
;//RaiseLastOSError;
end;
var
PrinterA{, PrinterB}: THandle;
Defaults: PPrinterDefaultsW;
DefaultsHandle: THandle;
DataType: string;
Settings: PDeviceModeW;
SettingsHandle: THandle;
Info2: PPrinterInfo2W;
Info2Handle: THandle;
// DC: HDC;
JobID: Cardinal;
begin
if not FileExists(FileNameXPS) then
raise Exception.Create('File not found: ' + FileNameXPS);
// Get DataType
Printer_Open(PrinterA);
try
Info2_Obtain(PrinterA, Info2Handle, Info2);
try
DataType := WideCharToString(Info2.pDatatype);
finally
ReleaseHandle(Info2Handle);
end;
finally
Printer_Close(PrinterA);
end;
Defaults_Obtain(DefaultsHandle, Defaults);
try
Defaults.pDatatype := PWideChar(DataType);
Defaults.pDevMode := nil;
Defaults.DesiredAccess := PRINTER_ALL_ACCESS;
Printer_Open(PrinterA, Defaults);
try
Info2_Obtain(PrinterA, Info2Handle, Info2);
try
Settings_Show(PrinterA, Info2.pDevMode, DM_IN_BUFFER or DM_IN_PROMPT or DM_OUT_BUFFER);
// Try according to:
// - Remarks section in http://msdn.microsoft.com/en-us/library/windows/desktop/dd145082%28v=vs.85%29.aspx
// - Comment on code line 246 in http://www.lessanvaezi.com/changing-printer-settings-using-the-windows-api/
Info2.pSecurityDescriptor := nil;
Info2_Apply(PrinterA, Info2);
JobID := JobCreate(PrinterA, FileNameXPS);
JobStart(PrinterA, JobID);
finally
ReleaseHandle(Info2Handle);
end;
finally
Printer_Close(PrinterA);
end;
finally
ReleaseHandle(DefaultsHandle);
end;
end;