{ *************************************************************************** }
{                                                                             }
{ EControl Syntax Editor SDK                                                  }
{                                                                             }
{ Copyright (c) 2004 - 2008 EControl Ltd., Zaharov Michael                    }
{     www.econtrol.ru                                                         }
{     support@econtrol.ru                                                     }
{                                                                             }
{ *************************************************************************** }
{$I ecSyntEdit.INC}

unit ecPrint;

interface

uses Windows, Messages, Classes, Controls, Forms, Graphics, Printers,
     ecSyntMemo, ecSyntAnal, ecStrUtils;

type

  TecPrinterInfo = class
  public
    Inch: TPoint;
    Offset: TPoint;
    PageSize: TPoint;
    PrintSize: TPoint;
    MinMargin: TRect;
    ScreenInch: TPoint;
    PrnIndex: integer;
    procedure Update(Orientation: TPrinterOrientation; DoInit: Boolean = False);
  end;

  TPrintUnits = (puMM, puCM, puInch, puThousandthsOfInches);
  TecPrintSide = (psHeader, psFooter, psLineLeft, psLineRight);
  TPrintColorMode = (cmRGB, cmGrayScale, cmBlackWhite);

  TPrintCanvasEvent = procedure(Sender: TObject; Canvas: TCanvas) of object;
  TGetFieldEvent = procedure(Sender: TObject; const FieldName: ecString; var FieldValue: ecString) of object;

  TecCustomPrinter = class(TComponent)
  private
    FMarginRight: double;
    FMarginLeft: double;
    FMarginBottom: double;
    FMarginTop: double;
    FUnits: TPrintUnits;
    FPrnInfo: TecPrinterInfo;
    FOrientation: TPrinterOrientation;
    FTitle: string;
    FFooter: ecString;
    FHeader: ecString;
    FFontHeader: TFont;
    FFontFooter: TFont;
    FOnGetField: TGetFieldEvent;
    FFields: TStrings;
    FOnBeforePrintPage: TPrintCanvasEvent;
    FOnAfterPrintPage: TPrintCanvasEvent;
    FColorMode: TPrintColorMode;
    FSvCanvasChanging: TNotifyEvent;
    FInvalid: Boolean;
    FCurPage: integer;
    FFirstPageHeadline: Boolean;
    procedure SetFisrtPageHeadline(const Value: Boolean);
    function GetMargin(const Index: Integer): double;
    procedure SetMargin(const Index: Integer; Value: double);
    function GetOrientation: TPrinterOrientation;
    procedure SetOrientation(const Value: TPrinterOrientation);
    procedure SetFooter(const Value: ecString);
    procedure SetHeader(const Value: ecString);
    procedure SetFontFooter(const Value: TFont);
    procedure SetFontHeader(const Value: TFont);
    procedure SetFields(const Value: TStrings);
    procedure SetColorMode(const Value: TPrintColorMode);
    procedure PrintCanvasChanging(Sender: TObject);
  protected
    procedure PrintToCanvas(Canvas: TCanvas; Page: integer); virtual;
    procedure PrintPageRect(Canvas: TCanvas; Page: integer; const PrintRect, Fields: TRect); virtual; abstract;
    procedure DoUpdatePages; virtual; abstract;
    function GetPageCount: integer; virtual; abstract;
    function GetPrintRect: TRect;
    function GetContentRect(Canvas: TCanvas; Page: integer): TRect;
    procedure PrintField(Canvas: TCanvas; R: TRect; Side: TecPrintSide; Page: integer); virtual;
    function GetFields(Canvas: TCanvas; Page: integer): TRect; virtual; // footer, header, ... in device units
    procedure ReplaceFields(var S: ecString; Page: integer); virtual;
    procedure BeforePrint(Canvas: TCanvas); dynamic;
    procedure AfterPrint(Canvas: TCanvas); dynamic;
    procedure Changed; dynamic;
    function GetPageSetupDlgClass: TComponentClass; virtual;
    property PrnInfo: TecPrinterInfo read FPrnInfo;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure UpdatePages;
    procedure Refresh;
    procedure PrintPages(FromPage, ToPage: integer; DoRefresh: boolean = False);
    procedure Print;
    function PageSetup: Boolean; virtual;
    property PageCount: integer read GetPageCount;
    property Page: integer read FCurPage;
  published
    property Units: TPrintUnits read FUnits write FUnits default puInch;
    property MarginLeft: double index 0 read GetMargin write SetMargin;
    property MarginRight: double index 1 read GetMargin write SetMargin;
    property MarginTop: double index 2 read GetMargin write SetMargin;
    property MarginBottom: double index 3 read GetMargin write SetMargin;
    property Orientation: TPrinterOrientation read GetOrientation write SetOrientation;
    property Title: string read FTitle write FTitle;

    property FontHeader: TFont read FFontHeader write SetFontHeader;
    property FontFooter: TFont read FFontFooter write SetFontFooter;
    property Header: ecString read FHeader write SetHeader;
    property Footer: ecString read FFooter write SetFooter;
    property Fields: TStrings read FFields write SetFields;
    property ColorMode: TPrintColorMode read FColorMode write SetColorMode default cmRGB;
    property FirstPageHeadline: Boolean read FFirstPageHeadline write SetFisrtPageHeadline default True;

    property OnBeforePrintPage: TPrintCanvasEvent read FOnBeforePrintPage write FOnBeforePrintPage;
    property OnAfterPrintPage: TPrintCanvasEvent read FOnAfterPrintPage write FOnAfterPrintPage;
    property OnGetField: TGetFieldEvent read FOnGetField write FOnGetField;
  end;

  TPreviewZoomMode = (zmCustom, zmPageWidth, zmWholePage);

  TecCustomPreview = class(TCustomControl)
  private
    FBorderStyle: TBorderStyle;
    FPage: integer;
    FZoom: integer;
    FShadowSize: integer;
    FScrollOffset: TPoint;
    FSyntPrinter: TecCustomPrinter;
    FZoomMode: TPreviewZoomMode;
    FOnZoomChanged: TNotifyEvent;
    FOnPageChanged: TNotifyEvent;
    procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
    procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
    procedure CMMouseWheel(var Message: TCMMouseWheel); message CM_MOUSEWHEEL;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure SetBorderStyle(const Value: TBorderStyle);
    procedure SetPage(Value: integer);
    procedure SetZoom(Value: integer);
    procedure SetScrollOffset(const Value: TPoint);
    procedure SetSyntPrinter(const Value: TecCustomPrinter);
    procedure SetZoomMode(const Value: TPreviewZoomMode);
    procedure UpdateZoom;
    procedure CheckOffset;
    procedure CanvasChanging(Sender: TObject);
    function GetPageCount: integer;
    procedure HorzScroll(Code, nPos: integer);
    procedure VertScroll(Code, nPos: integer);
  protected
    FViewMargin: TRect;
    procedure Paint; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure AdjustScrollBar;
    function CalcPageSize: TPoint;
    procedure DrawPage(R: TRect); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    procedure UpdatePreview;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle;
    property Page: integer read FPage write SetPage;
    property PageCount: integer read GetPageCount;
    property ScrollOffset: TPoint read FScrollOffset write SetScrollOffset;
    property SyntPrinter: TecCustomPrinter read FSyntPrinter write SetSyntPrinter;
    property Zoom: integer read FZoom write SetZoom;
    property ZoomMode: TPreviewZoomMode read FZoomMode write SetZoomMode;
    property OnZoomChanged: TNotifyEvent read FOnZoomChanged write FOnZoomChanged;
    property OnPageChanged: TNotifyEvent read FOnPageChanged write FOnPageChanged;
  end;

  TOnForceNewPage = procedure(Sender: TObject; const PrintRect: TRect; Line,
              LineHeight, LineTop: integer; var ForceNewPage: Boolean) of object;
  TLineNumbersPos = (lnpNone, lnpLeft, lnpRight, lnpOddLeft, lnpOddRight);

  TecSyntPrinter = class(TecCustomPrinter)
  private
    FSyntMemo: TCustomSyntaxMemo;
    FPageLines: TList;
    FLineHeights: TList;
    FOptions: TSyntMemoPrintOptions;
    FCurLine: integer;
    PrnCanvas: TCanvas;
    FOnForceNewPage: TOnForceNewPage;
    FLinNumdersFont: TFont;
    FLineNumbersPos: TLineNumbersPos;
    FLastY: integer;
    FFirstPageNumber: integer;
    FPrintStartPos: integer;
    FPrintEndPos: integer;
    FPrintSelection: Boolean; // position after last line
    procedure SetSyntMemo(const Value: TCustomSyntaxMemo);
    procedure SetOptions(const Value: TSyntMemoPrintOptions);
    procedure CanvasChanging(Sender: TObject);
    procedure SetLinNumdersFont(const Value: TFont);
    procedure SetLineNumbersPos(const Value: TLineNumbersPos);
    procedure SetPrintEndPos(const Value: integer);
    procedure SetPrintStartPos(const Value: integer);
    procedure SetPrintSelection(const Value: Boolean);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function GetPageCount: integer; override;
    procedure PrintPageRect(Canvas: TCanvas; Page: integer; const PrintRect, Fields: TRect); override;
    procedure PrintField(Canvas: TCanvas; R: TRect; Side: TecPrintSide; Page: integer); override;
    function GetFields(Canvas: TCanvas; Page: integer): TRect; override; // footer, header, ... in device units
    function GetPageSetupDlgClass: TComponentClass; override;
    function GetPrintedPart(Line: integer; var sPos, ePos: integer): Boolean;
    procedure DoUpdatePages; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;

    property PosAfterLines: integer read FLastY;
    property PrintStartPos: integer read FPrintStartPos write SetPrintStartPos;
    property PrintEndPos: integer read FPrintEndPos write SetPrintEndPos;
  published
    property SyntMemo: TCustomSyntaxMemo read FSyntMemo write SetSyntMemo;
    property Options: TSyntMemoPrintOptions read FOptions write SetOptions;

    property FontLineNumders: TFont read FLinNumdersFont write SetLinNumdersFont;
    property LineNumbersPos: TLineNumbersPos read FLineNumbersPos write SetLineNumbersPos;
    property FirstPageNumber: integer read FFirstPageNumber write FFirstPageNumber default 1;
    property PrintSelection: Boolean read FPrintSelection write SetPrintSelection;

    property OnForceNewPage: TOnForceNewPage read FOnForceNewPage write FOnForceNewPage;
  end;

  TecSyntPreview = class(TecCustomPreview)
  published
    property Align default alClient;
    property BorderStyle default bsSingle;
    property Color default clAppWorkSpace;
    property SyntPrinter;
    property Zoom default 100;
    property ZoomMode default zmCustom;
    property OnZoomChanged;
    property OnPageChanged;
  end;

  TecFormPrinter = class(TecCustomPrinter)
  private
    FForm: TForm;
    FPrintScale: TPrintScale;
    procedure SetForm(const Value: TForm);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function GetPageCount: integer; override;
    procedure PrintPageRect(Canvas: TCanvas; Page: integer; const PrintRect, Fields: TRect); override;
    function GetPageSetupDlgClass: TComponentClass; override;
    procedure DoUpdatePages; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property Form: TForm read FForm write SetForm;
    property PrintScale: TPrintScale read FPrintScale write FPrintScale default poProportional;
  end;

implementation

uses {$IFDEF EC_DOTNET} Types,{$ENDIF} SysUtils, contnrs,
   ecPageSetupEditor, ecPageSetupBase, ecPageSetupForm, ecSysUtils,
   ecMemoStrings, Math;

{ TPrinterInfo }

procedure TecPrinterInfo.Update(Orientation: TPrinterOrientation; DoInit: Boolean);
var DC: HDC;
begin
  if not DoInit and (Printer.Printers.Count > 0) then
   begin
    Printer.Orientation := Orientation;
    DC := Printer.Handle;
    Inch.X := GetDeviceCaps(DC, LOGPIXELSX);
    Inch.Y := GetDeviceCaps(DC, LOGPIXELSY);
    Offset.X := GetDeviceCaps(DC, PHYSICALOFFSETX);
    Offset.Y := GetDeviceCaps(DC, PHYSICALOFFSETY);
    PageSize.X := GetDeviceCaps(DC, PHYSICALWIDTH);
    PageSize.Y := GetDeviceCaps(DC, PHYSICALHEIGHT);
    PrintSize.X  := GetDeviceCaps(DC, HORZRES);
    PrintSize.Y  := GetDeviceCaps(DC, VERTRES);
   end else
   begin
    Inch := Point(600, 600);
    if Orientation = poPortrait then
     begin
       Offset := Point(130, 150);
       PageSize := Point(4960, 7015);
       PrintSize := Point(4676, 6744);
     end else
     begin
       Offset := Point(151, 110);
       PageSize := Point(7015, 4960);
       PrintSize := Point(6714, 4702);
     end;
   end;

  MinMargin.Left := Offset.X;
  MinMargin.Top := Offset.Y;
  MinMargin.Right := PageSize.X - PrintSize.X - Offset.X;
  MinMargin.Bottom := PageSize.Y - PrintSize.Y - Offset.Y;

  DC := GetDC(0);
  ScreenInch.X := GetDeviceCaps(DC, LOGPIXELSX);
  ScreenInch.Y := GetDeviceCaps(DC, LOGPIXELSY);
  ReleaseDC(0, DC);
end;

{ TecCustomPrinter }

constructor TecCustomPrinter.Create(AOwner: TComponent);
begin
  inherited;
  FPrnInfo := TecPrinterInfo.Create;
  FPrnInfo.Update(Orientation, True);
  // Minimal margins
  FMarginLeft := FPrnInfo.MinMargin.Left / FPrnInfo.Inch.X;
  FMarginTop  := FPrnInfo.MinMargin.Top / FPrnInfo.Inch.X;
  FMarginRight := FPrnInfo.MinMargin.Right / FPrnInfo.Inch.Y;
  FMarginBottom := FPrnInfo.MinMargin.Bottom / FPrnInfo.Inch.Y;
  FUnits := puInch;

  FColorMode := cmRGB;

  FFontHeader := TFont.Create;
  FFontHeader.Name := 'Courier New';
  FFontHeader.Size := 10;
  FFontFooter := TFont.Create;
  FFontFooter.Name := 'Courier New';
  FFontFooter.Size := 10;
  FFields := TStringList.Create;
  TStringList(FFields).Sorted := True;
  TStringList(FFields).Duplicates := dupIgnore;

  FCurPage := -1;
  FFirstPageHeadline := True;
end;

// In device units
destructor TecCustomPrinter.Destroy;
begin
  FPrnInfo.Free;
  FFontHeader.Free;
  FFontFooter.Free;
  FFields.Free;
  inherited;
end;

function TecCustomPrinter.GetPrintRect: TRect;
begin
  with FPrnInfo do
    begin
      Result.Left := Round(FMarginLeft * Inch.X) - MinMargin.Left;
      Result.Right := PrintSize.X - Round(FMarginRight * Inch.X) + MinMargin.Right;
      Result.Top := Round(FMarginTop * Inch.Y) - MinMargin.Top;
      Result.Bottom := PrintSize.Y - Round(FMarginBottom * Inch.Y) + MinMargin.Bottom;
    end;
end;

function TecCustomPrinter.GetContentRect(Canvas: TCanvas; Page: integer): TRect;
var Fields: TRect;
begin
  Result := GetPrintRect;
  if (Page <> 1) or FirstPageHeadline then
    begin
     Fields := GetFields(Canvas, Page);
     Result.Left := Result.Left + Fields.Left;
     Result.Top := Result.Top + Fields.Top;
     Result.Right := Result.Right - Fields.Right;
     Result.Bottom := Result.Bottom - Fields.Bottom;
    end;
end;

procedure TecCustomPrinter.PrintPages(FromPage, ToPage: integer; DoRefresh: boolean);
var i: integer;
begin
  if Printer.Printers.Count = 0 then Exit;
  if DoRefresh then Refresh;
  UpdatePages;
  Printer.Orientation := FOrientation;
  Printer.Title := FTitle;
  Printer.BeginDoc;
  for i := FromPage to ToPage do
   begin
     FCurPage := i;
     PrintToCanvas(Printer.Canvas, i);
     if i < ToPage then Printer.NewPage;
   end;
  Printer.EndDoc;
  FCurPage :=  -1;
end;

procedure TecCustomPrinter.Print;
begin
  Refresh;
  PrintPages(1, PageCount);
end;

function TecCustomPrinter.GetMargin(const Index: Integer): double;
begin
//  UpdatePages;
  case Index of
    0: Result := FMarginLeft;
    1: Result := FMarginRight;
    2: Result := FMarginTop;
    else Result := FMarginBottom;
  end;
  case FUnits of
    puCM: Result := Result * 2.54;
    puMM: Result := Result * 25.4;
    puThousandthsOfInches: Result := Result * 1000;
  end;
end;

procedure TecCustomPrinter.SetMargin(const Index: Integer;
  Value: double);
begin
  case FUnits of
    puCM: Value := Value / 2.54;
    puMM: Value := Value / 25.4;
    puThousandthsOfInches: Value := Value / 1000;
  end;
  case Index of
    0: if Value * FPrnInfo.Inch.X >= FPrnInfo.MinMargin.Left then
          FMarginLeft := Value;
    1: if Value * FPrnInfo.Inch.X >= FPrnInfo.MinMargin.Right then
          FMarginRight := Value;
    2: if Value * FPrnInfo.Inch.Y >= FPrnInfo.MinMargin.Top then
          FMarginTop := Value;
    else if Value * FPrnInfo.Inch.Y >= FPrnInfo.MinMargin.Bottom then
            FMarginBottom := Value;
  end;
  Changed;
end;

procedure TecCustomPrinter.UpdatePages;
begin
  if not FInvalid then Exit;

  if (pcOrientation in Printer.Capabilities)  and
     (Printer.Printers.Count <> 0) then
    FOrientation := Printer.Orientation;

  FPrnInfo.Update(Orientation);
  DoUpdatePages;
  FInvalid := False;
end;

function TecCustomPrinter.GetOrientation: TPrinterOrientation;
begin
{ if ( not (pcOrientation in Printer.Capabilities) ) or
   (Printer.Printers.Count = 0) then Result := FOrientation
     else Result := Printer.Orientation;}
  Result := FOrientation;
end;

procedure TecCustomPrinter.SetOrientation(
  const Value: TPrinterOrientation);
begin
  FOrientation := Value;
  if (pcOrientation in Printer.Capabilities)  and
     (Printer.Printers.Count <> 0) then
      Printer.Orientation := Value;
  Changed;
end;

function TecCustomPrinter.PageSetup: Boolean;
var cls: TComponentClass;
begin
  cls := GetPageSetupDlgClass;
  if (cls = nil) or not cls.InheritsFrom(TPageSetupBaseDlg) then
    Result := False
  else
  with TPageSetupBaseDlg(cls.Create(nil)) do
   try
     SetParams(Self);
     Result := ShowModal = mrOk;
     if Result then
       GetParams(Self);
   finally
     Free;
   end;
end;

procedure TecCustomPrinter.Assign(Source: TPersistent);
var src: TecCustomPrinter;
begin
  if Source is TecCustomPrinter then
   begin
    src := Source as TecCustomPrinter;
    FMarginRight := src.FMarginRight;
    FMarginLeft := src.FMarginLeft;
    FMarginBottom := src.FMarginBottom;
    FMarginTop := src.FMarginTop;
    FUnits := src.FUnits;
    Orientation := src.Orientation;
    FFontHeader.Assign(src.FFontHeader);
    FFontFooter.Assign(src.FFontFooter);
    FFooter := src.FFooter;
    FHeader := src.FHeader;
    FFirstPageHeadline := src.FirstPageHeadline;
    Changed;
   end else inherited;
end;

procedure TecCustomPrinter.SetFooter(const Value: ecString);
begin
  FFooter := Value;
  Changed;
end;

procedure TecCustomPrinter.SetHeader(const Value: ecString);
begin
  FHeader := Value;
  Changed;
end;

procedure TecCustomPrinter.SetFontFooter(const Value: TFont);
begin
  FFontFooter.Assign(Value);
  Changed;
end;

procedure TecCustomPrinter.SetFontHeader(const Value: TFont);
begin
  FFontHeader.Assign(Value);
  Changed;
end;

procedure TecCustomPrinter.SetFields(const Value: TStrings);
begin
  FFields.Assign(Value);
  Changed;
end;

procedure TecCustomPrinter.SetColorMode(const Value: TPrintColorMode);
begin
  FColorMode := Value;
  Changed;
end;

procedure TecCustomPrinter.PrintCanvasChanging(Sender: TObject);
  function ColorToGray(const Color: TColor): TColor;
  begin
    Result := (Color and $FF) * 21      // Blue
      + ((Color shr 8) and $FF) * 174   // Green
      + ((Color shr 16) and $FF) * 61;  // Red
    Result := (Result shr 8) and $FF;
    Result := Result + Result shl 8 + Result shl 16;
  end;
begin
  if Assigned(FSvCanvasChanging) then
    FSvCanvasChanging(Sender);
  with TCanvas(Sender) do
    begin
      case FColorMode of
        cmGrayScale:
          begin
            Font.Color := ColorToGray(ColorToRGB(Font.Color));
            if Brush.Style <> bsClear then
              Brush.Color := ColorToGray(ColorToRGB(Brush.Color));
          end;
        cmBlackWhite:
          begin
            Font.Color := clBlack;
            Brush.Style := bsClear;
          end;
      end;
    end;
end;

procedure TecCustomPrinter.ReplaceFields(var S: ecString; Page: integer);
var i, firstpos: integer;
    fld, fldVal: ecString;
begin
  firstpos := 0;
  for i := Length(S) downto 1 do
   if S[i] = '#' then
    if firstpos = 0 then firstpos := i else
     begin
       fld := Copy(S, i + 1, firstpos - i - 1);
       if fld = '' then Delete(S, i, 1) else
        begin
         Delete(S, i, firstpos - i + 1);
         if FFields.IndexOfName(fld) <> -1 then
           fldVal := FFields.Values[fld] else
         if SameText(fld, 'Page') then
           fldVal := IntToStr(Page) else
         if SameText(fld, 'Title') then
           fldVal := Title else
         if SameText(fld, 'Time') then
           fldVal := TimeToStr(Now) else
         if SameText(fld, 'Date') then
           fldVal := DateToStr(Now) else
         if SameText(fld, 'DateTime') then
           fldVal := DateTimeToStr(Now)
         else
           fldVal := '';
         if Assigned(FOnGetField) then
           FOnGetField(Self, fld, fldVal);
         Insert(fldVal, S, i);
        end;
       firstpos := 0;
     end;
end;

function TecCustomPrinter.GetFields(Canvas: TCanvas; Page: integer): TRect;

  procedure SetFont(AFont: TFont);
  begin
    Canvas.Font := AFont;
    if Assigned(Canvas.OnChanging) then
       Canvas.OnChanging(Canvas);
  end;

var stl: TecStringList;
begin
  stl := TecStringList.Create;
  try
    SetRectEmpty(Result);
    if FFooter <> '' then
      begin
        SetFont(FFontFooter);
        stl.Text := FFooter;
        Result.Bottom := 10 + (Canvas.TextHeight('W') + 1) * stl.Count;
      end;
    if FHeader <> '' then
      begin
        SetFont(FFontHeader);
        stl.Text := FHeader;
        Result.Top := 10 + (Canvas.TextHeight('W') + 1) * stl.Count;
      end;
  finally
    stl.Free;
  end;
end;

procedure TecCustomPrinter.PrintField(Canvas: TCanvas; R: TRect;
  Side: TecPrintSide; Page: integer);
var ts: TSize;
    stl: TecStringList;
    i, Y: integer;
    sTabbed: array[0..2] of ecString;

  procedure AnalyzeLine(Line: ecString);
  var k, i: integer;
  begin
    for i := 0 to 1 do
      begin
        k := Pos(#9, Line);
        if k = 0 then
         begin
          sTabbed[i] := Line;
          Line := '';
         end else
         begin
          sTabbed[i] := Copy(Line, 1, k - 1);
          Delete(Line, 1, k);
         end;
      end;
    sTabbed[2] := Line;
  end;

  procedure DrawTabbedLine(S: ecString; Y: integer);
  var i, x: integer;
  begin
    ReplaceFields(S, Page);
    AnalyzeLine(S);
    for i := 0 to 2 do
     if sTabbed[i] <> '' then
     begin
       S := sTabbed[i];
       ts := ecTextExtent(Canvas, S);
       case i of
         1: x := (R.Left + R.Right - ts.cx) div 2;
         2: x := R.Right - ts.cx;
         else x := R.Left
       end;
       ecTextOut(Canvas, X, Y, s);
     end;
  end;

begin
  With R do IntersectClipRect(Canvas.Handle, Left, Top, Right, Bottom);
  Canvas.Brush.Style := bsClear;
  case Side of
    // footer, header
    psFooter:
      begin
        Canvas.Font := FFontFooter;
        stl := TecStringList.Create;
        try
          stl.Text := FFooter;
          Y := R.Top + 10;
          for i := 0 to stl.Count - 1 do
            begin
              DrawTabbedLine(stl[i], Y);
              Y := Y + ecTextExtent(Canvas, 'W').cy;
            end;
        finally
          stl.Free;
        end;
      end;
    psHeader:
      begin
        Canvas.Font := FFontHeader;
        stl := TecStringList.Create;
        try
          stl.Text := FHeader;
          Y := R.Bottom - 10;
          for i := stl.Count - 1 downto 0 do
            begin
              Y := Y - ecTextExtent(Canvas, 'W').cy;
              DrawTabbedLine(stl[i], Y);
            end;
        finally
          stl.Free;
        end;
      end;
  end;
end;

procedure TecCustomPrinter.AfterPrint(Canvas: TCanvas);
begin
  try
    if Assigned(FOnAfterPrintPage) then
      FOnAfterPrintPage(Self, Canvas);
  finally
    Canvas.OnChanging := FSvCanvasChanging;
    FSvCanvasChanging := nil;
  end;
end;

procedure TecCustomPrinter.BeforePrint(Canvas: TCanvas);
begin
  FSvCanvasChanging := Canvas.OnChanging;
  Canvas.OnChanging := PrintCanvasChanging;
  if Assigned(FOnBeforePrintPage) then
    FOnBeforePrintPage(Self, Canvas);
end;

procedure TecCustomPrinter.PrintToCanvas(Canvas: TCanvas; Page: integer);
var PageRect, Fields: TRect;
begin
  if (Page < 1) or (Page > PageCount) then Exit;
  BeforePrint(Canvas);
  try
     PageRect := GetPrintRect;
     if (Page <> 1) or FFirstPageHeadline then
       begin
         Fields := GetFields(Canvas, Page);
         // Header
         if Fields.Top > 0 then
          begin
           PrintField(Canvas, Rect(PageRect.Left, PageRect.Top, PageRect.Right, PageRect.Top + Fields.Top), psHeader, Page);
           SelectClipRgn(Canvas.Handle, 0);
          end;
         // Footer
         if Fields.Bottom > 0 then
          begin
           PrintField(Canvas, Rect(PageRect.Left, PageRect.Bottom - Fields.Bottom, PageRect.Right, PageRect.Bottom), psFooter, Page);
           SelectClipRgn(Canvas.Handle, 0);
          end;

         PageRect.Top := PageRect.Top + Fields.Top;
         PageRect.Bottom := PageRect.Bottom - Fields.Bottom;
       end else
         SetRectEmpty(Fields);
     PrintPageRect(Canvas, Page, PageRect, Fields);
  finally
    AfterPrint(Canvas);
  end;
end;

procedure TecCustomPrinter.Changed;
begin
  FInvalid := True;
end;

function TecCustomPrinter.GetPageSetupDlgClass: TComponentClass;
begin
  Result := nil;
end;

procedure TecCustomPrinter.Refresh;
begin
  FInvalid := True;
end;

procedure TecCustomPrinter.SetFisrtPageHeadline(const Value: Boolean);
begin
  if FFirstPageHeadline <> Value then
    begin
      FFirstPageHeadline := Value;
      Changed;
    end;
end;

{ TecCustomPreview }

constructor TecCustomPreview.Create(AOwner: TComponent);
begin
  inherited;
  FBorderStyle := bsSingle;
  Align := alClient;
  Color := clAppWorkSpace;
  FViewMargin := Rect(30, 20, 30, 20);
  FShadowSize := 10;
  FZoom := 100;
  Canvas.OnChange := CanvasChanging;
end;

procedure TecCustomPreview.CreateParams(var Params: TCreateParams);
const
  BorderStyles: array[TBorderStyle] of DWord = (0, WS_BORDER);
begin
  inherited;
  with Params do begin
    Style := Style or WS_HSCROLL or WS_VSCROLL or BorderStyles[FBorderStyle] or WS_CLIPCHILDREN;
    if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then begin
      Style := Style and not WS_BORDER;
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end;
  end;
end;

function TecCustomPreview.CalcPageSize: TPoint;
begin
  if FSyntPrinter = nil then Result := Point(0, 0)
   else
    with FSyntPrinter.PrnInfo do
     begin
      Result.X := MulDiv(MulDiv(PageSize.X, ScreenInch.X, Inch.X), FZoom, 100);
      Result.Y := MulDiv(MulDiv(PageSize.Y, ScreenInch.Y, Inch.Y), FZoom, 100);
     end;
end;

procedure TecCustomPreview.DrawPage(R: TRect);
begin
  with Canvas do
   begin
     Brush.Color := clWhite;
     Brush.Style := bsSolid;
     Pen.Color := clBlack;
     Pen.Width := 1;
     Pen.Style := psSolid;
     Rectangle(R);
     Brush.Color := cl3DDkShadow;
     FillRect(Rect(R.Left + FShadowSize, R.Bottom, R.Right + FShadowSize, R.Bottom + FShadowSize));
     ExcludeClipRect(Handle, R.Left + FShadowSize, R.Bottom, R.Right + FShadowSize, R.Bottom + FShadowSize);
     FillRect(Rect(R.Right, R.Top + FShadowSize, R.Right + FShadowSize, R.Bottom));
     ExcludeClipRect(Handle, R.Right, R.Top + FShadowSize, R.Right + FShadowSize, R.Bottom);
     ExcludeClipRect(Handle, R.Left, R.Top, R.Right, R.Bottom);
   end;
end;

procedure TecCustomPreview.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
  Msg.Result := 1;
end;

procedure TecCustomPreview.CanvasChanging(Sender: TObject);
var FontSize: integer;
begin
  if Assigned(FSyntPrinter) then
  if FSyntPrinter.PrnInfo.Inch.X{Y} <> Canvas.Font.PixelsPerInch then
  begin
    FontSize := Canvas.Font.Size;
    Canvas.Font.PixelsPerInch := FSyntPrinter.PrnInfo.Inch.X{Y};
    Canvas.Font.Size := FontSize;
  end;
end;

procedure TecCustomPreview.Paint;
var Page: TRect;
    Org, scrPage: TPoint;
    rgn: HRGN;
begin
  with Canvas do
   begin
    // Fill background
    if Assigned(FSyntPrinter) and not (csDesigning in ComponentState) then
     begin
      scrPage := CalcPageSize;

      // Page rect
      Page.Left := FViewMargin.Left - FScrollOffset.X;
      Page.Top := FViewMargin.Top - FScrollOffset.Y;
      Page.Right := scrPage.X + Page.Left;
      Page.Bottom := scrPage.Y + Page.Top;

      with Page do rgn := CreateRectRGN(Left,Top,Right,Bottom);
      GetClipRgn(Handle, rgn);
      DrawPage(Page);
      Brush.Color := Self.Color;
      Brush.Style := bsSolid;
      Pen.Style := psClear;
      FillRect(ClipRect);
      SelectClipRGN(Handle, rgn);
      DeleteObject(rgn);

      // Prepare Canvas as Printer emulator
      with FSyntPrinter.PrnInfo do
       begin
        SetMapMode(Handle, MM_ANISOTROPIC);
        SetWindowExtEx(Handle, PageSize.X, PageSize.Y, nil);
        SetViewPortExtEx(Handle, scrPage.X, scrPage.Y, nil);
        Org.X := MulDiv(MinMargin.Left, scrPage.X, PageSize.X) + FViewMargin.Left - FScrollOffset.X;
        Org.Y := MulDiv(MinMargin.Top, scrPage.Y, PageSize.Y) + FViewMargin.Top - FScrollOffset.Y;
        SetViewPortOrgEx(Handle, Org.X, Org.Y, nil);

        IntersectClipRect(Handle, 0, 0, PrintSize.X, PrintSize.Y);
        // Draw page conent
        FSyntPrinter.PrintToCanvas(Canvas, FPage);
       end;
     end else
     begin
      Brush.Color := Self.Color;
      Brush.Style := bsSolid;
      Pen.Style := psClear;
      FillRect(ClipRect);

      Brush.Color := clWhite;
      Brush.Style := bsSolid;
      Pen.Color := clBlack;
      Pen.Width := 1;
      Pen.Style := psSolid;
      Org.X := (ClientWidth - 50) div 2;
      Org.Y := (ClientHeight - 70) div 2;
      Rectangle(Rect(Org.X, Org.Y, Org.X + 50, Org.Y + 70));
     end;
  end;
end;

procedure TecCustomPreview.SetBorderStyle(const Value: TBorderStyle);
begin
  if Value <> FBorderStyle then
  begin
    FBorderStyle := Value;
    RecreateWnd;
  end;
end;

procedure TecCustomPreview.SetPage(Value: integer);
begin
  if Value > PageCount then Value := PageCount;
  if Value < 1 then Value := 1;
  if FPage = Value then Exit;
  FPage := Value;
  Invalidate;
  if Assigned(FOnPageChanged) then FOnPageChanged(Self);
  if FZoomMode = zmWholePage then AdjustScrollBar;
end;

procedure TecCustomPreview.AdjustScrollBar;
var si: TScrollInfo;
    Page: TPoint;
    b: Boolean;
begin
  if HandleAllocated then
   begin
    {$IFNDEF EC_DOTNET}
    FillChar(si, SizeOf(TScrollInfo), 0);
    {$ENDIF}
    si.nMin := 0;
    si.cbSize := sizeof(TScrollInfo);
    si.fMask := SIF_ALL or SIF_DISABLENOSCROLL;

    Page := CalcPageSize;

    b := not (csDesigning in ComponentState) and Assigned(FSyntPrinter);
    ShowScrollbar(Handle, SB_HORZ, (FZoomMode = zmCustom) and b);
    ShowScrollbar(Handle, SB_VERT, b);

    if b then
    case FZoomMode of
    zmWholePage:
      if b then
      begin
        si.nMin := 1;
        si.nMax := PageCount;
        si.nPos := Self.Page;
        si.nPage := 1;
        SetScrollInfo(Handle, SB_VERT, si, True);
      end;
    zmPageWidth:
      begin
        // show vertical scrollbar
        si.nMax := Page.Y + FViewMargin.Top + FViewMargin.Bottom;
        si.nPos := FScrollOffset.Y;
        si.nPage := ClientHeight;
        SetScrollInfo(Handle, SB_VERT, si, True);
      end;
    zmCustom:
      begin
        // show horizontal scrollbar
        si.nMax := Page.X + FViewMargin.Left + FViewMargin.Right - 1;
        si.nPos := FScrollOffset.X;
        si.nPage := ClientWidth;
        SetScrollInfo(Handle, SB_HORZ, si, True);
        // show vertical scrollbar
        si.nMax := Page.Y + FViewMargin.Top + FViewMargin.Bottom - 1;
        si.nPos := FScrollOffset.Y;
        si.nPage := ClientHeight;
        SetScrollInfo(Handle, SB_VERT, si, True);
      end;
    end;
   end;
end;

procedure TecCustomPreview.HorzScroll(Code, nPos: integer);
begin
  case Code of
    SB_LINEUP:    ScrollOffset := Point(ScrollOffset.X - 1, ScrollOffset.Y);
    SB_PAGEUP:    ScrollOffset := Point(ScrollOffset.X - ClientWidth, ScrollOffset.Y);
    SB_TOP:       ScrollOffset := Point(0, ScrollOffset.Y);
    SB_LINEDOWN:  ScrollOffset := Point(ScrollOffset.X + 1, ScrollOffset.Y);
    SB_PAGEDOWN:  ScrollOffset := Point(ScrollOffset.X + ClientWidth, ScrollOffset.Y);
    SB_BOTTOM:    ScrollOffset := Point(100000, ScrollOffset.Y);
    SB_THUMBPOSITION,
    SB_THUMBTRACK: ScrollOffset := Point(nPos, ScrollOffset.Y);
  end;
end;

procedure TecCustomPreview.VertScroll(Code, nPos: integer);
begin
  if FZoomMode = zmWholePage then
  case Code of
    SB_LINEUP,
    SB_PAGEUP:    Page := Page - 1;
    SB_TOP:       Page := 1;
    SB_LINEDOWN,
    SB_PAGEDOWN:  Page := Page + 1;
    SB_BOTTOM:    Page := PageCount;
    SB_THUMBPOSITION,
    SB_THUMBTRACK: Page := nPos;
  end
  else
  case Code of
    SB_LINEUP:    ScrollOffset := Point(ScrollOffset.X, ScrollOffset.Y - 1);
    SB_PAGEUP:    ScrollOffset := Point(ScrollOffset.X, ScrollOffset.Y - ClientHeight);
    SB_TOP:       ScrollOffset := Point(ScrollOffset.X, 0);
    SB_LINEDOWN:  ScrollOffset := Point(ScrollOffset.X, ScrollOffset.Y + 1);
    SB_PAGEDOWN:  ScrollOffset := Point(ScrollOffset.X, ScrollOffset.Y + ClientHeight);
    SB_BOTTOM:    ScrollOffset := Point(ScrollOffset.X, 100000);
    SB_THUMBPOSITION,
    SB_THUMBTRACK: ScrollOffset := Point(ScrollOffset.X, nPos);
  end;
end;

procedure TecCustomPreview.WMHScroll(var Message: TWMHScroll);
begin
  HorzScroll(Message.ScrollCode, Message.Pos);
end;

procedure TecCustomPreview.WMVScroll(var Message: TWMVScroll);
begin
  VertScroll(Message.ScrollCode, Message.Pos);
end;

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

procedure TecCustomPreview.SetSyntPrinter(const Value: TecCustomPrinter);
begin
  if FSyntPrinter <> Value then
   begin
     FSyntPrinter := Value;
     if Assigned(FSyntPrinter) then
       begin
         FSyntPrinter.FreeNotification(Self);
         FSyntPrinter.Refresh;
       end;
     Page := 0;
     UpdateZoom;
   end;
end;

procedure TecCustomPreview.SetZoom(Value: integer);
begin
  if FZoom <= 0 then FZoom := 100;
  if (FZoom = Value) and (FZoomMode = zmCustom) then Exit;
  FZoom := Value;
  FZoomMode := zmCustom;
  CheckOffset;
  AdjustScrollBar;
  Invalidate;
  if Assigned(FOnZoomChanged) then FOnZoomChanged(Self);
end;

procedure TecCustomPreview.SetZoomMode(const Value: TPreviewZoomMode);
begin
  if FZoomMode <> Value then
   begin
    FZoomMode := Value;
    UpdateZoom;
   end;
end;

procedure TecCustomPreview.UpdateZoom;
var w, h, OldZoom: integer;
begin
  OldZoom := FZoom;
  if FSyntPrinter <> nil then
  with FSyntPrinter.PrnInfo do
   case FZoomMode of
    zmPageWidth:
      begin
       w := MulDiv(PageSize.X, ScreenInch.X, Inch.X);
       FZoom := MulDiv(ClientWidth - FViewMargin.Left - FViewMargin.Right, 100, w)
      end;
    zmWholePage:
      begin
       w := MulDiv(PageSize.Y, ScreenInch.Y, Inch.Y);
       h := MulDiv(PageSize.X, ScreenInch.X, Inch.X);
       w := MulDiv(ClientHeight - FViewMargin.Top - FViewMargin.Bottom, 100, w);
       h := MulDiv(ClientWidth - FViewMargin.Left - FViewMargin.Right, 100, h);
       if w < h then FZoom := w else FZoom := h;
      end;
   end;
  CheckOffset;
  AdjustScrollBar;
  Invalidate;
  if (OldZoom <> FZoom) and Assigned(FOnZoomChanged) then
    FOnZoomChanged(Self);
end;

procedure TecCustomPreview.SetScrollOffset(const Value: TPoint);
var old, offs: TPoint;
begin
  old := FScrollOffset;
  FScrollOffset := Value;
  CheckOffset;
  offs.X := old.X - FScrollOffset.X;
  offs.Y := old.Y - FScrollOffset.Y;
  if (offs.X = 0) and (offs.Y = 0) then // scroll not changed => scroll page
    begin
      if (FScrollOffset.Y < Value.Y) and (Page < PageCount) then
        begin
          FScrollOffset.Y := 0;
          CheckOffset;
          Page := Page + 1;
        end else
      if (FScrollOffset.Y > Value.Y) and (Page > 1) then
        begin
          FScrollOffset.Y := 100000;
          CheckOffset;
          Page := Page - 1;
        end;
      Exit;
    end
  else
    begin
      ScrollWindow(Handle, offs.X, offs.Y, nil, nil);
      Update;
    end;
  AdjustScrollBar;
end;

procedure TecCustomPreview.CheckOffset;
var W, H: integer;
    Page: TPoint;
begin
  Page := CalcPageSize;
  W := Page.X + FViewMargin.Left + FViewMargin.Right - ClientWidth;
  H := Page.Y + FViewMargin.Top + FViewMargin.Bottom - ClientHeight;
  if FScrollOffset.X < 0 then FScrollOffset.X := 0;
  if FScrollOffset.Y < 0 then FScrollOffset.Y := 0;
  if FScrollOffset.X > W then FScrollOffset.X := W;
  if FScrollOffset.Y > H then FScrollOffset.Y := H;
  if W < 0 then FScrollOffset.X := W div 2;
  if H < 0 then FScrollOffset.Y := H div 2;
end;

function TecCustomPreview.GetPageCount: integer;
begin
  if FSyntPrinter <> nil then
    Result := FSyntPrinter.PageCount
  else
    Result := 0;
end;

procedure TecCustomPreview.CreateWnd;
begin
  inherited;
  UpdateZoom;
end;

procedure TecCustomPreview.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  SetFocus;
end;

procedure TecCustomPreview.CMMouseWheel(var Message: TCMMouseWheel);
begin
  if FZoomMode = zmWholePage then
    Page := Page - Message.WheelDelta div 120
  else
    ScrollOffset := Point(ScrollOffset.X, ScrollOffset.Y - Message.WheelDelta);
  Message.Result := 1;
end;

procedure TecCustomPreview.KeyDown(var Key: Word; Shift: TShiftState);
var dx: integer;
begin
  inherited;
  dx := 10;
  if ssCtrl in Shift then dx := 50;
  case Key of
    VK_PRIOR: Page := Page - 1;
    VK_NEXT: Page := Page + 1;
    VK_END: Page := PageCount;
    VK_HOME: Page := 1;
    VK_LEFT:  ScrollOffset := Point(ScrollOffset.X - dx, ScrollOffset.Y);
    VK_RIGHT: ScrollOffset := Point(ScrollOffset.X + dx, ScrollOffset.Y);
    VK_UP:    ScrollOffset := Point(ScrollOffset.X, ScrollOffset.Y - dx);
    VK_DOWN:  ScrollOffset := Point(ScrollOffset.X, ScrollOffset.Y + dx);
  end;
end;

procedure TecCustomPreview.UpdatePreview;
begin
  if FSyntPrinter <> nil then
   begin
     FSyntPrinter.UpdatePages;
     UpdateZoom;
   end;
end;

procedure TecCustomPreview.WMSize(var Message: TWMSize);
begin
  inherited;
  UpdateZoom;
end;

procedure TecCustomPreview.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  Message.Result := DLGC_WANTALLKEYS or DLGC_WANTARROWS;
end;

{ TecSyntPrinter }

constructor TecSyntPrinter.Create(AOwner: TComponent);
begin
  inherited;
  FOptions := [mpWordWrap, mpBlockHighlight, mpBackColor];
  FPageLines := TObjectList.Create;
  FLineHeights := TObjectList.Create;
  FLinNumdersFont := TFont.Create;
  FLinNumdersFont.Name := 'Courier New';
  FLinNumdersFont.Size := 8;
  FFirstPageNumber := 1;
end;

destructor TecSyntPrinter.Destroy;
begin
  FPageLines.Free;
  FLineHeights.Free;
  FLinNumdersFont.Free;
  inherited;
end;

function TecSyntPrinter.GetPageCount: integer;
begin
  UpdatePages;
  Result := FPageLines.Count;
end;

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

procedure TecSyntPrinter.SetOptions(const Value: TSyntMemoPrintOptions);
begin
  FOptions := Value;
  Changed;
end;

procedure TecSyntPrinter.SetSyntMemo(const Value: TCustomSyntaxMemo);
begin
  if FSyntMemo <> Value then
    begin
      if Assigned(FSyntMemo) then
        FSyntMemo.RemoveClient(Self);
      FSyntMemo := Value;
      if Assigned(FSyntMemo) then
        FSyntMemo.AddClient(Self);
     Changed;
   end;
end;

procedure TecSyntPrinter.CanvasChanging(Sender: TObject);
var FontSize: integer;
begin
  if PrnInfo.Inch.X{Y} <> PrnCanvas.Font.PixelsPerInch then
  begin
    FontSize := PrnCanvas.Font.Size;
    PrnCanvas.Font.PixelsPerInch := PrnInfo.Inch.X{Y};
    PrnCanvas.Font.Size := FontSize;
  end;
end;

type
  TPageBreak = class
    Line: integer;
    SubLine: integer;
  public
    constructor Create(ALine, ASubLine: integer);
  end;

constructor TPageBreak.Create(ALine, ASubLine: integer);
begin
  inherited Create;
  Line := ALine;
  SubLine := ASubLine;
end;

procedure TecSyntPrinter.DoUpdatePages;
var i, j, Y, Hgt, sPos, ePos: integer;
    R, PrintRect: TRect;
    LogCanvas: Boolean;
    NewPage: Boolean;
    Info: TLineInfo;
begin
  inherited;
  FPageLines.Clear;

  PrnCanvas := TCanvas.Create;
  LogCanvas := Printer.Printers.Count = 0;
  if LogCanvas then
    PrnCanvas.Handle := GetDC(0)
  else
    PrnCanvas.Handle := Printer.Handle;
  PrnCanvas.OnChanging := CanvasChanging;

  StartWait;
  try
  if Assigned(FSyntMemo) then
   begin
     PrintRect := GetPrintRect;
     R := GetContentRect(PrnCanvas, 1);

     FLineHeights.Clear;
     FLineHeights.Count := FSyntMemo.Lines.Count;
     FPageLines.Add(TPageBreak.Create(0, 0));
     Y := R.Top;
     FSyntMemo.PrintOptions := FOptions;
     for i := 0 to FSyntMemo.Lines.Count - 1 do
      begin
       if (mpHideCollapsed in FOptions) and not FSyntMemo.Collapsed.IsLineVisible(i) then
         Continue;
       if not GetPrintedPart(i, sPos, ePos) then Continue;

       Info := TLineInfo.Create;
       PrnCanvas.Font.PixelsPerInch := PrnInfo.Inch.X;
       FSyntMemo.ProcessLine(PrnCanvas, Info, i, ptLineHeight, R, Point(0, 0), sPos, ePos);
       if Info.FHidden then
        begin
          Info.Free;
          Continue;
        end;
       FLineHeights[i] := Info;

       if Assigned(FOnForceNewPage) then
         begin // Manually force new page
          NewPage := False;
          FOnForceNewPage(Self, R, i, Info.Height, Y, NewPage);
          if NewPage then
           begin
            Y := R.Top + Info.Height;
            FPageLines.Add(TPageBreak.Create(i, 0));
            if (FPageLines.Count = 1) and not FirstPageHeadline then
              R := GetContentRect(PrnCanvas, 2);
            Continue;
           end;
         end;

       for j := 0 to Info.LineCount - 1 do
        begin
         Hgt := Info.Heights[j];
         if Y + Hgt > R.Bottom then
          begin
            R := GetContentRect(PrnCanvas, FPageLines.Count + 1);
            Y := R.Top + Hgt;
            FPageLines.Add(TPageBreak.Create(i, j));
            if (FPageLines.Count = 1) and not FirstPageHeadline then
              R := GetContentRect(PrnCanvas, 2);
          end
         else
          Inc(Y, Hgt);
        end;
      end;
   end;
  finally
   StopWait;
   if LogCanvas then
     ReleaseDC(0, PrnCanvas.Handle);
   PrnCanvas.Free;
  end;
end;

procedure TecSyntPrinter.PrintPageRect(Canvas: TCanvas; Page: integer;
  const PrintRect, Fields: TRect);
var i, Y, j, Bottom, FirstLine, LastLine, SubLine, LastSubLine, sPos, ePos: integer;
    Info: TLineInfo;
    R: TRect;
    DC: HDC;
    LeftRightFld, ShowFields: Boolean;
begin
  if FSyntMemo = nil then Exit;

  DC := Canvas.Handle;

  if Assigned(FSyntMemo.SyntObj) and (mpBlockStaples in FOptions) then
    FSyntMemo.SyntObj.ResetStaples;
  FSyntMemo.PrintOptions := FOptions;
  ShowFields := (Page <> 1) or FFirstPageHeadline;
  LeftRightFld := ((Fields.Left > 0) or (Fields.Right > 0)) and ShowFields;
  if not ShowFields then R := PrintRect else
  with PrintRect do
    R := Rect(Left + Fields.Left, Top, Right - Fields.Right, Bottom);

  Y := PrintRect.Top;
  FirstLine := TPageBreak(FPageLines[Page - 1]).Line;
  SubLine := TPageBreak(FPageLines[Page - 1]).SubLine;
  if Page >= FPageLines.Count then
    LastLine := FSyntMemo.Lines.Count - 1
  else if TPageBreak(FPageLines[Page]).SubLine = 0 then
    LastLine := TPageBreak(FPageLines[Page]).Line - 1
  else
    LastLine := TPageBreak(FPageLines[Page]).Line;

  for i := FirstLine to LastLine do
    begin
      if FLineHeights[i] = nil then Continue;
      Info := TLineInfo(FLineHeights[i]);
      if (i = LastLine) and (Page < FPageLines.Count) and
         (TPageBreak(FPageLines[Page]).SubLine > 0) then
        LastSubLine := TPageBreak(FPageLines[Page]).SubLine - 1
      else
        LastSubLine := Info.LineCount - 1;

      Bottom := Y;
      for j := SubLine to LastSubLine do
        Inc(Bottom, Info.Heights[j]);
//      if Y < Clip.Bottom then
       begin
        if LeftRightFld then
         begin
          FCurLine := i;
          if Fields.Left > 0 then
           begin
            SelectClipRgn(DC, 0);
            PrintField(Canvas, Rect(PrintRect.Left, Y, R.Left, Bottom), psLineLeft, Page);
           end;
          if Fields.Right > 0 then
           begin
            SelectClipRgn(DC, 0);
            PrintField(Canvas, Rect(R.Right, Y, PrintRect.Right, Bottom), psLineRight, Page);
           end;
         end;
        SelectClipRgn(DC, 0);
        IntersectClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
        GetPrintedPart(i, sPos, ePos);
        Canvas.Font.PixelsPerInch := PrnInfo.Inch.X;
        FSyntMemo.ProcessLine(Canvas, Info, i, ptDrawing, Rect(R.Left, Y, R.Right, Bottom), Point(SubLine, LastSubLine), sPos, ePos);
        Y := Bottom;
        SubLine := 0;
       end;
    end;
  SelectClipRgn(DC, 0);
  Canvas.Brush.Style := bsClear;
  FLastY := Y;

  if Assigned(FSyntMemo.SyntObj) and (mpBlockStaples in FOptions) then
    FSyntMemo.SyntObj.ResetStaples;
end;

function TecSyntPrinter.GetFields(Canvas: TCanvas; Page: integer): TRect;
var w: integer;
begin
  Result := inherited GetFields(Canvas, Page);
  if LineNumbersPos <> lnpNone then
    begin
      Canvas.Font := FLinNumdersFont;
      if Assigned(Canvas.OnChanging) then
         Canvas.OnChanging(Canvas);
      w := Canvas.TextWidth('000000');
      if (LineNumbersPos = lnpLeft) or
         (LineNumbersPos = lnpOddLeft) and ((Page and 1) <> 0) or
         (LineNumbersPos = lnpOddRight) and ((Page and 1) = 0) then
        Result.Left := w
      else
        Result.Right := w;
    end;
end;

procedure TecSyntPrinter.PrintField(Canvas: TCanvas; R: TRect;
  Side: TecPrintSide; Page: integer);
var s: ecString;
    ts: TSize;
    isLeft: Boolean;
begin
  inherited;
  // Line numbers
  if (LineNumbersPos <> lnpNone) and (Side in [psLineLeft, psLineRight]) then
   begin
     isLeft := (LineNumbersPos = lnpLeft) or
               (LineNumbersPos = lnpOddLeft) and ((Page and 1) <> 0) or
               (LineNumbersPos = lnpOddRight) and ((Page and 1) = 0);
     if isLeft <> (Side = psLineLeft) then Exit;
     Canvas.Font := FLinNumdersFont;
     s := IntToStr(FCurLine + 1);
     ts := Canvas.TextExtent(s);
     if isLeft then
       Canvas.TextOut(R.Left, (R.Bottom + R.Top - ts.cy) div 2, s)
     else
       Canvas.TextOut(R.Right - ts.cx, (R.Bottom + R.Top - ts.cy) div 2, s);
   end;
end;

procedure TecSyntPrinter.Assign(Source: TPersistent);
var src: TecSyntPrinter;
begin
  inherited;
  if Source is TecSyntPrinter then
   begin
    src := Source as TecSyntPrinter;
    FOptions := src.FOptions;
    FColorMode := src.ColorMode;
    FLinNumdersFont.Assign(src.FLinNumdersFont);
    FLineNumbersPos := src.FLineNumbersPos;
    FPrintSelection := src.PrintSelection;
   end;
end;

procedure TecSyntPrinter.SetLinNumdersFont(const Value: TFont);
begin
  FLinNumdersFont.Assign(Value);
  Changed;
end;

procedure TecSyntPrinter.SetLineNumbersPos(const Value: TLineNumbersPos);
begin
  FLineNumbersPos := Value;
  Changed;
end;

function TecSyntPrinter.GetPageSetupDlgClass: TComponentClass;
begin
  Result := TPageSetupEditorDlg;
end;

procedure TecSyntPrinter.SetPrintEndPos(const Value: integer);
begin
  if FPrintEndPos <> Value then
    begin
      FPrintEndPos := Value;
      Changed;
    end;
end;

procedure TecSyntPrinter.SetPrintStartPos(const Value: integer);
begin
  if FPrintStartPos <> Value then
    begin
      FPrintStartPos := Value;
      Changed;
    end;
end;

procedure TecSyntPrinter.SetPrintSelection(const Value: Boolean);
begin
  if FPrintSelection <> Value then
    begin
      FPrintSelection := Value;
      Changed;
    end;
end;

function TecSyntPrinter.GetPrintedPart(Line: integer; var sPos,
  ePos: integer): Boolean;
  function DoIntersect(selStart, selEnd: integer): Boolean;
  var ls, ll: integer;
  begin
     ls := SyntMemo.Lines.LineIndex(Line) - 1;
     ll := SyntMemo.Lines.LineLength(Line);
     Result := (ls + ll  >= SelStart) and (ls < selEnd);
     if Result then
       begin
         if SelStart > ls then
           sPos := SelStart - ls;
         if selEnd < ls + ll then
           ePos := selEnd - ls;
       end;
  end;
begin
  sPos := 0;
  ePos := 0;
  Result := True;
  with SyntMemo do
    if PrintSelection then
      begin
       if SelectMode = msColumn then
         begin
           Result := (Line <= SelRect.Bottom) and (Line >= SelRect.Top);
           if Result then
             begin
               sPos := LogToLinesPos(Point(SelRect.Left, Line)).X;
               ePos := LogToLinesPos(Point(SelRect.Right, Line)).X;
             end;
         end else
           Result := DoIntersect(SelStart, SelStart + SelLength);
      end else
    if (FPrintStartPos > 0) or (FPrintEndPos > 0) then
      Result := DoIntersect(FPrintStartPos, IfThen(FPrintStartPos <= FPrintEndPos, FPrintEndPos, Lines.TextLength));
end;

{ TecFormPrinter }

constructor TecFormPrinter.Create(AOwner: TComponent);
begin
  inherited;
  FPrintScale := poProportional;
end;

destructor TecFormPrinter.Destroy;
begin
  inherited;
end;

procedure TecFormPrinter.Assign(Source: TPersistent);
begin
  inherited;
  if Source is TecFormPrinter then
    FPrintScale := TecFormPrinter(Source).PrintScale;
end;

function TecFormPrinter.GetPageCount: integer;
begin
  Result := 1;
end;

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

procedure TecFormPrinter.PrintPageRect(Canvas: TCanvas; Page: integer;
  const PrintRect, Fields: TRect);
var
  FormImage: TBitmap;
{$IFNDEF EC_DOTNET}
  Info: PBitmapInfo;
  InfoSize: DWORD;
  Image: Pointer;
  ImageSize: DWORD;
  Bits: HBITMAP;
{$ENDIF}
  DIBWidth, DIBHeight: Longint;
  PrintWidth, PrintHeight: Longint;
  PageRect: TRect;
begin
  if FForm = nil then Exit;
  with PrintRect do IntersectClipRect(Canvas.Handle, Left, Top, Right, Bottom);

  SetWindowOrgEx(Canvas.Handle, -PrintRect.Left, -PrintRect.Top, nil);
  PageRect.Right := PrintRect.Right - PrintRect.Left;
  PageRect.Bottom := PrintRect.Bottom - PrintRect.Top;
  PageRect.Left := 0;
  PageRect.Top := 0;

  FormImage := FForm.GetFormImage;
  FormImage.Monochrome := ColorMode <> cmRGB;
  Canvas.Lock;
  try
    { Paint bitmap to the printer }
    begin
{$IFNDEF EC_DOTNET}
      Bits := FormImage.Handle;
      GetDIBSizes(Bits, InfoSize, ImageSize);
      Info := AllocMem(InfoSize);
      try
        Image := AllocMem(ImageSize);
        try
          GetDIB(Bits, 0, Info^, Image^);
          with Info^.bmiHeader do
          begin
            DIBWidth := biWidth;
            DIBHeight := biHeight;
          end;
{$ELSE}
          DIBWidth := FormImage.Width;
          DIBHeight := FormImage.Height;
{$ENDIF}
          case FPrintScale of
            poProportional:
              begin
                PrintWidth := MulDiv(DIBWidth,  PrnInfo.Inch.X, FForm.PixelsPerInch);
                PrintHeight := MulDiv(DIBHeight, PrnInfo.Inch.Y, FForm.PixelsPerInch);
              end;
            poPrintToFit:
              begin
                PrintWidth := MulDiv(DIBWidth, {PrnInfo.PrintSize.Y}PageRect.Bottom, DIBHeight);
                if PrintWidth < {PrnInfo.PrintSize.X}PageRect.Right then
                  PrintHeight := {PrnInfo.PrintSize.Y}PageRect.Bottom
                else
                begin
                  PrintWidth := {PrnInfo.PrintSize.X}PageRect.Right;
                  PrintHeight := MulDiv(DIBHeight, {PrnInfo.PrintSize.X}PageRect.Right, DIBWidth);
                end;
              end;
          else
            PrintWidth := DIBWidth;
            PrintHeight := DIBHeight;
          end;
{$IFDEF EC_DOTNET}
          Canvas.StretchDraw(Rect(0, 0, PrintWidth, PrintHeight), FormImage);
{$ELSE}
          StretchDIBits(Canvas.Handle, 0, 0, PrintWidth, PrintHeight, 0, 0,
            DIBWidth, DIBHeight, Image, Info^, DIB_RGB_COLORS, SRCCOPY);
        finally
          FreeMem(Image, ImageSize);
        end;
      finally
        FreeMem(Info, InfoSize);
      end;
{$ENDIF}
    end;
  finally
    Canvas.Unlock;
    FormImage.Free;
  end;
end;

procedure TecFormPrinter.SetForm(const Value: TForm);
begin
  if FForm = Value then Exit;
  FForm := Value;
  if FForm <> nil then
    FForm.FreeNotification(Self);
end;

procedure TecFormPrinter.DoUpdatePages;
begin
  inherited;

end;

function TecFormPrinter.GetPageSetupDlgClass: TComponentClass;
begin
  Result := TPageSetupFormDlg;
end;

end.
