1

私は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;
4

0 に答える 0