lazarus-ccr/components/kcontrols/source/kcontrols.pas

{ @abstract(This unit contains the base class for all visible controls.)
  @author(Tomas Krysl (tk@tkweb.eu))
  @created(18 Sep 2009)
  @lastmod(20 Jun 2010)

  This unit implements the base class TKCustomControl for all visible controls
  from the KControls Development Suite.

  Copyright � 2009 Tomas Krysl (tk@@tkweb.eu)<BR><BR>

  <B>License:</B><BR>
  This code is distributed as a freeware. You are free to use it as part
  of your application for any purpose including freeware, commercial and
  shareware applications. The origin of this source code must not be
  misrepresented; you must not claim your authorship. You may modify this code
  solely for your own purpose. Please feel free to contact the author if you
  think your changes might be useful for other users. You may distribute only
  the original package. The author accepts no liability for any damage
  that may result from using this code. }

unit KControls;

{$include kcontrols.inc}
{$WEAKPACKAGEUNIT ON}

interface

uses
{$IFDEF FPC}
  LCLType, LCLIntf, LMessages, LCLProc, LResources,
{$ELSE}
  Windows, Messages,
{$ENDIF}
  SysUtils, Classes, Graphics, Controls, Forms, KFunctions
{$IFDEF USE_THEMES}
  , Themes
 {$IFNDEF FPC}
  , UxTheme
 {$ENDIF}
{$ENDIF}
  ;

type
  { This array serves as storage place for all colors. }
  TKColorArray = array of TColor;

  { Declares possible indexes e.g. for the @link(TKPreviewColors.Color) property. }
  TKPreviewColorIndex = Integer;

  { Declares print options - possible values for the @link(TKPrintPageSetup.Options) property. }
  TKPrintOption = (
    { If there are more printed copies these will be collated. }
    poCollate,
    { The printed shape will be scaled to fit on page. }
    poFitToPage,
    { Every even page will be printed with mirrored (swapped) margins. }
    poMirrorMargins,
    { Page numbers will be added to the bottom of each printed page. }
    poPageNumbers,
    { Paints the selection in control's specific manner. }
    poPaintSelection,
    { Title will be printed to the top of each printed page. }
    poTitle,
    { Color page will be printed instead of B/W page. }
    poUseColor
  );

  { Print options can be arbitrary combined. }
  TKPrintOptions = set of TKPrintOption;

  { Declares possible values for the @link(TKPrintPageSetup.Range) property. }
  TKPrintRange = (
    { All pages will be printed. }
    prAll,
    { Only selected block will be printed. }
    prSelectedOnly,
    { Only given range of pages will be printed. }
    prRange
  );

  { Declares measurement units for KControls printing system. }
  TKPrintUnits = (
    { Corresponding value is given in millimeters. }
    puMM,
    { Corresponding value is given in centimeters. }
    puCM,
    { Corresponding value is given in inches. }
    puInch,
    { Corresponding value is given in hundredths of inches. }
    puHundredthInch
  );

const
  { Default value for the @link(TKCustomControl.BorderStyle) property. }
  cBorderStyleDef = bsSingle;

  { Minimum for the @link(TKPrintPageSetup.Copies) property }
  cCopiesMin = 1;
  { Maximum for the @link(TKPrintPageSetup.Copies) property }
  cCopiesMax = 1000;
  { Default value for the @link(TKPrintPageSetup.Copies) property }
  cCopiesDef = 1;

  { Default value for the @link(TKPrintPageSetup.MarginBottom) property }
  cMarginBottomDef = 2.0;
  { Default value for the @link(TKPrintPageSetup.MarginLeft) property }
  cMarginLeftDef = 1.5;
  { Default value for the @link(TKPrintPageSetup.MarginRight) property }
  cMarginRightDef = 1.5;
  { Default value for the @link(TKPrintPageSetup.MarginTop) property }
  cMarginTopDef = 1.8;

  { Default value for the @link(TKPrintPageSetup.Options) property. }
  cOptionsDef = [poFitToPage, poPageNumbers, poUseColor];

  { Default value for the @link(TKPrintPageSetup.Options) property. }
  cRangeDef = prAll;

  { Minimum for the @link(TKPrintPageSetup.Scale) property }
  cScaleDef = 100;
  { Maximum for the @link(TKPrintPageSetup.Scale) property }
  cScaleMin = 10;
  { Default value for the @link(TKPrintPageSetup.Scale) property }
  cScaleMax = 500;

  { Default value for the @link(TKPrintPageSetup.Units) property. }
  cUnitsDef = puCM;

  { Default value for the @link(TKPreviewColors.Paper) color property. }
  cPaperDef = clWhite;
  { Default value for the @link(TKPreviewColors.BkGnd) color property. }
  cBkGndDef = clAppWorkSpace;
  { Default value for the @link(TKPreviewColors.Border) color property. }
  cBorderDef = clBlack;
  { Default value for the @link(TKPreviewColors.SelectedBorder) color property. }
  cSelectedBorderDef = clNavy;

  { Index for the @link(TKPreviewColors.Paper) property. }
  ciPaper = TKPreviewColorIndex(0);
  { Index for the @link(TKPreviewColors.BkGnd) property. }
  ciBkGnd = TKPreviewColorIndex(1);
  { Index for the @link(TKPreviewColors.Border) property. }
  ciBorder = TKPreviewColorIndex(2);
  { Index for the @link(TKPreviewColors.SelectedBorder) property. }
  ciSelectedBorder = TKPreviewColorIndex(3);
  { Maximum color array index }
  ciPreviewColorsMax = ciSelectedBorder;

  { Constant for control scrollbars. It means: Leave that scrollbar untouched. }
  cScrollNoAction = -1;

  { Constant for control scrollbars. It means: Use given Delta to update scrollbar. }
  cScrollDelta = -2;

  { Internal flag for TKPrintPreview. }
  cPF_Dragging          = $00000001;
  { Internal flag for TKPrintPreview. }
  cPF_UpdateRange       = $00000002;

type
  { Declares possible values for the @link(ScaleMode) property }
  TKPreviewScaleMode = (
    { Apply scale defined by the @link(Scale) property }
    smScale,
    { Scale the page so that it horizontally fits to the window client area }
    smPageWidth,
    { Scale the page so that it fits to the window client area }
    smWholePage);

  { @abstract(Declares @link(TKPrintPreview.OnChanged) event handler)
    <UL>
    <LH>Parameters:</LH>
    <LI><I>Sender</I> - identifies the event caller</LI>
    </UL>
  }
  TKPreviewChangedEvent = procedure(Sender: TObject) of object;

  { @abstract(Declares the information structure for the @link(TKCustomControl.MeasurePages) method)
    <UL>
    <LH>Members:</LH>
    <LI><I>OutlineWidth</I> - printed outline width (maximum of all pages) in desktop pixels</LI>
    <LI><I>OutlineHeight</I> - printed outline height (maximum of all pages) in desktop pixels</LI>
    <LI><I>HorzPageCount</I> - number of pages to split a wide shape into</LI>
    <LI><I>VertPageCount</I> - number of pages to split a tall shape into</LI>
    <LI><I>PageCount</I> - total number of pages for 1 copy. Might be HorzPageCount * VertPageCount 
      but does not necessarilly have to be. </LI>
    </UL>
  }
  TKPrintMeasureInfo = record
    OutlineWidth: Integer;
    OutlineHeight: Integer;
    HorzPageCount: Integer;
    VertPageCount: Integer;
    PageCount: Integer;
  end;

  { Declares possible values for the Status parameter in the @link(TKPrintNotifyEvent) event }
  TKPrintStatus = (
    { This event occurs at the beginning of the print job - you may show an Abort dialog here }
    epsBegin,
    { This event occurs after each page has been printed - you may update the Page/Copy information
      in the Abort dialog }
    epsNewPage,
    { This event occurs at the end of the print job - you may hide the Abort dialog here }
    epsEnd
  );

  { @abstract(Declares @link(TKCustomControl.OnPrintNotify) event handler)
    <UL>
    <LH>Parameters:</LH>
    <LI><I>Sender</I> - identifies the event caller</LI>
    <LI><I>Status</I> - specifies the event type</LI>
    <LI><I>Abort</I> - set to True to abort the print job</LI>
    </UL>
    Remark: At certain time slots, the print spooler allows the message queue
    to be processed for the thread where the print job is running. This e.g. allows
    the user to press a button on the Abort dialog. Because this message loop can be invoked
    e.g. during a Printer.Canvas.TextRect function and any painting messages may hover in
    the message queue, any functions used both to print a job and to process particular
    messages should be reentrant to avoid conflicts. Perhaps should print jobs be run
    in seperate threads?
  }
  TKPrintNotifyEvent = procedure(Sender: TObject; Status: TKPrintStatus;
    var Abort: Boolean) of object;

  { @abstract(Declares @link(TKCustomControl.OnPrintPaint) event handler)
    <UL>
    <LH>Parameters:</LH>
    <LI><I>Sender</I> - identifies the event caller</LI>
    </UL>
  }
  TKPrintPaintEvent = procedure(Sender: TObject) of object;

  TKPrintPageSetup = class;
  TKPrintPreview = class;

  { Base class for all visible controls in KControls. }
  TKCustomControl = class(TCustomControl)
  private
  {$IFNDEF FPC}
    FBorderStyle: TBorderStyle;
  {$ENDIF}
  {$IFNDEF COMPILER10_UP}
    FMouseInClient: Boolean;
  {$ENDIF}
    FMemoryCanvas: TCanvas;
    FMemoryCanvasRect: TRect;
    FPageSetup: TKPrintPageSetup;
    FUpdateLock: Integer;
    FOnPrintNotify: TKPrintNotifyEvent;
    FOnPrintPaint: TKPrintPaintEvent;
  {$IFNDEF FPC}
    procedure CMCancelMode(var Msg: TMessage); message CM_CANCELMODE;
    procedure CMCtl3DChanged(var Msg: TMessage); message CM_CTL3DCHANGED;
  {$ENDIF}
    procedure CMMouseLeave(var Msg: TLMessage); message CM_MOUSELEAVE;
    function GetCanPrint: Boolean;
    function GetPageSetup: TKPrintPageSetup;
    function GetPageSetupAllocated: Boolean;
    procedure KMLateUpdate(var Msg: TLMessage); message KM_LATEUPDATE;
  {$IFNDEF FPC}
    procedure SetBorderStyle(Value: TBorderStyle);
  {$ENDIF}
    procedure SetPageSetup(Value: TKPrintPageSetup);
  {$IFNDEF FPC}
    procedure WMCancelMode(var Msg: TWMCancelMode); message WM_CANCELMODE;
  {$ENDIF}
  {$IFNDEF COMPILER10_UP}
    procedure WMMouseLeave(var Msg: TLMessage); message KM_MOUSELEAVE;
  {$ENDIF}
  {$IFNDEF FPC}
    procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
    procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
  {$ENDIF}
    procedure WMSize(var Msg: TLMSize); message LM_SIZE;
  {$IFNDEF FPC}
   {$IFDEF USE_THEMES}
    procedure WMThemeChanged(var Msg: TMessage); message WM_THEMECHANGED;
   {$ENDIF}
  {$ENDIF}
  protected
    { Holds the mutually inexclusive state as cXF... flags. }
    FFlags: Cardinal;
    { Defines the message queue for late update. }
    FMessages: array of TLMessage;
    { Gains access to the list of associated previews. }
    FPreviewList: TList;
    { Adds a preview control to the internal list of associated previews. }
    procedure AddPreview(APreview: TKPrintPreview);
    { Gives the descendant the possibility to adjust the associated TKPrintPageSetup
      instance just before printing. }
    procedure AdjustPageSetup; virtual;
    { Cancels any dragging or resizing operations performed by mouse. }
    procedure CancelMode; virtual;
    { Defines additional styles. }
    procedure CreateParams(var Params: TCreateParams); override;
  {$IFDEF FPC}
    { Overriden method. Calls @link(TKCustomControl.UpdateSize). }
    procedure CreateWnd; override;
    { Overriden method. Calls @link(TKCustomControl.UpdateSize). }
    procedure DoOnChangeBounds; override;
  {$ENDIF}
    { If Value is True, includes the flag specified by AFLag to @link(FFlags).
      If Value is False, excludes the flag specified by AFLag from @link(FFlags). }
    procedure FlagAssign(AFlag: Cardinal; Value: Boolean);
    { Excludes the flag specified by AFLag from @link(FFlags). }
    procedure FlagClear(AFlag: Cardinal);
    { Includes the flag specified by AFLag to @link(FFlags). }
    procedure FlagSet(AFlag: Cardinal);
    { If the flag specified by AFLag is included in @link(FFlags), FlagToggle
      excludes it and vice versa. }
    procedure FlagToggle(AFlag: Cardinal);
    { Invalidates the page setup settings. If page setup is required again,
      it's UpdateSettings method is called. }
    procedure InvalidatePageSetup;
    { Invalidates a rectangular part of the client area if control updating is not locked
      by @link(TKCustomControl.LockUpdate). }
    procedure InvalidateRectArea(const R: TRect); virtual;
    { Returns True if the control has a selection. }
    function InternalGetSelAvail: Boolean; virtual;
    { Called in UnlockUpdate. Allows the changes to be reflected. }
    procedure InternalUnlockUpdate; virtual;
    { Determines if control can be painted with OS themes. }
    function IsThemed: Boolean; virtual;
    { Called from KM_LATEUPDATE. Performs late update. Override to adapt. }
    procedure LateUpdate(var Msg: TLMessage); virtual;
    { Updates information about printed shape. }
    procedure MeasurePages(var Info: TKPrintMeasureInfo); virtual;
    { Retrieves a message from message queue if there is one. Used for late update.}
    function MessagePeek(out Msg: TLMessage): Boolean;
    { Puts a new message into the message queue. Used for late update.}
    procedure MessagePoke(const Msg: TLMessage);
    { Searches the message queue for given message code. }
    function MessageSearch(MsgCode: Cardinal): Boolean;
    { Responds to WM_MOUSELEAVE message. }
    procedure MouseFormLeave; virtual;
    { Overriden method - see Delphi help. }
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    { Notifies all associated previews about a change in the associated page setup. }
    procedure NotifyPreviews;
    { Overriden method - see Delphi help. Paints the entire control client area. }
    procedure Paint; override;
    { Paints a page to a printer/preview canvas. }
    procedure PaintPage; virtual;
    { Paints the control to the specified canvas. Must always be overriden. }
    procedure PaintToCanvas(ACanvas: TCanvas); virtual; abstract;
    { Adds a message to message queue for late update. Set IfNotExists to True to
      add that message only if the specified message code does not exist in the
      message queue at this moment. }
    procedure PostLateUpdate(const Msg: TLMessage; IfNotExists: Boolean = False);
    { Calls the @link(TKCustomControl.OnPrintNotify) event }
    procedure PrintNotify(Status: TKPrintStatus; var Abort: Boolean); virtual;
    { Calls the @link(TKCustomControl.OnPrintPaint) event }
    procedure PrintPaint; virtual;
    { Removse a preview control to the internal list of associated previews. }
    procedure RemovePreview(APreview: TKPrintPreview);
    { Updates mouse cursor according to the state determined from current mouse
      position. Returns True if cursor has been changed. }
    function SetMouseCursor(X, Y: Integer): Boolean; virtual;
    { Updates the control size. Responds to WM_SIZE under Delphi and similar
      notifications under Lazarus. }
    procedure UpdateSize; virtual;
  public
    { Creates the instance. Assigns default values to properties, allocates
      default column, row and cell data. }
    constructor Create(AOwner: TComponent); override;
    { Destroys the instance along with all allocated column, row and cell data.
      See TObject.Destroy in Delphi help. }
    destructor Destroy; override;
    { Determines whether a flag specified by AFlag is included in @link(FFlags). }
    function Flag(AFlag: Cardinal): Boolean;
    { Invalidates the entire control if control updating is not locked
      by @link(TKCustomControl.LockUpdate). }
    procedure Invalidate; override;
    { Locks control updating so that all possibly slow operations such as all Invalidate...
      methods will not be performed. This is useful e.g. when assigning many
      properties at one time. Every LockUpdate call must have
      a corresponding @link(TKCustomControl.UnlockUpdate) call, please use a
      try-finally section. }
    procedure LockUpdate;
    { Prints the control. }
    procedure PrintOut;
    { Unlocks back to normal control updating and calls InternalUnlockUpdate
      to reflect (possible) multiple changes made. Each @link(LockUpdate) call must
      be always followed by the UnlockUpdate call. }
    procedure UnlockUpdate;
    { Returns True if control updating is not locked, i.e. there is no open
      LockUpdate and UnlockUpdate pair. }
    function UpdateUnlocked: Boolean;
    { Determines whether a single line border is drawn around the control.
      Set BorderStyle to bsSingle to add a single line border around the control.
      Set BorderStyle to bsNone to omit the border. }
  {$IFDEF FPC}
    property BorderStyle default cBorderStyleDef;
  {$ELSE}
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default cBorderStyleDef;
  {$ENDIF}
    { Returns True if the control has anything to print and a printer is installed. }
    property CanPrint: Boolean read GetCanPrint;
  {$IFNDEF COMPILER10_UP}
    { This property has the same meaning as the MouseInClient property introduced
      into TWinControl in BDS 2006. }
    property MouseInClient: Boolean read FMouseInClient;
  {$ENDIF}
    { Setting this property causes the control to be painted to MemoryCanvas in it's
      Paint method. This approach replaces PaintTo as it does not work good for all
      LCL widget sets. The control is painted normally on it's Canvas and then
      copied only once to MemoryCanvas. MemoryCanvas is then set to nil (not freed)
      to indicate the copying is complete. }
    property MemoryCanvas: TCanvas read FMemoryCanvas write FMemoryCanvas;
    { Specifies what rectangular part of the control should be copied on MemoryCanvas. }
    property MemoryCanvasRect: TRect read FMemoryCanvasRect write FMemoryCanvasRect;
    { This event is called at certain phases of the actually running print job. }
    property OnPrintNotify: TKPrintNotifyEvent read FOnPrintNotify write FOnPrintNotify;
    { This event is called after the shape was drawn onto the printer canvas. }
    property OnPrintPaint: TKPrintPaintEvent read FOnPrintPaint write FOnPrintPaint;
    { Specifies the page setup component used for this control. }
    property PageSetup: TKPrintPageSetup read GetPageSetup write SetPageSetup;
    {Returns True if page setup component is allocated for this control. }
    property PageSetupAllocated: Boolean read GetPageSetupAllocated;
  end;

  { @abstract(Class to specify the print job parameters) }
  TKPrintPageSetup = class(TPersistent)
  private
    FActive: Boolean;
    FCanvas: TCanvas;
    FControl: TKCustomControl;
    FCopies: Integer;
    FCurrentCopy: Integer;
    FCurrentPage: Integer;
    FCurrentScale: Double;
    FDesktopPixelsPerInchX: Integer;
    FDesktopPixelsPerInchY: Integer;
    FEndPage: Integer;
    FFooterSpace: Double;
    FHeaderSpace: Double;
    FHorzPageCount: Integer;
    FIsValid: Boolean;
    FMarginBottom: Double;
    FMarginLeft: Double;
    FMarginRight: Double;
    FMarginTop: Double;
    FOptions: TKPrintOptions;
    FOutlineHeight: Integer;
    FOutlineWidth: Integer;
    FPageCount: Integer;
    FPageHeight: Integer;
    FPageWidth: Integer;
    FPaintAreaHeight: Integer;
    FPaintAreaWidth: Integer;
    FPreviewing: Boolean;
    FPrinterFooterSpace: Integer;
    FPrinterHeaderSpace: Integer;
    FPrinterMarginBottom: Integer;
    FPrinterMarginLeft: Integer;
    FPrinterMarginLeftMirrored: Integer;
    FPrinterMarginRight: Integer;
    FPrinterMarginRightMirrored: Integer;
    FPrinterMarginTop: Integer;
    FPrinterName: string;
    FPrinterPixelsPerInchX: Integer;
    FPrinterPixelsPerInchY: Integer;
    FPrintingMapped: Boolean;
    FRange: TKPrintRange;
    FStartPage: Integer;
    FScale: Integer;
    FTitle: string;
    FUnits: TKPrintUnits;
    FUpdateLock: Integer;
    FValidating: Boolean;
    FVertPageCount: Integer;
    function GetCanPrint: Boolean;
    procedure SetCopies(Value: Integer);
    procedure SetEndPage(Value: Integer);
    procedure SetFooterSpace(Value: Double);
    procedure SetHeaderSpace(Value: Double);
    procedure SetMarginBottom(Value: Double);
    procedure SetMarginLeft(Value: Double);
    procedure SetMarginRight(Value: Double);
    procedure SetMarginTop(Value: Double);
    procedure SetOptions(Value: TKPrintOptions);
    procedure SetPrinterName(const Value: string);
    procedure SetPrintingMapped(Value: Boolean);
    procedure SetRange(Value: TKPrintRange);
    procedure SetScale(Value: Integer);
    procedure SetStartPage(Value: Integer);
    procedure SetUnits(Value: TKPrintUnits);
    function GetSelAvail: Boolean;
  protected
    { Called before new Units are set. Converts the margins to inches by default. }
    procedure AfterUnitsChange; virtual;
    { Called after new Units are set. Converts the margins from inches by default. }
    procedure BeforeUnitsChange; virtual;
    { Paints a page to APreview.Canvas. }
    procedure PaintPageToPreview(APreview: TKPrintPreview); virtual;
    { Prints the page number at the bottom of the page, horizontally centered. }
    procedure PrintPageNumber(Value: Integer); virtual;
    { Prints the title at the top of the page. }
    procedure PrintTitle; virtual;
    { Updates entire printing information. }
    procedure UpdateSettings; virtual;
  public
    { Creates the instance. Assigns default values to properties. }
    constructor Create(AControl: TKCustomControl);
    { Copies shareable properties of another TKPrintPageSetup instance
      to this instance. }
    procedure Assign(Source: TPersistent); override;
    { Returns a value mapped from desktop horizontal units to printer horizontal units. }
    function HMap(Value: Integer): Integer;
    { Invalidates the settings. }
    procedure Invalidate;
    { Prints the associated control. }
    procedure PrintOut;
    { Locks page setup updating. Use this if you assign many properties at the
      same time. Every LockUpdate call must have a corresponding
      @link(TKPrintPageSetup.UnlockUpdate) call, please use a try-finally section. }
    procedure LockUpdate; virtual;
    { Unlocks page setup updating and updates the page settings.
      Each @link(TKPrintPageSetup.LockUpdate) call must be always followed
      by the UnlockUpdate call. }
    procedure UnlockUpdate; virtual;
    { Returns True if updating is not locked, i.e. there is no open
      LockUpdate and UnlockUpdate pair. }
    function UpdateUnlocked: Boolean; virtual;
    { Validates the settings. }
    procedure Validate;
    { Returns a value mapped from desktop vertical units to printer vertical units. }
    function VMap(Value: Integer): Integer;
    { Returns True if printing or previewing is active. }
    property Active: Boolean read FActive;
    { Returns True if the control is associated and has anything to print. }
    property CanPrint: Boolean read GetCanPrint;
    { Returns the Printer.Canvas or TkPrintPreview.Canvas. Do not access outside
      print job. }
    property Canvas: TCanvas read FCanvas;
    { Returns the control to which this TKPrintPageSetup instance is assigned. }
    property Control: TKCustomControl read FControl;
    { Specifies the number of copies to print. }
    property Copies: Integer read FCopies write SetCopies;
    { Returns the currently printed copy. }
    property CurrentCopy: Integer read FCurrentCopy;
    { Returns the currently printed page. }
    property CurrentPage: Integer read FCurrentPage;
    { Returns the horizontal scale for the printed shape, without dimension. }
    property CurrentScale: Double read FCurrentScale;
    { Returns the amount of pixels per inch for the desktop device context's horizontal axis }
    property DesktopPixelsPerInchX: Integer read FDesktopPixelsPerInchX;
    { Returns the amount of pixels per inch for the desktop device context's vertical axis }
    property DesktopPixelsPerInchY: Integer read FDesktopPixelsPerInchY;
    { Specifies last page printed if Range is eprRange. }
    property EndPage: Integer read FEndPage write SetEndPage;
    { Specifies the vertical space that should stay free for application
      specific footer. Value is given in Units. }
    property FooterSpace: Double read FFooterSpace write SetFooterSpace;
    { Specifies the vertical space that should stay free for application
      specific header. Value is given in Units. }
    property HeaderSpace: Double read FHeaderSpace write SetHeaderSpace;
    { Returns the maximum amount of pages for horizontal axis of the control. }
    property HorzPageCount: Integer read FHorzPageCount;
    { Specifies the bottom margin. Value is given in Units. }
    property MarginBottom: Double read FMarginBottom write SetMarginBottom;
    { Specifies the left margin. Value is given in Units. }
    property MarginLeft: Double read FMarginLeft write SetMarginLeft;
    { Specifies the right margin. Value is given in Units. }
    property MarginRight: Double read FMarginRight write SetMarginRight;
    { Specifies the top margin. Value is given in Units. }
    property MarginTop: Double read FMarginTop write SetMarginTop;
    { Specifies the printing options. }
    property Options: TKPrintOptions read FOptions write SetOptions;
    { Returns the printed shape height (maximum of all pages)
      in units depending on PrintingMapped.. }
    property OutlineHeight: Integer read FOutlineHeight;
    { Returns the printed shape width (maximum of all pages)
      in units depending on PrintingMapped.. }
    property OutlineWidth: Integer read FOutlineWidth;
    { Returns the amount of all pages. }
    property PageCount: Integer read FPageCount;
    { Returns the page height in printer device context's pixels. }
    property PageHeight: Integer read FPageHeight;
    { Returns the page width in printer device context's pixels. }
    property PageWidth: Integer read FPageWidth;
    { Returns the top paint area width on canvas in units depending on PrintingMapped. }
    property PaintAreaHeight: Integer read FPaintAreaHeight;
    { Returns the top paint area width on canvas in units depending on PrintingMapped. }
    property PaintAreaWidth: Integer read FPaintAreaWidth;
    { Returns True if painting to a TKPrintPreview.Canvas is active. }
    property Previewing: Boolean read FPreviewing;
    { Returns the footer space in printer device context's units. }
    property PrinterFooterSpace: Integer read FPrinterFooterSpace;
    { Returns the header space in printer device context's units. }
    property PrinterHeaderSpace: Integer read FPrinterHeaderSpace;
    { Returns the bottom margin in printer device context's units. }
    property PrinterMarginBottom: Integer read FPrinterMarginBottom;
    { Returns the left margin in printer device context's units. }
    property PrinterMarginLeft: Integer read FPrinterMarginLeft;
    { Returns the left margin in printer device context's units with respect to current page. }
    property PrinterMarginLeftMirrored: Integer read FPrinterMarginLeftMirrored;
    { Returns the right margin in printer device context's units. }
    property PrinterMarginRight: Integer read FPrinterMarginRight;
    { Returns the left margin in printer device context's units with respect to current page. }
    property PrinterMarginRightMirrored: Integer read FPrinterMarginRightMirrored;
    { Returns the top margin in printer device context's units. }
    property PrinterMarginTop: Integer read FPrinterMarginTop;
    { Specifies the printer name. }
    property PrinterName: string read FPrinterName write SetPrinterName;
    { Returns the amount of pixels per inch for the printer device context's horizontal axis }
    property PrinterPixelsPerInchX: Integer read FPrinterPixelsPerInchX;
    { Returns the amount of pixels per inch for the printer device context's vertical axis }
    property PrinterPixelsPerInchY: Integer read FPrinterPixelsPerInchY;
    { Specifies the units for printing the control's shape and OutlineX properties.
      If True, those extents are given in printer device context's pixels,
      otherwise in desktop device context's pixels. It can be adjusted by the descendant
      in the AdjustPageSetup method. }
    property PrintingMapped: Boolean read FPrintingMapped write SetPrintingMapped;
    { Specifies the printing range. }
    property Range: TKPrintRange read FRange write SetRange;
    { Returns True if the associated control has a selection. }
    property SelAvail: Boolean read GetSelAvail;
    { Specifies first page printed if Range is eprRange. }
    property StartPage: Integer read FStartPage write SetStartPage;
    { Specifies the requested scale for the printed shape, in percent.
      If epoFitToPage is specified in Options, this parameter is ignored. }
    property Scale: Integer read FScale write SetScale;
    { Specifies the document title as it appears in printer manager. }
    property Title: string read FTitle write FTitle;
    { Specifies the units for print margins. }
    property Units: TKPrintUnits read FUnits write SetUnits;
    { Returns the maximum amount of pages for vertical axis of the control. }
    property VertPageCount: Integer read FVertPageCount;
  end;

  { @abstract(Container for all colors used by @link(TKPrintPreview) class)
    This container allows to group many colors into one item in object inspector.
    Colors are accessible via published properties or several public Color*
    properties. }
  TKPreviewColors = class(TPersistent)
  private
    FPreview: TKPrintPreview;
    function GetColor(Index: TKPreviewColorIndex): TColor;
    function GetColorEx(Index: TKPreviewColorIndex): TColor;
    procedure SetColor(Index: TKPreviewColorIndex; Value: TColor);
    procedure SetColorEx(Index: TKPreviewColorIndex; Value: TColor);
    procedure SetColors(const Value: TKColorArray);
  protected
    FColors: TKColorArray;
    { Initializes the color array. }
    procedure Initialize; virtual;
    { Returns the specific color according to ColorScheme. }
    function InternalGetColor(Index: TKPreviewColorIndex): TColor; virtual;
    { Replaces the specific color. }
    procedure InternalSetColor(Index: TKPreviewColorIndex; Value: TColor); virtual;
  public
    { Creates the instance. You can create a custom instance and pass it
      e.g. to a @link(TKPrintPreview.Colors) property. The APreview parameter has no meaning
      in this case and you may set it to nil. }
    constructor Create(APreview: TKPrintPreview);
    { Copies the properties of another instance that inherits from
      TPersistent into this TKPreviewColors instance. }
    procedure Assign(Source: TPersistent); override;
    { Returns color for given index. }
    property Color[Index: TKPreviewColorIndex]: TColor read GetColorEx write SetColorEx;
    { Returns array of colors. }
    property Colors: TKColorArray read FColors write SetColors;
  published
    { Specifies the paper background color. }
    property Paper: TColor index ciPaper read GetColor write SetColor default cPaperDef;
    { Specifies the color of the background around paper. }
    property BkGnd: TColor index ciBkGnd read GetColor write SetColor default cBkGndDef;
    { Specifies the color of the paper border. }
    property Border: TColor index ciBorder read GetColor write SetColor default cBorderDef;
    { Specifies the color of the paper border when the control has input focus. }
    property SelectedBorder: TColor index ciSelectedBorder read GetColor write SetColor default cSelectedBorderDef;
  end;

  { @abstract(Print preview control for the TKCustomControl component) }
  TKPrintPreview = class(TKCustomControl)
  private
    FColors: TKPreviewColors;
    FControl: TKCustomControl;
    FMouseWheelAccumulator: Integer;
    FPage: Integer;
    FPageOld: Integer;
    FPageSize: TPoint;
    FExtent: TPoint;
    FPageOffset: TPoint;
    FScale: Integer;
    FScaleMode: TKPreviewScaleMode;
    FScrollExtent: TPoint;
    FScrollPos: TPoint;
    FScrollPosOld: TPoint;
    FX: Integer;
    FY: Integer;
    FOnChanged: TKPreviewChangedEvent;
    function GetCurrentScale: Integer;
    function GetEndPage: Integer;
    function GetStartPage: Integer;
    procedure SetControl(Value: TKCustomControl);
    procedure SetPage(Value: Integer);
    procedure SetScale(Value: Integer);
    procedure SetScaleMode(Value: TKPreviewScaleMode);
    procedure WMEraseBkgnd(var Msg: TLMessage); message LM_ERASEBKGND;
    procedure WMGetDlgCode(var Msg: TLMNoParams); message LM_GETDLGCODE;
    procedure WMHScroll(var Msg: TLMHScroll); message LM_HSCROLL;
    procedure WMKillFocus(var Msg: TLMKillFocus); message LM_KILLFOCUS;
    procedure WMSetFocus(var Msg: TLMSetFocus); message LM_SETFOCUS;
    procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL;
    procedure SetColors(const Value: TKPreviewColors);
  protected
    { Initializes a scroll message handling. }
    procedure BeginScrollWindow;
    { Defines additional styles. }
    procedure CreateParams(var Params: TCreateParams); override;
    { Overriden method - handles mouse wheel messages. }
    function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
      MousePos: TPoint): Boolean; override;
    { Calls the ScrollWindowEx function to complete a scroll message. }
    procedure EndScrollWindow;
    { Returns current page rectangle inside of the window client area. }
    function GetPageRect: TRect;
    { Processes virtual key strokes. }
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    { Processes scrollbar messages.
      <UL>
      <LH>Parameters:</LH>
      <LI><I>ScrollBar</I> - scrollbar type from OS</LI>
      <LI><I>ScrollCode</I> - scrollbar action from OS</LI>
      <LI><I>Delta</I> - scrollbar position change</LI>
      </UL> }
    procedure ModifyScrollBar(ScrollBar, ScrollCode, Delta: Integer);
    { Initializes drag&scroll functionality. }
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    { Performs drag&scroll functionality. }
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    { Finalizes drag&scroll functionality. }
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    { Notifies about associated TKCustomControl control removal. }
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    { Paints paper and control shape. }
    procedure Paint; override;
    { Calls the @link(OnChanged) event. }
    procedure Changed;
    { Grants the input focus to the control when possible and the control has had none before. }
    procedure SafeSetFocus;
    { Updates mouse cursor. }
    function SetMouseCursor(X, Y: Integer): Boolean; override;
    { Updates page sizes and scrollbar ranges. }
    procedure UpdateScrollRange;
    { Updates the control size. }
    procedure UpdateSize; override;
  public
    { Performs necessary initializations - default values to properties. }
    constructor Create(AOwner: TComponent); override;
    { Destroy instance... }
    destructor Destroy; override;
    { Shows first page for the given range. }
    procedure FirstPage;
    { Shows last page for the given range. }
    procedure LastPage;
    { Shows next page. }
    procedure NextPage;
    { Shows previous page. }
    procedure PreviousPage;
    { Updates the preview. }
    procedure UpdatePreview;
    { Returns the page scaling with regard to the @link(ScaleMode) property. }
    property CurrentScale: Integer read GetCurrentScale;
    { Returns the current page area rectangle in desktop pixels. }
    property PageRect: TRect read GetPageRect;
    { Returns the last page for the given range. }
    property EndPage: Integer read GetEndPage;
    { Returns the first page for the given range. }
    property StartPage: Integer read GetStartPage;
  published
    { Inherited property - see Delphi help. }
    property Align;
    { Inherited property - see Delphi help. }
    property Anchors;
    { See TKCustomControl.@link(TKCustomControl.BorderStyle) for details. }
    property BorderStyle;
    { Inherited property - see Delphi help. }
    property BorderWidth;
    { Specifies all colors used by TKPrintPreview's default painting. }
    property Colors: TKPreviewColors read FColors write SetColors;
    { Inherited property - see Delphi help. }
    property Constraints;
    { Specifies the associated control. }
    property Control: TKCustomControl read FControl write SetControl;
    { Inherited property - see Delphi help. }
    property DragCursor;
    { Inherited property - see Delphi help. }
    property DragKind;
    { Inherited property - see Delphi help. }
    property DragMode;
    { Specifies the currently displayed page. }
    property Page: Integer read FPage write SetPage default 1;
    { Inherited property - see Delphi help. }
    property ParentShowHint;
    { Inherited property - see Delphi help. }
    property PopupMenu;
    { Specifies the user defined page scale - i.e. when ScaleMode = smScale. }
    property Scale: Integer read FScale write SetScale default 100;
    { Specifies the scale mode to display and scroll previewed pages. }
    property ScaleMode: TKPreviewScaleMode read FScaleMode write SetScaleMode default smPageWidth;
    { Inherited property - see Delphi help. }
    property ShowHint;
    { Inherited property - see Delphi help. }
    property TabStop;
    { Inherited property - see Delphi help. }
    property TabOrder;
    { Inherited property - see Delphi help. }
    property Visible;
    { Called whenever print preview is updated. }
    property OnChanged: TKPreviewChangedEvent read FOnChanged write FOnChanged;
    { Inherited property - see Delphi help. }
    property OnClick;
    { Inherited property - see Delphi help. }
    property OnContextPopup;
    { Inherited property - see Delphi help. }
    property OnDblClick;
    { Inherited property - see Delphi help. }
    property OnDockDrop;
    { Inherited property - see Delphi help. }
    property OnDockOver;
    { Inherited property - see Delphi help. }
    property OnDragDrop;
    { Inherited property - see Delphi help. }
    property OnDragOver;
    { Inherited property - see Delphi help. }
    property OnEndDock;
    { Inherited property - see Delphi help. }
    property OnEndDrag;
    { Inherited property - see Delphi help. }
    property OnEnter;
    { Inherited property - see Delphi help. }
    property OnExit;
    { Inherited property - see Delphi help. }
    property OnGetSiteInfo;
    { Inherited property - see Delphi help. }
    property OnKeyDown;
    { Inherited property - see Delphi help. }
    property OnKeyPress;
    { Inherited property - see Delphi help. }
    property OnKeyUp;
    { Inherited property - see Delphi help. }
    property OnMouseDown;
    { Inherited property - see Delphi help. }
    property OnMouseMove;
    { Inherited property - see Delphi help. }
    property OnMouseUp;
    { Inherited property - see Delphi help. }
    property OnMouseWheel;
    { Inherited property - see Delphi help. }
    property OnMouseWheelDown;
    { Inherited property - see Delphi help. }
    property OnMouseWheelUp;
    { Inherited property - see Delphi help. }
    property OnResize;
    { Inherited property - see Delphi help. }
    property OnStartDock;
    { Inherited property - see Delphi help. }
    property OnStartDrag;
    { Inherited property - see Delphi help. }
    property OnUnDock;
  end;

{ Converts a value given in inches into a value given in specified units.
  <UL>
  <LH>Parameters:</LH>
  <LI><I>Units</I> - measurement units for the output value</LI>
  <LI><I>Value</I> - input value to convert</LI>
  </UL> }
function InchesToValue(Units: TKPrintUnits; Value: Double): Double;

{ Converts value given in specified units into a value given in inches.
  <UL>
  <LH>Parameters:</LH>
  <LI><I>Units</I> - measurement units for the input value</LI>
  <LI><I>Value</I> - input value to convert</LI>
  </UL> }
function ValueToInches(Units: TKPrintUnits; Value: Double): Double;

implementation

uses
  Math, Printers, KGraphics;

const
  cPreviewHorzBorder = 30;
  cPreviewVertBorder = 30;
  cPreviewShadowSize = 3;

function InchesToValue(Units: TKPrintUnits; Value: Double): Double;
begin
  case Units of
    puMM: Result := Value * 25.4;
    puCM: Result := Value * 2.54;
    puHundredthInch: Result := Value * 100;
  else
    Result := Value;
  end;
end;

function ValueToInches(Units: TKPrintUnits; Value: Double): Double;
begin
  case Units of
    puMM: Result := Value / 25.4;
    puCM: Result := Value / 2.54;
    puHundredthInch: Result := Value / 100;
  else
    Result := Value;
  end;
end;

{ TKCustomControl }

constructor TKCustomControl.Create(AOwner: TComponent);
begin
  inherited;
  BorderStyle := cBorderStyleDef;
  FFlags := 0;
  FMemoryCanvas := nil;
  FMessages := nil;
{$IFNDEF COMPILER10_UP}
  FMouseInClient := False;
{$ENDIF}
  FPageSetup := nil;
  FPreviewList := TList.Create;
  FUpdateLock := 0;
  FOnPrintNotify := nil;
  FOnPrintPaint := nil;
end;

destructor TKCustomControl.Destroy;
begin
  inherited;
  FMessages := nil;
  FreeAndNil(FPreviewList);
  FreeAndNil(FPageSetup);
end;

procedure TKCustomControl.AddPreview(APreview: TKPrintPreview);
begin
  if Assigned(APreview) then
    FPreviewList.Add(APreview);
end;

procedure TKCustomControl.AdjustPageSetup;
begin
end;

procedure TKCustomControl.CancelMode;
begin
end;

{$IFNDEF FPC}
procedure TKCustomControl.CMCancelMode(var Msg: TLMessage);
begin
  inherited;
  CancelMode;
end;

procedure TKCustomControl.CMCtl3DChanged(var Msg: TLMessage);
begin
  inherited;
  RecreateWnd;
end;
{$ENDIF}

procedure TKCustomControl.CMMouseLeave(var Msg: TLMessage);
begin
  inherited;
  try
    MouseFormLeave;
  except
  end;
end;

procedure TKCustomControl.CreateParams(var Params: TCreateParams);
begin
  inherited;
{$IFNDEF FPC}
  with Params do
  begin
    WindowClass.style := CS_DBLCLKS;
    if BorderStyle = bsSingle then
      if NewStyleControls and Ctl3D then
      begin
        Style := Style and not WS_BORDER;
        ExStyle := ExStyle or WS_EX_CLIENTEDGE;
      end
      else
        Style := Style or WS_BORDER;
  end;
{$ENDIF}
end;

{$IFDEF FPC}
procedure TKCustomControl.CreateWnd;
begin
  inherited;
  UpdateSize;
end;

procedure TKCustomControl.DoOnChangeBounds;
begin
  inherited;
  UpdateSize;
end;
{$ENDIF}

function TKCustomControl.Flag(AFlag: Cardinal): Boolean;
begin
  Result := FFlags and AFlag <> 0;
end;

procedure TKCustomControl.FlagAssign(AFlag: Cardinal; Value: Boolean);
begin
  if Value then
    FlagSet(AFlag)
  else
    FlagClear(AFlag);
end;

procedure TKCustomControl.FlagClear(AFlag: Cardinal);
begin
  FFlags := FFlags and not AFlag;
end;

procedure TKCustomControl.FlagSet(AFlag: Cardinal);
begin
  FFlags := FFlags or AFlag;
end;

procedure TKCustomControl.FlagToggle(AFlag: Cardinal);
begin
  FFlags := FFlags xor AFlag;
end;

function TKCustomControl.GetCanPrint: Boolean;
begin
  Result := PageSetup.CanPrint;
end;

function TKCustomControl.GetPageSetup: TKPrintPageSetup;
begin
  if not Assigned(FPageSetup) and not (csDestroying in ComponentState) then
  begin
    FPageSetup := TKPrintPageSetup.Create(Self);
    AdjustPageSetup;
  end;
  if Assigned(FPageSetup) then
    FPageSetup.Validate;
  Result := FPageSetup;
end;

function TKCustomControl.GetPageSetupAllocated: Boolean;
begin
  Result := Assigned(FPageSetup);
end;

function TKCustomControl.InternalGetSelAvail: Boolean;
begin
  Result := False;
end;

procedure TKCustomControl.InternalUnlockUpdate;
begin
end;

procedure TKCustomControl.Invalidate;
begin
  if UpdateUnlocked and HandleAllocated then
    inherited;
end;

procedure TKCustomControl.InvalidatePageSetup;
begin
  if Assigned(FPageSetup) then
    FPageSetup.Invalidate;
end;

procedure TKCustomControl.InvalidateRectArea(const R: TRect);
begin
  if UpdateUnlocked and HandleAllocated then
    InvalidateRect(Handle, @R, False);
end;

function TKCustomControl.IsThemed: Boolean;
begin
  Result := True;
end;

procedure TKCustomControl.KMLateUpdate(var Msg: TLMessage);
var
  M: TLMessage;
begin
  if MessagePeek(M) then
    LateUpdate(M);
end;

procedure TKCustomControl.LateUpdate(var Msg: TLMessage);
begin
  case Msg.Msg of
    LM_SIZE: UpdateSize;
  end;
end;

procedure TKCustomControl.LockUpdate;
begin
  Inc(FUpdateLock);
end;

procedure TKCustomControl.MeasurePages(var Info: TKPrintMeasureInfo);
begin
end;

function TKCustomControl.MessagePeek(out Msg: TLMessage): Boolean;
var
  ALen: Integer;
begin
  ALen := Length(FMessages);
  if ALen > 0 then
  begin
    Dec(ALen);
    Msg := FMessages[ALen];
    SetLength(FMessages, ALen);
    Result := True;
  end else
    Result := False;
end;

procedure TKCustomControl.MessagePoke(const Msg: TLMessage);
var
  ALen: Integer;
begin
  ALen := Length(FMessages);
  SetLength(FMessages, ALen + 1);
  FMessages[ALen] := Msg;
end;

function TKCustomControl.MessageSearch(MsgCode: Cardinal): Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to Length(FMessages) - 1 do
    if FMessages[I].Msg = MsgCode then
    begin
      Result := True;
      Exit;
    end;
end;

procedure TKCustomControl.MouseFormLeave;
begin
end;

procedure TKCustomControl.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited;
{$IFNDEF COMPILER10_UP}
  CallTrackMouseEvent(Self, FMouseInClient);
{$ENDIF}
{$IFDEF FPC}
  if not MouseCapture then
    SetMouseCursor(X, Y);
{$ENDIF}
end;

procedure TKCustomControl.NotifyPreviews;
var
  I: Integer;
begin
  for I := 0 to FPreviewList.Count - 1 do
    TKPrintPreview(FPreviewList[I]).UpdatePreview;
end;

procedure TKCustomControl.Paint;
begin
  PaintToCanvas(Canvas);
  if Assigned(FMemoryCanvas) then
  begin
  {$IFDEF USE_WINAPI}
    // this is the best method but does not work both on QT and GTK!
    MoveWindowOrg(FMemoryCanvas.Handle, -FMemoryCanvasRect.Left, -FMemoryCanvasRect.Top);
    try
      PaintToCanvas(FMemoryCanvas);
    finally
      MoveWindowOrg(FMemoryCanvas.Handle, FMemoryCanvasRect.Left, FMemoryCanvasRect.Top);
    end;
  {$ELSE}
    FMemoryCanvas.CopyRect(Rect(0, 0, FMemoryCanvasRect.Right - FMemoryCanvasRect.Left,
      FMemoryCanvasRect.Bottom - FMemoryCanvasRect.Top), Canvas, FMemoryCanvasRect);
  {$ENDIF}
    FMemoryCanvas := nil;
  end;
end;

procedure TKCustomControl.PostLateUpdate(const Msg: TLMessage;
  IfNotExists: Boolean);
begin
  if HandleAllocated then
  begin
    if not IfNotExists or not MessageSearch(Msg.Msg) then
      MessagePoke(Msg);
    PostMessage(Handle, KM_LATEUPDATE, 0, 0);
  end;
end;

procedure TKCustomControl.PrintNotify(Status: TKPrintStatus; var Abort: Boolean);
begin
  if Assigned(FOnPrintNotify) then
    FOnPrintNotify(Self, Status, Abort);
end;

procedure TKCustomControl.PrintPaint;
begin
  if Assigned(FOnPrintPaint) then
    FOnPrintPaint(Self);
end;

procedure TKCustomControl.PrintOut;
begin
  GetPageSetup.PrintOut;
end;

procedure TKCustomControl.PaintPage;
begin
end;

procedure TKCustomControl.RemovePreview(APreview: TKPrintPreview);
begin
  if Assigned(FPreviewList) and (FPreviewList.IndexOf(APreview) >= 0) then
    FPreviewList.Remove(APreview);
end;

{$IFNDEF FPC}
procedure TKCustomControl.SetBorderStyle(Value: TBorderStyle);
begin
  if FBorderStyle <> Value then
  begin
    FBorderStyle := Value;
    RecreateWnd;
  end;
end;
{$ENDIF}

function TKCustomControl.SetMouseCursor(X, Y: Integer): Boolean;
begin
  Result := False;
end;

procedure TKCustomControl.SetPageSetup(Value: TKPrintPageSetup);
begin
  if Value <> FPageSetup then
    GetPageSetup.Assign(Value);
end;

procedure TKCustomControl.UnlockUpdate;
begin
  if FUpdateLock > 0 then
  begin
    Dec(FUpdateLock);
    if FUpdateLock = 0 then
      InternalUnlockUpdate;
  end;
end;

procedure TKCustomControl.UpdateSize;
begin
end;

function TKCustomControl.UpdateUnlocked: Boolean;
begin
  Result := FUpdateLock = 0;
end;

{$IFNDEF FPC}
procedure TKCustomControl.WMCancelMode(var Msg: TWMCancelMode);
begin
  inherited;
  CancelMode;
end;
{$ENDIF}

{$IFNDEF COMPILER10_UP}
procedure TKCustomControl.WMMouseLeave(var Msg: TLMessage);
begin
  { this is because of CM_MOUSELEAVE is not sent if mouse has left client area
    and entered any of the standard control scrollbars. This behavior has been
    fixed via TrackMouseEvent in BDS 2006. }
  inherited;
  FMouseInClient := False;
  Perform(CM_MOUSELEAVE, 0, 0);
end;
{$ENDIF}

{$IFNDEF FPC}
procedure TKCustomControl.WMNCPaint(var Msg: TWMNCPaint);
{$IFDEF USE_THEMES}
var
  R: TRect;
  ExStyle: Integer;
  TempRgn: HRGN;
  BorderWidth,
  BorderHeight: Integer;
{$ENDIF}
begin
{$IFDEF USE_THEMES}
  with ThemeServices do if IsThemed and ThemesEnabled then
  begin
    // If OS themes are enabled and the client edge border is set for the window then prevent the default window proc
    // from painting the old border to avoid flickering.
    ExStyle := GetWindowLong(Handle, GWL_EXSTYLE);
    if (ExStyle and WS_EX_CLIENTEDGE) <> 0 then
    begin
      GetWindowRect(Handle, R);
      // Determine width of the client edge.
      BorderWidth := GetSystemMetrics(SM_CXEDGE);
      BorderHeight := GetSystemMetrics(SM_CYEDGE);
      InflateRect(R, -BorderWidth, -BorderHeight);
      TempRgn := CreateRectRgnIndirect(R);
      // Exclude the border from the message region if there is one. Otherwise just use the inflated
      // window area region.
      if Msg.Rgn <> 1 then
        CombineRgn(TempRgn, Msg.Rgn, TempRgn, RGN_AND);
      DefWindowProc(Handle, Msg.Msg, Integer(TempRgn), 0);
      DeleteObject(TempRgn);
      PaintBorder(Self, True);
    end else
      inherited;
  end else
{$ENDIF}
    inherited;
end;

procedure TKCustomControl.WMSetCursor(var Msg: TWMSetCursor);
var
  MousePt: TPoint;
begin
  if (Msg.HitTest = HTCLIENT) and (Msg.CursorWnd = Handle) then
  begin
    MousePt := ScreenToClient(Mouse.CursorPos);
    if SetMouseCursor(MousePt.X, MousePt.Y) then
      Msg.Result := 1
    else
      inherited
  end else
    inherited;
end;
{$ENDIF}

procedure TKCustomControl.WMSize(var Msg: TLMSize);
begin
  inherited;
  PostLateUpdate(FillMessage(LM_SIZE, 0, 0), True);
end;

{$IFNDEF FPC}
{$IFDEF USE_THEMES}
procedure TKCustomControl.WMThemeChanged(var Msg: TLMessage);
begin
  if IsThemed then
  begin
    inherited;
    ThemeServices.UpdateThemes;
    RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_VALIDATE or RDW_FRAME);
  end;
end;
{$ENDIF}
{$ENDIF}

{ TKPrintPageSetup }

constructor TKPrintPageSetup.Create(AControl: TKCustomControl);
begin
  inherited Create;
  FActive := False;
  FCanvas := nil;
  FControl := AControl;
  FCopies := cCopiesDef;
  FCurrentCopy := 0;
  FCurrentPage := 0;
  FCurrentScale := 0;
  FDesktopPixelsPerInchX := 0;
  FDesktopPixelsPerInchY := 0;
  FEndPage := 0;
  FFooterSpace := 0;
  FHeaderSpace := 0;
  FHorzPageCount := 0;
  FIsValid := False;
  FMarginBottom := cMarginBottomDef;
  FMarginLeft := cMarginLeftDef;
  FMarginRight := cMarginRightDef;
  FMarginTop := cMarginTopDef;
  FOptions := cOptionsDef;
  FOutlineHeight := 0;
  FOutlineWidth := 0;
  FPageCount := 0;
  FPageHeight := 0;
  FPageWidth := 0;
  FPaintAreaHeight := 0;
  FPaintAreaWidth := 0;
  FPreviewing := False;
  FPrinterFooterSpace := 0;
  FPrinterHeaderSpace := 0;
  FPrinterMarginBottom := 0;
  FPrinterMarginLeft := 0;
  FPrinterMarginLeftMirrored := 0;
  FPrinterMarginRight := 0;
  FPrinterMarginRightMirrored := 0;
  FPrinterMarginTop := 0;
  FPrinterName := '';
  FPrinterPixelsPerInchX := 0;
  FPrinterPixelsPerInchY := 0;
  FPrintingMapped := True;
  FRange := cRangeDef;
  FStartPage := 0;
  FScale := cScaleDef;
  FTitle := '';
  FUnits := cUnitsDef;
  FUpdateLock := 0;
  FValidating := False;
  FVertPageCount := 0;
end;

function TKPrintPageSetup.GetCanPrint: Boolean;
begin
  Result := Assigned(FControl) and (FPageCount > 0) and (Printer.Printers.Count > 0);
end;

function TKPrintPageSetup.GetSelAvail: Boolean;
begin
  if Assigned(FControl) then
    Result := FControl.InternalGetSelAvail
  else
    Result := False;
end;

procedure TKPrintPageSetup.AfterUnitsChange;
begin
  FFooterSpace := InchesToValue(FUnits, FFooterSpace);
  FHeaderSpace := InchesToValue(FUnits, FHeaderSpace);
  FMarginBottom := InchesToValue(FUnits, FMarginBottom);
  FMarginLeft := InchesToValue(FUnits, FMarginLeft);
  FMarginRight := InchesToValue(FUnits, FMarginRight);
  FMarginTop := InchesToValue(FUnits, FMarginTop);
end;

procedure TKPrintPageSetup.Assign(Source: TPersistent);
begin
  if Source is TKPrintPageSetup then
  begin
    LockUpdate;
    try
      Copies := TKPrintPageSetup(Source).Copies;
      EndPage := TKPrintPageSetup(Source).EndPage;
      FooterSpace := TKPrintPageSetup(Source).FooterSpace;
      HeaderSpace := TKPrintPageSetup(Source).HeaderSpace;
      MarginBottom := TKPrintPageSetup(Source).MarginBottom;
      MarginLeft := TKPrintPageSetup(Source).MarginLeft;
      MarginRight := TKPrintPageSetup(Source).MarginRight;
      MarginTop := TKPrintPageSetup(Source).MarginTop;
      Options := TKPrintPageSetup(Source).Options;
      PrinterName := TKPrintPageSetup(Source).PrinterName;
      Range := TKPrintPageSetup(Source).Range;
      StartPage := TKPrintPageSetup(Source).StartPage;
      Scale := TKPrintPageSetup(Source).Scale;
      Title := TKPrintPageSetup(Source).Title;
      Units := TKPrintPageSetup(Source).Units;
    finally
      UnlockUpdate;
    end;
  end;
end;

procedure TKPrintPageSetup.BeforeUnitsChange;
begin
  FFooterSpace := ValueToInches(FUnits, FFooterSpace);
  FHeaderSpace := ValueToInches(FUnits, FHeaderSpace);
  FMarginBottom := ValueToInches(FUnits, FMarginBottom);
  FMarginLeft := ValueToInches(FUnits, FMarginLeft);
  FMarginRight := ValueToInches(FUnits, FMarginRight);
  FMarginTop := ValueToInches(FUnits, FMarginTop);
end;

function TKPrintPageSetup.HMap(Value: Integer): Integer;
begin
  Result := MulDiv(Value, FPrinterPixelsPerInchX, FDesktopPixelsPerInchX);
end;

procedure TKPrintPageSetup.Invalidate;
begin
  FIsValid := False;
end;

procedure TKPrintPageSetup.LockUpdate;
begin
  Inc(FUpdateLock);
end;

procedure TKPrintPageSetup.PaintPageToPreview;
var
  PaperWidth, PaperHeight, SaveIndex: Integer;
  R, PageRect: TRect;
begin
  if UpdateUnlocked and Assigned(FControl) then
  begin
    FCanvas := APreview.Canvas;
    FActive := True;
    FPreviewing := True;
    try
      FCurrentCopy := 1;
      FCurrentPage := APreview.Page;
      if (poMirrorMargins in FOptions) and (FCurrentPage and 1 <> 0) then
      begin
        FPrinterMarginLeftMirrored := FPrinterMarginRight;
        FPrinterMarginRightMirrored := FPrinterMarginLeft;
      end else
      begin
        FPrinterMarginLeftMirrored := FPrinterMarginLeft;
        FPrinterMarginRightMirrored := FPrinterMarginRight;
      end;
      R := APreview.PageRect;
      PaperWidth := R.Right - R.Left;
      PaperHeight := R.Bottom - R.Top;
      SaveIndex := SaveDC(FCanvas.Handle);
      try
        // change the canvas mapping mode to scale the page outline
        CanvasSetOffset(FCanvas,
          R.Left + MulDiv(FPrinterMarginLeftMirrored, PaperWidth, FPageWidth),
          R.Top + MulDiv(FPrinterMarginTop + FPrinterHeaderSpace, PaperHeight, FPageHeight));
        if FPrintingMapped then
          CanvasSetScale(FCanvas, Round(PaperWidth * FCurrentScale), Round(PaperHeight * FCurrentScale),
            MulDiv(FPageWidth, FDesktopPixelsPerInchX, FPrinterPixelsPerInchX),
            MulDiv(FPageHeight, FDesktopPixelsPerInchY, FPrinterPixelsPerInchY))
        else
          CanvasSetScale(FCanvas, PaperWidth, PaperHeight, FPageWidth, FPageHeight);
        FControl.PaintPage;
      finally
        RestoreDC(FCanvas.Handle, SaveIndex);
      end;
      SaveIndex := SaveDC(FCanvas.Handle);
      try
        CanvasSetOffset(FCanvas, R.Left, R.Top);
        CanvasSetScale(FCanvas, PaperWidth, PaperHeight, FPageWidth, FPageHeight);
        PageRect := Rect(0, 0, FPageWidth, FPageHeight);
        TranslateRectToDevice(FCanvas.Handle, PageRect);
        SelectClipRect(FCanvas.Handle, PageRect);
        FControl.PrintPaint;
      finally
        RestoreDC(FCanvas.Handle, SaveIndex);
      end;
      SaveIndex := SaveDC(FCanvas.Handle);
      try
        CanvasSetOffset(FCanvas, R.Left, R.Top);
        CanvasSetScale(FCanvas, PaperWidth, PaperHeight, FPageWidth, FPageHeight);
        PageRect := Rect(0, 0, FPageWidth, FPageHeight);
        TranslateRectToDevice(FCanvas.Handle, PageRect);
        SelectClipRect(FCanvas.Handle, PageRect);
        PrintTitle;
        PrintPageNumber(FCurrentPage);
      finally
        RestoreDC(FCanvas.Handle, SaveIndex);
      end;
    finally
      FActive := False;
      FPreviewing := False;
      FCanvas := nil;
    end;
  end;
end;

procedure TKPrintPageSetup.PrintPageNumber(Value: Integer);
var
  S: string;
begin
  if poPageNumbers in FOptions then
  begin
    FCanvas.Brush.Style := bsClear;
    FCanvas.Font.Color := clBlack;
    FCanvas.Font.Height := 1;
    FCanvas.Font.Height := VMap(16);
    FCanvas.Font.Name := 'Arial';
    FCanvas.Font.Pitch := fpDefault;
    FCanvas.Font.Style := [fsBold];
    S := Format('- %d -', [Value]);
    FCanvas.TextOut(FPrinterMarginLeftMirrored + (FPageWidth - FPrinterMarginLeft - FPrinterMarginRight - FCanvas.TextWidth(S)) div 2,
      FPageHeight - FPrinterMarginBottom + VMap(5), S);
  end;
end;

procedure TKPrintPageSetup.PrintTitle;
begin
  if poTitle in FOptions then
  begin
    FCanvas.Brush.Style := bsClear;
    FCanvas.Font.Color := clBlack;
    FCanvas.Font.Height := 1;
    FCanvas.Font.Height := VMap(16);
    FCanvas.Font.Name := 'Arial';
    FCanvas.Font.Pitch := fpDefault;
    FCanvas.Font.Style := [fsBold];
    FCanvas.TextOut(FPrinterMarginLeftMirrored, FPrinterMarginTop - VMap(36), Title);
    FCanvas.Brush.Style := bsSolid;
    FCanvas.Brush.Color := clBlack;
    FCanvas.FillRect(Rect(FPrinterMarginLeftMirrored, FPrinterMarginTop - VMap(14), FPageWidth - FPrinterMarginRight, FPrinterMarginTop - VMap(12)));
  end;
end;

procedure TKPrintPageSetup.PrintOut;

  function DoPrint: Boolean;
  var
    SaveIndex: Integer;
    PageRect: TRect;
  begin
    Result := False;
    if (poMirrorMargins in FOptions) and (FCurrentPage and 1 <> 0) then
    begin
      FPrinterMarginLeftMirrored := FPrinterMarginRight;
      FPrinterMarginRightMirrored := FPrinterMarginLeft;
    end else
    begin
      FPrinterMarginLeftMirrored := FPrinterMarginLeft;
      FPrinterMarginRightMirrored := FPrinterMarginRight;
    end;
    SaveIndex := SaveDC(FCanvas.Handle);
    try
      CanvasSetOffset(FCanvas, FPrinterMarginLeftMirrored, FPrinterMarginTop + FPrinterHeaderSpace);
      if FPrintingMapped then
      begin
        // change the canvas mapping mode to scale the page outline
        CanvasSetScale(FCanvas, Round(FPageWidth * FCurrentScale), Round(FPageHeight * FCurrentScale),
          MulDiv(FPageWidth, FDesktopPixelsPerInchX, FPrinterPixelsPerInchX),
          MulDiv(FPageHeight, FDesktopPixelsPerInchY, FPrinterPixelsPerInchY));
      end else
        CanvasResetScale(FCanvas);
      FControl.PaintPage;
    finally
      RestoreDC(FCanvas.Handle, SaveIndex);
    end;
    SaveIndex := SaveDC(FCanvas.Handle);
    try
      CanvasResetScale(FCanvas);
      PageRect := Rect(0, 0, FPageWidth, FPageHeight);
      TranslateRectToDevice(FCanvas.Handle, PageRect);
      SelectClipRect(FCanvas.Handle, PageRect);
      FControl.PrintPaint;
    finally
      RestoreDC(FCanvas.Handle, SaveIndex);
    end;
    SaveIndex := SaveDC(FCanvas.Handle);
    try
      CanvasResetScale(FCanvas);
      PageRect := Rect(0, 0, FPageWidth, FPageHeight);
      TranslateRectToDevice(FCanvas.Handle, PageRect);
      SelectClipRect(FCanvas.Handle, PageRect);
      PrintTitle;
      PrintPageNumber(FCurrentPage);
    finally
      RestoreDC(FCanvas.Handle, SaveIndex);
    end;
    FControl.PrintNotify(epsNewPage, Result);
    if ((FCurrentPage < FEndPage) or (FCurrentCopy < FCopies)) and not Result then
      Printer.NewPage;
  end;

var
  I, J: Integer;
  AbortPrint: Boolean;
{  Orientation: TPrinterOrientation;
  PaperSize: TPaperSize;
  APageWidth, ApageHeight, APaperWidth, APaperHeight: Integer;
  PrinterType: TPrinterType;
  APaperRect: TPaperRect;}
begin
  if UpdateUnlocked and Assigned(FControl) then
  begin
    UpdateSettings;
    if FPageCount > 0 then
    begin
      AbortPrint := False;
      FCanvas := Printer.Canvas;
      Printer.Title := FTitle;
      Printer.Copies := 1;
{      PrinterType := Printer.PrinterType;
      APageWidth := Printer.PageWidth;
      APageHeight := Printer.PageHeight;
      APaperRect := Printer.PaperSize.PaperRect;
      Orientation := Printer.Orientation;}
      Printer.BeginDoc;
      FActive := True;
      try
        FControl.PrintNotify(epsBegin, AbortPrint);
{        Printer.Canvas.Font.Name := 'Arial';
        Printer.Canvas.Font.color := clBlack;
        Printer.Canvas.Font.height := 100;
        Printer.Canvas.TextOut(200, 200, 'hello!');}
        if not AbortPrint then
        begin
          if poCollate in FOptions then
            for I := 1 to FCopies do
            begin
              FCurrentCopy := I;
              for J := FStartPage to FEndPage do
              begin
                FCurrentPage := J;
                AbortPrint := DoPrint;
                if AbortPrint then Break;
              end;
              if AbortPrint then Break;
            end
          else
            for J := FStartPage to FEndPage do
            begin
              FCurrentPage := J;
              for I := 1 to FCopies do
              begin
                FCurrentCopy := I;
                AbortPrint := DoPrint;
                if AbortPrint then Break;
              end;
              if AbortPrint then Break;
            end
        end;
        FCurrentPage := 0;
        FCurrentCopy := 0;
        FControl.PrintNotify(epsEnd, AbortPrint);
      finally
        FActive := False;
        Printer.EndDoc;
        FCanvas := nil;
      end;
    end;
  end;
end;

procedure TKPrintPageSetup.SetCopies(Value: Integer);
begin
  if FActive then Exit;
  if Value <> FCopies then
  begin
    FCopies := Value;
    UpdateSettings;
  end;
end;

procedure TKPrintPageSetup.SetEndPage(Value: Integer);
begin
  if FActive then Exit;
  if Value <> FEndPage then
  begin
    FEndPage := Value;
    UpdateSettings;
  end;
end;

procedure TKPrintPageSetup.SetFooterSpace(Value: Double);
begin
  if FActive then Exit;
  if Value <> FFooterSpace then
  begin
    FFooterSpace := Value;
    UpdateSettings;
  end;
end;

procedure TKPrintPageSetup.SetHeaderSpace(Value: Double);
begin
  if FActive then Exit;
  if Value <> FHeaderSpace then
  begin
    FHeaderSpace := Value;
    UpdateSettings;
  end;
end;

procedure TKPrintPageSetup.SetMarginBottom(Value: Double);
begin
  if FActive then Exit;
  if Value <> FMarginBottom then
  begin
    FMarginBottom := Value;
    UpdateSettings;
  end;
end;

procedure TKPrintPageSetup.SetMarginLeft(Value: Double);
begin
  if FActive then Exit;
  if Value <> FMarginLeft then
  begin
    FMarginLeft := Value;
    UpdateSettings;
  end;
end;

procedure TKPrintPageSetup.SetMarginRight(Value: Double);
begin
  if FActive then Exit;
  if Value <> FMarginRight then
  begin
    FMarginRight := Value;
    UpdateSettings;
  end;
end;

procedure TKPrintPageSetup.SetMarginTop(Value: Double);
begin
  if FActive then Exit;
  if Value <> FMarginTop then
  begin
    FMarginTop := Value;
    UpdateSettings;
  end;
end;

procedure TKPrintPageSetup.SetOptions(Value: TKPrintOptions);
begin
  if FActive then Exit;
  if Value <> FOptions then
  begin
    FOptions := Value;
    UpdateSettings;
  end;
end;

procedure TKPrintPageSetup.SetPrinterName(const Value: string);
begin
  if FActive then Exit;
  if Value <> FPrinterName then
  begin
    FPrinterName := Value;
    UpdateSettings;
  end;
end;

procedure TKPrintPageSetup.SetPrintingMapped(Value: Boolean);
begin
  if FActive then Exit;
  if Value <> FPrintingMapped then
  begin
    FPrintingMapped := Value;
    UpdateSettings;
  end;
end;

procedure TKPrintPageSetup.SetRange(Value: TKPrintRange);
begin
  if FActive then Exit;
  if Value <> FRange then
  begin
    FRange := Value;
    UpdateSettings;
  end;
end;

procedure TKPrintPageSetup.SetScale(Value: Integer);
begin
  if FActive then Exit;
  if Value <> FScale then
  begin
    FScale := Value;
    UpdateSettings;
  end;
end;

procedure TKPrintPageSetup.SetStartPage(Value: Integer);
begin
  if FActive then Exit;
  if Value <> FStartPage then
  begin
    FStartPage := Value;
    UpdateSettings;
  end;
end;

procedure TKPrintPageSetup.SetUnits(Value: TKPrintUnits);
begin
  if FActive then Exit;
  if Value <> FUnits then
  begin
    BeforeUnitsChange;
    FUnits := Value;
    AfterUnitsChange;
  end;
end;

procedure TKPrintPageSetup.UnlockUpdate;
begin
  if FUpdateLock > 0 then
  begin
    Dec(FUpdateLock);
    UpdateSettings;
  end;
end;

procedure TKPrintPageSetup.UpdateSettings;
var
  I, PixelsPerInchX, PixelsPerInchY: Integer;
  D: Double;
  DC: HDC;
  Info: TKPrintMeasureInfo;
begin
  if UpdateUnlocked and not FActive and not FValidating then
  begin
    FValidating := True;
    try
      Printer.Refresh;
      I := Printer.Printers.IndexOf(FPrinterName);
      if I >= 0 then
        Printer.PrinterIndex := I;
      // limit copies and Scale
      FCopies := MinMax(FCopies, cCopiesMin, cCopiesMax);
      FScale := MinMax(FScale, cScaleMin, cScaleMax);
      // get metrics for the desktop
      DC := GetDC(0);
      try
        FDesktopPixelsPerInchX := GetDeviceCaps(DC, LOGPIXELSX);
        FDesktopPixelsPerInchY := GetDeviceCaps(DC, LOGPIXELSY);
      finally
        ReleaseDC(0, DC);
      end;
      // get metrics for the printer
      if Printer.Printers.Count > 0 then
      begin
        FPageWidth := Printer.PageWidth;
        FPageHeight := Printer.PageHeight;
      {$IFDEF FPC}
        FPrinterPixelsPerInchX := Printer.XDPI;
        FPrinterPixelsPerInchY := Printer.YDPI;
      {$ELSE}
        FPrinterPixelsPerInchX := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
        FPrinterPixelsPerInchY := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
      {$ENDIF}
      end else
      begin
        // fake printer metrics if no printer is installed
        FPageWidth := 2360;
        FPageHeight := 3400;
        FPrinterPixelsPerInchX := 300;
        FPrinterPixelsPerInchY := 300;
      end;
      // decide how to outline extent
      if FPrintingMapped then
      begin
        PixelsPerInchX := FDesktopPixelsPerInchX;
        PixelsPerInchY := FDesktopPixelsPerInchY;
      end else
      begin
        PixelsPerInchX := FPrinterPixelsPerInchX;
        PixelsPerInchY := FPrinterPixelsPerInchY;
      end;
      // limit and convert margins
      D := FPageWidth * 0.4; // 40% of the page
      FPrinterMarginLeft := Round(MinMax(ValueToInches(FUnits, FMarginLeft) * FPrinterPixelsPerInchX, 0, D));
      FPrinterMarginLeftMirrored := FPrinterMarginLeft;
      FMarginLeft := InchesToValue(FUnits, FPrinterMarginLeft / FPrinterPixelsPerInchX);
      FPrinterMarginRight := Round(MinMax(ValueToInches(FUnits, FMarginRight) * FPrinterPixelsPerInchX, 0, D));
      FPrinterMarginRightMirrored := FPrinterMarginRight;
      FMarginRight := InchesToValue(FUnits, FPrinterMarginRight / FPrinterPixelsPerInchX);
      D := FPageHeight * 0.4; // 40% of the page
      FPrinterMarginTop := Round(MinMax(ValueToInches(FUnits, FMarginTop) * FPrinterPixelsPerInchY, 0, D));
      FMarginTop := InchesToValue(FUnits, FPrinterMarginTop / FPrinterPixelsPerInchY);
      FPrinterMarginBottom := Round(MinMax(ValueToInches(FUnits, FMarginBottom) * FPrinterPixelsPerInchY, 0, D));
      FMarginBottom := InchesToValue(FUnits, FPrinterMarginBottom / FPrinterPixelsPerInchY);
      // limit and convert header and footer space
      FPrinterHeaderSpace := Round(MinMax(ValueToInches(FUnits, Max(FHeaderSpace, 0)) * FPrinterPixelsPerInchY, 0, D -  FPrinterMarginTop));
      FHeaderSpace := InchesToValue(FUnits, FPrinterHeaderSpace / FPrinterPixelsPerInchY);
      FPrinterFooterSpace := Round(MinMax(ValueToInches(FUnits, Max(FFooterSpace, 0)) * FPrinterPixelsPerInchY, 0, D -  FPrinterMarginBottom));
      FFooterSpace := InchesToValue(FUnits, FPrinterFooterSpace / FPrinterPixelsPerInchY);
      // paint area extent
      FPaintAreaHeight := MulDiv(FPageHeight - FPrinterMarginTop - FPrinterMarginBottom - FPrinterHeaderSpace - FPrinterFooterSpace, PixelsPerInchY, FPrinterPixelsPerInchY);
      FPaintAreaWidth := MulDiv(FPageWidth - FPrinterMarginLeft - FPrinterMarginRight, PixelsPerInchX, FPrinterPixelsPerInchX);
      // default horizontal scaling
      FCurrentScale := FScale / 100;
      // default page/copy info
      FCurrentCopy := 0;
      FCurrentPage := 0;
      // measured data
      if Assigned(FControl) then
      begin
        FillChar(Info, SizeOf(TKPrintMeasureInfo), 0);
        FControl.MeasurePages(Info);
        FOutlineWidth := Info.OutlineWidth;
        FOutlineHeight := Info.OutlineHeight;
        FHorzPageCount := Info.HorzPageCount;
        FVertPageCount := Info.VertPageCount;
        FPageCount := Info.PageCount;
        if FPageCount > 0 then
        begin
          // update horizontal scaling
          if (poFitToPage in FOptions) and (FOutlineWidth > 0) then
            FCurrentScale := FPaintAreaWidth / FOutlineWidth;
          // limit start and end page
          case FRange of
            prAll, prSelectedOnly:
            begin
              FStartPage := 1;
              FEndPage := FPageCount;
            end;
            prRange:
            begin
              FEndPage := MinMax(FEndPage, 1, FPageCount);
              FStartPage := MinMax(FStartPage, 1, FEndPage);
            end;
          end;
        end;
        // notify all previews/ force their repainting
        FControl.NotifyPreviews;
      end else
      begin
        FOutlineWidth := 0;
        FOutlineHeight := 0;
        FHorzPageCount := 0;
        FVertPageCount := 0;
        FPageCount := 0;
        FEndPage := 0;
        FStartPage := 0;
      end;
      FIsValid := True;
    finally
      FValidating := False;
    end;
  end;
end;

function TKPrintPageSetup.UpdateUnlocked: Boolean;
begin
  Result := FUpdateLock = 0;
end;

procedure TKPrintPageSetup.Validate;
begin
  if not FIsValid and not FValidating then
    UpdateSettings;
end;

function TKPrintPageSetup.VMap(Value: Integer): Integer;
begin
  Result := MulDiv(Value, FPrinterPixelsPerInchY, FDesktopPixelsPerInchY);
end;

{ TKPreviewColors }

constructor TKPreviewColors.Create(APreview: TKPrintPreview);
begin
  inherited Create;
  FPreview := APreview;
  Initialize;
end;

procedure TKPreviewColors.Assign(Source: TPersistent);
begin
  inherited;
  if Source is TKPreviewColors then
  begin
    Colors := TKPreviewColors(Source).Colors;
    FPreview.Invalidate;
  end
end;

function TKPreviewColors.GetColor(Index: TKPreviewColorIndex): TColor;
begin
  Result := InternalGetColor(Index);
end;

function TKPreviewColors.GetColorEx(Index: TKPreviewColorIndex): TColor;
begin
  Result := FColors[Index];
end;

procedure TKPreviewColors.Initialize;
begin
  SetLength(FColors, ciPreviewColorsMax + 1);
  FColors[ciPaper] := cPaperDef;
  FColors[ciBkGnd] := cBkGndDef;
  FColors[ciBorder] := cBorderDef;
  FColors[ciSelectedBorder] := cSelectedBorderDef;
end;

function TKPreviewColors.InternalGetColor(Index: TKPreviewColorIndex): TColor;
begin
  Result := FColors[Index];
end;

procedure TKPreviewColors.InternalSetColor(Index: TKPreviewColorIndex; Value: TColor);
begin
  if FColors[Index] <> Value then
  begin
    FColors[Index] := Value;
    if not (csLoading in FPreview.ComponentState) then
      FPreview.Invalidate;
  end;
end;

procedure TKPreviewColors.SetColor(Index: TKPreviewColorIndex; Value: TColor);
begin
  InternalSetColor(Index, Value);
end;

procedure TKPreviewColors.SetColorEx(Index: TKPreviewColorIndex; Value: TColor);
begin
  FColors[Index] := Value;
end;

procedure TKPreviewColors.SetColors(const Value: TKColorArray);
var
  I: Integer;
begin
  for I := 0 to Min(Length(FColors), Length(Value)) - 1 do
    FColors[I] := Value[I];
end;

{ TKPrintPreview }

constructor TKPrintPreview.Create(AOwner: TComponent);
begin
  inherited;
  FColors := TKPreviewColors.Create(Self);
  FControl := nil;
  FMouseWheelAccumulator := 0;
  FPage := 1;
  FPageSize := Point(0, 0);
  FScale := 100;
  FScaleMode := smPageWidth;
  FOnChanged := nil;
  LoadCustomCursor(crDragHandFree, 'KPREVIEW_CURSOR_HAND_FREE');
  LoadCustomCursor(crDragHandGrip, 'KPREVIEW_CURSOR_HAND_GRIP');
  Width := 300;
  Height := 200;
end;

destructor TKPrintPreview.Destroy;
begin
  if Assigned(FControl) then
    FControl.RemovePreview(Self);
  inherited;
  FColors.Free;
end;

procedure TKPrintPreview.BeginScrollWindow;
begin
  FPageOld := FPage;
  FScrollPosOld := FScrollPos;
end;

procedure TKPrintPreview.CreateParams(var Params: TCreateParams);
begin
  inherited;
  with Params do
    Style := Style or WS_HSCROLL or WS_VSCROLL;
end;

function TKPrintPreview.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  MousePos: TPoint): Boolean;
const
  cWheelDivisor = 120;
var
  Delta, WheelClicks: Integer;
begin
  Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
  if not Result then
  begin
    if ssCtrl in Shift then
    begin
      if FScaleMode = smWholePage then Delta := 10 else Delta := ClientHeight;
    end else
      if FScaleMode = smWholePage then Delta := 1 else Delta := ClientHeight div 10;
    Inc(FMouseWheelAccumulator, WheelDelta);
    WheelClicks := FMouseWheelAccumulator div cWheelDivisor;
    FMouseWheelAccumulator := FMouseWheelAccumulator mod cWheelDivisor;
    BeginScrollWindow;
    ModifyScrollBar(SB_VERT, -1, -WheelClicks * Delta);
    EndScrollWindow;
    Result := True;
  end;
end;

procedure TKPrintPreview.EndScrollWindow;
begin
  if (FPage <> FPageOld) then
    Invalidate
  else if (FScrollPos.X <> FScrollPosOld.X) or (FScrollPos.Y <> FScrollPosOld.Y) then
  begin
    ScrollWindowEx(Handle, FScrollPosOld.X - FScrollPos.X, FScrollPosOld.Y - FScrollPos.Y,
      nil, nil, 0, nil, SW_INVALIDATE);
  end;
end;

procedure TKPrintPreview.FirstPage;
begin
  Page := StartPage;
end;

function TKPrintPreview.GetCurrentScale: Integer;
begin
  if Assigned(FControl) then
    Result := MulDiv(FPageSize.X, 100, MulDiv(FControl.PageSetup.PageWidth, 300, FControl.PageSetup.PrinterPixelsPerInchX))
  else
    Result := FScale;
end;

function TKPrintPreview.GetEndPage: Integer;
begin
  if Assigned(FControl) then
  begin
    Result := FControl.PageSetup.EndPage;
    if Result = 0 then
    begin
      FControl.PageSetup.UpdateSettings;
      Result := FControl.PageSetup.EndPage
    end;
  end else
    Result := 0;
end;

function TKPrintPreview.GetPageRect: TRect;
begin
  with Result do
  begin
    Left := FPageOffset.X - FScrollPos.X;
    if FScaleMode = smWholePage then
      Top := FPageOffset.Y
    else
      Top := FPageOffset.Y - FScrollPos.Y;
    Right := Left + FPageSize.X;
    Bottom := Top + FPageSize.Y;
  end;
end;

function TKPrintPreview.GetStartPage: Integer;
begin
  if Assigned(FControl) then
  begin
    Result := FControl.PageSetup.StartPage;
    if Result = 0 then
    begin
      FControl.PageSetup.UpdateSettings;
      Result := FControl.PageSetup.StartPage
    end;
  end else
    Result := 0;
end;

procedure TKPrintPreview.KeyDown(var Key: Word; Shift: TShiftState);
var
  DeltaX, DeltaY, LineX, PageY: Integer;
  NoAlt, NoAltCtrl: Boolean;
begin
  NoAlt := Shift * [ssAlt] = [];
  NoAltCtrl := Shift * [ssAlt, ssCtrl] = [];
  DeltaX := 0;
  DeltaY := 0;
  LineX := ClientWidth div 10;
  PageY := ClientHeight;
  case Key of
    VK_UP:
      if NoAltCtrl then
      begin
        if FScaleMode = smWholePage then
          PreviousPage
        else
          DeltaY := -PageY div 10;
      end;
    VK_DOWN:
      if NoAltCtrl then
      begin
        if FScaleMode = smWholePage then
          NextPage
        else
          DeltaY := PageY div 10;
      end;
    VK_PRIOR:
      if NoAltCtrl then
      begin
        if FScaleMode = smWholePage then
          PreviousPage
        else
          DeltaY := -PageY;
      end;
    VK_NEXT:
      if NoAltCtrl then
      begin
        if FScaleMode = smWholePage then
          NextPage
        else
          DeltaY := PageY;
      end;
    VK_LEFT: if NoAltCtrl then DeltaX := -LineX;
    VK_RIGHT: if NoAltCtrl then DeltaX := LineX;
    VK_HOME:
      if NoAlt then
      begin
        if ssCtrl in Shift then
          FirstPage
        else
          DeltaX := -FScrollPos.X;
      end;
    VK_END:
      if NoAlt then
      begin
        if ssCtrl in Shift then
          LastPage
        else
          DeltaX := FScrollExtent.X - FScrollPos.X;
      end;
  end;
  if (DeltaX <> 0) or (DeltaY <> 0) then
  begin
    BeginScrollWindow;
    if DeltaX <> 0 then
      ModifyScrollBar(SB_HORZ, -1, DeltaX);
    if DeltaY <> 0 then
      ModifyScrollBar(SB_VERT, -1, DeltaY);
    EndScrollWindow;
  end;
end;

procedure TKPrintPreview.LastPage;
begin
  Page := EndPage;
end;

procedure TKPrintPreview.ModifyScrollBar(ScrollBar, ScrollCode, Delta: Integer);
var
  I, AEndPage: Integer;
  Divisor: Cardinal;
  PPos, PExtent: PInteger;
  SI: TScrollInfo;
begin
  Divisor := 10;
  if ScrollBar = SB_HORZ then
  begin
    PPos := @FScrollPos.X;
    PExtent := @FScrollExtent.X;
  end else
  begin
    if FScaleMode = smWholePage then
    begin
      PPos := @FPage;
      AEndPage := EndPage;
      PExtent := @AEndPage;
      Divisor := 1;
    end else
    begin
      PPos := @FScrollPos.Y;
      PExtent := @FScrollExtent.Y;
    end;
  end;
  if PExtent^ > 0 then
  begin
    SI.cbSize := SizeOf(TScrollInfo);
    SI.fMask := SIF_RANGE or SIF_PAGE or SIF_TRACKPOS;
    GetScrollInfo(Handle, ScrollBar, SI);
  {$IF DEFINED(LCLGTK2)}
    {.$WARNING "scrollbar arrows still not working properly on GTK2 in some cases!"}
    SI.nTrackPos := Delta;
  {$IFEND}
    I := PPos^;
    case ScrollCode of
      SB_TOP: I := SI.nMin;
      SB_BOTTOM: I := SI.nMax; // will be trimmed below
      SB_LINEUP: Dec(I, SI.nPage div Divisor);
      SB_LINEDOWN: Inc(I, SI.nPage div Divisor);
      SB_PAGEUP: Dec(I, SI.nPage);
      SB_PAGEDOWN: Inc(I, SI.nPage);
      SB_THUMBTRACK, SB_THUMBPOSITION: I := SI.nTrackPos;
    else
      Inc(I, Delta)
    end;
    if FScaleMode = smWholePage then
      I := MinMax(I, 1, PExtent^)
    else
      I := MinMax(I, 0, PExtent^);
    PPos^ := I;  
    SI.nPos := I;
    SI.fMask := SIF_POS;
    SetScrollInfo(Handle, ScrollBar, SI, True);
  end;
end;

procedure TKPrintPreview.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if ssLeft in Shift then
  begin
    SafeSetFocus;
    if (FScaleMode <> smWholePage) and PtInRect(GetPageRect, Point(X, Y)) then
    begin
      FlagSet(cPF_Dragging);
      FX := X;
      FY := Y;
      SetMouseCursor(X, Y);
    end;
  end;
end;

procedure TKPrintPreview.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if Flag(cPF_Dragging) and MouseCapture then
  begin
    BeginScrollWindow;
    if (X > FX) and (FScrollPos.X > 0) or (X < FX) and (FScrollPos.X < FScrollExtent.X) then
    begin
      ModifyScrollBar(SB_HORZ, -1, FX - X);
      FX := X;
    end;
    if (Y > FY) and (FScrollPos.Y > 0) or (Y < FY) and (FScrollPos.Y < FScrollExtent.Y) then
    begin
      ModifyScrollBar(SB_VERT, -1, FY - Y);
      FY := Y;
    end;
    EndScrollWindow;
  end;
end;

procedure TKPrintPreview.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  FlagClear(cPF_Dragging);
  SetMouseCursor(X, Y);
end;

procedure TKPrintPreview.NextPage;
begin
  Page := Page + 1;
end;

procedure TKPrintPreview.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FControl) then
  begin
    FControl := nil;
    UpdatePreview;
  end;
end;

procedure TKPrintPreview.Paint;

  procedure DoPaint(IsBuffer: Boolean);
  var
    C: TColor;
    R, RPaper, RPage: TRect;
    RgnPaper: HRGN;
  begin
    Canvas.Brush.Style := bsSolid;
    Canvas.Pen.Mode := pmCopy;
    Canvas.Pen.Style := psSolid;
    Canvas.Pen.Width := 1;
    RPage := GetPageRect;
    RPaper := RPage;
    with RPaper do
    begin
      Inc(Right, cPreviewShadowSize);
      Inc(Bottom, cPreviewShadowSize);
    end;
    if not IsBuffer then
      RgnPaper := CreateRectRgnIndirect(RPaper)
    else
      RgnPaper := 0;
    try
      // paint background around paper, we don't want at least this to flicker
      if IsBuffer or (ExtSelectClipRgn(Canvas.Handle, RgnPaper, RGN_DIFF) <> NULLREGION) then
      begin
        Canvas.Brush.Color := FColors.BkGnd;
        Canvas.FillRect(ClientRect);
      end;
      if not IsBuffer then
        SelectClipRgn(Canvas.Handle, RgnPaper);
    finally
      if not IsBuffer then
        DeleteObject(rgnPaper);
    end;
    // paint paper outline
    if Focused then
      C := FColors.SelectedBorder
    else
      C := FColors.Border;
    Canvas.Pen.Color := C;
    Canvas.Brush.Color := FColors.Paper;
    Canvas.Rectangle(RPage);
    Canvas.Brush.Color := FColors.BkGnd;
    R := Rect(RPage.Left, RPage.Bottom, RPage.Left + cPreviewShadowSize, RPage.Bottom + cPreviewShadowSize);
    Canvas.FillRect(R);
    R := Rect(RPage.Right, RPage.Top, RPage.Right + cPreviewShadowSize, RPage.Top + cPreviewShadowSize);
    Canvas.FillRect(R);
    Canvas.Brush.Color := C;
    R := Rect(RPage.Left + cPreviewShadowSize, RPage.Bottom, RPaper.Right, RPaper.Bottom);
    Canvas.FillRect(R);
    R := Rect(RPage.Right, RPage.Top + cPreviewShadowSize, RPaper.Right, RPaper.Bottom);
    Canvas.FillRect(R);
    // paint page outline
    InflateRect(RPage, -1, -1);
    FControl.PageSetup.PaintPageToPreview(Self);
  end;

var
  SaveIndex: Integer;
  RClient: TRect;
{$IFDEF USE_WINAPI}
  Org: TPoint;
  MemBitmap, OldBitmap: HBITMAP;
  DC: HDC;
{$ENDIF}
begin
  RClient := ClientRect;
  if Assigned(FControl) then
  begin
    SaveIndex := SaveDC(Canvas.Handle);
    try
    {$IFDEF USE_WINAPI}
      if DoubleBuffered then
      begin
        // we must paint always the entire client because of canvas scaling
        MemBitmap := CreateCompatibleBitmap(Canvas.Handle, RClient.Right - RClient.Left, RClient.Bottom - RClient.Top);
        try
          OldBitmap := SelectObject(Canvas.Handle, MemBitmap);
          try
            SetWindowOrgEx(Canvas.Handle, 0, 0, @Org);
            SelectClipRect(Canvas.Handle, Rect(0, 0, RClient.Right - RClient.Left, RClient.Bottom - RClient.Top));
            DoPaint(True);
          finally
            SelectObject(Canvas.Handle, OldBitmap);
            SetWindowOrgEx(Canvas.Handle, Org.X, Org.Y, nil);
          end;
          // copy MemBitmap to original canvas
          DC := CreateCompatibleDC(Canvas.Handle);
          try
            OldBitmap := SelectObject(DC, MemBitmap);
            try
              CopyBitmap(Canvas.Handle, RClient, DC, 0, 0);
            finally
              SelectObject(DC, OldBitmap);
            end;
          finally
            DeleteDC(DC);
          end;
        finally
          DeleteObject(MemBitmap);
        end;
      end else
    {$ENDIF}
        DoPaint(False);
    finally
      RestoreDC(Canvas.Handle, SaveIndex);
    end;
  end else
  begin
    Canvas.Brush.Color := FColors.BkGnd;
    Canvas.FillRect(RClient);
  end;
end;

procedure TKPrintPreview.Changed;
begin
  if Assigned(FOnChanged) then
    FOnChanged(Self);
end;

procedure TKPrintPreview.PreviousPage;
begin
  Page := Page - 1;
end;

procedure TKPrintPreview.SafeSetFocus;
var
  Form: TCustomForm;
begin
  Form := GetParentForm(Self);
  if (Form <> nil) and Form.Visible and Form.Enabled and Visible and Enabled then
    Form.ActiveControl := Self;
end;

procedure TKPrintPreview.SetColors(const Value: TKPreviewColors);
begin
  FColors.Assign(Value);
end;

procedure TKPrintPreview.SetControl(Value: TKCustomControl);
begin
  if (Value <> FControl) and (Value <> Self) and not (Value is TKPrintPreview) then
  begin
    if Assigned(FControl) then
      FControl.RemovePreview(Self);
    FControl := Value;
    if Assigned(FControl) then
      FControl.AddPreview(Self);
    UpdatePreview;
  end;
end;

procedure TKPrintPreview.SetPage(Value: Integer);
begin
  Value := MinMax(Value, StartPage, EndPage);
  if Value <> FPage then
  begin
    BeginScrollWindow;
    if FScaleMode = smWholePage then
      ModifyScrollBar(SB_VERT, -1, Value - FPage)
    else
      FPage := Value;
    EndScrollWindow;
    Changed;
  end;
end;

procedure TKPrintPreview.SetScale(Value: Integer);
begin
  Value := MinMax(Value, cScaleMin, cScaleMax);
  if Value <> FScale then
  begin
    FScale := Value;
    UpdatePreview;
  end;
end;

procedure TKPrintPreview.SetScaleMode(Value: TKPreviewScaleMode);
begin
  if Value <> FScaleMode then
  begin
    FScaleMode := Value;
    UpdatePreview;
  end;
end;

function TKPrintPreview.SetMouseCursor(X, Y: Integer): Boolean;
var
  ACursor: TCursor;
begin
  if PtInRect(GetPageRect, Point(X, Y)) and (FScaleMode <> smWholePage) then
  begin
    if MouseCapture then
      ACursor := crDragHandGrip
    else
      ACursor := crDragHandFree;
  end else
    ACursor := crDefault;
{$IFDEF FPC}
  FCursor := ACursor;
  SetTempCursor(ACursor);
{$ELSE}
  Windows.SetCursor(Screen.Cursors[ACursor]);
{$ENDIF}
  Result := True;
end;

procedure TKPrintPreview.UpdatePreview;
begin
  Page := FPage;
  UpdateScrollRange;
  Changed;
end;

procedure TKPrintPreview.UpdateScrollRange;
var
  I: Integer;
  PageWidth100Percent, PageHeight100Percent: Integer;
  SI: TScrollInfo;
begin
  if HandleAllocated and not Flag(cPF_UpdateRange) then
  begin
    FlagSet(cPF_UpdateRange);
    try
      if Assigned(FControl) then
      begin
        // get isotropic page size in 300 dpi
        PageWidth100Percent := MulDiv(FControl.PageSetup.PageWidth, 300, FControl.PageSetup.PrinterPixelsPerInchX);
        PageHeight100Percent := MulDiv(FControl.PageSetup.PageHeight, 300, FControl.PageSetup.PrinterPixelsPerInchY);
        case FScaleMode of
          smScale:
          begin
            FPageSize.X := MulDiv(PageWidth100Percent, FScale, 100);
            FPageSize.Y := MulDiv(PageHeight100Percent, FScale, 100);
          end;
          smPageWidth:
          begin
            FPageSize.X := Max(ClientWidth - 2 * cPreviewHorzBorder - cPreviewShadowSize, 40);
            FPageSize.Y := MulDiv(FPageSize.X, PageHeight100Percent, PageWidth100Percent);
          end;
          smWholePage:
          begin
            FPageSize.X := Max(ClientWidth - 2 * cPreviewHorzBorder - cPreviewShadowSize, 40);
            FPageSize.Y := Max(ClientHeight - 2 * cPreviewVertBorder - cPreviewShadowSize, 40);
            I := MulDiv(FPageSize.Y, PageWidth100Percent, PageHeight100Percent);
            if I < FPageSize.X then
              FPageSize.X := I
            else
              FPageSize.Y := MulDiv(FPageSize.X, PageHeight100Percent, PageWidth100Percent);
          end;
        end;
        FExtent.X := FPageSize.X + 2 * cPreviewHorzBorder + cPreviewShadowSize;
        FExtent.Y := FPageSize.Y + 2 * cPreviewVertBorder + cPreviewShadowSize;
        FPageOffset.X := cPreviewHorzBorder;
        if (FExtent.X < ClientWidth) then
          Inc(FPageOffset.X, (ClientWidth - FExtent.X) div 2);
        FPageOffset.Y := cPreviewVertBorder;
        if (FExtent.Y < ClientHeight) then
          Inc(FPageOffset.Y, (ClientHeight - FExtent.Y) div 2);
        // adjust horizontal scroll position
        I := FScrollPos.X + ClientWidth - FExtent.X - 1;
        if I > 0 then
          Dec(FScrollPos.X, I);
        FScrollPos.X := Max(FScrollPos.X, 0);
        // adjust vertical scroll position
        I := FScrollPos.Y + ClientHeight - FExtent.Y - 1;
        if I > 0 then
          Dec(FScrollPos.Y, I);
        FScrollPos.Y := Max(FScrollPos.Y, 0);
        // update scroll range
        FScrollExtent.X := 0;
        FScrollExtent.Y := 0;
        FillChar(SI, SizeOf(TScrollInfo), 0);
        SI.cbSize := SizeOf(TScrollInfo);
        SI.fMask := SIF_RANGE or SIF_PAGE or SIF_POS or SIF_DISABLENOSCROLL {$IFDEF UNIX}or SIF_UPDATEPOLICY{$ENDIF};
        SI.nMin := 0;
      {$IFDEF UNIX}
        SI.ntrackPos := SB_POLICY_CONTINUOUS;
      {$ENDIF}
        case FScaleMode of
          smScale:
          begin
            ShowScrollbar(Handle, SB_HORZ, True);
            ShowScrollbar(Handle, SB_VERT, True);
            SI.nMax := FExtent.X{$IFDEF FPC}+ 1{$ENDIF};
            SI.nPage := ClientWidth;
            SI.nPos := FScrollPos.X;
            FScrollExtent.X := SI.nMax - Integer(SI.nPage);
            SetScrollInfo(Handle, SB_HORZ, SI, True);
            SI.nMax := FExtent.Y{$IFDEF FPC}+ 1{$ENDIF};
            SI.nPage := ClientHeight;
            SI.nPos := FScrollPos.Y;
            FScrollExtent.Y := SI.nMax - Integer(SI.nPage);
            SetScrollInfo(Handle, SB_VERT, SI, True);
          end;
          smPageWidth:
          begin
            ShowScrollbar(Handle, SB_HORZ, False);
            ShowScrollbar(Handle, SB_VERT, True);
            SI.nMax := FExtent.Y{$IFDEF FPC}+ 1{$ENDIF};
            SI.nPage := ClientHeight;
            SI.nPos := FScrollPos.Y;
            FScrollExtent.Y := SI.nMax - Integer(SI.nPage);
            SetScrollInfo(Handle, SB_VERT, SI, True);
          end;
          smWholePage:
          begin
            // another mode for vertical scrollbar - page selection
            ShowScrollbar(Handle, SB_HORZ, False);
            ShowScrollbar(Handle, SB_VERT, True);
            SI.nMin := StartPage;
            SI.nMax := EndPage{$IFDEF FPC}+ 1{$ENDIF};
            SI.nPage := 1;
            SI.nPos := FPage;
            SetScrollInfo(Handle, SB_VERT, SI, True);
          end;
        end;
      end else
      begin
        ShowScrollbar(Handle, SB_HORZ, False);
        ShowScrollbar(Handle, SB_VERT, False);
      end;
      Invalidate;
    finally
      FlagClear(cPF_UpdateRange);
    end;
  end;
end;

procedure TKPrintPreview.UpdateSize;
begin
  inherited;
  UpdatePreview;
end;

procedure TKPrintPreview.WMEraseBkgnd(var Msg: TLMessage);
begin
  Msg.Result := 1;
end;

procedure TKPrintPreview.WMGetDlgCode(var Msg: TLMNoParams);
begin
  Msg.Result := DLGC_WANTARROWS;
end;

procedure TKPrintPreview.WMHScroll(var Msg: TLMHScroll);
begin
  SafeSetFocus;
  BeginScrollWindow;
  ModifyScrollBar(SB_HORZ, Msg.ScrollCode, Msg.Pos);
  EndScrollWindow;
end;

procedure TKPrintPreview.WMKillFocus(var Msg: TLMKillFocus);
begin
  inherited;
  Invalidate;
end;

procedure TKPrintPreview.WMSetFocus(var Msg: TLMSetFocus);
begin
  inherited;
  Invalidate;
end;

procedure TKPrintPreview.WMVScroll(var Msg: TLMVScroll);
begin
  SafeSetFocus;
  BeginScrollWindow;
  ModifyScrollBar(SB_VERT, Msg.ScrollCode, Msg.Pos);
  EndScrollWindow;
end;

{$IFDEF FPC}
initialization
  {$i kcontrols.lrs}
{$ELSE}
  {$R kcontrols.res}
{$ENDIF}
end.