(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)

unit AHMTPSDialog;
{$I AHM.INC}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  CommDlg,AHMDialogClass;

type
  TAHMPageSetupOption = (poDefaultMinMargins, poDisableMargins, poDisableOrientation,
             poDisablePagePainting, poDisablePaper, poDisablePrinter, poNoWarning, poShowHelp);
  TAHMPageSetupOptions = set of TAHMPageSetupOption;
  TAHMPaperType        = (ptPaper, ptEnvelope);
  TAHMPaperOrientation = (poPortrait, poLandscape);
  TAHMPrinterType      = (ptDotMatrix, ptHPPCL);
  TAHMPaintWhat = (pwFullPage, pwMinimumMargins, pwMargins,pwGreekText, pwEnvStamp, pwYAFullPage);
  TAHMMeasurements = (pmMillimeters, pmInches);
  TAHMPrinterEvent = procedure(Sender: TObject; Wnd: HWND) of object;
  PAHMDlgData = ^TAHMDlgData;
  TAHMDlgData = TPageSetupDlg;
  TAHMInitPaintPageEvent = function(Sender: TObject; PaperSize: short;
              PaperType: TAHMPaperType; PaperOrientation: TAHMPaperOrientation;
              PrinterType: TAHMPrinterType; pSetupData: PAHMDlgData): boolean of object;
  TAHMPaintPageEvent = function(Sender: TObject; PaintWhat: TAHMPaintWhat; Canvas: TCanvas; Rect: TRect): boolean of object;
  TAHMMargins = class(TGraphicsObject)
  private
    FBottom: Double;
    FLeft: Double;
    FTop: Double;
    FRight: Double;
    procedure SetBottom(const Value: Double);
    procedure SetLeft(const Value: Double);
    procedure SetRight(const Value: Double);
    procedure SetTop(const Value: Double);
  protected
  public
  published
    property Left : Double read FLeft write SetLeft;
    property Right : Double read FRight write SetRight;
    property Top : Double read FTop write SetTop;
    property Bottom : Double read FBottom write SetBottom;
  end;
  TAHMPaperSize = class(TGraphicsObject)
  private
    FHeight: Double;
    FWidth: Double;
    procedure SetHeight(const Value: Double);
    procedure SetWidth(const Value: Double);
  protected
  public
  published
    property Width : Double read FWidth write SetWidth;
    property Height : Double read FHeight write SetHeight;
  end;
  TAHMPageSetupDialog = class(TCommonDialog)
  private
    FAHMAboutStr : TAHMAboutDlgsStr;
    FOptions: TAHMPageSetupOptions;
    FCustomData: LPARAM;
    FMeasurements: TAHMMeasurements;
    FOnPrinter: TAHMPrinterEvent;
    FOnInitPaintPage: TAHMInitPaintPageEvent;
    FOnPaintPage: TAHMPaintPageEvent;
    FMinMargins: TAHMMargins;
    FMargins: TAHMMargins;
    FPaperSize: TAHMPaperSize;
    function DoPrinter(Wnd: HWND): boolean;
    function DoExecute(Func: pointer): boolean;
    procedure SetMinMargins(const Value: TAHMMargins);
    procedure SetMargins(const Value: TAHMMargins);
    procedure SetPaperSize(const Value: TAHMPaperSize);
  protected
    function Printer(Wnd: HWND): boolean; virtual;
    property CustomData: LPARAM read FCustomData  write FCustomData;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    {$IFDEF AHMINPRISE3}
    function Execute: boolean; override;
    {$ELSE}
    function Execute: boolean;
    {$ENDIF}
  published
    property MinMargins : TAHMMargins read FMinMargins write SetMinMargins;
    property Margins : TAHMMargins read FMargins write SetMargins;
    property PaperSize : TAHMPaperSize read FPaperSize write SetPaperSize;
    property About : TAHMAboutDlgsStr read FAHMAboutStr write FAHMAboutStr stored False;
    property Options: TAHMPageSetupOptions read FOptions write FOptions default [poDefaultMinMargins, poShowHelp];
    property Measurements: TAHMMeasurements read FMeasurements write FMeasurements default pmInches;
    property OnPrinter: TAHMPrinterEvent read FOnPrinter write FOnPrinter;
    property OnInitPaintPage: TAHMInitPaintPageEvent read FOnInitPaintPage write FOnInitPaintPage;
    property OnPaintPage: TAHMPaintPageEvent read FOnPaintPage write FOnPaintPage;
  end;


implementation

uses Printers;

const
  IDPRINTERBTN = $0402;
var
  HookCtl3D: boolean;

procedure CenterWindow(Wnd: HWnd);
var Rect: TRect;
begin
  GetWindowRect(Wnd, Rect);
  SetWindowPos(Wnd, 0,(GetSystemMetrics(SM_CXSCREEN) - Rect.Right + Rect.Left) div 2,
    (GetSystemMetrics(SM_CYSCREEN) - Rect.Bottom + Rect.Top) div 3,
    0, 0, SWP_NOACTIVATE or SWP_NOSIZE or SWP_NOZORDER);
end;


function DialogHook(Wnd: HWnd; Msg: UINT; WParam: WPARAM; LParam: LPARAM): UINT; stdcall;
begin
  Result := 0;
  case Msg of
    WM_INITDIALOG: begin
                     if HookCtl3D then
                     begin
                       Subclass3DDlg(Wnd, CTL3D_ALL);
                       SetAutoSubClass(True);
                     end;
                     CenterWindow(Wnd);
                     Result := 1;
                   end;
    WM_DESTROY: if HookCtl3D then SetAutoSubClass(False);
  end;
end;

var
  PageSetupDialog: TAHMPageSetupDialog;

function PageSetupDialogHook(Wnd: HWnd; Msg: UINT; WParam: WPARAM;
                             LParam: LPARAM): UINT; stdcall;
const
  PagePaintWhat: array[WM_PSD_FULLPAGERECT..WM_PSD_YAFULLPAGERECT] of TAHMPaintWhat = (
                           pwFullPage, pwMinimumMargins, pwMargins,
                           pwGreekText, pwEnvStamp, pwYAFullPage);
  PRINTER_MASK = $00000002;
  ORIENT_MASK  = $00000004;
  PAPER_MASK   = $00000008;
var
  PaperData: word;
  Paper: TAHMPaperType;
  Orient: TAHMPaperOrientation;
  Printer: TAHMPrinterType;
  PaintRect: TRect;
  PaintCanvas: TCanvas;
begin
  if (Msg = WM_COMMAND) and (LongRec(WParam).Lo = IDPRINTERBTN)
                        and (LongRec(WParam).Hi = BN_CLICKED) then
  begin
    Result := ord(PageSetupDialog.DoPrinter(Wnd));
  end else begin
    if assigned(PageSetupDialog.FOnInitPaintPage) and assigned(PageSetupDialog.FOnPaintPage) then
    begin
      case Msg of
        WM_PSD_PAGESETUPDLG:
        begin
          PaperData := HiWord(WParam);
          if (PaperData AND PAPER_MASK > 0)  then Paper := ptEnvelope else Paper := ptPaper;
          if (PaperData AND ORIENT_MASK > 0) then Orient := poPortrait else Orient := poLandscape;
          if (PaperData AND PAPER_MASK > 0) then Printer := ptHPPCL else Printer := ptDotMatrix;
          Result := Ord(PageSetupDialog.FOnInitPaintPage(PageSetupDialog,
                        LoWord(WParam), Paper, Orient, Printer, PAHMDlgData(LParam)));
        end;
        WM_PSD_FULLPAGERECT,WM_PSD_MINMARGINRECT,WM_PSD_MARGINRECT,
        WM_PSD_GREEKTEXTRECT,WM_PSD_ENVSTAMPRECT,WM_PSD_YAFULLPAGERECT:
        begin
          if LParam <> 0 then PaintRect := PRect(LParam)^ else PaintRect := Rect(0,0,0,0);
          PaintCanvas := TCanvas.Create;
          PaintCanvas.Handle := HDC(WParam);
          try
            Result := Ord(PageSetupDialog.FOnPaintPage(PageSetupDialog,PagePaintWhat[Msg],
                          PaintCanvas, PaintRect));
          finally
            PaintCanvas.Free;
          end;
        end;
        else Result := DialogHook(Wnd, Msg, wParam, lParam);
      end;
    end else Result := DialogHook(Wnd, Msg, wParam, lParam);
  end;
end;


constructor TAHMPageSetupDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FOptions := [poDefaultMinMargins, poShowHelp];
  FOnPrinter := NIL;
  FOnInitPaintPage := NIL;
  FOnPaintPage := NIL;
  FCustomData := 0;
  FMinMargins := TAHMMargins.Create;
  FMargins    := TAHMMargins.Create;
  FPaperSize  := TAHMPaperSize.Create;
  FMeasurements := pmInches;
end;

procedure GetPrinter(var DeviceMode, DeviceNames: THandle);
var
  Device, Driver, Port: array[0..79] of char;
  DevNames: PDevNames;
  Offset: PChar;
begin
  Printer.GetPrinter(Device, Driver, Port, DeviceMode);
  if DeviceMode <> 0 then
  begin
    DeviceNames := GlobalAlloc(GHND, SizeOf(TDevNames) +
     StrLen(Device) + StrLen(Driver) + StrLen(Port) + 3);
    DevNames := PDevNames(GlobalLock(DeviceNames));
    try
      Offset := PChar(DevNames) + SizeOf(TDevnames);
      with DevNames^ do
      begin
        wDriverOffset := Longint(Offset) - Longint(DevNames);
        Offset := StrECopy(Offset, Driver) + 1;
        wDeviceOffset := Longint(Offset) - Longint(DevNames);
        Offset := StrECopy(Offset, Device) + 1;
        wOutputOffset := Longint(Offset) - Longint(DevNames);;
        StrCopy(Offset, Port);
      end;
    finally
      GlobalUnlock(DeviceNames);
    end;
  end;
end;

procedure SetPrinter(DeviceMode, DeviceNames: THandle);
var
  DevNames: PDevNames;
begin
  DevNames := PDevNames(GlobalLock(DeviceNames));
  try
    with DevNames^ do
      Printer.SetPrinter(PChar(DevNames) + wDeviceOffset,
        PChar(DevNames) + wDriverOffset,PChar(DevNames) + wOutputOffset, DeviceMode);
  finally
    GlobalUnlock(DeviceNames);
    GlobalFree(DeviceNames);
  end;
end;

function CopyData(Handle: THandle): THandle;
var
  Src, Dest: PChar;
  Size: Integer;
begin
  if Handle <> 0 then
  begin
    Size := GlobalSize(Handle);
    Result := GlobalAlloc(GHND, Size);
    if Result <> 0 then
      try
        Src := GlobalLock(Handle);
        Dest := GlobalLock(Result);
        if (Src <> nil) and (Dest <> nil) then Move(Src^, Dest^, Size);
      finally
        GlobalUnlock(Handle);
        GlobalUnlock(Result);
      end
  end
  else Result := 0;
end;

function TAHMPageSetupDialog.DoExecute(Func: pointer): boolean;
const
  PageSetupOptions: array [TAHMPageSetupOption] of DWORD = (
      PSD_DEFAULTMINMARGINS, PSD_DISABLEMARGINS, PSD_DISABLEORIENTATION,
      PSD_DISABLEPAGEPAINTING, PSD_DISABLEPAPER, PSD_DISABLEPRINTER,
      PSD_NOWARNING, PSD_SHOWHELP);
  PageSetupMeasurements: array [TAHMMeasurements] of DWORD = (
      PSD_INHUNDREDTHSOFMILLIMETERS, PSD_INTHOUSANDTHSOFINCHES);
var
  Option: TAHMPageSetupOption;
  PageSetup: TPageSetupDlg;
  SavePageSetupDialog: TAHMPageSetupDialog;
  DevHandle: THandle;
begin
  FillChar(PageSetup, SizeOf(PageSetup), 0);
  with PageSetup do
  try
    lStructSize := SizeOf(TPageSetupDlg);
    Flags := PSD_MARGINS;
//    if assigned(FOnPrinter) or assigned(FOnInitPaintPage) or assigned(FOnPaintPage) then
    Flags := Flags or PSD_ENABLEPAGESETUPHOOK;
    lpfnPageSetupHook := PageSetupDialogHook;
    for Option := Low(Option) to High(Option) do if Option in FOptions then Flags := Flags OR PageSetupOptions[Option];
    Flags := Flags OR PageSetupMeasurements[FMeasurements];
    if assigned(FOnInitPaintPage) and assigned(FOnPaintPage) then Flags := Flags OR PSD_ENABLEPAGEPAINTHOOK;
    lpfnPagePaintHook := PageSetupDialogHook;
    hWndOwner := Application.Handle;
    GetPrinter(DevHandle, hDevNames);
    hDevMode := CopyData(DevHandle);
    lCustData := FCustomData;
    ptPaperSize := Point(Round(FPaperSize.Width*100),Round(FPaperSize.Height*100));
    rtMinMargin := Rect(Round(FMinMargins.Left*100),Round(FMinMargins.Top*100),Round(FMinMargins.Right*100),Round(FMinMargins.Bottom*100));
    rtMargin := Rect(Round(FMargins.Left*100),Round(FMargins.Top*100),Round(FMargins.Right*100),Round(FMargins.Bottom*100));
    SavePageSetupDialog := PageSetupDialog;
    PageSetupDialog := Self;
    Result := TaskModalDialog(Func, PageSetup);
    PageSetupDialog := SavePageSetupDialog;
    if Result then
    begin
      FPaperSize.Width := ptPaperSize.X/100;
      FPaperSize.Height  := ptPaperSize.Y/100;
      FMinMargins.Left := rtMinMargin.Left/100;
      FMinMargins.Top := rtMinMargin.Top/100;
      FMinMargins.Right := rtMinMargin.Right/100;
      FMinMargins.Bottom := rtMinMargin.Bottom/100;
      FMargins.Left := rtMargin.Left/100;
      FMargins.Top := rtMargin.Top/100;
      FMargins.Right := rtMargin.Right/100;
      FMargins.Bottom := rtMargin.Bottom/100;
      SetPrinter(hDevMode, hDevNames);
    end else
    begin
      if hDevMode <> 0 then GlobalFree(hDevMode);
      if hDevNames <> 0 then GlobalFree(hDevNames);
    end;
  finally
  end;
end;

function TAHMPageSetupDialog.Execute: boolean;
begin
  Result := DoExecute(@PageSetupDlg);
end;

function TAHMPageSetupDialog.Printer(Wnd: HWND): boolean;
begin
  Result :=  assigned(FOnPrinter);
  if Result then FOnPrinter(Self, Wnd);
end;

function TAHMPageSetupDialog.DoPrinter(Wnd: HWND): boolean;
begin
  try
    Result := Printer(Wnd);
  except
    Result := FALSE;
    Application.HandleException(Self);
  end;
end;

{ TAHMMargins }

procedure TAHMMargins.SetBottom(const Value: Double);
begin
  if Value>=0 then FBottom := StrToFloat(FormatFloat('0.000',Value));
  Changed;
end;

procedure TAHMMargins.SetLeft(const Value: Double);
begin
  if Value>=0 then FLeft := StrToFloat(FormatFloat('0.000',Value));
  Changed;
end;

procedure TAHMMargins.SetRight(const Value: Double);
begin
  if Value>=0 then FRight := StrToFloat(FormatFloat('0.000',Value));
  Changed;
end;

procedure TAHMMargins.SetTop(const Value: Double);
begin
  if Value>=0 then FTop := StrToFloat(FormatFloat('0.000',Value));
  Changed;
end;

destructor TAHMPageSetupDialog.Destroy;
begin
  FMinMargins.Free;
  FMargins.Free;
  FPaperSize.Free;
  inherited Destroy;
end;

procedure TAHMPageSetupDialog.SetMinMargins(const Value: TAHMMargins);
begin
  FMinMargins := Value;
end;

procedure TAHMPageSetupDialog.SetMargins(const Value: TAHMMargins);
begin
  FMargins := Value;
end;

{ TAHMPaperSize }

procedure TAHMPaperSize.SetHeight(const Value: Double);
begin
  FHeight := Value;
  Changed;
end;

procedure TAHMPaperSize.SetWidth(const Value: Double);
begin
  FWidth := Value;
  Changed;
end;

procedure TAHMPageSetupDialog.SetPaperSize(const Value: TAHMPaperSize);
begin
  FPaperSize := Value;
end;

end.

