/jcl/source/vcl/JclPrint.pas
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.