jclprint.pas

East make Tray Icon in delphi

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

// Last modified: $Date: 2005/03/08 08:33:20 $
// For history see end of file

unit JclPrint;

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

interface

uses
  Windows, Classes, StdCtrls, SysUtils,
  JclBase;

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

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

type
  EJclPrinterError = class(EJclError);

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

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

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

implementation

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

// Source of the original code: Microsoft Knowledge Base Article - 246772
//   http://support.microsoft.com/default.aspx?scid=kb;en-us;246772
function DPSetDefaultPrinter(const PrinterName: string): Boolean;
type
  TSetDefaultPrinter = function(APrinterName: PChar): BOOL; stdcall;
var
  Needed: DWORD;
  PI2: PPrinterInfo2;
  WinVer: TWindowsVersion;
  hPrinter: THandle;
  hWinSpool: HMODULE;
  SetDefPrint: TSetDefaultPrinter;
  PrinterStr: string;
begin
  Result := False;
  if PrinterName = '' then
    Exit;
  WinVer := GetWindowsVersion;
  if WinVer in [wvWin95, wvWin95OSR2, wvWin98, wvWin98SE, wvWinME] then
  begin
    Result := OpenPrinter(PChar(PrinterName), hPrinter, nil);
    if Result and (hPrinter <> 0) then
      try
        SetLastError(0);