{**************************************************************************************************}
{                                                                                                  }
{ Project JEDI Code Library (JCL)                                                                  }
{                                                                                                  }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
{ License at http://www.mozilla.org/MPL/                                                           }
{                                                                                                  }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
{ and limitations under the License.                                                               }
{                                                                                                  }
{ The Original Code is JclPrint.pas.                                                               }
{                                                                                                  }
{ The Initial Developers of the Original Code are unknown.                                         }
{ Portions created by these individuals are Copyright (C) of these individuals.                    }
{ All rights reserved.                                                                             }
{                                                                                                  }
{ The Initial Developer of the function DPSetDefaultPrinter is Microsoft. Portions created by      }
{ Microsoft are Copyright (C) 2004 Microsoft Corporation. All Rights Reserved.                     }
{                                                                                                  }
{ Contributors:                                                                                    }
{   Marcel van Brakel                                                                              }
{   Matthias Thoma (mthoma)                                                                        }
{                                                                                                  }
{**************************************************************************************************}

// Last modified: $Date: 2005/10/30 01:55:34 $
// For history see end of file

unit JclPrint;

{$I jcl.inc}
{$I windowsonly.inc}

interface

uses
  Windows, Classes, StdCtrls, SysUtils,
  JclBase;

const
  CCHBinName = 24;
  CCHPaperName = 64;
  CBinMax = 256;
  CPaperNames = 256;

type
  PWordArray = ^TWordArray;
  TWordArray = array [0..255] of Word;

type
  EJclPrinterError = class(EJclError);

  TJclPrintSet = class(TObject)
  private
    FDevice: PChar;  { TODO : change to string }
    FDriver: PChar;
    FPort: PChar;
    FHandle: THandle;
    FDeviceMode: PDeviceModeA;
    FPrinter: Integer;
    FBinArray: PWordArray;
    FNumBins: Byte;
    FPaperArray: PWordArray;
    FNumPapers: Byte;
    FDpiX: Integer;
    FiDpiY: Integer;
    procedure CheckPrinter;
    procedure SetBinArray;
    procedure SetPaperArray;
    function DefaultPaperName(const PaperID: Word): string;
  protected
    procedure SetOrientation(Orientation: Integer);
    function GetOrientation: Integer;
    procedure SetPaperSize(Size: Integer);
    function GetPaperSize: Integer;
    procedure SetPaperLength(Length: Integer);
    function GetPaperLength: Integer;
    procedure SetPaperWidth(Width: Integer);
    function GetPaperWidth: Integer;
    procedure SetScale(Scale: Integer);
    function GetScale: Integer;
    procedure SetCopies(Copies: Integer);
    function GetCopies: Integer;
    procedure SetBin(Bin: Integer);
    function GetBin: Integer;
    procedure SetPrintQuality(Quality: Integer);
    function GetPrintQuality: Integer;
    procedure SetColor(Color: Integer);
    function GetColor: Integer;
    procedure SetDuplex(Duplex: Integer);
    function GetDuplex: Integer;
    procedure SetYResolution(YRes: Integer);
    function GetYResolution: Integer;
    procedure SetTrueTypeOption(Option: Integer);
    function GetTrueTypeOption: Integer;
    function GetPrinterName: string;
    function GetPrinterPort: string;
    function GetPrinterDriver: string;
    procedure SetBinFromList(BinNum: Byte);
    function GetBinIndex: Byte;
    procedure SetPaperFromList(PaperNum: Byte);
    function GetPaperIndex: Byte;
    procedure SetPort(Port: string);
  public
    constructor Create; virtual;
    destructor Destroy; override;
    {$IFDEF KEEP_DEPRECATED}
    { TODO : Find a solution for deprecated }
    function GetBinSourceList: TStringList; overload; {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF}
    function GetPaperList: TStringList; overload; {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF}
    {$ENDIF KEEP_DEPRECATED}
    procedure GetBinSourceList(List: TStrings); overload;
    procedure GetPaperList(List: TStrings); overload;
    procedure SetDeviceMode(Creating: Boolean);
    procedure UpdateDeviceMode;
    procedure SaveToDefaults;
    procedure SavePrinterAsDefault;
    procedure ResetPrinterDialogs;
    function XInchToDot(const Inches: Double): Integer;
    function YInchToDot(const Inches: Double): Integer;
    function XCmToDot(const Cm: Double): Integer;
    function YCmToDot(const Cm: Double): Integer;
    function CpiToDot(const Cpi, Chars: Double): Integer;
    function LpiToDot(const Lpi, Lines: Double): Integer;
    procedure TextOutInch(const X, Y: Double; const Text: string);
    procedure TextOutCm(const X, Y: Double; const Text: string);
    procedure TextOutCpiLpi(const Cpi, Chars, Lpi, Lines: Double; const Text: string);
    procedure CustomPageSetup(const Width, Height: Double);
    procedure SaveToIniFile(const IniFileName, Section: string);
    function ReadFromIniFile(const IniFileName, Section: string): Boolean;
    property Orientation: Integer read GetOrientation write SetOrientation;
    property PaperSize: Integer read GetPaperSize write SetPaperSize;
    property PaperLength: Integer read GetPaperLength write SetPaperLength;
    property PaperWidth: Integer read GetPaperWidth write SetPaperWidth;
    property Scale: Integer read GetScale write SetScale;
    property Copies: Integer read GetCopies write SetCopies;
    property DefaultSource: Integer read GetBin write SetBin;
    property PrintQuality: Integer read GetPrintQuality write SetPrintQuality;
    property Color: Integer read GetColor write SetColor;
    property Duplex: Integer read GetDuplex write SetDuplex;
    property YResolution: Integer read GetYResolution write SetYResolution;
    property TrueTypeOption: Integer read GetTrueTypeOption write SetTrueTypeOption;
    property PrinterName: string read GetPrinterName;
    property PrinterPort: string read GetPrinterPort write SetPort;
    property PrinterDriver: string read GetPrinterDriver;
    property BinIndex: Byte read GetBinIndex write SetBinFromList;
    property PaperIndex: Byte read GetPaperIndex write SetPaperFromList;
    property DpiX: Integer read FDpiX write FDpiX;
    property DpiY: Integer read FiDpiY write FiDpiY;
  end;

procedure DirectPrint(const Printer, Data: string);
procedure SetPrinterPixelsPerInch;
function GetPrinterResolution: TPoint;
function CharFitsWithinDots(const Text: string; const Dots: Integer): Integer;
//procedure PrintTextRotation(X, Y: Integer; Rotation: Word; Text: string);
procedure PrintMemo(const Memo: TMemo; const Rect: TRect);

function GetDefaultPrinterName: string;
function DPGetDefaultPrinter(out PrinterName: string): Boolean;
function DPSetDefaultPrinter(const PrinterName: string): Boolean;

implementation

uses
  Graphics, IniFiles, Messages, Printers, WinSpool,
  JclSysInfo, JclResources;

const
  PrintIniPrinterName   = 'PrinterName';
  PrintIniPrinterPort   = 'PrinterPort';
  PrintIniOrientation   = 'Orientation';
  PrintIniPaperSize     = 'PaperSize';
  PrintIniPaperLength   = 'PaperLength';
  PrintIniPaperWidth    = 'PaperWidth';
  PrintIniScale         = 'Scale';
  PrintIniCopies        = 'Copies';
  PrintIniDefaultSource = 'DefaultSource';
  PrintIniPrintQuality  = 'PrintQuality';
  PrintIniColor         = 'Color';
  PrintIniDuplex        = 'Duplex';
  PrintIniYResolution   = 'YResolution';
  PrintIniTTOption      = 'TTOption';

  cWindows: PChar = 'windows';
  cDevice = 'device';
  cPrintSpool = 'winspool.drv';

// Misc. functions
procedure DirectPrint(const Printer, Data: string);
const
  cRaw = 'RAW';
type
  TDoc_Info_1 = record
    DocName: PChar;
    OutputFile: PChar;
    Datatype: PChar;
  end;
var
  PrinterHandle: THandle;
  DocInfo: TDoc_Info_1;
  BytesWritten: Cardinal;
  Count: Cardinal;
  Defaults: TPrinterDefaults;
begin
  // Defaults added for network printers. Supposedly the last member is ignored
  // by Windows 9x but is necessary for Windows NT. Code was copied from a msg
  // by Alberto Toledo to the C++ Builder techlist and fwd by Theo Bebekis.
  Defaults.pDatatype := cRaw;
  Defaults.pDevMode := nil;
  Defaults.DesiredAccess := PRINTER_ACCESS_USE;
  Count := Length(Data);
  if not OpenPrinter(PChar(Printer), PrinterHandle, @Defaults) then
    raise EJclPrinterError.CreateRes(@RsInvalidPrinter);
  // Fill in the structure with info about this "document"
  DocInfo.DocName := PChar(RsSpoolerDocName);
  DocInfo.OutputFile := nil;
  DocInfo.Datatype := cRaw;
  try
    // Inform the spooler the document is beginning
    if StartDocPrinter(PrinterHandle, 1, @DocInfo) = 0 then
      EJclPrinterError.CreateRes(@RsNAStartDocument);
    try
      // Start a page
      if not StartPagePrinter(PrinterHandle) then
        EJclPrinterError.CreateRes(@RsNAStartPage);
      try
        // Send the data to the printer
        if not WritePrinter(PrinterHandle, @Data, Count, BytesWritten) then
          EJclPrinterError.CreateRes(@RsNASendData);
      finally
        // End the page
        if not EndPagePrinter(PrinterHandle) then
          EJclPrinterError.CreateRes(@RsNAEndPage);
      end;
    finally
      // Inform the spooler that the document is ending
      if not EndDocPrinter(PrinterHandle) then
        EJclPrinterError.CreateRes(@RsNAEndDocument);
    end;
  finally
    // Tidy up the printer handle
    ClosePrinter(PrinterHandle);
  end;
  // Check to see if correct number of bytes written
  if BytesWritten <> Count then
    EJclPrinterError.CreateRes(@RsNATransmission);
end;

procedure SetPrinterPixelsPerInch;
var
  FontSize: Integer;
begin
  FontSize := Printer.Canvas.Font.Size;
  Printer.Canvas.Font.PixelsPerInch := GetDeviceCaps(Printer.Handle, LogPixelsY);
  Printer.Canvas.Font.Size := FontSize;
end;

function GetPrinterResolution: TPoint;
begin
  Result.X := GetDeviceCaps(Printer.Handle, LogPixelsX);
  Result.Y := GetDeviceCaps(Printer.Handle, LogPixelsY);
end;

function CharFitsWithinDots(const Text: string; const Dots: Integer): Integer;
begin
  Result := Length(Text);
  while (Result > 0) and (Printer.Canvas.TextWidth(Copy(Text, 1, Result)) > Dots) do
    Dec(Result);
end;

//WIMDC: The function CanvasTextOutRotation contains a bug in DxGraphics so no need to
//       implement it right now here
(*
procedure PrintTextRotation(X, Y: Integer; Rotation: Word; Text: string);
begin
  CanvasTextOutRotation(Printer.Canvas, X, Y, Rotation, Text);
end;
*)

//WIMDC took the function from DXGraphics and replaced some lines to work with the TStrings class
//      of the memo.

procedure CanvasMemoOut(Canvas: TCanvas; Memo: TMemo; Rect: TRect);
var
  MemoText: PChar;
begin
  MemoText := Memo.Lines.GetText;
  if MemoText <> nil then
    try
      DrawText(Canvas.Handle, MemoText, StrLen(MemoText), Rect,
        DT_LEFT or DT_EXPANDTABS or DT_WORDBREAK);
    finally
      StrDispose(MemoText);
    end;
end;

procedure PrintMemo(const Memo: TMemo; const Rect: TRect);
begin
  CanvasMemoOut(Printer.Canvas, Memo, Rect);
end;

function GetDefaultPrinterName: string;
begin
  DPGetDefaultPrinter(Result);
end;

{ TODO -cHelp : DPGetDefaultPrinter, Author: Microsoft }
// DPGetDefaultPrinter
// Parameters:
//   PrinterName: Return the printer name.
// Returns: True for success, False for failure.

// Source of the original code: Microsoft Knowledge Base Article - 246772
//   http://support.microsoft.com/default.aspx?scid=kb;en-us;246772
function DPGetDefaultPrinter(out PrinterName: string): Boolean;
const
  BUFSIZE = 8192;
type
  TGetDefaultPrinter = function(Buffer: PChar; var Size: DWORD): BOOL; stdcall;
var
  Needed, Returned: DWORD;
  PI2: PPrinterInfo2;
  WinVer: TWindowsVersion;
  hWinSpool: HMODULE;
  GetDefPrint: TGetDefaultPrinter;
  Size: DWORD;
begin
  Result := False;
  PrinterName := '';
  WinVer := GetWindowsVersion;
  // Windows 9x uses EnumPrinters
  if WinVer in [wvWin95, wvWin95OSR2, wvWin98, wvWin98SE, wvWinME] then
  begin
    SetLastError(0);
    Result := EnumPrinters(PRINTER_ENUM_DEFAULT, nil, 2, nil, 0, Needed, Returned);
    if not Result and ((GetLastError <> ERROR_INSUFFICIENT_BUFFER) or (Needed = 0)) then
      Exit;
    GetMem(PI2, Needed);
    try
      Result := EnumPrinters(PRINTER_ENUM_DEFAULT, nil, 2, PI2, Needed, Needed, Returned);
      if Result then
        PrinterName := PI2^.pPrinterName;
    finally
      FreeMem(PI2);
    end;
  end
  else
  // Win NT uses WIN.INI (registry)
  if WinVer in [wvWinNT31, wvWinNT35, wvWinNT351, wvWinNT4] then
  begin
    SetLength(PrinterName, BUFSIZE);
    Result := GetProfileString(cWindows, cDevice, ',,,', PChar(PrinterName), BUFSIZE) > 0;
    if Result then
      PrinterName := Copy(PrinterName, 1, Pos(',', PrinterName) - 1)
    else
      PrinterName := '';
  end
  else
  // >= Win 2000 uses GetDefaultPrinter
  begin
    hWinSpool := LoadLibrary(cPrintSpool);
    if hWinSpool <> 0 then
      try
        @GetDefPrint := GetProcAddress(hWinSpool, 'GetDefaultPrinterA');
        if not Assigned(GetDefPrint) then
          Exit;
        Size := BUFSIZE;
        SetLength(PrinterName, Size);
        Result := GetDefPrint(PChar(PrinterName), Size);
        if Result then
          SetLength(PrinterName, StrLen(PChar(PrinterName)))
        else
          PrinterName := '';
      finally
        FreeLibrary(hWinSpool);
      end;
  end;
end;

{ TODO -cHelp : DPSetDefaultPrinter, Author: Microsoft }
// DPSetDefaultPrinter
// Parameters:
//   PrinterName: Valid name of existing printer to make default.
// Returns: True for success, False for failure.

// Source of the original code: Microsoft Knowledge Base Article - 246772
//   http://support.microsoft.com/default.aspx?scid=kb;en-us;246772
function DPSetDefaultPrinter(const PrinterName: string): Boolean;
type
  TSetDefaultPrinter = function(APrinterName: PChar): BOOL; stdcall;
var
  Needed: DWORD;
  PI2: PPrinterInfo2;
  WinVer: TWindowsVersion;
  hPrinter: THandle;
  hWinSpool: HMODULE;
  SetDefPrint: TSetDefaultPrinter;
  PrinterStr: string;
begin
  Result := False;
  if PrinterName = '' then
    Exit;
  WinVer := GetWindowsVersion;
  if WinVer in [wvWin95, wvWin95OSR2, wvWin98, wvWin98SE, wvWinME] then
  begin
    Result := OpenPrinter(PChar(PrinterName), hPrinter, nil);
    if Result and (hPrinter <> 0) then
      try
        SetLastError(0);
        Result := GetPrinter(hPrinter, 2, nil, 0, @Needed);
        if not Result and ((GetLastError <> ERROR_INSUFFICIENT_BUFFER) or (Needed = 0)) then
          Exit;
        GetMem(PI2, Needed);
        try
          Result := GetPrinter(hPrinter, 2, PI2, Needed, @Needed);
          if Result then
          begin
            PI2^.Attributes := PI2^.Attributes or PRINTER_ATTRIBUTE_DEFAULT;
            Result := SetPrinter(hPrinter, 2, PI2, 0);
            if Result then
              SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, 0,
                LPARAM(cWindows), SMTO_NORMAL, 1000, Needed);
          end;
        finally
          FreeMem(PI2);
        end;
      finally
        ClosePrinter(hPrinter);
      end;
  end
  else
  // Win NT uses WIN.INI (registry)
  if WinVer in [wvWinNT31, wvWinNT35, wvWinNT351, wvWinNT4] then
  begin
    Result := OpenPrinter(PChar(PrinterName), hPrinter, nil);
    if Result and (hPrinter <> 0) then
      try
        SetLastError(0);
        Result := GetPrinter(hPrinter, 2, nil, 0, @Needed);
        if not Result and ((GetLastError <> ERROR_INSUFFICIENT_BUFFER) or (Needed = 0)) then
          Exit;
        GetMem(PI2, Needed);
        try
          Result := GetPrinter(hPrinter, 2, PI2, Needed, @Needed);
          if Result and (PI2^.pDriverName <> nil) and (PI2^.pPortName <> nil) then
          begin
            PrinterStr := PrinterName + ',' + PI2^.pDriverName + ',' + PI2^.pPortName;
            Result := WriteProfileString(cWindows, cDevice, PChar(PrinterStr));
            if Result then
              SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0,
                SMTO_NORMAL, 1000, Needed);
          end;
        finally
          FreeMem(PI2);
        end;
      finally
        ClosePrinter(hPrinter);
      end;
  end
  else
  // >= Win 2000 uses SetDefaultPrinter
  begin
    hWinSpool := LoadLibrary(cPrintSpool);
    if hWinSpool <> 0 then
      try
        @SetDefPrint := GetProcAddress(hWinSpool, 'SetDefaultPrinterA');
        if Assigned(SetDefPrint) then
          Result := SetDefPrint(PChar(PrinterName));
      finally
        FreeLibrary(hWinSpool);
      end;
  end;
end;

// TJclPrintSet
constructor TJclPrintSet.Create;
begin
  inherited Create;
  FBinArray := nil;
  FPaperArray := nil;
  FPrinter := -99;         { TODO : why -99 }
  GetMem(FDevice, 255);
  GetMem(FDriver, 255);
  GetMem(FPort, 255);
end;

destructor TJclPrintSet.Destroy;
begin
  if FBinArray <> nil then
    FreeMem(FBinArray, FNumBins * SizeOf(Word));
  if FPaperArray <> nil then
    FreeMem(FPaperArray, FNumPapers * SizeOf(Word));
  if FDevice <> nil then
    FreeMem(FDevice, 255);
  if FDriver <> nil then
    FreeMem(FDriver, 255);
  if FPort <> nil then
    FreeMem(FPort, 255);
  inherited Destroy;
end;

procedure TJclPrintSet.CheckPrinter;
begin
  if FPrinter <> Printer.PrinterIndex then
  begin
    Printer.GetPrinter(FDevice, FDriver, FPort, FHandle);
    Printer.SetPrinter(FDevice, FDriver, FPort, FHandle);
    SetDeviceMode(False);
  end;
end;

procedure TJclPrintSet.SetBinArray;
var
  NumBinsRec: Integer;
begin
  if FBinArray <> nil then
    FreeMem(FBinArray, FNumBins * SizeOf(Word));
  FBinArray := nil;
  FNumBins := DeviceCapabilities(FDevice, FPort, DC_Bins, nil, FDeviceMode);
  if FNumBins > 0 then
  begin
    GetMem(FBinArray, FNumBins * SizeOf(Word));
    NumBinsRec := DeviceCapabilities(FDevice, FPort, DC_Bins,
      PChar(FBinArray), FDeviceMode);
    if NumBinsRec <> FNumBins then
      raise EJclPrinterError.CreateRes(@RsRetrievingSource);
  end;
end;

procedure TJclPrintSet.SetPaperArray;
var
  NumPapersRec: Integer;
begin
  if FPaperArray <> nil then
    FreeMem(FPaperArray, FNumPapers * SizeOf(Word));
  FNumPapers := DeviceCapabilities(FDevice, FPort, DC_Papers, nil, FDeviceMode);
  if FNumPapers > 0 then
  begin
    GetMem(FPaperArray, FNumPapers * SizeOf(Word));
    NumPapersRec := DeviceCapabilities(FDevice, FPort, DC_Papers,
      PChar(FPaperArray), FDeviceMode);
    if NumPapersRec <> FNumPapers then
      raise EJclPrinterError.CreateRes(@RsRetrievingPaperSource);
  end
  else
    FPaperArray := nil;
end;

{ TODO : complete this list }
// Since Win32 the strings are stored in the printer driver, no chance to get
// a list from Windows
function TJclPrintSet.DefaultPaperName(const PaperID: Word): string;
begin
  case PaperID of
    dmpaper_Letter:
      Result := RsPSLetter;
    dmpaper_LetterSmall:
      Result := RsPSLetter;
    dmpaper_Tabloid:
      Result := RsPSTabloid;
    dmpaper_Ledger:
      Result := RsPSLedger;
    dmpaper_Legal:
      Result := RsPSLegal;
    dmpaper_Statement:
      Result := RsPSStatement;
    dmpaper_Executive:
      Result := RsPSExecutive;
    dmpaper_A3:
      Result := RsPSA3;
    dmpaper_A4:
      Result := RsPSA4;
    dmpaper_A4Small:
      Result := RsPSA4;
    dmpaper_A5:
      Result := RsPSA5;
    dmpaper_B4:
      Result := RsPSB4;
    dmpaper_B5:
      Result := RsPSB5;
    dmpaper_Folio:
      Result := RsPSFolio;
    dmpaper_Quarto:
      Result := RsPSQuarto;
    dmpaper_10X14:
      Result := RsPS10x14;
    dmpaper_11X17:
      Result := RsPS11x17;
    dmpaper_Note:
      Result := RsPSNote;
    dmpaper_Env_9:
      Result := RsPSEnv9;
    dmpaper_Env_10:
      Result := RsPSEnv10;
    dmpaper_Env_11:
      Result := RsPSEnv11;
    dmpaper_Env_12:
      Result := RsPSEnv12;
    dmpaper_Env_14:
      Result := RsPSEnv14;
    dmpaper_CSheet:
      Result := RsPSCSheet;
    dmpaper_DSheet:
      Result := RsPSDSheet;
    dmpaper_ESheet:
      Result := RsPSESheet;
    dmpaper_User:
      Result := RsPSUser;
  else
    Result := RsPSUnknown;
  end;
end;

{$IFDEF KEEP_DEPRECATED}
function TJclPrintSet.GetBinSourceList: TStringList;
begin
  Result := TStringList.Create;
  try
    GetBinSourceList(Result);
  except
    FreeAndNil(Result);
    raise;
  end;
end;
{$ENDIF KEEP_DEPRECATED}

procedure TJclPrintSet.GetBinSourceList(List: TStrings);
type
  TBinName = array [0..CCHBinName - 1] of Char;
  TBinArray = array [1..cBinMax] of TBinName;
  PBinArray = ^TBinArray;
var
  NumBinsRec: Integer;
  BinArray: PBinArray;
  BinStr: string;
  Idx: Integer;
begin
  CheckPrinter;
  BinArray := nil;
  if FNumBins = 0 then
    Exit;
  List.BeginUpdate;
  try
    GetMem(BinArray, FNumBins * SizeOf(TBinName));
    List.Clear;
    NumBinsRec := DeviceCapabilities(FDevice, FPort, DC_BinNames,
      PChar(BinArray), FDeviceMode);
    if NumBinsRec <> FNumBins then
      raise EJclPrinterError.CreateRes(@RsRetrievingSource);
    for Idx := 1 to NumBinsRec do
    begin
      BinStr := StrPas(BinArray^[Idx]);
      List.Add(BinStr);
    end;
  finally
    List.EndUpdate;
    if BinArray <> nil then
      FreeMem(BinArray, FNumBins * SizeOf(TBinName));
  end;
end;

{$IFDEF KEEP_DEPRECATED}
function TJclPrintSet.GetPaperList: TStringList;
begin
  Result := TStringList.Create;
  try
    GetPaperList(Result);
  except
    FreeAndNil(Result);
    raise;
  end;
end;
{$ENDIF KEEP_DEPRECATED}

procedure TJclPrintSet.GetPaperList(List: TStrings);
type
  TPaperName = array [0..CCHPaperName - 1] of Char;
  TPaperArray = array [1..cPaperNames] of TPaperName;
  PPaperArray = ^TPaperArray;
var
  NumPaperRec: Integer;
  PaperArray: PPaperArray;
  PaperStr: string;
  Idx: Integer;
begin
  CheckPrinter;
  PaperArray := nil;
  if FNumPapers = 0 then
    Exit;
  List.BeginUpdate;
  List.Clear;
  try
    GetMem(PaperArray, FNumPapers * SizeOf(TPaperName));
    NumPaperRec := DeviceCapabilities(FDevice, FPort, DC_PaperNames,
      PChar(PaperArray), FDeviceMode);
    if NumPaperRec <> FNumPapers then
    begin
      for Idx := 1 to FNumPapers do
      begin
        PaperStr := DefaultPaperName(FPaperArray^[Idx - 1]);
        List.Add(PaperStr);
      end;
    end
    else
    begin
      for Idx := 1 to NumPaperRec do
      begin
        PaperStr := StrPas(PaperArray^[Idx]);
        List.Add(PaperStr);
      end;
    end;
  finally
    List.EndUpdate;
    if PaperArray <> nil then
      FreeMem(PaperArray, FNumPapers * SizeOf(TPaperName));
  end;
end;

procedure TJclPrintSet.SetDeviceMode(Creating: Boolean);
var
  Res: TPoint;
begin
  Printer.GetPrinter(FDevice, FDriver, FPort, FHandle);
  if FHandle = 0 then
  begin
    Printer.PrinterIndex := Printer.PrinterIndex;
    Printer.GetPrinter(FDevice, FDriver, FPort, FHandle);
  end;
  if FHandle <> 0 then
  begin
    FDeviceMode := GlobalLock(FHandle);
    FPrinter := Printer.PrinterIndex;
    FDeviceMode^.dmFields := dm_Orientation or dm_PaperSize or
      dm_PaperLength or dm_PaperWidth or
      dm_Scale or dm_Copies or
      dm_DefaultSource or dm_PrintQuality or
      dm_Color or dm_Duplex or
      dm_YResolution or dm_TTOption;
    UpdateDeviceMode;
    FDeviceMode^.dmFields := 0;
    SetBinArray;
    SetPaperArray;
  end
  else
  begin
    FDeviceMode := nil;
    if not Creating then
      raise EJclPrinterError.CreateRes(@RsDeviceMode);
    FPrinter := -99;
  end;
  Res := GetPrinterResolution;
  dpiX := Res.X;
  dpiY := Res.Y;
  if FHandle <> 0 then
    GlobalUnLock(FHandle);
end;

procedure TJclPrintSet.UpdateDeviceMode;
var
  DrvHandle: THandle;
  ExtDevCode: Integer;
begin
  CheckPrinter;      
  if OpenPrinter(FDevice, DrvHandle, nil) then
  try
    FDeviceMode^.dmFields := dm_Orientation or dm_PaperSize or
      dm_PaperLength or dm_PaperWidth or
      dm_Scale or dm_Copies or
      dm_DefaultSource or dm_PrintQuality or
      dm_Color or dm_Duplex or
      dm_YResolution or dm_TTOption;
    ExtDevCode := DocumentProperties(0, DrvHandle, FDevice,
      FDeviceMode^, FDeviceMode^,
      DM_IN_BUFFER or DM_OUT_BUFFER);
    if ExtDevCode <> IDOK then
      raise EJclPrinterError.CreateRes(@RsUpdatingPrinter);
  finally
    ClosePrinter(DrvHandle);
  end;
end;

procedure TJclPrintSet.SaveToDefaults;
var
  DrvHandle: THandle;
  ExtDevCode: Integer;
begin
  CheckPrinter;
  OpenPrinter(FDevice, DrvHandle, nil);
  ExtDevCode := DocumentProperties(0, DrvHandle, FDevice,
    FDeviceMode^, FDeviceMode^, DM_IN_BUFFER or DM_UPDATE);
  if ExtDevCode <> IDOK then
    raise EJclPrinterError.CreateRes(@RsUpdatingPrinter)
  else
    SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0);
  ClosePrinter(DrvHandle);
end;

procedure TJclPrintSet.SavePrinterAsDefault;
begin
  CheckPrinter;
  DPSetDefaultPrinter(FDevice);
end;

procedure TJclPrintSet.ResetPrinterDialogs;
begin
  Printer.GetPrinter(FDevice, FDriver, FPort, FHandle);
  Printer.SetPrinter(FDevice, FDriver, FPort, FHandle);
  SetDeviceMode(False);
end;

function TJclPrintSet.XInchToDot(const Inches: Double): Integer;
begin
  Result := Trunc(DpiX * Inches);
end;

function TJclPrintSet.YInchToDot(const Inches: Double): Integer;
begin
  Result := Trunc(DpiY * Inches);
end;

function TJclPrintSet.XCmToDot(const Cm: Double): Integer;
begin
  Result := Trunc(DpiX * (Cm * 2.54));
end;

function TJclPrintSet.YCmToDot(const Cm: Double): Integer;
begin
  Result := Trunc(DpiY * (Cm * 2.54));
end;

function TJclPrintSet.CpiToDot(const Cpi, Chars: Double): Integer;
begin
  Result := Trunc((DpiX * Chars) / Cpi);
end;

function TJclPrintSet.LpiToDot(const Lpi, Lines: Double): Integer;
begin
  Result := Trunc((DpiY * Lpi) / Lines);
end;

procedure TJclPrintSet.TextOutInch(const X, Y: Double; const Text: string);
begin
  Printer.Canvas.TextOut(XInchToDot(X), YInchToDot(Y), Text);
end;

procedure TJclPrintSet.TextOutCm(const X, Y: Double; const Text: string);
begin
  Printer.Canvas.TextOut(XCmToDot(X), YCmToDot(Y), Text);
end;

procedure TJclPrintSet.TextOutCpiLpi(const Cpi, Chars, Lpi, Lines: Double; const Text: string);
begin
  Printer.Canvas.TextOut(CpiToDot(Cpi, Chars), LpiToDot(Lpi, Lines), Text);
end;

procedure TJclPrintSet.CustomPageSetup(const Width, Height: Double);
begin
  PaperSize := dmPaper_User;
  PaperLength := Trunc(254 * Height);
  YResolution := Trunc(DpiY * Height);
  PaperWidth := Trunc(254 * Width);
end;

procedure TJclPrintSet.SaveToIniFile(const IniFileName, Section: string);
var
  PrIniFile: TIniFile;
  CurrentName: string;
begin
  PrIniFile := TIniFile.Create(IniFileName);
  CurrentName := Printer.Printers[Printer.PrinterIndex];
  PrIniFile.WriteString(Section, PrintIniPrinterName, CurrentName);
  PrIniFile.WriteString(Section, PrintIniPrinterPort, PrinterPort);
  PrIniFile.WriteInteger(Section, PrintIniOrientation, Orientation);
  PrIniFile.WriteInteger(Section, PrintIniPaperSize, PaperSize);
  PrIniFile.WriteInteger(Section, PrintIniPaperLength, PaperLength);
  PrIniFile.WriteInteger(Section, PrintIniPaperWidth, PaperWidth);
  PrIniFile.WriteInteger(Section, PrintIniScale, Scale);
  PrIniFile.WriteInteger(Section, PrintIniCopies, Copies);
  PrIniFile.WriteInteger(Section, PrintIniDefaultSource, DefaultSource);
  PrIniFile.WriteInteger(Section, PrintIniPrintQuality, PrintQuality);
  PrIniFile.WriteInteger(Section, PrintIniColor, Color);
  PrIniFile.WriteInteger(Section, PrintIniDuplex, Duplex);
  PrIniFile.WriteInteger(Section, PrintIniYResolution, YResolution);
  PrIniFile.WriteInteger(Section, PrintIniTTOption, TrueTypeOption);
  PrIniFile.Free;
end;

function TJclPrintSet.ReadFromIniFile(const IniFileName, Section: string): Boolean;
var
  PrIniFile: TIniFile;
  SavedName: string;
  NewIndex: Integer;
begin
  Result := False;
  PrIniFile := TIniFile.Create(IniFileName);
  SavedName := PrIniFile.ReadString(Section, PrintIniPrinterName, PrinterName);
  if PrinterName <> SavedName then
  begin
    NewIndex := Printer.Printers.IndexOf(SavedName);
    if NewIndex <> -1 then
    begin
      Result := True;
      Printer.PrinterIndex := NewIndex;
      PrinterPort := PrIniFile.ReadString(Section, PrintIniPrinterPort, PrinterPort);
      Orientation := PrIniFile.ReadInteger(Section, PrintIniOrientation, Orientation);
      PaperSize := PrIniFile.ReadInteger(Section, PrintIniPaperSize, PaperSize);
      PaperLength := PrIniFile.ReadInteger(Section, PrintIniPaperLength, PaperLength);
      PaperWidth := PrIniFile.ReadInteger(Section, PrintIniPaperWidth, PaperWidth);
      Scale := PrIniFile.ReadInteger(Section, PrintIniScale, Scale);
      Copies := PrIniFile.ReadInteger(Section, PrintIniCopies, Copies);
      DefaultSource := PrIniFile.ReadInteger(Section, PrintIniDefaultSource, DefaultSource);
      PrintQuality := PrIniFile.ReadInteger(Section, PrintIniPrintQuality, PrintQuality);
      Color := PrIniFile.ReadInteger(Section, PrintIniColor, Color);
      Duplex := PrIniFile.ReadInteger(Section, PrintIniDuplex, Duplex);
      YResolution := PrIniFile.ReadInteger(Section, PrintIniYResolution, YResolution);
      TrueTypeOption := PrIniFile.ReadInteger(Section, PrintIniTTOption, TrueTypeOption);
    end
    else
      Result := False;
  end;
  PrIniFile.Free;
end;

procedure TJclPrintSet.SetOrientation(Orientation: Integer);
begin
  CheckPrinter;
  FDeviceMode^.dmOrientation := Orientation;
  Printer.Orientation := TPrinterOrientation(Orientation - 1);
  FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_ORIENTATION;
end;

function TJclPrintSet.GetOrientation: Integer;
begin
  CheckPrinter;
  Result := FDeviceMode^.dmOrientation;
end;

procedure TJclPrintSet.SetPaperSize(Size: Integer);
begin
  CheckPrinter;
  FDeviceMode^.dmPaperSize := Size;
  FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_PAPERSIZE;
end;

function TJclPrintSet.GetPaperSize: Integer;
begin
  CheckPrinter;
  Result := FDeviceMode^.dmPaperSize;
end;

procedure TJclPrintSet.SetPaperLength(Length: Integer);
begin
  CheckPrinter;
  FDeviceMode^.dmPaperLength := Length;
  FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_PAPERLENGTH;
end;

function TJclPrintSet.GetPaperLength: Integer;
begin
  CheckPrinter;
  Result := FDeviceMode^.dmPaperLength;
end;

procedure TJclPrintSet.SetPaperWidth(Width: Integer);
begin
  CheckPrinter;
  FDeviceMode^.dmPaperWidth := Width;
  FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_PAPERWIDTH;
end;

function TJclPrintSet.GetPaperWidth: Integer;
begin
  CheckPrinter;
  Result := FDeviceMode^.dmPaperWidth;
end;

procedure TJclPrintSet.SetScale(Scale: Integer);
begin
  CheckPrinter;
  FDeviceMode^.dmScale := Scale;
  FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_SCALE;
end;

function TJclPrintSet.GetScale: Integer;
begin
  CheckPrinter;
  Result := FDeviceMode^.dmScale;
end;

procedure TJclPrintSet.SetCopies(Copies: Integer);
begin
  CheckPrinter;
  FDeviceMode^.dmCopies := Copies;
  FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_COPIES;
end;

function TJclPrintSet.GetCopies: Integer;
begin
  CheckPrinter;
  Result := FDeviceMode^.dmCopies;
end;

procedure TJclPrintSet.SetBin(Bin: Integer);
begin
  CheckPrinter;
  FDeviceMode^.dmDefaultSource := Bin;
  FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_DEFAULTSOURCE;
end;

function TJclPrintSet.GetBin: Integer;
begin
  CheckPrinter;
  Result := FDeviceMode^.dmDefaultSource;
end;

procedure TJclPrintSet.SetPrintQuality(Quality: Integer);
begin
  CheckPrinter;
  FDeviceMode^.dmPrintQuality := Quality;
  FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_PRINTQUALITY;
end;

function TJclPrintSet.GetPrintQuality: Integer;
begin
  CheckPrinter;
  Result := FDeviceMode^.dmPrintQuality;
end;

procedure TJclPrintSet.SetColor(Color: Integer);
begin
  CheckPrinter;
  FDeviceMode^.dmColor := Color;
  FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_ORIENTATION;
end;

function TJclPrintSet.GetColor: Integer;
begin
  CheckPrinter;
  Result := FDeviceMode^.dmColor;
end;

procedure TJclPrintSet.SetDuplex(Duplex: Integer);
begin
  CheckPrinter;
  FDeviceMode^.dmDuplex := Duplex;
  FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_DUPLEX;
end;

function TJclPrintSet.GetDuplex: Integer;
begin
  CheckPrinter;
  Result := FDeviceMode^.dmDuplex;
end;

procedure TJclPrintSet.SetYResolution(YRes: Integer);
var
  PrintDevMode: PDeviceModeA;
begin
  CheckPrinter;
  PrintDevMode := @FDeviceMode^;
  PrintDevMode^.dmYResolution := YRes;
  FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_YRESOLUTION;
end;

function TJclPrintSet.GetYResolution: Integer;
var
  PrintDevMode: PDeviceModeA;
begin
  CheckPrinter;
  PrintDevMode := @FDeviceMode^;
  Result := PrintDevMode^.dmYResolution;
end;

procedure TJclPrintSet.SetTrueTypeOption(Option: Integer);
var
  PrintDevMode: PDeviceModeA;
begin
  CheckPrinter;
  PrintDevMode := @FDeviceMode^;
  PrintDevMode^.dmTTOption := Option;
  FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_TTOPTION;
end;

function TJclPrintSet.GetTrueTypeOption: Integer;
var
  PrintDevMode: PDeviceModeA;
begin
  CheckPrinter;
  PrintDevMode := @FDeviceMode^;
  Result := PrintDevMode^.dmTTOption;
end;

function TJclPrintSet.GetPrinterName: string;
begin
  CheckPrinter;
  Result := StrPas(FDevice);
end;

function TJclPrintSet.GetPrinterPort: string;
begin
  CheckPrinter;
  Result := StrPas(FPort);
end;

function TJclPrintSet.GetPrinterDriver: string;
begin
  CheckPrinter;
  Result := StrPas(FDriver);
end;

procedure TJclPrintSet.SetBinFromList(BinNum: Byte);
begin
  CheckPrinter;
  if FNumBins = 0 then
    Exit;
  if BinNum > FNumBins then
    raise EJclPrinterError.CreateRes(@RsIndexOutOfRange)
  else
    DefaultSource := FBinArray^[BinNum];
end;

function TJclPrintSet.GetBinIndex: Byte;
var
  Idx: Byte;
begin
  Result := 0;
  for Idx := 0 to FNumBins do
  begin
    if FBinArray^[Idx] = Word(FDeviceMode^.dmDefaultSource) then
    begin
      Result := Idx;
      Break;
    end;
  end;
end;

procedure TJclPrintSet.SetPaperFromList(PaperNum: Byte);
begin
  CheckPrinter;
  if FNumPapers = 0 then
    Exit;
  if PaperNum > FNumPapers then
    raise EJclPrinterError.CreateRes(@RsIndexOutOfRangePaper)
  else
    PaperSize := FPaperArray^[PaperNum];
end;

procedure TJclPrintSet.SetPort(Port: string);
begin
  CheckPrinter;
  Port := Port + #0;
  Move(Port[1], FPort^, Length(Port));
  Printer.SetPrinter(FDevice, FDriver, FPort, FHandle);
end;

function TJclPrintSet.GetPaperIndex: Byte;
var
  Idx: Byte;
begin
  Result := 0;
  for Idx := 0 to FNumPapers do
  begin
    if FPaperArray^[Idx] = Word(FDeviceMode^.dmPaperSize) then
    begin
      Result := Idx;
      Break;
    end;
  end;
end;

// History:

// $Log: JclPrint.pas,v $
// Revision 1.21  2005/10/30 01:55:34  rrossmair
// - introduce KEEP_DEPRECATED as alias for ~DROP_OBSOLETE_CODE
//
// Revision 1.20  2005/03/08 08:33:20  marquardt
// overhaul of exceptions and resourcestrings, minor style cleaning
//
// Revision 1.19  2005/03/05 06:31:19  rrossmair
// - allow conditional compilation for deprecated code (symbol DROP_OBSOLETE_CODE)
//
// Revision 1.18  2005/02/24 16:34:51  marquardt
// remove divider lines, add section lines (unfinished)
//
// Revision 1.17  2004/11/06 02:07:05  mthoma
// cleaning.
//
// Revision 1.16  2004/10/09 13:58:52  marquardt
// style cleaning JclPrint
// remove WinSpool related functions from JclWin32
//
// Revision 1.15  2004/10/09 06:17:27  marquardt
// cleaning: DPSetDefaultPrinter reimplemented from scratch
//
// Revision 1.14  2004/10/08 16:45:31  marquardt
// cleaning: DPGetDefaultPrinter reimplemented from scratch
//
// Revision 1.13  2004/09/16 19:47:32  rrossmair
// check-in in preparation for release 1.92
//
// Revision 1.12  2004/08/02 15:30:16  marquardt
// hunting down (rom) comments
//
// Revision 1.11  2004/08/02 06:34:59  marquardt
// minor string literal improvements
//
// Revision 1.10  2004/07/30 07:20:25  marquardt
// fixing TStringLists, adding BeginUpdate/EndUpdate
//
// Revision 1.9  2004/07/28 18:00:52  marquardt
// various style cleanings, some minor fixes
//
// Revision 1.8  2004/06/14 13:05:20  marquardt
// style cleaning ENDIF, Tabs
//
// Revision 1.7  2004/06/14 11:05:52  marquardt
// symbols added to all ENDIFs and some other minor style changes like removing IFOPT
//
// Revision 1.6  2004/05/13 07:32:18  rrossmair
// header updated according to new policy: initial developers & contributors listed
//
// Revision 1.5  2004/04/13 13:33:38
// add DPSetDefaultPrinter, bugfix GetDefaultPrinterName
//
// Revision 1.4  2004/04/11 22:12:16  mthoma
// Added a new function: GetDefaultPrinterName.
//
// Revision 1.3  2004/04/06 04:37:59
// DPSetDefaultPrinter
//

end.