传真(Fax)编程

开发平台：
Delphi

faxfield.pas：源码内容
							unit FaxField;
{$I AWDEFINE.INC}
interface
uses
  {$IFDEF Win32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  Messages, Classes, Graphics, Controls, Forms, StdCtrls, ExtCtrls,
  {$IFDEF DELPHI3} ExtDlgs, {$ENDIF}
  Dialogs, Ruler,jpeg,menus;
type
  {Records used for saving cover page to a disk file}
  TUserDataArray = array[0..1023] of Byte;
  TPageRecord = packed record
    prVersionNum       : string[11];
    prPageWidthPixels  : LongInt;
    prPageHeightPixels : LongInt;
    prPageWidthInches  : Double;
    prPageHeightInches : Double;
    prIsMetric         : Boolean;
    {Extra field for storing miscellaneous additional data}
    prUserData         : TUserDataArray;
  end;
  TFieldRecord = packed record
    frLeftInches   : Double;
    frTopInches    : Double;
    frWidthInches  : Double;
    frHeightInches : Double;
  end;
  TFontRecord = packed record
    frCharSet       : Byte;
    frColor         : LongInt;
    frHeight        : LongInt;
    frName          : string[255];
    frPitch         : Byte;
    frSize          : LongInt;
    frFontBold      : Boolean;
    frFontItalic    : Boolean;
    frFontUnderline : Boolean;
    frFontStrikeout : Boolean;
  end;
  TStretchModes = (smNone, smDrag, smE, smW, smS, smN, smNE, smSW, smSE, smNW);
  TStretchHandle = class(TPaintBox)
  private
    FHandlePosition : TStretchModes;
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner : TComponent); override;
    property HandlePosition : TStretchModes
      read FHandlePosition write FHandlePosition;
  end;
  TStretchHandleArray = array[0..7] of TStretchHandle;
  TBaseField = class(TShape)
  private
    FSelected        : Boolean;
    FStretchMode     : TStretchModes;
    bfStretchHandles : TStretchHandleArray;
  protected
    procedure bfMouseDown(Sender: TObject; Button: TMouseButton;
                          Shift: TShiftState; X, Y: Integer);
    procedure bfMouseUp(Sender: TObject; Button: TMouseButton;
                        Shift: TShiftState; X, Y: Integer);
    procedure bfMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure SetParent(AParent: TWinControl); override;
    procedure SetSelected(IsSelected : Boolean);
    function GetStretchHandleCoords(WhichHandle : TStretchModes) : TPoint;
      {-Returns the coordinates (Left, Top) where the StretchHandle should be drawn}
    procedure Write(Stream : TStream); virtual;
      {-Writes all necessary TBaseField properties out to Stream}
    procedure Read(Stream : TStream); virtual;
      {-Reads BaseField properties from Stream and assigns those properties to Self}
    procedure Draw(ACanvas : TCanvas); virtual; abstract;
      {-Draws Self on ACanvas}
  public
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    constructor Create(AOwner: TComponent); override;
    property Selected : Boolean read FSelected write SetSelected;
    property StretchMode : TStretchModes read FStretchMode write FStretchMode;
  end;
  TTextField = class(TBaseField)
  protected
    FMemo : TMemo;
    FPopupMenu:TPopupMenu;
    procedure SetParent(AParent: TWinControl); override;
    function GetTextHeight : Integer;
      {-Returns the height of one row of text, including external leading, given the
        current font assigned to the field}
    function GetText : string;
    procedure Write(Stream : TStream); override;
      {-Writes all necessary properties out to Stream}
    procedure Read(Stream : TStream); override;
      {-Reads properties from Stream and assigns those properties to Self}
    procedure Draw(ACanvas : TCanvas); override;
      {-Draws Self on ACanvas}
    procedure tfEnter(Sender : TObject);
    procedure tfExit(Sender : TObject);
  public
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    constructor Create(AOwner: TComponent); override;
    procedure MemoDblClick(Sender: TObject);
    procedure OnLoadFromFile(Sender: TObject);
    procedure SetFocus;
    property Text : string read GetText;
  end;
  TImageField = class(TBaseField)
  protected
    FImage : TImage;
    procedure SetParent(AParent: TWinControl); override;
    function GetPicture : TPicture;
    procedure Write(Stream : TStream); override;
      {-Writes all necessary properties out to Stream}
    procedure Read(Stream : TStream); override;
      {-Reads properties from Stream and assigns those properties to Self}
    procedure Draw(ACanvas : TCanvas); override;
      {-Draws Self on ACanvas}
  public
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    constructor Create(AOwner: TComponent); override;
    procedure ImageDblClick(Sender: TObject);
    property Picture : TPicture read GetPicture;
  end;
  TSelectionChangeEvent = procedure(IsFieldSelected : Boolean) of object;
  TPositionChangeEvent = procedure(Left, Top, Width, Height : Integer) of object;
  TFaxPanel = class(TPanel)
  private
    FShowGrid               : Boolean;
    FSnapToGrid             : Boolean;
    FGridSpacingX           : Integer;
    FGridSpacingY           : Integer;
    FPageWidthInches        : Double;
    FPageHeightInches       : Double;
    FEditMode               : Boolean; {Are we in Edit Mode or Design Mode}
    FStretchMode            : TStretchModes;
    FOnFieldSelectionChange : TSelectionChangeEvent;
    FOnFieldPositionChange  : TPositionChangeEvent;
    FNeedsSaving            : Boolean;
    FPageCount              : Integer;
    FPageNumber             : Integer;
    FSender                 : string;
    FRecipient              : string;
    FPageTitle              : string;
    FStationID              : string;
    fpDragging              : Boolean;
    fpMaxGridLine           : TPoint;
    fpHorzPixelsPerInch     : Double;
    fpVertPixelsPerInch     : Double;
    fpMouseAnchor           : TPoint;
    fpIsMouseDown           : Boolean;
    fpFieldList             : TList;
    function GetFieldCount : Integer;
    function GetField(Index : Integer) : TBaseField;
    function GetSelectedField : TBaseField;
    procedure SetEditMode(Value : Boolean);
    procedure SetPageWidthInches(AWidth : Double);
    procedure SetPageHeightInches(AHeight : Double);
    procedure SetShowGrid(AShowGrid : Boolean);
    procedure SetSnapToGrid(ASnapToGrid : Boolean);
    procedure SetGridSpacingX(GridSpacing : Integer);
    procedure SetGridSpacingY(GridSpacing : Integer);
    procedure AdjustLeftToGrid(var ALeft : Integer);
      {-If SnapToGrid is True, adjusts ALeft to be on the nearest grid line}
    procedure AdjustTopToGrid(var ATop : Integer);
      {-If SnapToGrid is True, adjusts ATop to be on the nearest grid line}
    procedure AdjustWidthToGrid(ALeft : Integer; var AWidth : Integer);
      {-If SnapToGrid is True, adjusts AWidth to be on the nearest grid line.
        Caller should ensure that ALeft is already on a grid line, possibly by
        calling AdjustLeftToGrid.}
    procedure AdjustHeightToGrid(ATop : Integer; var AHeight : Integer);
      {-If SnapToGrid is True, adjusts AHeight to be on the nearest grid line.
        Caller should ensure that ATop is already on a grid line, possibly by
        calling AdjustTopToGrid.}
    function GetDrawAdjustFactor : Double;
    function GetDrawWidth : Integer;
      {-Returns the width that the TCanvas passed to the Draw method should be}
    function GetDrawHeight : Integer;
      {-Returns the height that the TCanvas passed to the Draw method should be}
    procedure SetStretchMode(NewStretchMode : TStretchModes);
    procedure DeselectAllFields;
    procedure DeleteAllFields;
    procedure AddField(Field : TBaseField);
  protected
    procedure Paint; override;
    procedure fpResize(Sender : TObject);
    procedure fpMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure fpMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure fpMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FieldSelectionChange(IsFieldSelected : Boolean);
      {-Calls OnFieldSelectionChange event handler when a field becomes
        deselected or when a new field becomes selected}
    procedure FieldPositionChange(ALeft, ATop, AWidth, AHeight : Integer);
      {-Calls OnFieldPositionChange event handler when the location or size of
        the currently-selected field changes}
    procedure FieldChange(Sender : TObject);
    property Canvas;
    property StretchMode : TStretchModes read FStretchMode write SetStretchMode;
    property PageWidthInches : Double read FPageWidthInches write SetPageWidthInches;
    property PageHeightInches : Double read FPageHeightInches write SetPageHeightInches;
    property DrawAdjustFactor : Double read GetDrawAdjustFactor;
  public
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    function HorzPixelsToInches(P : Integer) : Double;
      {-Returns the value of P converted to inches given the current values of
        Width and PageWidthInches}
    function VertPixelsToInches(P : Integer) : Double;
      {-Returns the value of P converted to inches given the current values of
        Height and PageHeightInches}
    function HorzInchesToPixels(Inches : Double) : Integer;
      {-Returns the value of Inches converted to pixels given the current values
        of Width and PageWidthInches}
    function VertInchesToPixels(Inches : Double) : Integer;
      {-Returns the value of Inches converted to pixels given the current values
        of Height and PageHeightInches}
    procedure SizeMove(Sender : TObject; Key : Word; Shift : TShiftState);
      {-move/size the field}
    function AddTextField : TTextField;
    function AddImageField : TImageField;
    procedure DeleteSelectedField;
      {-Deletes currently selected field}
    procedure CenterSelectedField(IsHorizontal : Boolean);
      {-Centers the currently-selected field within the panel. IsHorizontal
        specifies whether the field will be centered vertically or horizontally.}
    function SelectedFieldsExist : Boolean;
      {-Returns True if the panel contains at least one selected field}
    procedure FieldPositionChangeForSelectedField;
      {-If a selected field exists, calls FieldPositionChange with that field's
        coordinates}
    procedure Write(Stream : TStream);
      {-Writes all defining information out to Stream}
    procedure Read(Stream : TStream);
      {-Reads Stream and loads its properties into Self}
    procedure Draw(ACanvas : TCanvas);
      {-Draws an image of Self, including all fields, on ACanvas}
    property ShowGrid : Boolean read FShowGrid write SetShowGrid;
    property SnapToGrid : Boolean read FSnapToGrid write SetSnapToGrid;
    property GridSpacingX : Integer read FGridSpacingX write SetGridSpacingX;
    property GridSpacingY : Integer read FGridSpacingY write SetGridSpacingY;
    property EditMode : Boolean
      read FEditMode
      write SetEditMode;
    property NeedsSaving : Boolean read FNeedsSaving write FNeedsSaving;
    property OnFieldSelectionChange : TSelectionChangeEvent
      read FOnFieldSelectionChange write FOnFieldSelectionChange;
    property OnFieldPositionChange : TPositionChangeEvent
      read FOnFieldPositionChange write FOnFieldPositionChange;
    {When creating a bitmap for use in creating an APF file, the bitmap's width
     should be set to TFaxPanel.DrawWidth, and the bitmap's height should be
     set to TFaxPanel.DrawHeight.}
    property DrawWidth : Integer read GetDrawWidth;
      {-Returns the width that the TCanvas passed to the Draw method should be}
    property DrawHeight : Integer read GetDrawHeight;
      {-Returns the height that the TCanvas passed to the Draw method should be}
    property FieldCount : Integer
      read GetFieldCount;
    property Field[Index : Integer] : TBaseField
      read GetField;
    property SelectedField : TBaseField
      read GetSelectedField;
    {These properties are the values that are substituted for replacement tags
     when the cover page is saved as an APF file}
    property PageCount : Integer read FPageCount write FPageCount;
      {-Value substituted for $N replacement tag}
    property PageNumber : Integer read FPageNumber write FPageNumber;
      {-Value substituted for $P replacement tag}
    property Sender : string read FSender write FSender;
      {-Value substituted for $F replacement tag}
    property Recipient : string read FRecipient write FRecipient;
      {-Value substituted for $R replacement tag}
    property PageTitle : string read FPageTitle write FPageTitle;
      {-Value substituted for $S replacement tag}
    property StationID : string read FStationID write FStationID;
      {-Value substituted for $I replacement tag}
  end;
  TFaxScrollBox = class(TScrollBox)
  private
    FOnHorzScroll : TScrollEvent;
    FOnVertScroll : TScrollEvent;
    procedure WMHScroll(var Message : TWMHScroll); message WM_HSCROLL;
    procedure WMVScroll(var Message : TWMVScroll); message WM_VSCROLL;
  public
    property OnHorzScroll : TScrollEvent read FOnHorzScroll write FOnHorzScroll;
    property OnVertScroll : TScrollEvent read FOnVertScroll write FOnVertScroll;
  end;
  TFaxDesigner = class(TPanel)
  private
    FFaxPanel   : TFaxPanel;
    FIsNew      : Boolean;
    FIsMetric   : Boolean;
    FUserData   : TUserDataArray;
    fdHorzRuler : TRuler;
    fdVertRuler : TRuler;
    fdScrollBox : TFaxScrollBox;
    procedure HorzScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
    procedure VertScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
    function GetPageWidthPixels : Integer;
    procedure SetPageWidthPixels(AWidth : Integer);
    function GetPageHeightPixels : Integer;
    procedure SetPageHeightPixels(AHeight : Integer);
    function GetPageWidthInches : Double;
    procedure SetPageWidthInches(AWidth : Double);
    function GetPageHeightInches : Double;
    procedure SetPageHeightInches(AHeight : Double);
    procedure SetIsMetric(AIsMetric : Boolean);
    procedure SetMarkPositions(ALeft, ATop, AWidth, AHeight : Integer);
      {-Sets the position of the red position marks on the Ruler bars. To
        suppress drawing of the marks, set to a negative value.}
  protected
    procedure SetParent(AParent: TWinControl); override;
  public
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    constructor Create(AOwner : TComponent); override;
    procedure Write(Stream : TStream);
      {-Writes all defining information out to Stream}
    procedure Read(Stream : TStream);
      {-Reads Stream and loads its properties into Self}
    property FaxPanel : TFaxPanel read FFaxPanel;
    property PageWidthPixels  : Integer read GetPageWidthPixels write SetPageWidthPixels;
    property PageHeightPixels : Integer read GetPageHeightPixels write SetPageHeightPixels;
    property PageWidthInches  : Double read GetPageWidthInches write SetPageWidthInches;
    property PageHeightInches : Double read GetPageHeightInches write SetPageHeightInches;
    property IsMetric : Boolean read FIsMetric write SetIsMetric;
    property UserData : TUserDataArray read FUserData write FUserData;
      {-Misc data field. Gets written to and read from the Stream when Write or
        Read are called}
    property IsNew : Boolean read FIsNew write FIsNew;
      {-Returns True if this is a new cover page that hasn't been given a real
        name yet. Returns False if this cover page was read in using the Read
        method or if it was written out using the Write method.}
  end;
implementation
uses SysUtils;
const
  ctVersionNum   = '1.00';
  ftTextField    = 0;
  ftImageField   = 1;
  ctGridStart    = 1;
  ctGridSpacingX = 20;
  ctGridSpacingY = 20;
  ctDefaultWidthPixels  = 600;
  ctDefaultHeightPixels = 776;
  ctDefaultWidthInches  = 8.5;
  ctDefaultHeightInches = 11.0;
  ctStretchHandleSize   = 5; {Stretch handles are 5 x 5 pixels}
procedure Constrain(var X : Integer; MinVal, MaxVal : Integer);
  {-Forces an integer between two values}
begin
  if X > MaxVal then
    X := MaxVal
  else if X < MinVal then
    X := MinVal;
end;  { Constrain }
procedure ConvertCoords(Source, Target : TControl; var X, Y : Integer);
  {-Converts Source coordinates X, Y to Target coordinates}
var
  P : TPoint;
begin
  P.X := X;
  P.Y := Y;
  P   := Target.ScreenToClient(Source.ClientToScreen(P));
  X   := P.X;
  Y   := P.Y;
end;
{*** TStretchHandle *}
constructor TStretchHandle.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Canvas.Brush.Color := clBlack;
  Canvas.Brush.Style := bsSolid;
  SetBounds(Top, Left, ctStretchHandleSize, ctStretchHandleSize);
end;
procedure TStretchHandle.Paint;
begin
  Canvas.FillRect(Rect(0, 0, Width, Height));
end;
{------------------------------ TBaseField ---------------------------------}
constructor TBaseField.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Brush.Color := clWindow;
  Brush.Style := bsClear;
  DragCursor  := crCross;
  DragMode    := dmManual;
  Pen.Mode    := pmCopy;
  Pen.Style   := psDashDot;
  Pen.Color   := clBlack;
  Pen.Width   := 1;
  Shape       := stRectangle;
  Visible     := False; {Caller must make visible after setting size and position}
  SetSelected(False);
end;
procedure TBaseField.bfMouseDown(Sender: TObject; Button: TMouseButton;
                                 Shift: TShiftState; X, Y: Integer);
begin
  if Parent is TPanel then begin
    {If Sender is one of the StretchHandles, convert its coordinates to our own}
    if Sender is TStretchHandle then
      ConvertCoords(Sender as TStretchHandle, Self, X, Y);
    (Parent as TPanel).OnMouseDown(Self, Button, Shift, X, Y);
  end;
end;
procedure TBaseField.bfMouseUp(Sender: TObject; Button: TMouseButton;
                               Shift: TShiftState; X, Y: Integer);
begin
  if Parent is TPanel then begin
    {If Sender is one of the StretchHandles, convert its coordinates to our own}
    if Sender is TStretchHandle then
      ConvertCoords(Sender as TStretchHandle, Self, X, Y);
    (Parent as TPanel).OnMouseUp(Self, Button, Shift, X, Y);
  end;
end;
procedure TBaseField.bfMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if Parent is TPanel then begin
    {If Sender is one of the StretchHandles, convert its coordinates to our own}
    if Sender is TStretchHandle then begin
      ConvertCoords(Sender as TStretchHandle, Self, X, Y);
      if not (ssLeft in Shift) then
        StretchMode := (Sender as TStretchHandle).HandlePosition;
    end else
      StretchMode := smDrag;
    (Parent as TPanel).OnMouseMove(Self, Shift, X, Y);
  end;
end;
procedure TBaseField.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  I : Integer;
  P : TPoint;
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  {Move all StretchHandles to the proper positions}
  for I := Low(bfStretchHandles) to High(bfStretchHandles) do
    if Assigned(bfStretchHandles[I]) then
      with bfStretchHandles[I] do begin
        P := GetStretchHandleCoords(HandlePosition);
        SetBounds(P.X, P.Y, Width, Height);
      end;
end;
procedure TBaseField.SetParent(AParent: TWinControl);
  function CreateStretchHandle(WhichHandle : TStretchModes) : TStretchHandle;
  var
    P : TPoint;
  begin
    P := GetStretchHandleCoords(WhichHandle);
    Result := TStretchHandle.Create(Self);
    with Result do begin
      HandlePosition := WhichHandle;
      Parent         := AParent;
      Visible        := Selected;
      OnMouseDown    := bfMouseDown;
      OnMouseUp      := bfMouseUp;
      OnMouseMove    := bfMouseMove;
      SetBounds(P.X, P.Y, Width, Height);
    end;
  end;
const
  ctStretchHandleCorners :
    array[Low(TStretchHandleArray)..High(TStretchHandleArray)] of TStretchModes =
      (smNW, smN, smNE, smE, smSE, smS, smSW, smW);
var
  I : Integer;
begin
  if AParent <> Parent then begin
    inherited SetParent(AParent);
    if Assigned(AParent) then begin
      OnMouseDown := (AParent as TPanel).OnMouseDown;
      OnMouseUp   := (AParent as TPanel).OnMouseUp;
      OnMouseMove := (AParent as TPanel).OnMouseMove;
      {If StretchHandles already exist, destroy them}
      for I := Low(bfStretchHandles) to High(bfStretchHandles) do
        if Assigned(bfStretchHandles[I]) then begin
          bfStretchHandles[I].Free;
          bfStretchHandles[I] := nil;
        end;
      {Create new StretchHandles}
      for I := Low(bfStretchHandles) to High(bfStretchHandles) do
        bfStretchHandles[I] := CreateStretchHandle(ctStretchHandleCorners[I]);
    end else begin
      OnMouseDown := nil;
      OnMouseUp   := nil;
      OnMouseMove := nil;
    end;
  end;
end;
procedure TBaseField.SetSelected(IsSelected : Boolean);
var
  I : Integer;
begin
  if IsSelected <> FSelected then begin
    FSelected := IsSelected;
    for I := Low(bfStretchHandles) to High(bfStretchHandles) do
      with bfStretchHandles[I] do begin
        Visible := FSelected;
        {BringToFront to ensure that if this is a TImageField, StretchHandle
         isn't partially hidden behind the image}
        if FSelected then
          BringToFront;
      end;
    Refresh;
  end;
end;
function TBaseField.GetStretchHandleCoords(WhichHandle : TStretchModes) : TPoint;
  {-Returns the coordinates (Left, Top) where the StretchHandle should be drawn}
var
  Offset : Integer;
begin
  with Result do
    case WhichHandle of
      smNW : begin
               Offset := ctStretchHandleSize div 2;
               X      := Left - Offset;
               Y      := Top - Offset;
             end;
      smN  : begin
               Offset := ctStretchHandleSize div 2;
               X      := Left + (Width div 2) - Offset;
               Y      := Top - Offset;
             end;
      smNE : begin
               Offset := (ctStretchHandleSize + 1) div 2;
               X      := Left + Width - Offset;
               Offset := ctStretchHandleSize div 2;
               Y      := Top - Offset;
             end;
      smE  : begin
               Offset := (ctStretchHandleSize + 1) div 2;
               X      := Left + Width - Offset;
               Offset := ctStretchHandleSize div 2;
               Y      := Top + (Height div 2) - Offset;
             end;
      smSE : begin
               Offset := (ctStretchHandleSize + 1) div 2;
               X      := Left + Width - Offset;
               Y      := Top + Height - Offset;
             end;
      smS  : begin
               Offset := ctStretchHandleSize div 2;
               X      := Left + (Width div 2) - Offset;
               Offset := (ctStretchHandleSize + 1) div 2;
               Y      := Top + Height - Offset;
             end;
      smSW : begin
               Offset := ctStretchHandleSize div 2;
               X      := Left - Offset;
               Offset := (ctStretchHandleSize + 1) div 2;
               Y      := Top + Height - Offset;
             end;
      smW  : begin
               Offset := ctStretchHandleSize div 2;
               X      := Left - Offset;
               Y      := Top + (Height div 2) - Offset;
             end;
      else begin
        X := 0;
        Y := 0;
      end;
    end;
end;
procedure TBaseField.Read(Stream : TStream);
var
  FieldRec : TFieldRecord;
begin
  Stream.ReadBuffer(FieldRec, SizeOf(FieldRec));
  if Parent is TFaxPanel then
    with (Parent as TFaxPanel), FieldRec do begin
      Self.Left   := HorzInchesToPixels(frLeftInches);
      Self.Top    := VertInchesToPixels(frTopInches);
      Self.Width  := HorzInchesToPixels(frWidthInches);
      Self.Height := VertInchesToPixels(frHeightInches);
    end;
end;
procedure TBaseField.Write(Stream : TStream);
var
  FieldRec : TFieldRecord;
begin
  FillChar(FieldRec, SizeOf(FieldRec), 0);
  if Parent is TFaxPanel then
    with (Parent as TFaxPanel), FieldRec do begin
      frLeftInches   := HorzPixelsToInches(Self.Left);
      frTopInches    := VertPixelsToInches(Self.Top);
      frWidthInches  := HorzPixelsToInches(Self.Width);
      frHeightInches := VertPixelsToInches(Self.Height);
    end;
  Stream.WriteBuffer(FieldRec, SizeOf(FieldRec));
end;
{*** TTextField ***}
constructor TTextField.Create(AOwner: TComponent);
const
  ctDefWidth = 200;
var
  Items1:TMenuItem;
begin
  inherited Create(AOwner);
  Pen.Style := psClear;  {Don't need the TShape border because FMemo will have a border}
  FpopupMenu:=TPopupMenu.Create(self);
  Items1:=TMenuItem.Create(self);
  Items1.Caption:='载入文本';
  Items1.OnClick:=OnLoadFromFile;
  FPopupmenu.Items.Add(items1);
  FMemo := TMemo.Create(Self);
  FMemo.PopupMenu:=FPopupMenu;
  with FMemo do begin
    Ctl3D       := False;
    ParentCtl3D := False;
    WordWrap    := True;
    OnMouseDown := bfMouseDown;
    OnMouseUp   := bfMouseUp;
    OnMouseMove := bfMouseMove;
    OnDblClick  := MemoDblClick;
    OnEnter     := tfEnter;
    OnExit      := tfExit;
  end;
  FMemo.Font.Name:='宋体';
  FMemo.Font.Size:=11;
  SetBounds(Left, Top, ctDefWidth, Height);
end;
procedure TTextField.Draw(ACanvas : TCanvas);
  procedure ReplaceTags(TagStr     : string;
                  const ReplaceStr : string;
                    var TargetStr  : string);
  var
    Posn    : Integer;
    TempStr : string;
  begin
    TagStr := UpperCase(TagStr);
    repeat
      TempStr := UpperCase(TargetStr);
      Posn    := Pos(TagStr, TempStr);
      if Posn > 0 then begin
        Delete(TargetStr, Posn, Length(TagStr));
        Insert(ReplaceStr, TargetStr, Posn);
      end;
    until Posn = 0;
  end;
var
  I          : Integer;
  X, Y       : Integer;
  TextHeight : Integer;
  S          : string;
  DateStr    : string;
  TimeStr    : string;
begin
  with FMemo do begin
    ACanvas.Font := Font;
    TextHeight := GetTextHeight;
    {Format date string to use for $D replacement tag}
    DateStr := DateToStr(Date);
    {Format time string to use for $T replacement tag}
    TimeStr := TimeToStr(Time);
    Delete(TimeStr, Length(TimeStr) - 5, 4);  {Strip off the seconds}
    TimeStr := LowerCase(TimeStr); {Convert AM or PM to lower case}
    X := Round((Parent as TFaxPanel).DrawAdjustFactor * Self.Left);
    for I := 0 to Lines.Count - 1 do begin
      S := Lines[I];
      {Look for replaceable tags and do replacements as required}
      ReplaceTags('$D', DateStr, S);
      ReplaceTags('$T', TimeStr, S);
      ReplaceTags('$N', IntToStr((Parent as TFaxPanel).PageCount), S);
      ReplaceTags('$P', IntToStr((Parent as TFaxPanel).PageNumber), S);
      ReplaceTags('$F', (Parent as TFaxPanel).Sender, S);
      ReplaceTags('$R', (Parent as TFaxPanel).Recipient, S);
      ReplaceTags('$S', (Parent as TFaxPanel).PageTitle, S);
      ReplaceTags('$I', (Parent as TFaxPanel).StationID, S);
      Y := Round((Parent as TFaxPanel).DrawAdjustFactor * (Self.Top + (I * TextHeight)));
      ACanvas.TextOut(X, Y, S);
    end;
  end;
end;
procedure TTextField.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  if Assigned(FMemo) then
    FMemo.SetBounds(ALeft, ATop, AWidth, AHeight);
end;
procedure TTextField.SetParent(AParent: TWinControl);
var
  NewHeight : Integer;
begin
  inherited SetParent(AParent);
  if Assigned(FMemo) then begin
    FMemo.Parent := AParent;
    {If no text has yet been entered, get the height of one row of text for the
     current font, and adjust the field height to match}
    if (FMemo.Text = '') and Assigned(AParent) then begin
      NewHeight := GetTextHeight + 4;
      {If SnapToGrid is enabled, adjust height to fall on a grid line}
      with Parent as TFaxPanel do
        if SnapToGrid then
          AdjustHeightToGrid(Top, NewHeight);
      SetBounds(Left, Top, Width, NewHeight);
    end;
    if AParent is TFaxPanel then
      FMemo.OnChange := (AParent as TFaxPanel).FieldChange;
  end;
end;
procedure TTextField.SetFocus;
begin
  FMemo.SetFocus;
end;
function TTextField.GetTextHeight : Integer;
var
  Canvas     : TCanvas;
  TextMetric : TTextMetric;
begin
  Canvas := TCanvas.Create;
  try
    Canvas.Handle := GetDC(FMemo.Handle);
    try
      Canvas.Font := FMemo.Font;
      GetTextMetrics(Canvas.Handle, TextMetric);
      with TextMetric do
        Result := tmHeight + tmExternalLeading;
    finally
      ReleaseDC(FMemo.Handle, Canvas.Handle);
    end;
  finally
    Canvas.Free;
  end;
end;
procedure TTextField.MemoDblClick(Sender: TObject);
var
  NewHeight  : Integer;
  LineCount  : Integer;
  FontDialog : TFontDialog;
begin
  FontDialog := TFontDialog.Create(nil);
  try
    FontDialog.Font := FMemo.Font;
    if FontDialog.Execute then begin
      FMemo.Font := FontDialog.Font;
      {Adjust field height to allow for the new font size}
      LineCount := FMemo.Lines.Count;
      if LineCount < 1 then
        LineCount := 1;
      NewHeight := GetTextHeight * LineCount + 4;
      Constrain(NewHeight, 0, (Parent as TWinControl).Height - Top);
      {If SnapToGrid is enabled, adjust height to fall on a grid line}
      if (Parent as TFaxPanel).SnapToGrid then
        (Parent as TFaxPanel).AdjustHeightToGrid(Top, NewHeight);
      SetBounds(Left, Top, Width, NewHeight);
      if FSelected then begin
        (Parent as TFaxPanel).FieldPositionChange(Left, Top, Width, Height);
        {Set Ruler position marks to the new coordinates}
        if (Parent as TFaxPanel).Owner is TFaxDesigner then
          ((Parent as TFaxPanel).Owner as TFaxDesigner).SetMarkPositions(Left, Top, Width, Height);
      end;
    end;
    if Parent is TFaxPanel then
      (Parent as TFaxPanel).FieldChange(nil);
  finally
    FontDialog.Free;
  end;
end;
procedure TTextField.OnLoadFromFile(Sender: TObject);
var
  OpenDialog : TOpenDialog;
begin
  OpenDialog := TOpenDialog.Create(nil);
  OpenDialog.Filter:='文本文件 (*.txt)|*.TXT|所有文件(*.*)|*.*';
  if OpenDialog.Execute then
  begin
    FMemo.WordWrap:=true;
    FMemo.Lines.LoadFromFile(OpenDialog.FileName);
  end;
end;
function TTextField.GetText : string;
begin
  if Assigned(FMemo) then
    Result := FMemo.Text
  else
    Result := '';
end;
type
  TLocalMemo = class(TMemo);
procedure TTextField.tfEnter(Sender : TObject);
var
  PF : {$IFDEF DELPHI3}TCustomForm{$ELSE}TForm{$ENDIF};
begin
  if (Parent as TFaxPanel).EditMode then begin
    TLocalMemo(FMemo).SetDesigning(False);
  end else begin
    PF := GetParentForm(FMemo);
    PF.DefocusControl(FMemo, False);
    TLocalMemo(FMemo).SetDesigning(True);
  end;
end;
procedure TTextField.tfExit(Sender : TObject);
begin
  TLocalMemo(FMemo).SetDesigning(True);
end;
procedure TTextField.Read(Stream : TStream);
var
  BufSize : LongInt;
  Buffer  : PChar;
  FontRec : TFontRecord;
begin
  {Read BaseField properties}
  inherited Read(Stream);
  {Read the font properties and assign them to TMemo.Font}
  Stream.ReadBuffer(FontRec, SizeOf(FontRec));
  with FMemo.Font, FontRec do begin
    {$IFDEF DELPHI3}
    CharSet := TFontCharSet(frCharSet);
    {$ENDIF}
    Color   := TColor(frColor);
    Height  := frHeight;
    Name    := frName;
    Pitch   := TFontPitch(frPitch);
    Size    := frSize;
    Style   := [];
    if frFontBold then
      Style := Style + [fsBold];
    if frFontItalic then
      Style := Style + [fsItalic];
    if frFontUnderline then
      Style := Style + [fsUnderline];
    if frFontStrikeout then
      Style := Style + [fsStrikeout];
  end;
  {Read the buffer size needed to store the text}
  Stream.ReadBuffer(BufSize, SizeOf(BufSize));
  {If text exists, read it into the buffer and assign it to the TMemo}
  if BufSize > 1 then begin
    GetMem(Buffer, BufSize);
    try
      FillChar(Buffer^, BufSize, 0);
      Stream.ReadBuffer(Buffer^, BufSize);
      FMemo.Text := StrPas(Buffer);
    finally
      FreeMem(Buffer, BufSize);
    end;
  end;
end;
procedure TTextField.Write(Stream : TStream);
var
  FieldType : Byte;
  BufSize   : LongInt;
  Buffer    : PChar;
  FontRec   : TFontRecord;
begin
  {First thing to write out is the field type}
  FieldType := ftTextField;
  Stream.WriteBuffer(FieldType, SizeOf(FieldType));
  {Write out BaseField properties}
  inherited Write(Stream);
  {Initialize FontRec with the font properties and write it out}
  with FMemo.Font, FontRec do begin
    {$IFDEF DELPHI3}
    frCharSet       := Ord(CharSet);
    {$ELSE}
    frCharSet       := 0;
    {$ENDIF}
    frColor         := Color;
    frHeight        := Height;
    frName          := Name;
    frPitch         := Ord(Pitch);
    frSize          := Size;
    frFontBold      := fsBold in Style;
    frFontItalic    := fsItalic in Style;
    frFontUnderline := fsUnderline in Style;
    frFontStrikeout := fsStrikeout in Style;
  end;
  Stream.WriteBuffer(FontRec, SizeOf(FontRec));
  {Find out how big a buffer we need, and write out the buffer size}
  BufSize := FMemo.GetTextLen + 1; {Add one to allow for null character}
  Stream.WriteBuffer(BufSize, SizeOf(BufSize));
  {If the buffer isn't empty, get the memo text and write it out}
  if BufSize > 1 then begin
    GetMem(Buffer, BufSize);
    try
      FillChar(Buffer^, BufSize, 0);
      FMemo.GetTextBuf(Buffer, BufSize);
      Stream.WriteBuffer(Buffer^, BufSize);
    finally
      FreeMem(Buffer, BufSize);
    end;
  end;
end;
{------------------------------ TImageField --------------------------------}
constructor TImageField.Create(AOwner: TComponent);
const
  DefWidth  = 120;
  DefHeight = 120;
begin
  inherited Create(AOwner);
  FImage := TImage.Create(Self);
  with FImage do begin
    Stretch     := True;
    OnMouseDown := bfMouseDown;
    OnMouseUp   := bfMouseUp;
    OnMouseMove := bfMouseMove;
    OnDblClick  := ImageDblClick;
  end;
  SetBounds(Left, Top, DefWidth, DefHeight);
end;  
procedure TImageField.Draw(ACanvas : TCanvas);
var
  AdjustFactor : Double;
begin
  if not FImage.Picture.Bitmap.Empty then begin
    AdjustFactor := (Parent as TFaxPanel).DrawAdjustFactor;
    ACanvas.StretchDraw(Rect(Round(Left * AdjustFactor), Round(Top * AdjustFactor),
                             Round((Left + Width) * AdjustFactor),
                             Round((Top + Height) * AdjustFactor)),
                        FImage.Picture.Bitmap);
  end;
end;
function TImageField.GetPicture : TPicture;
begin
  if Assigned(FImage) then
    Result := FImage.Picture
  else
    Result := nil;
end;
procedure TImageField.ImageDblClick(Sender: TObject);
var
  {$IFDEF DELPHI3}
  PictureDialog : TOpenPictureDialog;
  {$ELSE}
  PictureDialog : TOpenDialog;
  {$ENDIF}
  I             : Integer;
  Ext:String;
  image1:TImage;
  bmp:TBitmap;
begin
  {$IFDEF DELPHI3}
  PictureDialog := TOpenPictureDialog.Create(nil);
  {$ELSE}
  PictureDialog := TOpenDialog.Create(nil);
  {$ENDIF}
  try
    {$IFNDEF DELPHI3}
    PictureDialog.Filter := 'Bitmap files|*.BMP';
    {$ENDIF}
    PictureDialog.Options := [ofHideReadOnly, ofFileMustExist,
                              ofPathMustExist, ofNoChangeDir];
    if PictureDialog.Execute then begin
      Ext:=Uppercase(ExtractFileExt(PictureDialog.FileName));
       if (Ext='.JPG') or (Ext='.JPEG') then
        begin
          image1:=Timage.Create(self);
          image1.picture.loadfromfile(pictureDialog.filename);
          bmp:=TBitmap.create;
          bmp.assign(TJPEGImage(image1.picture.Graphic));
          Fimage.Picture.Bitmap:=bmp;
        end
        else
        FImage.Picture.LoadFromFile(PictureDialog.FileName);
        FImage.Visible := True;
        {Bring all StretchHandles to front so they draw on top of the image}
        for I := Low(bfStretchHandles) to High(bfStretchHandles) do
          bfStretchHandles[I].BringToFront;
        if Parent is TFaxPanel then
          (Parent as TFaxPanel).FieldChange(nil);
    end;
  finally
    PictureDialog.Free;
  end;
end;
procedure TImageField.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  if Assigned(FImage) then
    FImage.SetBounds(ALeft, ATop, AWidth, AHeight);
end;
procedure TImageField.SetParent(AParent: TWinControl);
begin
  inherited SetParent(AParent);
  if Assigned(FImage) then
    FImage.Parent := AParent;
end;
type
  TLocalBitmap = class(TBitmap);
procedure TImageField.Read(Stream : TStream);
var
  IsEmpty : Boolean;
begin
  {Read BaseField properties}
  inherited Read(Stream);
  {Read the IsEmpty value to determine if a bitmap exists}
  Stream.ReadBuffer(IsEmpty, SizeOf(IsEmpty));
  {If we have a bitmap, read it in}
  if not IsEmpty then
    TLocalBitmap(FImage.Picture.Bitmap).ReadData(Stream);
    {ReadData is used because when using SaveToStream/LoadFromStream,
     LoadFromStream assumes that the bitmap occupies the remaining data
     in the stream, therefor no other items can be stored after the bitmap.
     ReadData first reads in the size of the bitmap.
     The WriteData/ReadData routines are protected, but the type-cast using
     a local class alias allow us to access them anyway}
    {FImage.Picture.Bitmap.LoadFromStream(Stream);}
end;
procedure TImageField.Write(Stream : TStream);
var
  FieldType : Byte;
  IsEmpty   : Boolean;
begin
  {First thing to write out is the field type}
  FieldType := ftImageField;
  Stream.WriteBuffer(FieldType, SizeOf(FieldType));
  {Write out BaseField properties}
  inherited Write(Stream);
  {Determine whether a Bitmap is assigned and write this boolean value out}
  IsEmpty := FImage.Picture.Bitmap.Empty;
  Stream.WriteBuffer(IsEmpty, SizeOf(IsEmpty));
  {If we have a bitmap, write it out}
  if not IsEmpty then
    TLocalBitmap(FImage.Picture.Bitmap).WriteData(Stream);
    {WriteData is used because when using SaveToStream/LoadFromStream,
     LoadFromStream assumes that the bitmap occupies the remaining data
     in the stream, therefor no other items can be stored after the bitmap.
     WriteData first writes out the size of the bitmap data.
     The WriteData/ReadData routines are protected, but the type-cast using
     a local class alias allow us to access them anyway}
    {FImage.Picture.Bitmap.SaveToStream(Stream);}
end;
{*** TFaxPanel ***}
constructor TFaxPanel.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  FGridSpacingX     := ctGridSpacingX;
  FGridSpacingY     := ctGridSpacingY;
  OnResize          := fpResize;
  OnMouseDown       := fpMouseDown;
  OnMouseUp         := fpMouseUp;
  OnMouseMove       := fpMouseMove;
  fpFieldList       := TList.Create;
end;
destructor TFaxPanel.Destroy;
begin
  {Destroy all items in fpFieldList}
  DeleteAllFields;
  {Now destroy the list itself}
  fpFieldList.Free;
  inherited Destroy;
end;
function TFaxPanel.GetFieldCount : Integer;
begin
  Result := fpFieldList.Count;
end;
function TFaxPanel.GetField(Index : Integer) : TBaseField;
begin
  Result := TBaseField(fpFieldList[Index]);
end;
function TFaxPanel.GetSelectedField : TBaseField;
var
  I      : Integer;
begin
  for I := fpFieldList.Count - 1 downto 0 do begin
    Result := fpFieldList[I];
    if Result.Selected then
      Exit;
  end;
  Result := nil;
end;
procedure TFaxPanel.SetEditMode(Value : Boolean);
var
  I     : Integer;
  Field : TBaseField;
begin
  if Value <> FEditMode then begin
    FEditMode := Value;
    for I := fpFieldList.Count - 1 downto 0 do begin
      Field := fpFieldList[I];
      if Field.Selected and (Field is TTextField) then begin
        TTextField(Field).tfEnter(nil);
        if Value then
          TTextField(Field).SetFocus;
      end;
    end;
  end;
end;
procedure TFaxPanel.SetPageWidthInches(AWidth : Double);
begin
  if AWidth <> FPageWidthInches then begin
    FPageWidthInches := AWidth;
    {Recalc pixels per inch and post position messages if necessary}
    SetBounds(Left, Top, Width, Height);
    FNeedsSaving := True;
  end;
end;
procedure TFaxPanel.SetPageHeightInches(AHeight : Double);
begin
  if AHeight <> FPageHeightInches then begin
    FPageHeightInches := AHeight;
    {SetBounds recalcs pixels per inch and calls OnFieldPositionChange if
     necessary}
    SetBounds(Left, Top, Width, Height);
    FNeedsSaving := True;
  end;
end;  
procedure TFaxPanel.SetShowGrid(AShowGrid : Boolean);
begin
  if AShowGrid <> FShowGrid then begin
    FShowGrid := AShowGrid;
    Invalidate;
  end;
end;
procedure TFaxPanel.SetSnapToGrid(ASnapToGrid : Boolean);
var
  I         : Integer;
  NewLeft   : Integer;
  NewTop    : Integer;
  NewWidth  : Integer;
  NewHeight : Integer;
  Field     : TBaseField;
begin
  if ASnapToGrid <> FSnapToGrid then begin
    FSnapToGrid := ASnapToGrid;
    {If SnapToGrid was just turned on, force all existing fields to snap to the grid}
    if FSnapToGrid then begin
      for I := 0 to fpFieldList.Count - 1 do begin
        Field     := fpFieldList[I];
        NewLeft   := Field.Left;
        NewTop    := Field.Top;
        NewWidth  := Field.Width;
        NewHeight := Field.Height;
        {Adjust coordinates to be on grid lines}
        AdjustLeftToGrid(NewLeft);
        AdjustTopToGrid(NewTop);
        AdjustWidthToGrid(NewLeft, NewWidth);
        AdjustHeightToGrid(NewTop, NewHeight);
        Field.SetBounds(NewLeft, NewTop, NewWidth, NewHeight);
      end;
      FNeedsSaving := True;
    end;
  end;
end;
procedure TFaxPanel.SetGridSpacingX(GridSpacing : Integer);
begin
  if (GridSpacing > 0) and (GridSpacing <> FGridSpacingX) then begin
    FGridSpacingX := GridSpacing;
    fpResize(nil);  {Recalculate fpMaxGridLine}
    if FSnapToGrid then begin
      {Turn SnapToGrid off and back on to force all fields to align to the new grid size}
      SetSnapToGrid(False);
      SetSnapToGrid(True);
    end;
    if FShowGrid then
      Invalidate;
  end;
end;
procedure TFaxPanel.SetGridSpacingY(GridSpacing : Integer);
begin
  if (GridSpacing > 0) and (GridSpacing <> FGridSpacingY) then begin
    FGridSpacingY := GridSpacing;
    fpResize(nil);  {Recalculate fpMaxGridLine}
    if FSnapToGrid then begin
      {Turn SnapToGrid off and back on to force all fields to align to the new grid size}
      SetSnapToGrid(False);
      SetSnapToGrid(True);
    end;
    if FShowGrid then
      Invalidate;
  end;
end;
procedure TFaxPanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  procedure UpdateFieldPositionsAndSizes(OldWidth, OldHeight : Integer);
  var
    I           : Integer;
    NewLeft     : Integer;
    NewTop      : Integer;
    NewWidth    : Integer;
    NewHeight   : Integer;
    Field       : TBaseField;
    WidthRatio  : Double;
    HeightRatio : Double;
  begin
    if OldWidth = 0 then
      WidthRatio := 0.0
    else
      WidthRatio  := Width / OldWidth;
    if OldHeight = 0 then
      HeightRatio := 0.0
    else
      HeightRatio  := Height / OldHeight;
    for I := fpFieldList.Count - 1 downto 0 do begin
      Field := fpFieldList[I];
      with Field do begin
        NewLeft   := Round(Left * WidthRatio);
        NewTop    := Round(Top * HeightRatio);
        NewWidth  := Round(Width * WidthRatio);
        NewHeight := Round(Height * HeightRatio);
        AdjustLeftToGrid(NewLeft);
        AdjustWidthToGrid(NewLeft, NewWidth);
        AdjustTopToGrid(NewTop);
        AdjustHeightToGrid(NewTop, NewHeight);
        SetBounds(NewLeft, NewTop, NewWidth, NewHeight);
        if Selected then begin
          FieldPositionChange(Left, Top, Width, Height);
          {Set Ruler position marks to the new coordinates}
          if Self.Owner is TFaxDesigner then
            (Self.Owner as TFaxDesigner).SetMarkPositions(Left, Top, Width, Height);
        end;
      end;
    end;
  end;  
var
  OldWidth  : Integer;
  OldHeight : Integer;
begin
  OldWidth  := Width;
  Oldheight := Height;
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  if FPageWidthInches = 0.0 then
    fpHorzPixelsPerInch := 0.0
  else
    fpHorzPixelsPerInch := Width / FPageWidthInches;
  if FPageHeightInches = 0.0 then
    fpVertPixelsPerInch := 0.0
  else
    fpVertPixelsPerInch := Height / FPageHeightInches;
  {Move and resize all fields so they retain the same relative positions and
   sizes in relation to the FaxPanel size}
  if Assigned(fpFieldList) then
    UpdateFieldPositionsAndSizes(OldWidth, OldHeight);
end;
procedure TFaxPanel.Paint;
var
  X, Y : Integer;
begin
  inherited Paint;
  if FShowGrid then begin
    X := ctGridStart;
    with Canvas do
      while X < Width do begin
        {To improve painting performance, don't draw anything that isn't
         within the current ClipRect}
        if (ClipRect.Left <= X) and (X <= ClipRect.Right) then begin
          Y := ctGridStart;
          while Y < Height do begin
            {To improve painting performance, don't draw anything that isn't
             within the current ClipRect}
            if (ClipRect.Top <= Y) and (Y <= ClipRect.Bottom) then
              Canvas.Pixels[X,Y] := clBlack;
            Y := Y + FGridSpacingY;
          end;
        end;
        X := X + FGridSpacingX;
      end;
  end;
end;
procedure TFaxPanel.fpResize(Sender : TObject);
var
  Extent      : Integer;
  NrGridLines : Integer;
begin
  {Calculate the coordinates of the rightmost and bottommost grid lines given
   the current panel size, and store the results in fpMaxGridLine}
  Extent := Width - ctGridStart;
  NrGridLines := Extent div FGridSpacingX;
  fpMaxGridLine.X := (NrGridLines * FGridSpacingX) + ctGridStart;
  Extent := Height - ctGridStart;
  NrGridLines := Extent div FGridSpacingY;
  fpMaxGridLine.Y := (NrGridLines * FGridSpacingY) + ctGridStart;
end;
procedure TFaxPanel.fpMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  {If user clicked on a field, translate the coordinates to MainPanel
   coordinates and set fpMouseAnchor to those coordinates}
  if Sender is TBaseField then begin
    ConvertCoords(Sender as TControl, Self, X, Y);
    fpMouseAnchor := Point(X, Y);
    if (Button = mbLeft) and not (ssDouble in Shift) then
      fpIsMouseDown := True;
  end else
    fpMouseAnchor := Point(X, Y);
end;
procedure TFaxPanel.fpMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  IsFieldSelected : Boolean;
begin
  case Button of
    mbRight : if Sender is TControl then begin
                ConvertCoords(Sender as TControl, Self, X, Y);
                fpMouseAnchor := Point(X, Y);
              end;
    mbLeft :
      begin
        DeselectAllFields;
        IsFieldSelected := False;  {No fields are currently selected}
        {If user clicked on a field, mark it as selected}
        if Sender is TBaseField then begin
          IsFieldSelected := True;
          fpIsMouseDown   := False;
          with Sender as TBaseField do begin
            Selected := True;
            {Set Ruler position marks to the new coordinates}
            (Self.Owner as TFaxDesigner).SetMarkPositions(Left, Top, Width, Height);
          end;
        end else
          {Turn Ruler position marks off since no fields are selected}
          (Self.Owner as TFaxDesigner).SetMarkPositions(-1, -1, -1, -1);
        FieldSelectionChange(IsFieldSelected);
        if IsFieldSelected then
          with Sender as TBaseField do
            FieldPositionChange(Left, Top, Width, Height);
      end;
  end;
end;
procedure TFaxPanel.fpMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  XDiff     : Integer;
  YDiff     : Integer;
  OldLeft   : Integer;
  OldTop    : Integer;
  NewLeft   : Integer;
  NewTop    : Integer;
  NewWidth  : Integer;
  NewHeight : Integer;
begin
  if Sender is TBaseField then begin
    if fpIsMouseDown and (ssLeft in Shift) then begin
      if fpDragging then
        Exit;
      fpDragging := True;
      try
        case (Sender as TBaseField).StretchMode of
          smDrag :
            begin
              {TextFields can't be moved while in Edit Mode}
              if FEditMode and (Sender is TTextField) then
                Exit;
              ConvertCoords(Sender as TControl, Self, X, Y);
              Constrain(X, 0, Width);
              Constrain(Y, 0, Height);
              XDiff := X - fpMouseAnchor.X;
              YDiff := Y - fpMouseAnchor.Y;
              with Sender as TBaseField do begin
                NewLeft := Left + XDiff;
                NewTop  := Top + YDiff;
                {Ensure field remains entirely within Self}
                Constrain(NewLeft, 0, Self.Width  - Width);
                Constrain(NewTop,  0, Self.Height - Height);
                if FSnapToGrid then begin
                  {Adjust NewLeft and NewTop to be on grid lines if necessary}
                  AdjustLeftToGrid(NewLeft);
                  AdjustTopToGrid(NewTop);
                  {Make sure we haven't moved past the rightmost or bottommost grid line}
                  if NewLeft + Width - 1 > fpMaxGridLine.X then
                    NewLeft := NewLeft - FGridSpacingX;
                  if NewTop + Height - 1 > fpMaxGridLine.Y then
                    NewTop := NewTop - FGridSpacingY;
                end;
                OldLeft := Left;
                OldTop  := Top;
                SetBounds(NewLeft, NewTop, Width, Height);
              end;
              {Set fpMouseAnchor to new mouse position, but ONLY if the field
               position has changed. If SnapToGrid is enabled, the field position
               might not have changed even though the mouse position did.}
              fpMouseAnchor.X := fpMouseAnchor.X + NewLeft - OldLeft;
              fpMouseAnchor.Y := fpMouseAnchor.Y + NewTop - OldTop;
            end;
          smE :
            with Sender as TBaseField do begin
              NewWidth := X;
              Constrain(NewWidth, 0, Self.Width - Left);
              AdjustWidthToGrid(Left, NewWidth);
              SetBounds(Left, Top, NewWidth, Height);
              if Width <= 1 then
                StretchMode := smW;
            end;
          smW :
            with Sender as TBaseField do begin
              NewLeft := Left + X;
              {Prevent creeping to right when switching from smW to smE}
              Constrain(NewLeft, 0, Left + Width);
              AdjustLeftToGrid(NewLeft);
              NewWidth := Width + Left - NewLeft;
              Constrain(NewWidth, 0, Self.Width - NewLeft);
              AdjustWidthToGrid(NewLeft, NewWidth);
              SetBounds(NewLeft, Top, NewWidth, Height);
              if Width <= 1 then
                StretchMode := smE;
            end;
          smS :
            with Sender as TBaseField do begin
              NewHeight := Y;
              Constrain(NewHeight, 0, Self.Height - Top);
              AdjustHeightToGrid(Top, NewHeight);
              SetBounds(Left, Top, Width, NewHeight);
              if Height <= 1 then
                StretchMode := smN;
            end;
          smN :
            with Sender as TBaseField do begin
              NewTop := Top + Y;
              {Prevent creeping down when switching from smN to smS}
              Constrain(NewTop, 0, Top + Height);
              AdjustTopToGrid(NewTop);
              NewHeight := Height + Top - NewTop;
              Constrain(NewHeight, 0, Self.Height - NewTop);
              AdjustHeightToGrid(NewTop, NewHeight);
              SetBounds(Left, NewTop, Width, NewHeight);
              if Height <= 1 then
                StretchMode := smS;
            end;
          smNE :
            with Sender as TBaseField do begin
              NewTop := Top + Y;
              {Prevent creeping down when switching from smN? to smS?}
              Constrain(NewTop, 0, Top + Height);
              AdjustTopToGrid(NewTop);
              NewWidth := X;
              Constrain(NewWidth, 0, Self.Width - Left);
              AdjustWidthToGrid(Left, NewWidth);
              NewHeight := Height + Top - NewTop;
              Constrain(NewHeight, 0, Self.Height - NewTop);
              AdjustHeightToGrid(NewTop, NewHeight);
              SetBounds(Left, NewTop, NewWidth, NewHeight);
              if Width <= 1 then begin
                if Height <= 1 then
                  StretchMode := smSW
                else
                  StretchMode := smNW;
              end else if Height <= 1 then
                StretchMode := smSE;
            end;
          smSW :
            with Sender as TBaseField do begin
              NewLeft := Left + X;
              {Prevent creeping to right when switching from smW to smE}
              Constrain(NewLeft, 0, Left + Width);
              AdjustLeftToGrid(NewLeft);
              NewWidth := Width + Left - NewLeft;
              Constrain(NewWidth, 0, Self.Width - NewLeft);
              AdjustWidthToGrid(NewLeft, NewWidth);
              NewHeight := Y;
              Constrain(NewHeight, 0, Self.Height - Top);
              AdjustHeightToGrid(Top, NewHeight);
              SetBounds(NewLeft, Top, NewWidth, NewHeight);
              if Width <= 1 then begin
                if Height <= 1 then
                  StretchMode := smNE
                else
                  StretchMode := smSE;
              end else if Height <= 1 then
                StretchMode := smNW;
            end;
          smSE :
            with Sender as TBaseField do begin
              NewWidth := X;
              Constrain(NewWidth, 0, Self.Width - Left);
              AdjustWidthToGrid(Left, NewWidth);
              NewHeight := Y;
              Constrain(NewHeight, 0, Self.Height - Top);
              AdjustHeightToGrid(Top, NewHeight);
              SetBounds(Left, Top, NewWidth, NewHeight);
              if Width <= 1 then begin
                if Height <= 1 then
                  StretchMode := smNW
                else
                  StretchMode := smSW;
              end else if Height <= 1 then
                StretchMode := smNE;
            end;
          smNW :
            with Sender as TBaseField do begin
              NewLeft := Left + X;
              {Prevent creeping to right when switching from sm?W to sm?E}
              Constrain(NewLeft, 0, Left + Width);
              AdjustLeftToGrid(NewLeft);
              NewWidth := Width + Left - NewLeft;
              Constrain(NewWidth, 0, Self.Width - NewLeft);
              AdjustWidthToGrid(NewLeft, NewWidth);
              NewTop := Top + Y;
              {Prevent creeping down when switching from smN? to smS?}
              Constrain(NewTop, 0, Top + Height);
              AdjustTopToGrid(NewTop);
              NewHeight := Height + Top - NewTop;
              Constrain(NewHeight, 0, Self.Height - NewTop);
              AdjustHeightToGrid(NewTop, NewHeight);
              SetBounds(NewLeft, NewTop, NewWidth, NewHeight);
              if Width <= 1 then begin
                if Height <= 1 then
                  StretchMode := smSE
                else
                  StretchMode := smNE;
              end else if Height <= 1 then
                StretchMode := smSW;
            end;
        end;
        Application.ProcessMessages;
      finally
        fpDragging := False;
      end;
      with Sender as TBaseField do
        if Selected then begin
          FieldPositionChange(Left, Top, Width, Height);
          {Set Ruler position marks to the new coordinates}
          if Self.Owner is TFaxDesigner then
            (Self.Owner as TFaxDesigner).SetMarkPositions(Left, Top, Width, Height);
        end;
      FNeedsSaving := True;
    end;
    StretchMode := (Sender as TBaseField).StretchMode;
  end else
    StretchMode := smNone;
end;
procedure TFaxPanel.SizeMove(Sender : TObject; Key : Word; Shift : TShiftState);
var
  X, Y      : Integer;
  NewWidth  : Integer;
  NewHeight : Integer;
  Delta     : TPoint;
  I, J      : Integer;
  BF        : TBaseField;
begin
  if Sender is TBaseField then begin
    case Key of
      VK_UP    : Delta := Point(0, -1);
      VK_DOWN  : Delta := Point(0, 1);
      VK_RIGHT : Delta := Point(1, 0);
      VK_LEFT  : Delta := Point(-1, 0);
    else
      if (Key = VK_TAB) and (Shift = []) then begin
        {select next object}
        J := -1;
        for I := 0 to FieldCount-1 do
          if Field[I].Selected then begin
            J := I;
            Break;
          end;
        if J >= 0 then begin
          Field[J].Selected := False;
          Inc(J);
          if J >= FieldCount then
            J := 0;
          Field[J].Selected := True;
          Invalidate;
        end;
      end else if (Key = VK_TAB) and (Shift = [ssShift]) then begin
        {select previous object}
        J := -1;
        for I := 0 to FieldCount-1 do
          if Field[I].Selected then begin
            J := I;
            Break;
          end;
        if J >= 0 then begin
          Field[J].Selected := False;
          Dec(J);
          if J < 0 then
            J := FieldCount-1;
          Field[J].Selected := True;
          Invalidate;
        end;
      end;
      Exit;
    end;
    BF := Sender as TBaseField;
    if (ssShift in Shift) then begin
      {size}
      X := BF.Width + Delta.X;
      Y := BF.Height + Delta.Y;
      NewWidth := X;
      NewHeight := Y;
      Constrain(NewWidth, 0, Self.Width - BF.Left);
      Constrain(NewHeight, 0, Self.Height - BF.Top);
      BF.SetBounds(BF.Left, BF.Top, NewWidth, NewHeight);
    end else if (ssCtrl in Shift) then begin
      {move}
      X := BF.Left + Delta.X;
      Y := BF.Top + Delta.Y;
      Constrain(X, 0, Width);
      Constrain(Y, 0, Height);
      {Ensure field remains entirely within Self}
      Constrain(X, 0, Self.Width  - BF.Width);
      Constrain(Y,  0, Self.Height - BF.Height);
      BF.SetBounds(X, Y, BF.Width, BF.Height);
    end;
    
    with Sender as TBaseField do
      if Selected then begin
        FieldPositionChange(Left, Top, Width, Height);
        {Set Ruler position marks to the new coordinates}
        if Self.Owner is TFaxDesigner then
          (Self.Owner as TFaxDesigner).SetMarkPositions(Left, Top, Width, Height);
      end;
    FNeedsSaving := True;
  end;
end;
procedure TFaxPanel.FieldSelectionChange(IsFieldSelected : Boolean);
  {-Calls OnFieldSelectionChange event handler when a field becomes
    deselected or when a new field becomes selected}
begin
  if Assigned(FOnFieldSelectionChange) then
    FOnFieldSelectionChange(IsFieldSelected);
end;
procedure TFaxPanel.FieldPositionChange(ALeft, ATop, AWidth, AHeight : Integer);
  {-Calls OnFieldPositionChange event handler when the location or size of
    the currently-selected field changes}
begin
  if Assigned(FOnFieldPositionChange) then
    FOnFieldPositionChange(ALeft, ATop, AWidth, AHeight);
end;
procedure TFaxPanel.FieldChange(Sender : TObject);
begin
  FNeedsSaving := True;
end;
procedure TFaxPanel.AdjustLeftToGrid(var ALeft : Integer);
begin
  if FSnapToGrid then begin
    if ALeft < ctGridStart then
      ALeft := ctGridStart
    else if ALeft > fpMaxGridLine.X then
      ALeft := fpMaxGridLine.X
    else
      ALeft := (Round((ALeft - ctGridStart) / FGridSpacingX) * FGridSpacingX) + ctGridStart;
  end;
end;
procedure TFaxPanel.AdjustTopToGrid(var ATop : Integer);
begin
  if FSnapToGrid then begin
    if ATop < ctGridStart then
      ATop := ctGridStart
    else if ATop > fpMaxGridLine.Y then
      ATop := fpMaxGridLine.Y
    else
      ATop := (Round((ATop - ctGridStart) / FGridSpacingY) * FGridSpacingY) + ctGridStart;
  end;
end;
procedure TFaxPanel.AdjustWidthToGrid(ALeft : Integer; var AWidth : Integer);
begin
  if FSnapToGrid then begin
    if AWidth < 0 then
      AWidth := 0
    else if ALeft + AWidth > fpMaxGridLine.X then
      AWidth := fpMaxGridLine.X - ALeft
    else
      AWidth := Round((AWidth) / FGridSpacingX) * FGridSpacingX + 1;
  end;
end;
procedure TFaxPanel.AdjustHeightToGrid(ATop : Integer; var AHeight : Integer);
begin
  if FSnapToGrid then begin
    if AHeight < 0 then
      AHeight := 0
    else if ATop + AHeight > fpMaxGridLine.Y then
      AHeight := fpMaxGridLine.Y - ATop
    else
      AHeight := Round((AHeight) / FGridSpacingY) * FGridSpacingY + 1;
  end;
end;
function TFaxPanel.GetDrawAdjustFactor : Double;
const
  ctFaxWidthInPixels = 1728;  {Faxes are 1728 pixels in width}
begin
  if Width = 0 then
    Result := 0.0
  else
    Result := ((ctFaxWidthInPixels / 2) - 10) / Width;
end;
function TFaxPanel.GetDrawWidth : Integer;
begin
  Result := Round(Width * DrawAdjustFactor);
end;
function TFaxPanel.GetDrawHeight : Integer;
begin
  Result := Round(Height * DrawAdjustFactor);
end;
procedure TFaxPanel.SetStretchMode(NewStretchMode : TStretchModes);
begin
  if NewStretchMode <> FStretchMode then begin
    FStretchMode := NewStretchMode;
    case FStretchMode of
      smN, smS   : Cursor := crSizeNS;
      smE, smW   : Cursor := crSizeWE;
      smNW, smSE : Cursor := crSizeNWSE;
      smNE, smSW : Cursor := crSizeNESW;
      else Cursor := crDefault;
    end;
  end;
end;
procedure TFaxPanel.FieldPositionChangeForSelectedField;
var
  I     : Integer;
  Field : TBaseField;
begin
  for I := 0 to fpFieldList.Count - 1 do begin
    Field := fpFieldList[I];
    with Field do
      if Selected then begin
        FieldPositionChange(Left, Top, Width, Height);
        Break; {Only one field can be selected at a time and we just found it, so exit loop}
      end;
  end;
end;
procedure TFaxPanel.Write(Stream : TStream);
var
  I         : Integer;
  NumFields : LongInt;
  Field     : TBaseField;
begin
  {Write the number of fields to the stream}
  NumFields := fpFieldList.Count;
  Stream.WriteBuffer(NumFields, SizeOf(NumFields));
  {Write out each field's information}
  for I := 0 to fpFieldList.Count - 1 do begin
    Field := fpFieldList[I];
    Field.Write(Stream);
  end;
  {We just saved, so set NeedsSaving to False}
  FNeedsSaving := False;
end;
procedure TFaxPanel.Read(Stream : TStream);
var
  FieldType : Byte;
  I         : Integer;
  NumFields : LongInt;
  Field     : TBaseField;
begin
  {Clear out fpFieldList to ensure we're starting off with an empty FaxPanel}
  DeleteAllFields;
  {Read the number of fields that were written out to the stream}
  Stream.ReadBuffer(NumFields, SizeOf(NumFields));
  {For each field, create a new field of the proper type, and then let it read
   itself in}
  for I := 1 to NumFields do begin
    Field := nil;
    Stream.ReadBuffer(FieldType, SizeOf(FieldType));
    case FieldType of
      ftTextField  : Field := AddTextField;
      ftImageField : Field := AddImageField;
    end;
    if Assigned(Field) then
      Field.Read(Stream);
  end;
  {No changes have been made yet, so set NeedsSaving to False}
  FNeedsSaving := False;
end;
procedure TFaxPanel.Draw(ACanvas : TCanvas);
var
  I     : Integer;
  Field : TBaseField;
begin
  {Draw each field}
  for I := 0 to fpFieldList.Count - 1 do begin
    Field := fpFieldList[I];
    Field.Draw(ACanvas);
  end;
end;
function TFaxPanel.HorzPixelsToInches(P : Integer) : Double;
begin
  if fpHorzPixelsPerInch = 0.0 then
    Result := 0.0
  else
    Result := P / fpHorzPixelsPerInch;
end;
function TFaxPanel.VertPixelsToInches(P : Integer) : Double;
begin
  if fpVertPixelsPerInch = 0.0 then
    Result := 0.0
  else
    Result := P / fpVertPixelsPerInch;
end;
function TFaxPanel.HorzInchesToPixels(Inches : Double) : Integer;
begin
  Result := Round(Inches * fpHorzPixelsPerInch);
end;
function TFaxPanel.VertInchesToPixels(Inches : Double) : Integer;
begin
  Result := Round(Inches * fpVertPixelsPerInch);
end;
procedure TFaxPanel.DeselectAllFields;
var
  I     : Integer;
  Field : TBaseField;
begin
  for I := fpFieldList.Count - 1 downto 0 do begin
    Field := fpFieldList[I];
    Field.Selected := False;
  end;
end;
procedure TFaxPanel.DeleteAllFields;
var
  I     : Integer;
  Field : TBaseField;
begin
  for I := fpFieldList.Count - 1 downto 0 do begin
    Field := fpFieldList[I];
    Field.Free;
    fpFieldList.Remove(fpFieldList[I]);
  end;
  FNeedsSaving := True;
end;
procedure TFaxPanel.AddField(Field : TBaseField);
var
  NewLeft   : Integer;
  NewTop    : Integer;
  NewWidth  : Integer;
  NewHeight : Integer;
begin
  DeselectAllFields;
  NewLeft := fpMouseAnchor.X;
  NewTop  := fpMouseAnchor.Y;
  with Field do begin
    {Update NewLeft and NewTop to ensure new field will be entirely within MainPanel}
    Constrain(NewLeft, 0, Self.Width  - Width);
    Constrain(NewTop,  0, Self.Height - Height);
    NewWidth  := Width;
    NewHeight := Height;
    {If SnapToGrid is enabled, adjust coordinates to be on grid lines}
    if FSnapToGrid then begin
      AdjustLeftToGrid(NewLeft);
      AdjustTopToGrid(NewTop);
      AdjustWidthToGrid(NewLeft, NewWidth);
      AdjustHeightToGrid(NewTop, NewHeight);
    end;
    SetBounds(NewLeft, NewTop, NewWidth, NewHeight);
    Parent   := Self;
    Visible  := True;
    Selected := True; {New fields start out Selected}
  end;
  if Field is TTextField then
    (Field as TTextField).SetFocus;
  fpFieldList.Add(Field);
  FieldSelectionChange(True);
  with Field do
    FieldPositionChange(Left, Top, Width, Height);
  FNeedsSaving := True;
  Inc(fpMouseAnchor.X, 5);
  Inc(fpMouseAnchor.Y, 5);
end;
function TFaxPanel.AddTextField : TTextField;
begin
  Result := TTextField.Create(nil);
  AddField(Result);
end;
function TFaxPanel.AddImageField : TImageField;
begin
  Result := TImageField.Create(nil);
  AddField(Result);
end;
procedure TFaxPanel.DeleteSelectedField;
var
  I     : Integer;
  Field : TBaseField;
begin
  {Delete all fields that are currently selected}
  for I := fpFieldList.Count - 1 downto 0 do begin
    Field := fpFieldList[I];
    if Field.Selected then begin
      Field.Free;
      fpFieldList.Remove(fpFieldList[I]);
      FNeedsSaving := True;
    end;
  end;
  {Turn Ruler position marks off since no fields are selected}
  if Self.Owner is TFaxDesigner then
    (Self.Owner as TFaxDesigner).SetMarkPositions(-1, -1, -1, -1);
end;  
procedure TFaxPanel.CenterSelectedField(IsHorizontal : Boolean);
var
  I      : Integer;
  NewPos : Integer;
  Field  : TBaseField;
begin
  for I := fpFieldList.Count - 1 downto 0 do begin
    Field := fpFieldList[I];
    if Field.Selected then begin
      if IsHorizontal then begin
        NewPos := Round((Width - Field.Width) / 2);
        AdjustLeftToGrid(NewPos);  {Align to grid if SnapToGrid is enabled}
        Field.Left := NewPos;
      end else begin
        NewPos := Round((Height - Field.Height) / 2);
        AdjustTopToGrid(NewPos);  {Align to grid if SnapToGrid is enabled}
        Field.Top := NewPos;
      end;
      with Field do begin
        FieldPositionChange(Left, Top, Width, Height);
        {Set Ruler position marks to the new coordinates}
        if Self.Owner is TFaxDesigner then
          (Self.Owner as TFaxDesigner).SetMarkPositions(Left, Top, Width, Height);
      end;
      FNeedsSaving := True;
      Break;
    end;
  end;
end;
function TFaxPanel.SelectedFieldsExist : Boolean;
var
  I     : Integer;
  Field : TBaseField;
begin
  Result := False;
  for I := 0 to fpFieldList.Count - 1 do begin
    Field := fpFieldList[I];
    if Field.Selected then begin
      Result := True;
      Break;
    end;
  end;
end;
{------------------------------- TFaxScrollBox ------------------------------}
procedure TFaxScrollBox.WMHScroll(var Message : TWMHScroll);
var
  Dummy : Integer;
begin
  inherited;
  if Assigned(FOnHorzScroll) and (Message.ScrollBar = 0) and HorzScrollBar.Visible then
    {Doesn't matter what parameters we pass because they aren't used}
    FOnHorzScroll(nil, scTop, Dummy);
end;
procedure TFaxScrollBox.WMVScroll(var Message : TWMVScroll);
var
  Dummy : Integer;
begin
  inherited;
  if Assigned(FOnVertScroll) and (Message.ScrollBar = 0) and VertScrollBar.Visible then
    {Doesn't matter what parameters we pass because they aren't used}
    FOnVertScroll(nil, scTop, Dummy);
end;
{*** TFaxDesigner ***}
constructor TFaxDesigner.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  Align       := alClient;
  BevelInner  := bvNone;
  BevelOuter  := bvRaised;
  BorderStyle := bsNone;
  FIsNew      := True;
  fdScrollBox := TFaxScrollBox.Create(Self);
  with fdScrollBox do begin
    BorderStyle := bsNone;
    Parent      := Self;
    {$IFDEF Win32}
    HorzScrollBar.Tracking := True;
    VertScrollBar.Tracking := True;
    {$ENDIF}
    OnHorzScroll := HorzScroll;
    OnVertScroll := VertScroll;
  end;
  fdHorzRuler := TRuler.Create(Self);
  with fdHorzRuler do begin
    IsHorizontal := True;
    Parent       := Self;
  end;
  fdVertRuler := TRuler.Create(Self);
  with fdVertRuler do begin
    IsHorizontal := False;
    Parent       := Self;
  end;
  FFaxPanel := TFaxPanel.Create(Self);
  with FFaxPanel do begin
    Color  := clWindow;
    Parent := fdScrollBox;
  end;
  {These access FFaxPanel, so they must be called AFTER FFaxPanel is created}
  SetPageWidthPixels(ctDefaultWidthPixels);
  SetPageHeightPixels(ctDefaultHeightPixels);
  SetPageWidthInches(ctDefaultWidthInches);
  SetPageHeightInches(ctDefaultHeightInches);
  {FaxPanel.NeedsSaving will have been changed to True when we set the Width and
   Height in Inches. No changes have actually been made, so reset it to False.}
  FFaxPanel.NeedsSaving := False;
end;
procedure TFaxDesigner.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  Length    : Integer;
  OldWidth  : Integer;
  OldHeight : Integer;
  Dummy     : Integer;
begin
  OldWidth  := Width;
  OldHeight := Height;
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  if Parent <> nil then begin
    fdScrollBox.SetBounds(ALeft + fdVertRuler.Width, ATop + fdHorzRuler.Height,
                          Self.ClientWidth - fdVertRuler.Width,
                          Self.ClientHeight - fdHorzRuler.Height);
    {Ensure that HorzRuler doesn't get longer than the width of the FaxPanel}
    if Self.ClientHeight - fdHorzRuler.Height < FFaxPanel.Height then
      Length := Self.ClientHeight - fdHorzRuler.Height
    else
      Length := FFaxPanel.Height;
    fdVertRuler.SetBounds(0, fdHorzRuler.Height, fdVertRuler.Width, Length);
    {Ensure that VertRuler doesn't get taller than the height of the FaxPanel}
    if Self.ClientWidth - fdVertRuler.Width < FFaxPanel.Width then
      Length := Self.ClientWidth - fdVertRuler.Width
    else
      Length := FFaxPanel.Width;
    fdHorzRuler.SetBounds(fdVertRuler.Width, 0, Length, fdHorzRuler.Height);
    {If the form has been made wider or taller, its possible that the one of the
     rulers might need to "scroll" to match, so call HorzScroll or VertScroll
     as needed. It doesn't matter what parameters we pass because the parameters
     aren't used.}
    if Width <> OldWidth then
      HorzScroll(nil, scTop, Dummy);
    if Height <> OldHeight then
      VertScroll(nil, scTop, Dummy);
  end;
end;  
procedure TFaxDesigner.SetParent(AParent: TWinControl);
begin
  inherited SetParent(AParent);
  if Assigned(AParent) then
    {Now that a Parent is set, call SetBounds to put the Rulers in the correct positions}
    SetBounds(Left, Top, Width, Height);
end;
procedure TFaxDesigner.HorzScroll(Sender: TObject; ScrollCode: TScrollCode;
                              var ScrollPos: Integer);
var
  X, Y : Integer;
begin
  {Find the leftmost FFaxPanel point that is displaying within fdScrollBox}
  X := 0;
  Y := 0;
  ConvertCoords(fdScrollBox, FFaxPanel, X, Y);
  {Scroll fdHorzRuler to match the scroll position of FFaxPanel}
  fdHorzRuler.StartPosition := X;
end; 
procedure TFaxDesigner.VertScroll(Sender: TObject; ScrollCode: TScrollCode;
                              var ScrollPos: Integer);
var
  X, Y : Integer;
begin
  {Find the topmost FFaxPanel point that is displaying within fdScrollBox}
  X := 0;
  Y := 0;
  ConvertCoords(fdScrollBox, FFaxPanel, X, Y);
  {Scroll fdVertRuler to match the scroll position of FFaxPanel}
  fdVertRuler.StartPosition := Y;
end;
function TFaxDesigner.GetPageWidthPixels : Integer;
begin
  Result := FFaxPanel.Width;
end;
procedure TFaxDesigner.SetPageWidthPixels(AWidth : Integer);
var
  Dummy : Integer;
begin
  if FFaxPanel.Width <> AWidth then begin
    FFaxPanel.Width := AWidth;
    if Assigned(fdHorzRuler) then begin
      fdHorzRuler.SizePixels := AWidth;
      {Call SetBounds to force fdHorzRuler to the correct size}
      SetBounds(Left, Top, Width, Height);
      if Parent <> nil then
        HorzScroll(nil, scTop, Dummy);  {Update ruler position}
    end;
  end;
end;
function TFaxDesigner.GetPageHeightPixels : Integer;
begin
  Result := FFaxPanel.Height;
end;
procedure TFaxDesigner.SetPageHeightPixels(AHeight : Integer);
var
  Dummy : Integer;
begin
  if FFaxPanel.Height <> AHeight then begin
    FFaxPanel.Height := AHeight;
    if Assigned(fdVertRuler) then begin
      fdVertRuler.SizePixels := AHeight;
      //设为正确的大小
      SetBounds(Left, Top, Width, Height);
      if Parent <> nil then
        VertScroll(nil, scTop, Dummy);//更新尺的位置
    end;
  end;
end;
function TFaxDesigner.GetPageWidthInches : Double;
begin
  Result := FFaxPanel.PageWidthInches;
end;
procedure TFaxDesigner.SetPageWidthInches(AWidth : Double);
begin
  if Assigned(fdHorzRuler) then
    fdHorzRuler.SizeInches := AWidth;
  //调整页度
  FFaxPanel.PageWidthInches := AWidth;
  if PageWidthInches <> 0.0 then
    SetPageHeightPixels(Round(PageHeightInches * PageWidthPixels / PageWidthInches));
end;
function TFaxDesigner.GetPageHeightInches : Double;
begin
  Result := FFaxPanel.PageHeightInches;
end;
procedure TFaxDesigner.SetPageHeightInches(AHeight : Double);
begin
  if Assigned(fdVertRuler) then
    fdVertRuler.SizeInches := AHeight;
  FFaxPanel.PageHeightInches := AHeight;
  //调整页高
  if PageWidthInches <> 0.0 then
    SetPageHeightPixels(Round(PageHeightInches * PageWidthPixels / PageWidthInches));
end;
procedure TFaxDesigner.SetIsMetric(AIsMetric : Boolean);
begin
  if AIsMetric <> FIsMetric then begin
    FIsMetric := AIsMetric;
    if Assigned(fdHorzRuler) then
      fdHorzRuler.IsMetric := AIsMetric;
    if Assigned(fdVertRuler) then
      fdVertRuler.IsMetric := AIsMetric;
    //
    FFaxPanel.FieldPositionChangeForSelectedField;
  end;
end;
procedure TFaxDesigner.SetMarkPositions(ALeft, ATop, AWidth, AHeight : Integer);
begin
  if Assigned(fdHorzRuler) then
    fdHorzRuler.SetMarkPositions(ALeft, ALeft + AWidth);
  if Assigned(fdVertRuler) then
    fdVertRuler.SetMarkPositions(ATop, ATop + AHeight);
end;
procedure TFaxDesigner.Read(Stream : TStream);
var
  PageRec : TPageRecord;
begin
   Stream.ReadBuffer(PageRec, SizeOf(PageRec));
  with PageRec do begin
    if prVersionNum <> ctVersionNum then begin
      MessageDlg('Version mismatch! Unable to read Fax Cover Page!', mtError, [mbOK], 0);
      Exit;
    end;
    SetPageWidthPixels(prPageWidthPixels);
    SetPageHeightPixels(prPageHeightPixels);
    SetPageWidthInches(prPageWidthInches);
    SetPageHeightInches(prPageHeightInches);
    SetIsMetric(prIsMetric);
    FUserData := prUserData;
  end;
   FFaxPanel.Read(Stream);
  //设置为已存在封面页
  FIsNew := False;
end;
procedure TFaxDesigner.Write(Stream : TStream);
var
  PageRec : TPageRecord;
begin
  //初始化pageRec
  FillChar(PageRec, SizeOf(PageRec), 0);
  with PageRec do begin
    prVersionNum       := ctVersionNum;
    prPageWidthPixels  := GetPageWidthPixels;
    prPageHeightPixels := GetPageHeightPixels;
    prPageWidthInches  := GetPageWidthInches;
    prPageHeightInches := GetPageHeightInches;
    prIsMetric         := FIsMetric;
    prUserData         := FUserData;
  end;
  Stream.WriteBuffer(PageRec, SizeOf(PageRec));
  FFaxPanel.Write(Stream);
 
  FIsNew := False;
end;
end.

						