?? 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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -