unit UserSizePaperUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, plSetPrinter, Buttons;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    plSetPrinter1: TplSetPrinter;
    Panel1: TPanel;
    Edit1: TEdit;
    Panel2: TPanel;
    Edit2: TEdit;
    Panel3: TPanel;
    Panel5: TPanel;
    Panel4: TPanel;
    Panel6: TPanel;
    BitBtn1: TBitBtn;
    ComboBox1: TComboBox;
    PrinterSetupDialog1: TPrinterSetupDialog;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
  private
    { Private 宣言 }
    FUserPaperName: string;
    FResultPaperName : string;
    procedure DisplayPaperSize;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Printers,
  Math,
  ShellAPI;

{$R *.DFM}

//=============================================================================
//  用紙のサイズを指定
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  //プリンタの一覧を作成
  ComboBox1.Style := csDropDownList;
  ComboBox1.Items.Assign(plSetPrinter1.PrinterList);
  plSetPrinter1.PrinterName := Printer.Printers[Printer.PrinterIndex];

  ComboBox1.ItemIndex := ComboBox1.Items.IndexOf(plSetPrinter1.PrinterName);
  if ComboBox1.ItemIndex = -1 then ComboBox1.ItemIndex := 0;

  //ユーザ定義用紙のサイズの初期値
  Edit1.Text := '1200';
  Edit2.Text := '1800';
  //用紙名
  FUserPaperName := 'テスト用紙';
end;

//=============================================================================
//  プリンタを選択
//  Delphi6,7であればOnCloseUpイベントに記述した方がよい．
//=============================================================================
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  plSetPrinter1.PrinterName := ComboBox1.Text;
end;

//=============================================================================
//  ユーザ定義用紙を作成して結果を表示
//  サイズが範囲外だと失敗
//  WindowsNT,2000の場合,作成の権限がないと失敗
//  ユーザ定義サイズを独自管理している場合は同じ用紙名が登録済みだと失敗
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LPaperHorz : Integer;
  LPaperVert : Integer;
  LResText   : string;
begin
  LPaperHorz := StrToInt(Edit1.Text);
  LPaperVert := StrToInt(Edit2.Text);

  if plSetPrinter1.SetUserPaper(FUserPaperName, LPaperHorz, LPaperVert) then begin
    FResultPaperName := plSetPrinter1.PaperName;
    LResText := '指定用紙サイズが次の用紙名で使用可能になりました．' + sLineBreak
              + FResultPaperName;
    MessageBox(Handle, PChar(LResText), '結果', MB_ICONINFORMATION);
  end else begin
    FResultPaperName := '';
    LResText := '以下の用紙名またはサイズの登録に失敗しました　' + sLineBreak
              + 'プリントサーバには登録された可能性があります．' + sLineBreak
              + FUserPaperName;
    MessageBox(Handle, PChar(LResText), '結果', MB_ICONINFORMATION);
  end;

  DisplayPaperSize;
end;

//=============================================================================
//  ユーザ定義用紙の削除
//  Windows95,98では常に成功(実際には削除しない)
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LText : string;
begin
  if plSetPrinter1.DeleteUserPaper(FUserPaperName) then begin
    if plSetPrinter1.PaperList.IndexOf(FUserPaperName) < 0 then begin
      LText := 'プリントサーバから以下の用紙名を削除しました．' + sLineBreak
             + FUserPaperName;
    end else begin
      LText := '以下の用紙名の削除に失敗しました．' + sLineBreak
             + FUserPaperName;
    end;
    MessageBox(Handle, PChar(LText), '結果', MB_ICONINFORMATION);
  end else begin
    if (FUserPaperName <> FResultPaperName) and (FResultPaperName <> '') then begin
      LText := '以下の用紙名を使用しましたが，用紙サイズを設定しただけです．'
             + sLineBreak
             + FResultPaperName + sLineBreak
             + 'プリントサーバに以下の用紙名が残っているかも知れません．' + sLineBreak
             + FUserPaperName;
    end else begin
      if plSetPrinter1.PaperList.IndexOf(FUserPaperName) < 0 then begin
        LText := '以下の用紙名は既に削除されているか，存在しません．' + sLineBreak
               + FUserPaperName;
      end else begin
        LText := '以下の用紙名の削除に失敗しました．' + sLineBreak
               + 'プリントサーバに登録されたままの可能性がありますが，' + sLineBreak
               + 'このプリンタドライバからは削除できません．' + sLineBreak
               + FUserPaperName;
      end;
    end;
    MessageBox(Handle, PChar(LText), '結果', MB_ICONINFORMATION);
  end;

  //削除した場合はデフォルトの用紙サイズを表示
  plSetPrinter1.GetPrinterInfo;
  DisplayPaperSize;
end;

//=============================================================================
//  [プリンタの設定]ダイアログを表示して結果を確認
//  プリンタに変更があった場合はGetPrinterInfoを実行しないと変更されない
//=============================================================================
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  if PrinterSetupDialog1.Execute then begin
    plSetPrinter1.GetPrinterInfo;
    DisplayPaperSize;
  end;
end;

//=============================================================================
//  [プリンタのプロパティ]ダイアログを表示して結果を確認
//  本コンポのメソッドShowDialogではGetPrinterInfoは不要
//=============================================================================
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  plSetPrinter1.ShowDialog;
  DisplayPaperSize;
end;

//-----------------------------------------------------------------------------
//  32ビットのWindowsか64ビットのWindowsかを調べる関数
//  64ビット版のWindowsの場合はTrueを返す
//-----------------------------------------------------------------------------
function Is64bitWindows: Boolean;
var
  Wow64Proc : function(hProcess: THandle; var Wow64: BOOL): BOOL stdcall;
  RetFlag   : LongBool;
begin
  @Wow64Proc := GetProcAddress(GetModuleHandle('Kernel32.dll'), 'IsWow64Process');
  if @Wow64Proc <> nil then begin
    Wow64Proc(GetCurrentProcess, RetFlag);

    if SizeOf(THandle) = 4 then begin
      Result := RetFlag;
    end else
    if SizeOf(THandle) = 8 then begin
      Result := True;
    end;
  end else begin
    //Windows XPの64ビット版か
    Result := CheckWin32Version(5, 2);
  end;
end;

//=============================================================================
//  [プリントサーバのプロパティ]ダイアログを表示
//  ユーザ定義用紙の登録と削除の確認用
//
//  ShellExecuteの使用にはusesにShellAPIが必要
//=============================================================================
procedure TForm1.BitBtn3Click(Sender: TObject);
var
  LCmdExe   : string;
  LCmdParam : string;
begin
  //64ビットWindowsの場合で32ビットEXEの場合
  if (Is64bitWindows) and (SizeOf(Pointer) = 4) then begin
    LCmdExe := 'C:\Windows\Sysnative\rundll32';
  end else begin
    LCmdExe := 'rundll32';
  end;
  LCmdParam := 'printui.dll,PrintUIEntry /s';

  ShellExecute(0, nil, PChar(LCmdExe), PChar(LCmdParam), nil, SW_SHOWNORMAL);
end;

//-----------------------------------------------------------------------------
//  取得した用紙の幅と長さを表示
//-----------------------------------------------------------------------------
procedure TForm1.DisplayPaperSize;
var
  LPaperWmm : Integer;
  LPaperHmm : Integer;
begin
  //幅を0.1mm単位に換算
  LPaperWmm := Ceil(plSetPrinter1.PaperWidth * 254.0 / plSetPrinter1.XResolution);
  //長さを0.1mm単位に換算
  LPaperHmm := Ceil(plSetPrinter1.PaperHeight * 254.0 / plSetPrinter1.YResolution);

  //計算結果を文字列にして表示
  Panel5.Caption := '  ' + IntToStr(LPaperWmm);
  Panel6.Caption := '  ' + InttoStr(LPaperHmm);
end;

end.