pgsetup.pas

动态提示控件

{$I DFS.INC}  { Standard defines for all Delphi Free Stuff components }

{------------------------------------------------------------------------------}
{ TdfsPageSetupDialog v2.14                                                    }
{------------------------------------------------------------------------------}
{ A component to wrap the Win95 PageSetupDlg common dialog API function.       }
{ Borland seems to have forgotten this new common dialog in Delphi 2.0.        }
{                                                                              }
{ Copyright 2000-2001, Brad Stowers.  All Rights Reserved.                     }
{                                                                              }
{ Copyright:                                                                   }
{ All Delphi Free Stuff (hereafter "DFS") source code is copyrighted by        }
{ Bradley D. Stowers (hereafter "author"), and shall remain the exclusive      }
{ property of the author.                                                      }
{                                                                              }
{ Distribution Rights:                                                         }
{ You are granted a non-exlusive, royalty-free right to produce and distribute }
{ compiled binary files (executables, DLLs, etc.) that are built with any of   }
{ the DFS source code unless specifically stated otherwise.                    }
{ You are further granted permission to redistribute any of the DFS source     }
{ code in source code form, provided that the original archive as found on the }
{ DFS web site (http://www.delphifreestuff.com) is distributed unmodified. For }
{ example, if you create a descendant of TDFSColorButton, you must include in  }
{ the distribution package the colorbtn.zip file in the exact form that you    }
{ downloaded it from http://www.delphifreestuff.com/mine/files/colorbtn.zip.   }
{                                                                              }
{ Restrictions:                                                                }
{ Without the express written consent of the author, you may not:              }
{   * Distribute modified versions of any DFS source code by itself. You must  }
{     include the original archive as you found it at the DFS site.            }
{   * Sell or lease any portion of DFS source code. You are, of course, free   }
{     to sell any of your own original code that works with, enhances, etc.    }
{     DFS source code.                                                         }
{   * Distribute DFS source code for profit.                                   }
{                                                                              }
{ Warranty:                                                                    }
{ There is absolutely no warranty of any kind whatsoever with any of the DFS   }
{ source code (hereafter "software"). The software is provided to you "AS-IS", }
{ and all risks and losses associated with it's use are assumed by you. In no  }
{ event shall the author of the softare, Bradley D. Stowers, be held           }
{ accountable for any damages or losses that may occur from use or misuse of   }
{ the software.                                                                }
{                                                                              }
{ Support:                                                                     }
{ Support is provided via the DFS Support Forum, which is a web-based message  }
{ system.  You can find it at http://www.delphifreestuff.com/discus/           }
{ All DFS source code is provided free of charge. As such, I can not guarantee }
{ any support whatsoever. While I do try to answer all questions that I        }
{ receive, and address all problems that are reported to me, you must          }
{ understand that I simply can not guarantee that this will always be so.      }
{                                                                              }
{ Clarifications:                                                              }
{ If you need any further information, please feel free to contact me directly.}
{ This agreement can be found online at my site in the "Miscellaneous" section.}
{------------------------------------------------------------------------------}
{ The lateset version of my components are always available on the web at:     }
{   http://www.delphifreestuff.com/                                            }
{ See PgSetup.txt for notes, known issues, and revision history.               }
{------------------------------------------------------------------------------}
{ Date last modified:  June 28, 2001                                           }
{------------------------------------------------------------------------------}


// Make sure we have RTTI available for the TPSRect class below.
{$M+}

unit PgSetup;

interface

{$IFNDEF DFS_WIN32}
  ERROR!  This unit only available for Delphi 2.0 or later!!!
{$ENDIF}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
{$IFDEF DFS_DEBUG}
  mmsystem,
{$ENDIF}
  CommDlg;


const
  { This shuts up C++Builder 3 about the redefiniton being different. There
    seems to be no equivalent in C1.  Sorry. }
  {$IFDEF DFS_CPPB_3_UP}
  {$EXTERNALSYM DFS_COMPONENT_VERSION}
  {$ENDIF}
  DFS_COMPONENT_VERSION = 'TdfsPageSetupDialog v2.14';

type
  TPageSetupOption = (
       poDefaultMinMargins, poDisableMargins, poDisableOrientation,
       poDisablePagePainting, poDisablePaper, poDisablePrinter, poNoWarning,
       poShowHelp
     );
  TPageSetupOptions = set of TPageSetupOption;
  TPSPaperType = (ptPaper, ptEnvelope);
  TPSPaperOrientation = (poPortrait, poLandscape);
  TPSPrinterType = (ptDotMatrix, ptHPPCL);
  TPSPaintWhat = (pwFullPage, pwMinimumMargins, pwMargins,
                  pwGreekText, pwEnvStamp, pwYAFullPage);

  TPSMeasureVal = Double;
  TPSMeasurements = (pmDefault, pmMillimeters, pmInches);
  TPSPrinterEvent = procedure(Sender: TObject; Wnd: HWND) of object;

  (* PPSDlgData is simply redeclared as PPageSetupDlg (COMMDLG.PAS) to prevent
     compile errors in units that have this event.  They won't compile unless
     you add CommDlg to their units.  This circumvents the problem.           *)
  PPSDlgData = ^TPSDlgData;
  TPSDlgData = TPageSetupDlg;
  { PaperSize: See DEVMODE help topic, dmPaperSize member. DMPAPER_* constants.}
  TPSInitPaintPageEvent = function(Sender: TObject; PaperSize: short;
     PaperType: TPSPaperType; PaperOrientation: TPSPaperOrientation;
     PrinterType: TPSPrinterType; pSetupData: PPSDlgData): boolean of object;
  TPSPaintPageEvent = function(Sender: TObject; PaintWhat: TPSPaintWhat;
     Canvas: TCanvas; Rect: TRect): boolean of object;

  (* TPSRect is used for published properties that would normally be of TRect
     type.  Can't publish properties that are record types, so this is used.  *)
  TPSRect = class(TPersistent)
  private
    FRect: TRect;

    {$IFDEF DFS_CPPB_4_UP}
    function GetLeft: integer;
    procedure SetLeft(Value: integer);
    function GetRight: integer;
    procedure SetRight(Value: integer);
    function GetTop: integer;
    procedure SetTop(Value: integer);
    function GetBottom: integer;
    procedure SetBottom(Value: integer);
    {$ENDIF}
  public
    function Compare(Other: TPSRect): boolean;

    property Rect: TRect
       read FRect
       write FRect;
  published
    property Left: integer
       read {$IFDEF DFS_CPPB_4_UP} GetLeft {$ELSE} FRect.Left {$ENDIF}
       write {$IFDEF DFS_CPPB_4_UP} SetLeft {$ELSE} FRect.Left {$ENDIF};
    property Right: integer
       read {$IFDEF DFS_CPPB_4_UP} GetRight {$ELSE} FRect.Right {$ENDIF}
       write {$IFDEF DFS_CPPB_4_UP} SetRight {$ELSE} FRect.Right {$ENDIF};
    property Top: integer
       read {$IFDEF DFS_CPPB_4_UP} GetTop {$ELSE} FRect.Top {$ENDIF}
       write {$IFDEF DFS_CPPB_4_UP} SetTop {$ELSE} FRect.Top {$ENDIF};
    property Bottom: integer
       read {$IFDEF DFS_CPPB_4_UP} GetBottom {$ELSE} FRect.Bottom {$ENDIF}
       write {$IFDEF DFS_CPPB_4_UP} SetBottom {$ELSE} FRect.Bottom {$ENDIF};
  end;

  (* TPSPoint is needed for the same reason as TPSRect above.                 *)
  TPSPoint = class(TPersistent)
  private
    FPoint: TPoint;
  protected
    function GetX: longint;
    procedure SetX(Val: longint);
    function GetY: longint;
    procedure SetY(Val: longint);
  public
    function Compare(Other: TPSPoint): boolean;

    property Point: TPoint
       read FPoint
       write FPoint;
  published
    property X: longint
       read GetX
       write SetX;
    property Y: longint
       read GetY
       write SetY;
  end;


  TdfsPageSetupDialog = class(TCommonDialog)
  private
    FGettingDefaults: boolean;
    FCentered: boolean;
    FOptions: TPageSetupOptions;
    FCustomData: LPARAM;
    FPaperSize: TPSPoint;
    FMinimumMargins: TPSRect;
    FMargins: TPSRect;
    FMeasurements: TPSMeasurements;
    FOnPrinter: TPSPrinterEvent;
    FOnInitPaintPage: TPSInitPaintPageEvent;
    FOnPaintPage: TPSPaintPageEvent;

    function DoPrinter(Wnd: HWND): boolean;
    function DoExecute(Func: pointer): boolean;
  protected
    procedure SetName(const NewName: TComponentName); override;
    function Printer(Wnd: HWND): boolean; virtual;

    procedure SetPaperSize(const Val: TPSPoint);
    function StorePaperSize: boolean;
    procedure SetMinimumMargins(const Val: TPSRect);
    function StoreMinimumMargins: boolean;
    procedure SetMargins(const Val: TPSRect);
    function StoreMargins: boolean;
    procedure SetMeasurements(Val: TPSMeasurements);
    function GetDefaultMeasurements: TPSMeasurements;
    function GetCurrentMeasurements: TPSMeasurements;
    function GetVersion: string;
    procedure SetVersion(const Val: string);
    function GetPaperSizeType: short;
    procedure SetPaperSizeType(Value: short);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    { Delphi and C++Builder 3 finally got it right! }
    function Execute: boolean;
       {$IFDEF DFS_COMPILER_3_UP} override; {$ELSE} virtual; {$ENDIF}
    function ReadCurrentValues: boolean; virtual;
    function FromMeasurementVal(Val: integer): TPSMeasureVal;
    function ToMeasurementVal(Val: TPSMeasureVal): integer;

    { Did the user select a user-defined size? }
    property PaperSizeType: SHORT
       read GetPaperSizeType
       write SetPaperSizeType;
    { How does the user's system like to measure things? }
    property DefaultMeasurements: TPSMeasurements
       read GetDefaultMeasurements;
    { What are we using currently, i.e. translate pmDefault value }
    property CurrentMeasurements: TPSMeasurements
       read GetCurrentMeasurements;

    { It is the user's responsibility to clean up this pointer if necessary. }
    property CustomData: LPARAM
       read FCustomData
       write FCustomData;
  published
    property Version: string
       read GetVersion
       write SetVersion
       stored FALSE;
    // Measurements property has to be declared before PaperSize, MinimumMargins
    // and Margins because of streaming quirks.
    property Measurements: TPSMeasurements
       read FMeasurements
       write SetMeasurements
       nodefault;

    property PaperSize: TPSPoint
       read FPaperSize
       write SetPaperSize
       stored StorePaperSize;
    property MinimumMargins: TPSRect
       read FMinimumMargins
       write SetMinimumMargins
       stored StoreMinimumMargins;
    property Margins: TPSRect
       read FMargins
       write SetMargins
       stored StoreMargins;

    property Centered: boolean
       read FCentered
       write FCentered
       default TRUE;
    property Options: TPageSetupOptions
       read FOptions
       write FOptions
       default [poDefaultMinMargins, poShowHelp];

    { Events }
    property OnPrinter: TPSPrinterEvent
       read FOnPrinter
       write FOnPrinter;
    property OnInitPaintPage: TPSInitPaintPageEvent
       read FOnInitPaintPage
       write FOnInitPaintPage;
    property OnPaintPage: TPSPaintPageEvent
       read FOnPaintPage
       write FOnPaintPage;
  end;

implementation

uses
{$IFDEF DFS_COMPILER_3_UP}
  Dlgs,
{$ENDIF}
  Printers;

const
  IDPRINTERBTN = {$IFDEF DFS_COMPILER_3_UP} Dlgs.psh3 {$ELSE} $0402 {$ENDIF};

{ Private globals }
var
  NeedInitGlobals: boolean;
  HelpMsg: Integer;
  DefPaperSizeI: TPSPoint;
  DefMinimumMarginsI: TPSRect;
  DefMarginsI: TPSRect;
  DefPaperSizeM: TPSPoint;
  DefMinimumMarginsM: TPSRect;
  DefMarginsM: TPSRect;
  HookCtl3D: boolean;
  PageSetupDialog: TdfsPageSetupDialog;


procedure InitGlobals; forward;

{ Center the given window on the screen }
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;

{ Generic dialog hook. Centers the dialog on the screen in response to
  the WM_INITDIALOG message }
function DialogHook(Wnd: HWnd; Msg: UINT; WParam: WPARAM; LParam: LPARAM): UINT; stdcall;
begin
  Result := 0;
  case Msg of
    WM_INITDIALOG:
      begin
        {$IFNDEF DFS_COMPILER_5_UP}
        if HookCtl3D then
        begin
          // These were only stubbed in D5, and deprecated in D6.
          Subclass3DDlg(Wnd, CTL3D_ALL);
          SetAutoSubClass(True);
        end;
        {$ENDIF}
        if PageSetupDialog.Centered then
          CenterWindow(Wnd);
        Result := 1;
      end;
    {$IFNDEF DFS_COMPILER_5_UP}
    WM_DESTROY:
      if HookCtl3D then
        SetAutoSubClass(False);
    {$ENDIF}
  end;
end;