faxfield.bak

将图像转换为传真文件

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