PageRenderTime 29ms CodeModel.GetById 20ms app.highlight 5ms RepoModel.GetById 0ms app.codeStats 0ms

/jcl/source/vcl/JclPrint.pas

https://github.com/the-Arioch/jcl
Pascal | 1632 lines | 1399 code | 118 blank | 115 comment | 78 complexity | 5da3cd05be4dfce70d81f91d9812de2f MD5 | raw file
Possible License(s): BSD-3-Clause
   1{**************************************************************************************************}
   2{                                                                                                  }
   3{ Project JEDI Code Library (JCL)                                                                  }
   4{                                                                                                  }
   5{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
   6{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
   7{ License at http://www.mozilla.org/MPL/                                                           }
   8{                                                                                                  }
   9{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
  10{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
  11{ and limitations under the License.                                                               }
  12{                                                                                                  }
  13{ The Original Code is JclPrint.pas.                                                               }
  14{                                                                                                  }
  15{ The Initial Developers of the Original Code are unknown.                                         }
  16{ Portions created by these individuals are Copyright (C) of these individuals.                    }
  17{ All rights reserved.                                                                             }
  18{                                                                                                  }
  19{ The Initial Developer of the function DPSetDefaultPrinter is Microsoft. Portions created by      }
  20{ Microsoft are Copyright (C) 2004 Microsoft Corporation. All Rights Reserved.                     }
  21{                                                                                                  }
  22{ Contributors:                                                                                    }
  23{   Marcel van Brakel                                                                              }
  24{   Matthias Thoma (mthoma)                                                                        }
  25{   Karl Ivar Hansen                                                                               }
  26{   Martin Cakrt                                                                                   }
  27{   Jared Davison                                                                                  }
  28{                                                                                                  }
  29{**************************************************************************************************}
  30{                                                                                                  }
  31{ This unit contains print-related classes and functions.                                          }
  32{                                                                                                  }
  33{**************************************************************************************************}
  34{                                                                                                  }
  35{ Last modified: $Date::                                                                         $ }
  36{ Revision:      $Rev::                                                                          $ }
  37{ Author:        $Author::                                                                       $ }
  38{                                                                                                  }
  39{**************************************************************************************************}
  40
  41unit JclPrint;
  42
  43{$I jcl.inc}
  44{$I windowsonly.inc}
  45
  46interface
  47
  48uses
  49  {$IFDEF UNITVERSIONING}
  50  JclUnitVersioning,
  51  {$ENDIF UNITVERSIONING}
  52  {$IFDEF HAS_UNITSCOPE}
  53  Winapi.Windows, System.Classes, Vcl.StdCtrls, System.SysUtils, System.IniFiles,
  54  {$ELSE ~HAS_UNITSCOPE}
  55  Windows, Classes, StdCtrls, SysUtils, IniFiles,
  56  {$ENDIF ~HAS_UNITSCOPE}
  57  JclBase;
  58
  59const
  60  CCHBinName = 24;
  61  CCHPaperName = 64;
  62  CBinMax = 256;
  63  CPaperNames = 256;
  64
  65type
  66  PWordArray = ^TWordArray;
  67  TWordArray = array [0..255] of Word;
  68
  69type
  70  EJclPrinterError = class(EJclError);
  71
  72  TJclPrintSet = class(TObject)
  73  private
  74    FDevice: PChar;  { TODO : change to string }
  75    FDriver: PChar;
  76    FPort: PChar;
  77    FHandle: THandle;
  78    FPrinter: Integer;
  79    FBinArray: PWordArray;
  80    FNumBins: DWord;
  81    FPaperArray: PWordArray;
  82    FNumPapers: DWord;
  83    FDpiX: Integer;
  84    FiDpiY: Integer;
  85    procedure CheckPrinter;
  86    procedure SetBinArray;
  87    procedure SetPaperArray;
  88    function DefaultPaperName(const PaperID: Word): string;
  89    function GetDevModePrinterDriverVersion: Word;
  90    function GetDevModePrinterDriver: string;
  91    function GetDevModePrinterDriverExtra: TDynByteArray;
  92    function LockDeviceMode: PDeviceMode;
  93    procedure SetDeviceMode(Creating: Boolean);
  94    procedure SetPrinterName(const Value: string);
  95    procedure UnlockDeviceMode;
  96  protected
  97    procedure SetOrientation(Orientation: Integer);
  98    function GetOrientation: Integer;
  99    procedure SetPaperSize(Size: Integer);
 100    function GetPaperSize: Integer;
 101    procedure SetPaperLength(Length: Integer);
 102    function GetPaperLength: Integer;
 103    procedure SetPaperWidth(Width: Integer);
 104    function GetPaperWidth: Integer;
 105    procedure SetScale(Scale: Integer);
 106    function GetScale: Integer;
 107    procedure SetCopies(Copies: Integer);
 108    function GetCopies: Integer;
 109    procedure SetBin(Bin: Integer);
 110    function GetBin: Integer;
 111    procedure SetPrintQuality(Quality: Integer);
 112    function GetPrintQuality: Integer;
 113    procedure SetColor(Color: Integer);
 114    function GetColor: Integer;
 115    procedure SetDuplex(Duplex: Integer);
 116    function GetDuplex: Integer;
 117    procedure SetYResolution(YRes: Integer);
 118    function GetYResolution: Integer;
 119    procedure SetTrueTypeOption(Option: Integer);
 120    function GetTrueTypeOption: Integer;
 121    function GetPrinterName: string;
 122    function GetPrinterPort: string;
 123    function GetPrinterDriver: string;
 124    procedure SetBinFromList(BinNum: Word);
 125    function GetBinIndex: Word;
 126    procedure SetPaperFromList(PaperNum: Word);
 127    function GetPaperIndex: Word;
 128    function ReadFromCustomIni(const PrIniFile: TCustomIniFile; const Section: string): Boolean;
 129    procedure SaveToCustomIni(const PrIniFile: TCustomIniFile; const Section: string);
 130    procedure SetPort(Port: string);
 131    procedure DevModePrinterDriverExtraReinstate(const ExtraData: TDynByteArray;
 132      const ExtraDataDriverName: string; const ExtraDataDriverVersion: Word);
 133  public
 134    constructor Create; virtual;
 135    destructor Destroy; override;
 136    // use the other implementations
 137    //function GetBinSourceList: TStringList; overload;
 138    //function GetPaperList: TStringList; overload;
 139    procedure GetBinSourceList(List: TStrings); overload;
 140    procedure GetPaperList(List: TStrings); overload;
 141    procedure UpdateDeviceMode(const ADeviceMode: PDeviceMode);
 142    procedure SaveToDefaults;
 143    procedure SavePrinterAsDefault;
 144    procedure ResetPrinterDialogs;
 145    function XInchToDot(const Inches: Double): Integer;
 146    function YInchToDot(const Inches: Double): Integer;
 147    function XCmToDot(const Cm: Double): Integer;
 148    function YCmToDot(const Cm: Double): Integer;
 149    function CpiToDot(const Cpi, Chars: Double): Integer;
 150    function LpiToDot(const Lpi, Lines: Double): Integer;
 151    procedure TextOutInch(const X, Y: Double; const Text: string);
 152    procedure TextOutCm(const X, Y: Double; const Text: string);
 153    procedure TextOutCpiLpi(const Cpi, Chars, Lpi, Lines: Double; const Text: string);
 154    procedure CustomPageSetup(const Width, Height: Double);
 155    procedure DevModePrinterDriverExtraClear;
 156    procedure SaveToIniFile(const IniFileName, Section: string); virtual;
 157    function ReadFromIniFile(const IniFileName, Section: string): Boolean; virtual;
 158    property Orientation: Integer read GetOrientation write SetOrientation;
 159    property PaperSize: Integer read GetPaperSize write SetPaperSize;
 160    property PaperLength: Integer read GetPaperLength write SetPaperLength;
 161    property PaperWidth: Integer read GetPaperWidth write SetPaperWidth;
 162    property Scale: Integer read GetScale write SetScale;
 163    property Copies: Integer read GetCopies write SetCopies;
 164    property DefaultSource: Integer read GetBin write SetBin;
 165    property PrintQuality: Integer read GetPrintQuality write SetPrintQuality;
 166    property Color: Integer read GetColor write SetColor;
 167    property Duplex: Integer read GetDuplex write SetDuplex;
 168    property YResolution: Integer read GetYResolution write SetYResolution;
 169    property TrueTypeOption: Integer read GetTrueTypeOption write SetTrueTypeOption;
 170    property PrinterName: string read GetPrinterName write SetPrinterName;
 171    property PrinterPort: string read GetPrinterPort write SetPort;
 172    property PrinterDriver: string read GetPrinterDriver;
 173    property BinIndex: Word read GetBinIndex write SetBinFromList;
 174    property DevModePrinterDriverVersion: Word read GetDevModePrinterDriverVersion;
 175    property DevModePrinterDriver: string read GetDevModePrinterDriver;
 176    property DevModePrinterDriverExtra: TDynByteArray read
 177        GetDevModePrinterDriverExtra;
 178    property PaperIndex: Word read GetPaperIndex write SetPaperFromList;
 179    property DpiX: Integer read FDpiX write FDpiX;
 180    property DpiY: Integer read FiDpiY write FiDpiY;
 181  end;
 182
 183  TPrinterData = {$IFDEF SUPPORTS_UNICODE_STRING}RawByteString{$ELSE}AnsiString{$ENDIF};
 184
 185procedure DirectPrint(const Printer: string; const Data: TPrinterData;
 186  const DocumentName: string = '');
 187procedure SetPrinterPixelsPerInch;
 188function GetPrinterResolution: TPoint;
 189function CharFitsWithinDots(const Text: string; const Dots: Integer): Integer;
 190//procedure PrintTextRotation(X, Y: Integer; Rotation: Word; Text: string);
 191procedure PrintMemo(const Memo: TMemo; const Rect: TRect);
 192
 193function GetDefaultPrinterName: string;
 194function DPGetDefaultPrinter(out PrinterName: string): Boolean;
 195function DPSetDefaultPrinter(const PrinterName: string): Boolean;
 196
 197{$IFDEF UNITVERSIONING}
 198const
 199  UnitVersioning: TUnitVersionInfo = (
 200    RCSfile: '$URL$';
 201    Revision: '$Revision$';
 202    Date: '$Date$';
 203    LogPath: 'JCL\source\vcl';
 204    Extra: '';
 205    Data: nil
 206    );
 207{$ENDIF UNITVERSIONING}
 208
 209implementation
 210
 211uses
 212  {$IFDEF HAS_UNITSCOPE}
 213  Vcl.Graphics, Winapi.Messages, Vcl.Printers, Winapi.WinSpool,
 214  {$ELSE ~HAS_UNITSCOPE}
 215  Graphics, Messages, Printers, WinSpool,
 216  {$ENDIF ~HAS_UNITSCOPE}
 217  JclSysInfo, JclVclResources;
 218
 219const
 220  PrintIniPrinterName   = 'PrinterName';
 221  PrintIniPrinterPort   = 'PrinterPort';
 222  PrintIniOrientation   = 'Orientation';
 223  PrintIniPaperSize     = 'PaperSize';
 224  PrintIniPaperLength   = 'PaperLength';
 225  PrintIniPaperWidth    = 'PaperWidth';
 226  PrintIniScale         = 'Scale';
 227  PrintIniCopies        = 'Copies';
 228  PrintIniDefaultSource = 'DefaultSource';
 229  PrintIniPrintQuality  = 'PrintQuality';
 230  PrintIniColor         = 'Color';
 231  PrintIniDuplex        = 'Duplex';
 232  PrintIniYResolution   = 'YResolution';
 233  PrintIniTTOption      = 'TTOption';
 234
 235  PrintDriverExtraSize = 'DriverExtraSize';
 236  PrintDriverExtraData = 'DriverExtraData';
 237  PrintDriverVersion = 'DriverVersion';
 238  PrintDriverName = 'DriverName';
 239
 240  cWindows: PChar = 'windows';
 241  cDevice = 'device';
 242  cPrintSpool = 'winspool.drv';
 243
 244// Misc. functions
 245procedure DirectPrint(const Printer: string; const Data: TPrinterData; const DocumentName: string);
 246const
 247  cRaw = 'RAW';
 248type
 249  TDoc_Info_1 = record
 250    DocName: PChar;
 251    OutputFile: PChar;
 252    Datatype: PChar;
 253  end;
 254var
 255  PrinterHandle: THandle;
 256  DocInfo: TDoc_Info_1;
 257  BytesWritten: Cardinal;
 258  Count: Cardinal;
 259  Defaults: TPrinterDefaults;
 260begin
 261  // Defaults added for network printers. Supposedly the last member is ignored
 262  // by Windows 9x but is necessary for Windows NT. Code was copied from a msg
 263  // by Alberto Toledo to the C++ Builder techlist and fwd by Theo Bebekis.
 264  Defaults.pDatatype := cRaw;
 265  Defaults.pDevMode := nil;
 266  Defaults.DesiredAccess := PRINTER_ACCESS_USE;
 267  Count := Length(Data);
 268  if not OpenPrinter(PChar(Printer), PrinterHandle, @Defaults) then
 269    raise EJclPrinterError.CreateRes(@RsInvalidPrinter);
 270  // Fill in the structure with info about this "document"
 271  if DocumentName = '' then
 272    DocInfo.DocName := PChar(LoadResString(@RsSpoolerDocName))
 273  else
 274    DocInfo.DocName := PChar(DocumentName);
 275  DocInfo.OutputFile := nil;
 276  DocInfo.Datatype := cRaw;
 277  try
 278    // Inform the spooler the document is beginning
 279    if StartDocPrinter(PrinterHandle, 1, @DocInfo) = 0 then
 280      EJclPrinterError.CreateRes(@RsNAStartDocument);
 281    try
 282      // Start a page
 283      if not StartPagePrinter(PrinterHandle) then
 284        EJclPrinterError.CreateRes(@RsNAStartPage);
 285      try
 286        // Send the data to the printer
 287        if not WritePrinter(PrinterHandle, PAnsiChar(Data), Count * SizeOf(AnsiChar), BytesWritten) then
 288          EJclPrinterError.CreateRes(@RsNASendData);
 289      finally
 290        // End the page
 291        if not EndPagePrinter(PrinterHandle) then
 292          EJclPrinterError.CreateRes(@RsNAEndPage);
 293      end;
 294    finally
 295      // Inform the spooler that the document is ending
 296      if not EndDocPrinter(PrinterHandle) then
 297        EJclPrinterError.CreateRes(@RsNAEndDocument);
 298    end;
 299  finally
 300    // Tidy up the printer handle
 301    ClosePrinter(PrinterHandle);
 302  end;
 303  // Check to see if correct number of bytes written
 304  if BytesWritten <> Count * SizeOf(AnsiChar) then
 305    EJclPrinterError.CreateRes(@RsNATransmission);
 306end;
 307
 308procedure SetPrinterPixelsPerInch;
 309var
 310  FontSize: Integer;
 311begin
 312  FontSize := Printer.Canvas.Font.Size;
 313  Printer.Canvas.Font.PixelsPerInch := GetDeviceCaps(Printer.Handle, LogPixelsY);
 314  Printer.Canvas.Font.Size := FontSize;
 315end;
 316
 317function GetPrinterResolution: TPoint;
 318begin
 319  Result.X := GetDeviceCaps(Printer.Handle, LogPixelsX);
 320  Result.Y := GetDeviceCaps(Printer.Handle, LogPixelsY);
 321end;
 322
 323function CharFitsWithinDots(const Text: string; const Dots: Integer): Integer;
 324begin
 325  Result := Length(Text);
 326  while (Result > 0) and (Printer.Canvas.TextWidth(Copy(Text, 1, Result)) > Dots) do
 327    Dec(Result);
 328end;
 329
 330//WIMDC: The function CanvasTextOutRotation contains a bug in DxGraphics so no need to
 331//       implement it right now here
 332(*
 333procedure PrintTextRotation(X, Y: Integer; Rotation: Word; Text: string);
 334begin
 335  CanvasTextOutRotation(Printer.Canvas, X, Y, Rotation, Text);
 336end;
 337*)
 338
 339//WIMDC took the function from DXGraphics and replaced some lines to work with the TStrings class
 340//      of the memo.
 341
 342procedure CanvasMemoOut(Canvas: TCanvas; Memo: TMemo; Rect: TRect);
 343var
 344  MemoText: PChar;
 345begin
 346  MemoText := Memo.Lines.GetText;
 347  if MemoText <> nil then
 348    try
 349      DrawText(Canvas.Handle, MemoText, StrLen(MemoText), Rect,
 350        DT_LEFT or DT_EXPANDTABS or DT_WORDBREAK);
 351    finally
 352      StrDispose(MemoText);
 353    end;
 354end;
 355
 356procedure PrintMemo(const Memo: TMemo; const Rect: TRect);
 357begin
 358  CanvasMemoOut(Printer.Canvas, Memo, Rect);
 359end;
 360
 361function GetDefaultPrinterName: string;
 362begin
 363  DPGetDefaultPrinter(Result);
 364end;
 365
 366{ TODO -cHelp : DPGetDefaultPrinter, Author: Microsoft }
 367// DPGetDefaultPrinter
 368// Parameters:
 369//   PrinterName: Return the printer name.
 370// Returns: True for success, False for failure.
 371
 372// Source of the original code: Microsoft Knowledge Base Article - 246772
 373//   http://support.microsoft.com/default.aspx?scid=kb;en-us;246772
 374function DPGetDefaultPrinter(out PrinterName: string): Boolean;
 375const
 376  BUFSIZE = 8192;
 377type
 378  TGetDefaultPrinter = function(Buffer: PChar; var Size: DWORD): BOOL; stdcall;
 379var
 380  Needed, Returned: DWORD;
 381  PI2: PPrinterInfo2;
 382  WinVer: TWindowsVersion;
 383  hWinSpool: HMODULE;
 384  GetDefPrint: TGetDefaultPrinter;
 385  Size: DWORD;
 386begin
 387  Result := False;
 388  PrinterName := '';
 389  WinVer := GetWindowsVersion;
 390  // Windows 9x uses EnumPrinters
 391  if WinVer in [wvWin95, wvWin95OSR2, wvWin98, wvWin98SE, wvWinME] then
 392  begin
 393    SetLastError(0);
 394    Result := EnumPrinters(PRINTER_ENUM_DEFAULT, nil, 2, nil, 0, Needed, Returned);
 395    if not Result and ((GetLastError <> ERROR_INSUFFICIENT_BUFFER) or (Needed = 0)) then
 396      Exit;
 397    GetMem(PI2, Needed);
 398    try
 399      Result := EnumPrinters(PRINTER_ENUM_DEFAULT, nil, 2, PI2, Needed, Needed, Returned);
 400      if Result then
 401        PrinterName := PI2^.pPrinterName;
 402    finally
 403      FreeMem(PI2);
 404    end;
 405  end
 406  else
 407  // Win NT uses WIN.INI (registry)
 408  if WinVer in [wvWinNT31, wvWinNT35, wvWinNT351, wvWinNT4] then
 409  begin
 410    SetLength(PrinterName, BUFSIZE);
 411    Result := GetProfileString(cWindows, cDevice, ',,,', PChar(PrinterName), BUFSIZE) > 0;
 412    if Result then
 413      PrinterName := Copy(PrinterName, 1, Pos(',', PrinterName) - 1)
 414    else
 415      PrinterName := '';
 416  end
 417  else
 418  // >= Win 2000 uses GetDefaultPrinter
 419  begin
 420    hWinSpool := SafeLoadLibrary(cPrintSpool);
 421    if hWinSpool <> 0 then
 422      try
 423        {$IFDEF UNICODE}
 424        @GetDefPrint := GetProcAddress(hWinSpool, 'GetDefaultPrinterW');
 425        {$ELSE}
 426        @GetDefPrint := GetProcAddress(hWinSpool, 'GetDefaultPrinterA');
 427        {$ENDIF UNICODE}
 428        if not Assigned(GetDefPrint) then
 429          Exit;
 430        Size := BUFSIZE;
 431        SetLength(PrinterName, Size);
 432        Result := GetDefPrint(PChar(PrinterName), Size);
 433        if Result then
 434          SetLength(PrinterName, StrLen(PChar(PrinterName)))
 435        else
 436          PrinterName := '';
 437      finally
 438        FreeLibrary(hWinSpool);
 439      end;
 440  end;
 441end;
 442
 443{ TODO -cHelp : DPSetDefaultPrinter, Author: Microsoft }
 444// DPSetDefaultPrinter
 445// Parameters:
 446//   PrinterName: Valid name of existing printer to make default.
 447// Returns: True for success, False for failure.
 448
 449// Source of the original code: Microsoft Knowledge Base Article - 246772
 450//   http://support.microsoft.com/default.aspx?scid=kb;en-us;246772
 451function DPSetDefaultPrinter(const PrinterName: string): Boolean;
 452type
 453  TSetDefaultPrinter = function(APrinterName: PChar): BOOL; stdcall;
 454var
 455  Needed: DWORD;
 456  PI2: PPrinterInfo2;
 457  WinVer: TWindowsVersion;
 458  hPrinter: THandle;
 459  hWinSpool: HMODULE;
 460  SetDefPrint: TSetDefaultPrinter;
 461  PrinterStr: string;
 462begin
 463  Result := False;
 464  if PrinterName = '' then
 465    Exit;
 466  WinVer := GetWindowsVersion;
 467  if WinVer in [wvWin95, wvWin95OSR2, wvWin98, wvWin98SE, wvWinME] then
 468  begin
 469    Result := OpenPrinter(PChar(PrinterName), hPrinter, nil);
 470    if Result and (hPrinter <> 0) then
 471      try
 472        SetLastError(0);
 473        Result := GetPrinter(hPrinter, 2, nil, 0, @Needed);
 474        if not Result and ((GetLastError <> ERROR_INSUFFICIENT_BUFFER) or (Needed = 0)) then
 475          Exit;
 476        GetMem(PI2, Needed);
 477        try
 478          Result := GetPrinter(hPrinter, 2, PI2, Needed, @Needed);
 479          if Result then
 480          begin
 481            PI2^.Attributes := PI2^.Attributes or PRINTER_ATTRIBUTE_DEFAULT;
 482            Result := SetPrinter(hPrinter, 2, PI2, 0);
 483            if Result then
 484              SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, 0,
 485                LPARAM(cWindows), SMTO_NORMAL, 1000, {$IFDEF RTL230_UP}@{$ENDIF}Needed);
 486          end;
 487        finally
 488          FreeMem(PI2);
 489        end;
 490      finally
 491        ClosePrinter(hPrinter);
 492      end;
 493  end
 494  else
 495  // Win NT uses WIN.INI (registry)
 496  if WinVer in [wvWinNT31, wvWinNT35, wvWinNT351, wvWinNT4] then
 497  begin
 498    Result := OpenPrinter(PChar(PrinterName), hPrinter, nil);
 499    if Result and (hPrinter <> 0) then
 500      try
 501        SetLastError(0);
 502        Result := GetPrinter(hPrinter, 2, nil, 0, @Needed);
 503        if not Result and ((GetLastError <> ERROR_INSUFFICIENT_BUFFER) or (Needed = 0)) then
 504          Exit;
 505        GetMem(PI2, Needed);
 506        try
 507          Result := GetPrinter(hPrinter, 2, PI2, Needed, @Needed);
 508          if Result and (PI2^.pDriverName <> nil) and (PI2^.pPortName <> nil) then
 509          begin
 510            PrinterStr := PrinterName + ',' + PI2^.pDriverName + ',' + PI2^.pPortName;
 511            Result := WriteProfileString(cWindows, cDevice, PChar(PrinterStr));
 512            if Result then
 513              SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0,
 514                SMTO_NORMAL, 1000, {$IFDEF RTL230_UP}@{$ENDIF}Needed);
 515          end;
 516        finally
 517          FreeMem(PI2);
 518        end;
 519      finally
 520        ClosePrinter(hPrinter);
 521      end;
 522  end
 523  else
 524  // >= Win 2000 uses SetDefaultPrinter
 525  begin
 526    hWinSpool := SafeLoadLibrary(cPrintSpool);
 527    if hWinSpool <> 0 then
 528      try
 529        {$IFDEF UNICODE}
 530        @SetDefPrint := GetProcAddress(hWinSpool, 'SetDefaultPrinterW');
 531        {$ELSE}
 532        @SetDefPrint := GetProcAddress(hWinSpool, 'SetDefaultPrinterA');
 533        {$ENDIF UNICODE}
 534        if Assigned(SetDefPrint) then
 535          Result := SetDefPrint(PChar(PrinterName));
 536      finally
 537        FreeLibrary(hWinSpool);
 538      end;
 539  end;
 540end;
 541
 542// TJclPrintSet
 543constructor TJclPrintSet.Create;
 544begin
 545  inherited Create;
 546  FBinArray := nil;
 547  FPaperArray := nil;
 548  FPrinter := -99;         { TODO : why -99 }
 549  GetMem(FDevice, 255);
 550  GetMem(FDriver, 255);
 551  GetMem(FPort, 255);
 552  FHandle := 0;
 553end;
 554
 555destructor TJclPrintSet.Destroy;
 556begin
 557  if FBinArray <> nil then
 558    FreeMem(FBinArray, FNumBins * SizeOf(Word));
 559  if FPaperArray <> nil then
 560    FreeMem(FPaperArray, FNumPapers * SizeOf(Word));
 561  if FDevice <> nil then
 562    FreeMem(FDevice, 255);
 563  if FDriver <> nil then
 564    FreeMem(FDriver, 255);
 565  if FPort <> nil then
 566    FreeMem(FPort, 255);
 567  inherited Destroy;
 568end;
 569
 570procedure TJclPrintSet.CheckPrinter;
 571var
 572  NewHandle: THandle;
 573  PrinterChanged: Boolean;
 574  LastDevice, LastDriver, LastPort: string;
 575begin
 576  LastDevice := FDevice;
 577  LastDriver := FDriver;
 578  LastPort := FPort;
 579  
 580  Printer.GetPrinter(FDevice, FDriver, FPort, NewHandle);
 581  PrinterChanged := (FHandle <> NewHandle) or (LastDevice <> FDevice)
 582    or (LastDriver <> FDriver) or (LastPort <> FPort) or (FPrinter <> Printer.PrinterIndex);
 583  FHandle := NewHandle;
 584  FPrinter := Printer.PrinterIndex;
 585  Printer.SetPrinter(FDevice, FDriver, FPort, FHandle);
 586  if PrinterChanged then
 587    SetDeviceMode(False);
 588end;
 589
 590procedure TJclPrintSet.SetBinArray;
 591var
 592  NumBinsRec: DWord;
 593  ADeviceMode: PDeviceMode;
 594begin
 595  if FBinArray <> nil then
 596    FreeMem(FBinArray, FNumBins * SizeOf(Word));
 597  FBinArray := nil;
 598  ADeviceMode := LockDeviceMode;
 599  try
 600    FNumBins := DeviceCapabilities(FDevice, FPort, DC_Bins, nil, ADeviceMode);
 601    if FNumBins > 0 then
 602    begin
 603      GetMem(FBinArray, FNumBins * SizeOf(Word));
 604      NumBinsRec := DeviceCapabilities(FDevice, FPort, DC_Bins,
 605        PChar(FBinArray), ADeviceMode);
 606      if NumBinsRec <> FNumBins then
 607        raise EJclPrinterError.CreateRes(@RsRetrievingSource);
 608    end;
 609  finally
 610    UnlockDeviceMode;
 611  end;
 612end;
 613
 614procedure TJclPrintSet.SetPaperArray;
 615var
 616  NumPapersRec: DWord;
 617  ADeviceMode: PDeviceMode;
 618begin
 619  if FPaperArray <> nil then
 620    FreeMem(FPaperArray, FNumPapers * SizeOf(Word));
 621  ADeviceMode := LockDeviceMode;
 622  try
 623    FNumPapers := DeviceCapabilities(FDevice, FPort, DC_Papers, nil, ADeviceMode);
 624    if FNumPapers > 0 then
 625    begin
 626      GetMem(FPaperArray, FNumPapers * SizeOf(Word));
 627      NumPapersRec := DeviceCapabilities(FDevice, FPort, DC_Papers,
 628        PChar(FPaperArray), ADeviceMode);
 629      if NumPapersRec <> FNumPapers then
 630        raise EJclPrinterError.CreateRes(@RsRetrievingPaperSource);
 631    end
 632    else
 633      FPaperArray := nil;
 634  finally
 635    UnlockDeviceMode;
 636  end;
 637end;
 638
 639{ TODO : complete this list }
 640// Since Win32 the strings are stored in the printer driver, no chance to get
 641// a list from Windows
 642function TJclPrintSet.DefaultPaperName(const PaperID: Word): string;
 643begin
 644  case PaperID of
 645    dmpaper_Letter:
 646      Result := LoadResString(@RsPSLetter);
 647    dmpaper_LetterSmall:
 648      Result := LoadResString(@RsPSLetter);
 649    dmpaper_Tabloid:
 650      Result := LoadResString(@RsPSTabloid);
 651    dmpaper_Ledger:
 652      Result := LoadResString(@RsPSLedger);
 653    dmpaper_Legal:
 654      Result := LoadResString(@RsPSLegal);
 655    dmpaper_Statement:
 656      Result := LoadResString(@RsPSStatement);
 657    dmpaper_Executive:
 658      Result := LoadResString(@RsPSExecutive);
 659    dmpaper_A3:
 660      Result := LoadResString(@RsPSA3);
 661    dmpaper_A4:
 662      Result := LoadResString(@RsPSA4);
 663    dmpaper_A4Small:
 664      Result := LoadResString(@RsPSA4);
 665    dmpaper_A5:
 666      Result := LoadResString(@RsPSA5);
 667    dmpaper_B4:
 668      Result := LoadResString(@RsPSB4);
 669    dmpaper_B5:
 670      Result := LoadResString(@RsPSB5);
 671    dmpaper_Folio:
 672      Result := LoadResString(@RsPSFolio);
 673    dmpaper_Quarto:
 674      Result := LoadResString(@RsPSQuarto);
 675    dmpaper_10X14:
 676      Result := LoadResString(@RsPS10x14);
 677    dmpaper_11X17:
 678      Result := LoadResString(@RsPS11x17);
 679    dmpaper_Note:
 680      Result := LoadResString(@RsPSNote);
 681    dmpaper_Env_9:
 682      Result := LoadResString(@RsPSEnv9);
 683    dmpaper_Env_10:
 684      Result := LoadResString(@RsPSEnv10);
 685    dmpaper_Env_11:
 686      Result := LoadResString(@RsPSEnv11);
 687    dmpaper_Env_12:
 688      Result := LoadResString(@RsPSEnv12);
 689    dmpaper_Env_14:
 690      Result := LoadResString(@RsPSEnv14);
 691    dmpaper_CSheet:
 692      Result := LoadResString(@RsPSCSheet);
 693    dmpaper_DSheet:
 694      Result := LoadResString(@RsPSDSheet);
 695    dmpaper_ESheet:
 696      Result := LoadResString(@RsPSESheet);
 697    dmpaper_User:
 698      Result := LoadResString(@RsPSUser);
 699  else
 700    Result := LoadResString(@RsPSUnknown);
 701  end;
 702end;
 703
 704procedure TJclPrintSet.GetBinSourceList(List: TStrings);
 705type
 706  TBinName = array [0..CCHBinName - 1] of Char;
 707  TBinArray = array [1..cBinMax] of TBinName;
 708  PBinArray = ^TBinArray;
 709var
 710  NumBinsRec: DWord;
 711  BinArray: PBinArray;
 712  BinStr: string;
 713  Idx: Integer;
 714  ADeviceMode: PDeviceMode;
 715begin
 716  CheckPrinter;
 717  BinArray := nil;
 718  if FNumBins = 0 then
 719    Exit;
 720  List.BeginUpdate;
 721  try
 722    GetMem(BinArray, FNumBins * SizeOf(TBinName));
 723    List.Clear;
 724    ADeviceMode := LockDeviceMode;
 725    try
 726      NumBinsRec := DeviceCapabilities(FDevice, FPort, DC_BinNames,
 727        PChar(BinArray), ADeviceMode);
 728    finally
 729      UnlockDeviceMode;
 730    end;
 731    if NumBinsRec <> FNumBins then
 732      raise EJclPrinterError.CreateRes(@RsRetrievingSource);
 733    for Idx := 1 to NumBinsRec do
 734    begin
 735      BinStr := StrPas(BinArray^[Idx]);
 736      List.Add(BinStr);
 737    end;
 738  finally
 739    List.EndUpdate;
 740    if BinArray <> nil then
 741      FreeMem(BinArray, FNumBins * SizeOf(TBinName));
 742  end;
 743end;
 744
 745procedure TJclPrintSet.GetPaperList(List: TStrings);
 746type
 747  TPaperName = array [0..CCHPaperName - 1] of Char;
 748  TPaperArray = array [1..cPaperNames] of TPaperName;
 749  PPaperArray = ^TPaperArray;
 750var
 751  NumPaperRec: DWord;
 752  PaperArray: PPaperArray;
 753  PaperStr: string;
 754  Idx: Integer;
 755  ADeviceMode: PDeviceMode;
 756begin
 757  CheckPrinter;
 758  PaperArray := nil;
 759  if FNumPapers = 0 then
 760    Exit;
 761  List.BeginUpdate;
 762  List.Clear;
 763  try
 764    GetMem(PaperArray, FNumPapers * SizeOf(TPaperName));
 765    ADeviceMode := LockDeviceMode;
 766    try
 767      NumPaperRec := DeviceCapabilities(FDevice, FPort, DC_PaperNames,
 768        PChar(PaperArray), ADeviceMode);
 769    finally
 770      UnlockDeviceMode;
 771    end;
 772    if NumPaperRec <> FNumPapers then
 773    begin
 774      for Idx := 1 to FNumPapers do
 775      begin
 776        PaperStr := DefaultPaperName(FPaperArray^[Idx - 1]);
 777        List.Add(PaperStr);
 778      end;
 779    end
 780    else
 781    begin
 782      for Idx := 1 to NumPaperRec do
 783      begin
 784        PaperStr := StrPas(PaperArray^[Idx]);
 785        List.Add(PaperStr);
 786      end;
 787    end;
 788  finally
 789    List.EndUpdate;
 790    if PaperArray <> nil then
 791      FreeMem(PaperArray, FNumPapers * SizeOf(TPaperName));
 792  end;
 793end;
 794
 795procedure TJclPrintSet.SetDeviceMode(Creating: Boolean);
 796var
 797  Res: TPoint;
 798  ADeviceMode: PDeviceMode;
 799  NewHandle: THandle;
 800begin
 801  Printer.GetPrinter(FDevice, FDriver, FPort, NewHandle);
 802  if NewHandle = 0 then
 803  begin
 804    Printer.PrinterIndex := Printer.PrinterIndex;
 805    Printer.GetPrinter(FDevice, FDriver, FPort, NewHandle);
 806  end;
 807  FHandle := NewHandle;
 808  if FHandle <> 0 then
 809  begin
 810    ADeviceMode := GlobalLock(FHandle);
 811
 812    FPrinter := Printer.PrinterIndex;
 813    UpdateDeviceMode(ADeviceMode);
 814    //FDeviceMode^.dmFields := 0;
 815    SetBinArray;
 816    SetPaperArray;
 817  end
 818  else
 819  begin
 820    if not Creating then
 821      raise EJclPrinterError.CreateRes(@RsDeviceMode);
 822    FPrinter := -99;
 823  end;
 824  Res := GetPrinterResolution;
 825  dpiX := Res.X;
 826  dpiY := Res.Y;
 827  if FHandle <> 0 then
 828    GlobalUnLock(FHandle);
 829end;
 830
 831procedure TJclPrintSet.UpdateDeviceMode(const ADeviceMode: PDeviceMode);
 832var
 833  DrvHandle: THandle;
 834  ExtDevCode: Integer;
 835begin
 836  // ONLY CALL when ADeviceMode is locked by caller!!!
 837
 838  //CheckPrinter;
 839  if OpenPrinter(FDevice, DrvHandle, nil) then
 840  try
 841    ADeviceMode^.dmFields := dm_Orientation or dm_PaperSize or
 842      dm_PaperLength or dm_PaperWidth or
 843      dm_Scale or dm_Copies or
 844      dm_DefaultSource or dm_PrintQuality or
 845      dm_Color or dm_Duplex or
 846      dm_YResolution or dm_TTOption;
 847    ExtDevCode := DocumentProperties(0, DrvHandle, FDevice,
 848      ADeviceMode^, ADeviceMode^,
 849      DM_IN_BUFFER or DM_OUT_BUFFER);
 850    if ExtDevCode <> IDOK then
 851      raise EJclPrinterError.CreateRes(@RsUpdatingPrinter);
 852  finally
 853    ClosePrinter(DrvHandle);
 854  end;
 855end;
 856
 857procedure TJclPrintSet.SaveToDefaults;
 858var
 859  DrvHandle: THandle;
 860  ExtDevCode: Integer;
 861  ADeviceMode: PDeviceMode;
 862begin
 863  CheckPrinter;
 864  OpenPrinter(FDevice, DrvHandle, nil);
 865  ADeviceMode := LockDeviceMode;
 866  try
 867    ExtDevCode := DocumentProperties(0, DrvHandle, FDevice,
 868      ADeviceMode^, ADeviceMode^, DM_IN_BUFFER or DM_UPDATE);
 869  finally
 870    UnlockDeviceMode;
 871  end;
 872  if ExtDevCode <> IDOK then
 873    raise EJclPrinterError.CreateRes(@RsUpdatingPrinter)
 874  else
 875    SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0);
 876  ClosePrinter(DrvHandle);
 877end;
 878
 879procedure TJclPrintSet.SavePrinterAsDefault;
 880begin
 881  CheckPrinter;
 882  DPSetDefaultPrinter(FDevice);
 883end;
 884
 885procedure TJclPrintSet.ResetPrinterDialogs;
 886begin
 887  Printer.GetPrinter(FDevice, FDriver, FPort, FHandle);
 888  Printer.SetPrinter(FDevice, FDriver, FPort, FHandle);
 889  SetDeviceMode(False);
 890end;
 891
 892function TJclPrintSet.XInchToDot(const Inches: Double): Integer;
 893begin
 894  Result := Trunc(DpiX * Inches);
 895end;
 896
 897function TJclPrintSet.YInchToDot(const Inches: Double): Integer;
 898begin
 899  Result := Trunc(DpiY * Inches);
 900end;
 901
 902function TJclPrintSet.XCmToDot(const Cm: Double): Integer;
 903begin
 904  Result := Trunc(DpiX * (Cm * 2.54));
 905end;
 906
 907function TJclPrintSet.YCmToDot(const Cm: Double): Integer;
 908begin
 909  Result := Trunc(DpiY * (Cm * 2.54));
 910end;
 911
 912function TJclPrintSet.CpiToDot(const Cpi, Chars: Double): Integer;
 913begin
 914  Result := Trunc((DpiX * Chars) / Cpi);
 915end;
 916
 917function TJclPrintSet.LpiToDot(const Lpi, Lines: Double): Integer;
 918begin
 919  Result := Trunc((DpiY * Lpi) / Lines);
 920end;
 921
 922procedure TJclPrintSet.TextOutInch(const X, Y: Double; const Text: string);
 923begin
 924  Printer.Canvas.TextOut(XInchToDot(X), YInchToDot(Y), Text);
 925end;
 926
 927procedure TJclPrintSet.TextOutCm(const X, Y: Double; const Text: string);
 928begin
 929  Printer.Canvas.TextOut(XCmToDot(X), YCmToDot(Y), Text);
 930end;
 931
 932procedure TJclPrintSet.TextOutCpiLpi(const Cpi, Chars, Lpi, Lines: Double; const Text: string);
 933begin
 934  Printer.Canvas.TextOut(CpiToDot(Cpi, Chars), LpiToDot(Lpi, Lines), Text);
 935end;
 936
 937procedure TJclPrintSet.CustomPageSetup(const Width, Height: Double);
 938begin
 939  PaperSize := dmPaper_User;
 940  PaperLength := Trunc(254 * Height);
 941  YResolution := Trunc(DpiY * Height);
 942  PaperWidth := Trunc(254 * Width);
 943end;
 944
 945procedure TJclPrintSet.DevModePrinterDriverExtraClear;
 946var
 947  ADeviceMode: PDeviceMode;
 948begin
 949  CheckPrinter;
 950  ADeviceMode := LockDeviceMode;
 951  try
 952    ADeviceMode^.dmDriverExtra := 0;
 953  finally
 954    UnlockDeviceMode;
 955  end;
 956end;
 957
 958procedure TJclPrintSet.DevModePrinterDriverExtraReinstate(const ExtraData: TDynByteArray;
 959  const ExtraDataDriverName: string; const ExtraDataDriverVersion: Word);
 960var
 961  Src, Dest: PDeviceMode;
 962  ADeviceModeDriverExtra: PByte;
 963  NewHandle: THandle;
 964begin
 965  CheckPrinter;
 966    { http://support.microsoft.com/kb/167345
 967      Using a DEVMODE structure to modify printer settings is more difficult than just changing the fields of the structure. Specifically, a valid DEVMODE structure for a device contains private data that can only be modified by the DocumentProperties() function.
 968      This article explains how to modify the contents of a DEVMODE structure with the DocumentProperties() function.}
 969
 970  if FHandle <> 0 then
 971  begin
 972    Src := GlobalLock(FHandle);
 973    try
 974      if not ((Src^.dmDeviceName = ExtraDataDriverName) and (Src^.dmDriverVersion = ExtraDataDriverVersion)) then
 975        exit;
 976        //raise Exception.Create('TJclPrintSet.DevModePrinterDriverExtraReinstate - Driver Private data does not match selected printer');
 977
 978      NewHandle := GlobalAlloc(GHND, sizeof(DEVMODE) + Length(ExtraData));
 979      if NewHandle <> 0 then
 980        try
 981          Dest := GlobalLock(NewHandle);
 982
 983          if (Src <> nil) and (Dest <> nil) then
 984          begin
 985            Move(Src^, Dest^, Src^.dmSize);
 986            Dest^.dmDriverExtra := 0;
 987
 988            Dest^.dmDriverExtra := Length(ExtraData);
 989
 990
 991            ADeviceModeDriverExtra := PByte(Dest);
 992            Inc(ADeviceModeDriverExtra, Dest^.dmSize);
 993            Move(ExtraData[0], ADeviceModeDriverExtra^, dest^.dmDriverExtra);
 994          end
 995          else
 996            raise Exception.Create('TJclPrintSet.DevModePrinterDriverExtraReinstate - GlobalLock failed');
 997        finally
 998          GlobalUnlock(NewHandle);
 999        end;
1000
1001      Printer.SetPrinter(FDevice, FDriver, FPort, NewHandle);
1002      FHandle := NewHandle;
1003      SetDeviceMode(False);
1004    finally
1005      GlobalUnlock(FHandle);
1006    end;
1007  end
1008  else
1009    raise Exception.Create('TJclPrintSet.DevModePrinterDriverExtraReinstate invalid handle');
1010end;
1011
1012procedure TJclPrintSet.SaveToIniFile(const IniFileName, Section: string);
1013var
1014  PrIniFile: TMemIniFile;
1015begin
1016  PrIniFile := TMemIniFile.Create(IniFileName);   // use TMemIniFile as TIniFile truncats longs values
1017  try
1018    SaveToCustomIni(PrIniFile, Section);
1019    PrIniFile.UpdateFile;
1020  finally
1021    PrIniFile.Free;
1022  end;
1023end;
1024
1025function TJclPrintSet.ReadFromIniFile(const IniFileName, Section: string): Boolean;
1026var
1027  PrIniFile: TMemIniFile;
1028begin
1029  PrIniFile := TMemIniFile.Create(IniFileName);     // use TMemIniFile as TIniFile truncats longs values
1030  try
1031    Result := ReadFromCustomIni(PrIniFile, Section);
1032  finally
1033    PrIniFile.Free;
1034  end;
1035end;
1036
1037procedure TJclPrintSet.SetOrientation(Orientation: Integer);
1038var
1039  ADeviceMode: PDeviceMode;
1040begin
1041  CheckPrinter;
1042  ADeviceMode := LockDeviceMode;
1043  try
1044    ADeviceMode^.dmOrientation := Orientation;
1045    Printer.Orientation := TPrinterOrientation(Orientation - 1);
1046    ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_ORIENTATION;
1047  finally
1048    UnlockDeviceMode;
1049  end;
1050end;
1051
1052function TJclPrintSet.GetOrientation: Integer;
1053var
1054  ADeviceMode: PDeviceMode;
1055begin
1056  CheckPrinter;
1057  ADeviceMode := LockDeviceMode;
1058  try
1059    Result := ADeviceMode^.dmOrientation;
1060  finally
1061    UnlockDeviceMode;
1062  end;
1063end;
1064
1065procedure TJclPrintSet.SetPaperSize(Size: Integer);
1066var
1067  ADeviceMode: PDeviceMode;
1068begin
1069  CheckPrinter;
1070  ADeviceMode := LockDeviceMode;
1071  try
1072    ADeviceMode^.dmPaperSize := Size;
1073    ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_PAPERSIZE;
1074  finally
1075    UnlockDeviceMode;
1076  end;
1077end;
1078
1079function TJclPrintSet.GetPaperSize: Integer;
1080var
1081  ADeviceMode: PDeviceMode;
1082begin
1083  CheckPrinter;
1084  ADeviceMode := LockDeviceMode;
1085  try
1086    Result := ADeviceMode^.dmPaperSize;
1087  finally
1088    UnlockDeviceMode;
1089  end;
1090end;
1091
1092procedure TJclPrintSet.SetPaperLength(Length: Integer);
1093var
1094  ADeviceMode: PDeviceMode;
1095begin
1096  CheckPrinter;
1097  ADeviceMode := LockDeviceMode;
1098  try
1099    ADeviceMode^.dmPaperLength := Length;
1100    ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_PAPERLENGTH;
1101  finally
1102    UnlockDeviceMode;
1103  end;
1104end;
1105
1106function TJclPrintSet.GetPaperLength: Integer;
1107var
1108  ADeviceMode: PDeviceMode;
1109begin
1110  CheckPrinter;
1111  ADeviceMode := LockDeviceMode;
1112  try
1113    Result := ADeviceMode^.dmPaperLength;
1114  finally
1115    UnlockDeviceMode;
1116  end;
1117end;
1118
1119procedure TJclPrintSet.SetPaperWidth(Width: Integer);
1120var
1121  ADeviceMode: PDeviceMode;
1122begin
1123  CheckPrinter;
1124  ADeviceMode := LockDeviceMode;
1125  try
1126    ADeviceMode^.dmPaperWidth := Width;
1127    ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_PAPERWIDTH;
1128  finally
1129    UnlockDeviceMode;
1130  end;
1131end;
1132
1133function TJclPrintSet.GetPaperWidth: Integer;
1134var
1135  ADeviceMode: PDeviceMode;
1136begin
1137  CheckPrinter;
1138  ADeviceMode := LockDeviceMode;
1139  try
1140    Result := ADeviceMode^.dmPaperWidth;
1141  finally
1142    UnlockDeviceMode;
1143  end;
1144end;
1145
1146procedure TJclPrintSet.SetScale(Scale: Integer);
1147var
1148  ADeviceMode: PDeviceMode;
1149begin
1150  CheckPrinter;
1151  ADeviceMode := LockDeviceMode;
1152  try
1153    ADeviceMode^.dmScale := Scale;
1154    ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_SCALE;
1155  finally
1156    UnlockDeviceMode;
1157  end;
1158end;
1159
1160function TJclPrintSet.GetScale: Integer;
1161var
1162  ADeviceMode: PDeviceMode;
1163begin
1164  CheckPrinter;
1165  ADeviceMode := LockDeviceMode;
1166  try
1167    Result := ADeviceMode^.dmScale;
1168  finally
1169    UnlockDeviceMode;
1170  end;
1171end;
1172
1173procedure TJclPrintSet.SetCopies(Copies: Integer);
1174var
1175  ADeviceMode: PDeviceMode;
1176begin
1177  CheckPrinter;
1178  ADeviceMode := LockDeviceMode;
1179  try
1180    ADeviceMode^.dmCopies := Copies;
1181    ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_COPIES;
1182  finally
1183    UnlockDeviceMode;
1184  end;
1185end;
1186
1187function TJclPrintSet.GetCopies: Integer;
1188var
1189  ADeviceMode: PDeviceMode;
1190begin
1191  CheckPrinter;
1192  ADeviceMode := LockDeviceMode;
1193  try
1194    Result := ADeviceMode^.dmCopies;
1195  finally
1196    UnlockDeviceMode;
1197  end;
1198end;
1199
1200procedure TJclPrintSet.SetBin(Bin: Integer);
1201var
1202  ADeviceMode: PDeviceMode;
1203begin
1204  CheckPrinter;
1205  ADeviceMode := LockDeviceMode;
1206  try
1207    ADeviceMode^.dmDefaultSource := Bin;
1208    ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_DEFAULTSOURCE;
1209  finally
1210    UnlockDeviceMode;
1211  end;
1212end;
1213
1214function TJclPrintSet.GetBin: Integer;
1215var
1216  ADeviceMode: PDeviceMode;
1217begin
1218  CheckPrinter;
1219  ADeviceMode := LockDeviceMode;
1220  try
1221    Result := ADeviceMode^.dmDefaultSource;
1222  finally
1223    UnlockDeviceMode;
1224  end;
1225end;
1226
1227procedure TJclPrintSet.SetPrintQuality(Quality: Integer);
1228var
1229  ADeviceMode: PDeviceMode;
1230begin
1231  CheckPrinter;
1232  ADeviceMode := LockDeviceMode;
1233  try
1234    ADeviceMode^.dmPrintQuality := Quality;
1235    ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_PRINTQUALITY;
1236  finally
1237    UnlockDeviceMode;
1238  end;
1239end;
1240
1241function TJclPrintSet.GetPrintQuality: Integer;
1242var
1243  ADeviceMode: PDeviceMode;
1244begin
1245  CheckPrinter;
1246  ADeviceMode := LockDeviceMode;
1247  try
1248    Result := ADeviceMode^.dmPrintQuality;
1249  finally
1250    UnlockDeviceMode;
1251  end;
1252end;
1253
1254procedure TJclPrintSet.SetColor(Color: Integer);
1255var
1256  ADeviceMode: PDeviceMode;
1257begin
1258  CheckPrinter;
1259  ADeviceMode := LockDeviceMode;
1260  try
1261    ADeviceMode^.dmColor := Color;
1262    ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_COLOR;
1263  finally
1264    UnlockDeviceMode;
1265  end;
1266end;
1267
1268function TJclPrintSet.GetColor: Integer;
1269var
1270  ADeviceMode: PDeviceMode;
1271begin
1272  CheckPrinter;
1273  ADeviceMode := LockDeviceMode;
1274  try
1275    Result := ADeviceMode^.dmColor;
1276  finally
1277    UnlockDeviceMode;
1278  end;
1279end;
1280
1281procedure TJclPrintSet.SetDuplex(Duplex: Integer);
1282var
1283  ADeviceMode: PDeviceMode;
1284begin
1285  CheckPrinter;
1286  ADeviceMode := LockDeviceMode;
1287  try
1288    ADeviceMode^.dmDuplex := Duplex;
1289    ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_DUPLEX;
1290  finally
1291    UnlockDeviceMode;
1292  end;
1293end;
1294
1295function TJclPrintSet.GetDuplex: Integer;
1296var
1297  ADeviceMode: PDeviceMode;
1298begin
1299  CheckPrinter;
1300  ADeviceMode := LockDeviceMode;
1301  try
1302    Result := ADeviceMode^.dmDuplex;
1303  finally
1304    UnlockDeviceMode;
1305  end;
1306end;
1307
1308procedure TJclPrintSet.SetYResolution(YRes: Integer);
1309var
1310  PrintDevMode: PDeviceModeA;
1311  ADeviceMode: PDeviceMode;
1312begin
1313  CheckPrinter;
1314  ADeviceMode := LockDeviceMode;
1315  try
1316    PrintDevMode := @ADeviceMode^;
1317    PrintDevMode^.dmYResolution := YRes;
1318    ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_YRESOLUTION;
1319  finally
1320    UnlockDeviceMode;
1321  end;
1322end;
1323
1324function TJclPrintSet.GetYResolution: Integer;
1325var
1326  PrintDevMode: PDeviceModeA;
1327  ADeviceMode: PDeviceMode;
1328begin
1329  CheckPrinter;
1330  ADeviceMode := LockDeviceMode;
1331  try
1332    PrintDevMode := @ADeviceMode^;
1333    Result := PrintDevMode^.dmYResolution;
1334  finally
1335    UnlockDeviceMode;
1336  end;
1337end;
1338
1339procedure TJclPrintSet.SetTrueTypeOption(Option: Integer);
1340var
1341  PrintDevMode: PDeviceModeA;
1342  ADeviceMode: PDeviceMode;
1343begin
1344  CheckPrinter;
1345  ADeviceMode := LockDeviceMode;
1346  try
1347    PrintDevMode := @ADeviceMode^;
1348    PrintDevMode^.dmTTOption := Option;
1349    ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_TTOPTION;
1350  finally
1351    UnlockDeviceMode;
1352  end;
1353end;
1354
1355function TJclPrintSet.GetTrueTypeOption: Integer;
1356var
1357  PrintDevMode: PDeviceModeA;
1358  ADeviceMode: PDeviceMode;
1359begin
1360  CheckPrinter;
1361  ADeviceMode := LockDeviceMode;
1362  try
1363    PrintDevMode := @ADeviceMode^;
1364    Result := PrintDevMode^.dmTTOption;
1365  finally
1366    UnlockDeviceMode;
1367  end;
1368end;
1369
1370function TJclPrintSet.GetPrinterName: string;
1371begin
1372  CheckPrinter;
1373  Result := StrPas(FDevice);
1374end;
1375
1376function TJclPrintSet.GetPrinterPort: string;
1377begin
1378  CheckPrinter;
1379  Result := StrPas(FPort);
1380end;
1381
1382function TJclPrintSet.GetPrinterDriver: string;
1383begin
1384  CheckPrinter;
1385  Result := StrPas(FDriver);
1386end;
1387
1388procedure TJclPrintSet.SetBinFromList(BinNum: Word);
1389begin
1390  CheckPrinter;
1391  if FNumBins = 0 then
1392    Exit;
1393  if BinNum > FNumBins then
1394    raise EJclPrinterError.CreateRes(@RsIndexOutOfRange)
1395  else
1396    DefaultSource := FBinArray^[BinNum];
1397end;
1398
1399function TJclPrintSet.GetBinIndex: Word;
1400var
1401  Idx: Word;
1402  ADeviceMode: PDeviceMode;
1403begin
1404  Result := 0;
1405  ADeviceMode := LockDeviceMode;
1406  try
1407    for Idx := 0 to FNumBins do
1408    begin
1409      if FBinArray^[Idx] = Word(ADeviceMode^.dmDefaultSource) then
1410      begin
1411        Result := Idx;
1412        Break;
1413      end;
1414    end;
1415  finally
1416    UnlockDeviceMode;
1417  end;
1418end;
1419
1420function TJclPrintSet.GetDevModePrinterDriverVersion: Word;
1421var
1422  ADeviceMode: PDeviceMode;
1423begin
1424  CheckPrinter;
1425  ADeviceMode := LockDeviceMode;
1426  try
1427    Result := ADeviceMode^.dmDriverVersion;
1428  finally
1429    UnlockDeviceMode;
1430  end;
1431end;
1432
1433function TJclPrintSet.GetDevModePrinterDriver: string;
1434var
1435  ADeviceMode: PDeviceMode;
1436begin
1437  CheckPrinter;
1438  ADeviceMode := LockDeviceMode;
1439  try
1440    Result := ADeviceMode^.dmDeviceName;
1441  finally
1442    UnlockDeviceMode;
1443  end;
1444end;
1445
1446function TJclPrintSet.GetDevModePrinterDriverExtra: TDynByteArray;
1447var
1448  ADeviceMode: PDeviceMode;
1449  ADeviceModeDriverExtra: PByte;
1450begin
1451  CheckPrinter;
1452  ADeviceMode := LockDeviceMode;
1453  try
1454    ADeviceModeDriverExtra := PByte(ADeviceMode);
1455    Inc(ADeviceModeDriverExtra, ADeviceMode^.dmSize);
1456    SetLength(Result, ADeviceMode^.dmDriverExtra);
1457    Move(ADeviceModeDriverExtra^, Result[0], ADeviceMode^.dmDriverExtra);
1458  finally
1459    UnlockDeviceMode;
1460  end;
1461end;
1462
1463procedure TJclPrintSet.SetPaperFromList(PaperNum: Word);
1464begin
1465  CheckPrinter;
1466  if FNumPapers = 0 then
1467    Exit;
1468  if PaperNum > FNumPapers then
1469    raise EJclPrinterError.CreateRes(@RsIndexOutOfRangePaper)
1470  else
1471    PaperSize := FPaperArray^[PaperNum];
1472end;
1473
1474procedure TJclPrintSet.SetPort(Port: string);
1475begin
1476  CheckPrinter;
1477  Port := Port + #0;
1478  Move(Port[1], FPort^, Length(Port));
1479  Printer.SetPrinter(FDevice, FDriver, FPort, FHandle);
1480end;
1481
1482function TJclPrintSet.GetPaperIndex: Word;
1483var
1484  Idx: Word;
1485  ADeviceMode: PDeviceMode;
1486begin
1487  Result := 0;
1488  ADeviceMode := LockDeviceMode;
1489  try
1490    for Idx := 0 to FNumPapers do
1491    begin
1492      if FPaperArray^[Idx] = Word(ADeviceMode^.dmPaperSize) then
1493      begin
1494        Result := Idx;
1495        Break;
1496      end;
1497    end;
1498  finally
1499    UnlockDeviceMode;
1500  end;
1501end;
1502
1503function TJclPrintSet.LockDeviceMode: PDeviceMode;
1504begin
1505  if FHandle <> 0 then
1506  begin
1507    Result := GlobalLock(FHandle);
1508    if not assigned(Result) then
1509      RaiseLastOSError;
1510  end
1511  else
1512    raise Exception.Create('TJclPrintSet.LockDeviceMode invalid FHandle');
1513end;
1514
1515function TJclPrintSet.ReadFromCustomIni(const PrIniFile: TCustomIniFile; const Section: string): Boolean;
1516var
1517  privData: TMemoryStream;
1518  privDataExtra: TDynByteArray;
1519  privDataExtraSize: Integer;
1520  DevModeDriverName: string;
1521  DevModeDriverVersion: Word;
1522begin
1523  PrinterName := PrIniFile.ReadString(Section, PrintIniPrinterName, PrinterName);
1524  PrinterPort := PrIniFile.ReadString(Section, PrintIniPrinterPort, PrinterPort);
1525  Orientation := PrIniFile.ReadInteger(Section, PrintIniOrientation, Orientation);
1526  PaperSize := PrIniFile.ReadInteger(Section, PrintIniPaperSize, PaperSize);
1527  PaperLength := PrIniFile.ReadInteger(Section, PrintIniPaperLength, PaperLength);
1528  PaperWidth := PrIniFile.ReadInteger(Section, PrintIniPaperWidth, PaperWidth);
1529  Scale := PrIniFile.ReadInteger(Section, PrintIniScale, Scale);
1530  Copies := PrIniFile.ReadInteger(Section, PrintIniCopies, Copies);
1531  DefaultSource := PrIniFile.ReadInteger(Section, PrintIniDefaultSource, DefaultSource);
1532  PrintQuality := PrIniFile.ReadInteger(Section, PrintIniPrintQuality, PrintQuality);
1533  Color := PrIniFile.ReadInteger(Section, PrintIniColor, Color);
1534  Duplex := PrIniFile.ReadInteger(Section, PrintIniDuplex, Duplex);
1535  YResolution := PrIniFile.ReadInteger(Section, PrintIniYResolution, YResolution);
1536  TrueTypeOption := PrIniFile.ReadInteger(Section, PrintIniTTOption, TrueTypeOption);
1537
1538  DevModeDriverName := PrIniFile.ReadString(Section, PrintDriverName, '');
1539  DevModeDriverVersion := Word(PrIniFile.ReadInteger(Section, PrintDriverVersion, 0));
1540  if (DevModePrinterDriver = DevModeDriverName) and
1541     (DevModePrinterDriverVersion = DevModeDriverVersion) then
1542  begin
1543    privData := TMemoryStream.Create;
1544    try
1545
1546      PrIniFile.ReadBinaryStream(Section, PrintDriverExtraData, privData);
1547      privDataExtraSize := PrIniFile.ReadInteger(Section, PrintDriverExtraSize, 0);
1548      if (privData.Size = privDataExtraSize) then
1549      begin
1550        SetLength(privDataExtra, privDataExtraSize);
1551        privdata.Read(privDataExtra[0], privDataExtraSize);
1552
1553        DevModePrinterDriverExtraReinstate(privDataExtra, DevModeDriverName, DevModeDriverVersion);
1554      end;
1555    finally
1556      privData.Free;
1557    end;
1558  end;
1559  Result := True;
1560end;
1561
1562procedure TJclPrintSet.SaveToCustomIni(const PrIniFile: TCustomIniFile; const Section: string);
1563var
1564  CurrentName: string;
1565  
1566  privData: TMemoryStream;
1567  privDataExtra: TDynByteArray;
1568begin
1569    PrIniFile.EraseSection(Section);
1570
1571    CurrentName := Printer.Printers[Printer.PrinterIndex];
1572    PrIniFile.WriteString(Section, PrintIniPrinterName, CurrentName);
1573    PrIniFile.WriteString(Section, PrintIniPrinterPort, PrinterPort);
1574    PrIniFile.WriteInteger(Section, PrintIniOrientation, Orientation);
1575    PrIniFile.WriteInteger(Section, PrintIniPaperSize, PaperSize);
1576    PrIniFile.WriteInteger(Section, PrintIniPaperLength, PaperLength);
1577    PrIniFile.WriteInteger(Section, PrintIniPaperWidth, PaperWidth);
1578    PrIniFile.WriteInteger(Section, PrintIniScale, Scale);
1579    PrIniFile.WriteInteger(Section, PrintIniCopies, Copies);
1580    PrIniFile.WriteInteger(Section, PrintIniDefaultSource, DefaultSource);
1581    PrIniFile.WriteInteger(Section, PrintIniPrintQuality, PrintQuality);
1582    PrIniFile.WriteInteger(Section, PrintIniColor, Color);
1583    PrIniFile.WriteInteger(Section, PrintIniDuplex, Duplex);
1584    PrIniFile.WriteInteger(Section, PrintIniYResolution, YResolution);
1585    PrIniFile.WriteInteger(Section, PrintIniTTOption, TrueTypeOption);
1586
1587    PrIniFile.WriteString(Section, PrintDriverName, DevModePrinterDriver);
1588    PrIniFile.WriteInteger(Section, PrintDriverVersion, DevModePrinterDriverVersion);
1589    PrIniFile.WriteInteger(Section, PrintDriverExtraSize, Length(DevModePrinterDriverExtra));
1590
1591    privDataExtra := DevModePrinterDriverExtra;
1592
1593    privData := TMemoryStream.Create;
1594    try
1595      privdata.Write(privDataExtra[0], Length(privDataExtra));
1596      privData.Position := 0;
1597      PrIniFile.WriteBinaryStream(Section, PrintDriverExtraData, privData);
1598    finally
1599      privData.Free;
1600    end;
1601end;
1602
1603procedure TJclPrintSet.SetPrinterName(const Value: string);
1604var
1605  NewIndex: Integer;
1606begin
1607  if PrinterName <> Value then
1608  begin
1609    NewIndex := Printer.Printers.IndexOf(Value);
1610    if NewIndex <> -1 then
1611    begin
1612      Printer.PrinterIndex := NewIndex;
1613    end;
1614  end;
1615  CheckPrinter;
1616end;
1617
1618procedure TJclPrintSet.UnlockDeviceMode;
1619begin
1620 if FHandle <> 0 then
1621   GlobalUnLock(FHandle);
1622end;
1623
1624{$IFDEF UNITVERSIONING}
1625initialization
1626  RegisterUnitVersion(HInstance, UnitVersioning);
1627
1628finalization
1629  UnregisterUnitVersion(HInstance);
1630{$ENDIF UNITVERSIONING}
1631
1632end.