home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Chip 2001 October
/
Chip_2001-10_cd1.bin
/
zkuste
/
delphi
/
kompon
/
d123456
/
CHEMPLOT.ZIP
/
TPlot
/
Titles.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
2001-07-25
|
102KB
|
2,909 lines
unit Titles;
{$I Plot.inc}
{-----------------------------------------------------------------------------
The contents of this file are subject to the Q Public License
("QPL"); you may not use this file except in compliance
with the QPL. You may obtain a copy of the QPL from
the file QPL.html in this distribution, derived from:
http://www.trolltech.com/products/download/freelicense/license.html
The QPL prohibits development of proprietary software.
There is a Professional Version of this software available for this.
Contact sales@chemware.hypermart.net for more information.
Software distributed under the QPL is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the QPL for
the specific language governing rights and limitations under the QPL.
The Original Code is: Titles.pas, released 12 September 2000.
The Initial Developer of the Original Code is Mat Ballard.
Portions created by Mat Ballard are Copyright (C) 1999 Mat Ballard.
Portions created by Microsoft are Copyright (C) 1998, 1999 Microsoft Corp.
All Rights Reserved.
Contributor(s): Mat Ballard e-mail: mat.ballard@chemware.hypermart.net.
Last Modified: 02/25/2000
Current Version: 2.00
You may retrieve the latest version of this file from:
http://Chemware.hypermart.net/
This work was created with the Project JEDI VCL guidelines:
http://www.delphi-jedi.org/Jedi:VCLVCL
in mind.
Purpose:
This unit contains many sub-components:
TRectangle
TBorder
TCaption
TLegend
TTitle
that manage various screen areas and objects for TPlot.
Known Issues:
- This would normally be called Series, but TeeChart already uses that unit name.
-----------------------------------------------------------------------------}
interface
uses
Classes, SysUtils,
{$IFDEF NO_MATH}NoMath,{$ELSE}Math,{$ENDIF}
{$IFDEF WINDOWS}
Wintypes,
TrimStr,
Controls, Dialogs, Graphics,
{$ENDIF}
{$IFDEF WIN32}
Windows,
Controls, Dialogs, Graphics,
{$ENDIF}
{$IFDEF LINUX}
Types,
QControls, QDialogs, QGraphics,
{$ENDIF}
Misc, Plotdefs;
const
SIN_30 = 0.5;
SIN_60 = 0.86602540378443864676372317075294;
COS_30 = 0.86602540378443864676372317075294;
COS_60 = 0.5;
type
{TRectangle *******************************************************************}
TRectangle = class(TPersistent)
{TRectangle is extremely important to the functioning of TSciGraph.}
{}
{Not only is it used for a variety of objects, it is also the base class
of many on-screen objects: Axes, Titles, Captions, Legends, etc.}
{}
{As well as having the properties that one would expect for a rectangle,
it also has some properties that are useful to its various descendants:
Alignment, Name and Visibility to be precise.}
private
FAlignment: TAlignment;
FFireEvents: Boolean;
FLeft: Integer;
FTop: Integer;
FRight: Integer;
FBottom: Integer;
FName: String;
FOwner: TPersistent;
FTag: Longint;
FVisible: Boolean;
protected
FOnChange: TNotifyEvent;
{Events are normally private/published, but D1 does not allow descendants to
check the assignment of events: FOnChange is inaccessible, and OnChange
cannot be examined because it is a function.}
{Get functions for virtual properties:}
function GetHeight: Integer;
function GetWidth: Integer;
function GetMidX: Integer;
function GetMidY: Integer;
{Set procedures that we may wish to override later:}
procedure SetLeft(Value: Integer); virtual;
{This sets the Left screen position property. It also moves the Right by the
same amount, thereby preserving the Width. Ie: it moves the whole TRectangle.}
procedure SetMidX(Value: Integer); virtual;
{This sets the MidX screen virtual position property. It thereby moves the Left and Right.}
procedure SetMidY(Value: Integer); virtual;
{This sets the MidY screen virtual position property. It thereby moves the Top and Bottom.}
procedure SetTop(Value: Integer); virtual;
{This sets the Top screen position property. It also moves the Bottom by the
same amount, thereby preserving the Height. Ie: it moves the whole TRectangle.}
procedure SetAlignment(Value: TAlignment);
procedure SetRight(Value: Integer); virtual;
procedure SetBottom(Value: Integer); virtual;
procedure SetVisible(Value: Boolean); virtual;
{Set procedures for virtual properties:}
procedure SetHeight(Value: Integer); virtual;
procedure SetWidth(Value: Integer); virtual;
procedure DoHandleChange; virtual;
{All Set methods call this to handle the OnChange logic.}
public
{virtual write-only properties:}
//property DeltaX: Integer write SetDeltaX;
{This changes the Left and Right by DeltaX, thereby moving the TRectangle.
It is similar to getting then setting the Left property, but quicker.}
//property DeltaY: Integer write SetDeltaY;
{This changes the Top and Bottom by DeltaY, thereby moving the TRectangle.
It is similar to getting then setting the Top property, but quicker.}
property Owner: TPersistent read FOwner;
{This is similar to TComponent.Owner: TComponent, except that:}
{ 1. it is a TPersistent;}
{ 2. this component is NOT freed automatically when the Owner is freed.}
property Tag: Longint read FTag write FTag;
{The usual Tag property, as in TComponent.Tag}
{}
{However, DO NOT USE THIS PROPERTY !
It is used by TPlot to store the object type, and hence control the visible
behaviour of the TRectangle descendant.}
Constructor Create(AOwner: TPersistent); virtual;
{The standard constructor, where standard properties are set.}
Destructor Destroy; override;
{The standard destructor, where the OnChange event is "freed".}
{procedure Assign(Source: TPersistent); override;}
procedure AssignTo(Dest: TPersistent); override;
{TRectangle's implementation of the standard Assign(To) method.}
procedure AssignToRect(Dest: TRect);
{TRectangle's implementation of a non-standard AssignTo method.}
function ClickedOn(iX, iY: Integer): Boolean; virtual;
{Was this TRectangle clicked on ?}
procedure MoveTo(iX, iY: Integer); virtual;
{Move the rectangle to a new (Top, Left) location.}
procedure MoveBy(dX, dY: Integer); virtual;
{Move the rectangle by (iX, iY) from (Top, Left) to (Top + iX, Left + iY) .}
procedure Outline(ACanvas: TCanvas); virtual;
{Draws an Outline around this rectangle.}
published
property Alignment: TAlignment read FAlignment write SetAlignment;
{Can a rectangle have alignment ? Not really, but its descendants can !}
property FireEvents: Boolean read FFireEvents write FFireEvents;
{Do we fire events in response to a geometry change ?
For the TCaption descendants, the answer is no, because they dance around
the screen with every repaint.}
property Name: String read FName write FName;
{This is what is displayed when the user is offered a choice.
Eg: "Move the X-Axis Caption or the Bottom Border ?".}
property Left: Integer read FLeft write SetLeft;
{This is the usual position property.}
property Top: Integer read FTop write SetTop;
{This is the usual position property.}
property Right: Integer read FRight write SetRight;
{This is the usual position property.}
property Bottom: Integer read FBottom write SetBottom;
{This is the usual position property.}
Property Visible: Boolean read FVisible write SetVisible;
{Is the Rectangle (or its descendants) visible ?}
{virtual properties:}
property Height: Integer read GetHeight write SetHeight;
{The standard Height property.}
property Width: Integer read GetWidth write SetWidth;
{The standard Width property.}
property MidX: Integer read GetMidX write SetMidX;
{The X midpoint of the TRectangle.}
property MidY: Integer read GetMidY write SetMidY;
{The Y midpoint of the TRectangle.}
Property OnChange: TNotifyEvent read FOnChange write FOnChange;
{The standard OnChange event (for geometry).}
end;
{TBorder **********************************************************************}
TBorder = class(TRectangle)
{TBorder adds a third point to a TRectangle, hence creating a border.
The following diagram explains this:}
{}
{ Top, Left
----------------------------------------====================
| | + |
| | + |
| | + |
| | + |
| .MidX,MidY |<----RightGap---->+ |
| | + |
| | + |
| |Right,Bottom + HeightEx
----------------------------------------******************** |
+ | * # |
+ | * # |
+ BottomGap * # |
+ | * # |
+ | * # |
+=======================================*###################
RightEx,BottomEx
<---------------------------WidthEx------------------------>
}
private
FRightEx: Integer;
FBottomEx: Integer;
procedure SetRightEx(Value: Integer);
procedure SetBottomEx(Value: Integer);
{Get functions for the new virtual properties:}
function GetRightGap: Integer;
function GetBottomGap: Integer;
function GetHeightEx: Integer;
function GetWidthEx: Integer;
{Set procedures for the new virtual properties:}
procedure SetRightGap(Value: Integer);
procedure SetBottomGap(Value: Integer);
procedure SetHeightEx(Value: Integer);
procedure SetWidthEx(Value: Integer);
protected
procedure SetLeft(Value: Integer); override;
{Setting the Left also moves the Right and RightEx, thereby preserving the
Width and RightGap. Ie: it moves the whole TBorder.}
procedure SetTop(Value: Integer); override;
{Setting the Top also moves the Bottom and BottomEx, thereby preserving the
Height and BottomGap. Ie: it moves the whole TBorder.}
public
Constructor Create(AOwner: TPersistent); override;
{The standard constructor, where standard properties are set.}
published
property RightEx: Integer read FRightEx write SetRightEx;
{The extreme right, to the right of Right.}
property BottomEx: Integer read FBottomEx write SetBottomEx;
{The extreme Bottom, below Bottom.}
{the "virtual" properties:}
property RightGap: Integer read GetRightGap write SetRightGap;
{The gap (or width) between the Right and RightEx.}
property BottomGap: Integer read GetBottomGap write SetBottomGap;
{The gap (or height) between the Bottom and BottomEx.}
property HeightEx: Integer read GetHeightEx write SetHeightEx;
{The total height between the Top and BottomEx.}
property WidthEx: Integer read GetWidthEx write SetWidthEx;
{The total width between the Left and RightEx.}
end;
{TAngleRect *******************************************************************}
{TAngleRect is extremely important to the functioning of TSciGraph.}
{}
{Not only is it used for a variety of objects, it is also the base class
of many on-screen objects: Axes, Titles, Captions, Legends, etc.}
{}
{As well as having the properties that one would expect for a rectangle,
it also has some properties that are useful to its various descendants:
Alignment, Name and Visibility to be precise.
^
.
.
__- .
_O-- \. ╪ - Angle between vertical and parallelogram
_-- \ \ ╪ = 0 for Y Axis
\ \ .\ ╪ = 90 for X Axis
\ \ . \ ╪ = 225 for Z Axis
\ \ . \
\ \ . \ Real properties are:
\ \. \ Origin(.x,y), Length, Breadth, Angle
\ ......\..................>
\ \ \ Virtual properties are:
\ \ \ Left, Top, Right, Bottom,
\ \ \ Height, Width
\ \ \
\ \ \ Rotation by ╪:
\ \ __-- [NewX] = [cos╪ sin╪][X]
\ __V- [NewY] [-sin╪ cos╪][Y]
\_--
}
TAngleRect = class(TRectangle)
private
FAngle: TDegrees;
FAngleRadians: Single;
FLength,
FBreadth: Word;
FCentre: TPoint;
FOrigin: TPoint;
FPolyRect: array[0..4] of TPoint;
FSin,
FCos,
FSinM30,
FCosM30,
FSinP30,
FCosP30: Extended;
protected
{Descendants need access to these sines and cosines:}
property Sin: Extended read FSin;
property Cos: Extended read FCos;
property SinM30: Extended read FSinM30;
property CosM30: Extended read FCosM30;
property SinP30: Extended read FSinP30;
property CosP30: Extended read FCosP30;
procedure DoGeometry;
function RotatePoint(APoint: TPoint): TPoint;
{Real properties:}
procedure SetAngle(Value: TDegrees);
{Sets the angle of the rectangle to the vertical.}
procedure SetLength(Value: Word);
{Sets the length of opposite sides parallel to the Vector of the rectangle.}
procedure SetBreadth(Value: Word);
{Sets the length of opposite sides perpendicular to the Vector of the rectangle.}
procedure SetOrigin(Value: TPoint);
{This sets the Origin REAL screen position property.}
{Get functions for VIRTUAL properties:}
function GetVector: TPoint; virtual;
{Set procedures for virtual properties:}
procedure SetLeft(Value: Integer); override;
{This sets the Left virtual screen position property,
thereby changing the MidX, inter alia.}
procedure SetTop(Value: Integer); override;
{This sets the Top virtual screen position property,
thereby changing the MidY, inter alia.}
procedure SetRight(Value: Integer); override;
{This sets the Right virtual screen position property,
thereby changing the Width, inter alia.}
procedure SetBottom(Value: Integer); override;
{This sets the Bottom virtual screen position property,
thereby changing the Height, inter alia.}
procedure SetMidX(Value: Integer); override;
{This sets the MidX screen virtual position property. It thereby moves the Left and Right.}
procedure SetMidY(Value: Integer); override;
{This sets the MidY screen virtual position property. It thereby moves the Top and Bottom.}
procedure SetHeight(Value: Integer); override;
{This sets the Height virtual screen position property,
thereby changing the ???, inter alia.}
procedure SetWidth(Value: Integer); override;
{This sets the Width virtual screen position property,
thereby changing the ???, inter alia.}
procedure SetCentre(NewCentre: TPoint); virtual;
{This sets the new centre of the Rectangle.}
procedure SetVector(Value: TPoint); virtual;
{This sets the Vector virtual screen position property,
thereby changing the Length and Angle.}
public
{$IFDEF BCB}
property Origin: TPoint read FOrigin write SetOrigin;
{The origin of the Rectangle: eg: (MidY, Left) for an X Axis.}
{Now the virtual properties:}
property Centre: TPoint read FCentre write SetCentre;
{The centre of the rotated rectangle.}
property Vector: TPoint read GetVector write SetVector;
{The Vector of the Rectangle: eg: (Width, 0) for an X Axis.}
{$ENDIF}
Constructor Create(AOwner: TPersistent); override;
{The standard constructor, where standard properties are set.}
Destructor Destroy; override;
{The standard destructor, where the OnChange event is "freed".}
procedure AssignTo(Dest: TPersistent); override;
{TRectangle's implementation of the standard Assign(To) method.}
function ClickedOn(iX, iY: Integer): Boolean; override;
{Was this TRectangle clicked on ?}
procedure MoveTo(NewX, NewY: Integer); override;
{Move the rectangle to a new (Top, Left) location.}
procedure MoveBy(dX, dY: Integer); override;
{Move the rectangle by (iX, iY) from (Top, Left) to (Top + iX, Left + iY) .}
procedure SetNewGeometry(NewOrigin: TPoint; NewAngle: TDegrees; NewLength, NewBreadth: Integer);
{Move the rectangle to a new (Top, Left) location.}
procedure Outline(ACanvas: TCanvas); override;
{Draws an Outline around this rectangle.}
published
{Real properties:}
{A rectangle does not really have alignment - but its descendants do,
and it is neccessary to to put the arrows on the axes.
- taLeftJustify means that the arrow points towards the Origin
- taRightJustify means that the arrow points away from the Origin
- taCenter means no arrow.}
property Angle: TDegrees read FAngle write SetAngle;
{The angle between the rotated rectangle and the vertical.}
property Breadth: Word read FBreadth write SetBreadth;
{The broadness of the rectangle - can be either the Width or Height or something else.}
property Length: Word read FLength write SetLength;
{The Length of the rectangle - can be either the Width or Height or something else.}
{$IFNDEF BCB}
property Origin: TPoint read FOrigin write SetOrigin;
{The origin of the Rectangle: eg: (MidY, Left) for an X Axis.}
{Now the virtual properties:}
property Centre: TPoint read FCentre write SetCentre;
{The centre of the rotated rectangle.}
property Vector: TPoint read GetVector write SetVector;
{The Vector of the Rectangle: eg: (Width, 0) for an X Axis.}
{$ENDIF}
end;
{TCaption *********************************************************************}
TCaption = class(TRectangle)
{A TCaption inherits the positional behaviour of TRectangle,
and adds a Caption and a Font.}
private
FCaption: String;
FFont: TFont;
FOnCaptionChange: TNotifyEvent;
protected
procedure CreateName; virtual;
{This sets the name after the Caption is set.}
procedure SetCaption(Value: String); virtual;
{This sets the Caption and calls CreateName.}
procedure SetFont(Value: TFont);
public
constructor Create(AOwner: TPersistent); override;
destructor Destroy; override;
{The standard constructor, where standard properties are set.}
{procedure Assign(Source: TPersistent); override;}
procedure AssignTo(Dest: TPersistent); override;
published
property Caption: String read FCaption write SetCaption;
{This is the text that is displayed on the screen.
Eg: "X-Axis". Setting the Caption also sets the Name:}
{}
{ FName := FCaption + ' Caption';}
property Font: TFont read FFont write SetFont;
{The font used to display the caption.}
Property OnCaptionChange: TNotifyEvent read FOnCaptionChange write FOnCaptionChange;
{Has the Caption changed ?}
end;
{TTitle ***********************************************************************}
TTitle = class(TCaption)
{This is an extended TCaption that dances around the screen depending on
Alignment, Orientation and Direction, and Draws itself.}
private
FDirection : TDirection;
FOrientation: TOrientation;
FEnvelope: TRect;
FUnits: String;
FFullCaption: String;
procedure SetDirection(Value: TDirection);
procedure SetOrientation(Value: TOrientation);
procedure SetEnvelope(Value: TRect);
procedure SetUnits(Value: String);
protected
procedure DoGeometry(ACanvas: TCanvas; TheText: String); dynamic;
{This determines where the TTitle is exactly on the screen, depending on the
Envelope, Direction, Orientation and Alignment.}
procedure SetCaption(Value: String); override;
{This handles the tricky question of Caption and Units. If Value contains a
pair of brackets '()', then the contents of these brackets is taken to be the
Units. If it doesn't, then the FullCaption is constructed from Value and Units.}
public
property Envelope: TRect read FEnvelope write SetEnvelope;
{This is the region just outside which the Caption can appear.
Its exact position will depend on the Alignment, Direction and Orientation}
property FullCaption: String read FFullCaption;
{This is a read-only property formed from the Caption and the Units.}
constructor Create(AOwner: TPersistent); override;
{The standard constructor, where standard properties are set.}
procedure Draw(ACanvas: TCanvas);
{procedure Assign(Source: TPersistent); override;}
procedure AssignTo(Dest: TPersistent); override;
{This Draws the TTitle on the given Canvas. It calls DoGeometry, and also
various API functions to create a vertical font if neccessary.}
published
property Units: String read FUnits write SetUnits;
{These are the physical units, eg: mm, mV, seconds, etc, of the Axis.}
property Direction : TDirection read FDirection write SetDirection;
{Is the Caption drawn Horizontal or Vertical ?}
property Orientation: TOrientation read FOrientation write SetOrientation;
{Is the caption to the Left or Right of the Axis ?}
end;
{TLegend **********************************************************************}
TLegend = class(TRectangle)
{This is an extended TCaption that dances around the screen depending on
Alignment, Orientation and Direction, and Draws itself.}
private
FCheckboxes: Boolean;
FDirection : TDirection;
FFont: TFont;
FFontHeight: Integer;
FStringWidth: Integer;
FCheckWidth: Integer;
FLineWidth: Integer;
FSeriesList: TList;
protected
function GetItemWidth: Integer;
procedure SetCheckboxes(Value: Boolean);
procedure SetDirection(Value: TDirection);
procedure SetFont(Value: TFont);
//procedure SetFontHeight(Value: Integer);
//procedure SetStringWidth(Value: Integer);
public
property FontHeight: Integer read FFontHeight;
{The height of the font.}
//property StringWidth: Integer read FStringWidth;
{The width of the text portion of the Legend.}
//property SymbolWidth: Integer read GetSymbolWidth;
{The width of the Symbol + Line portion of the Legend.}
{It is 1/3rd of the StringWidth.}
property ItemWidth: Integer read GetItemWidth;
constructor CreateList(AOwner: TPersistent; SeriesList: TList); virtual;
destructor Destroy; override;
function GetHit(iX, iY: Integer; var TheRect: TRect): Integer;
{The rectangle of the series name under the point iX, iY.}
procedure Draw(ACanvas: TCanvas; SeriesIncrement: Integer);
published
property CheckBoxes: Boolean read FCheckBoxes write SetCheckBoxes;
{Display Checkboxes ?}
property Direction : TDirection read FDirection write SetDirection;
{Is the Legend drawn Horizontal or Vertical ?}
property Font: TFont read FFont write SetFont;
{The font used to display the caption.}
end;
{TNote ************************************************************************}
TNote = class(TCaption)
private
FArrowLeft: Integer;
FArrowTop: Integer;
FArrowLeftReal: Single;
FArrowTopReal: Single;
FOwner: TPersistent; {ie: TPlot}
FLeftReal: Single;
FTopReal: Single;
//FOnNoteChange: TNotifyEvent;
ArrowStartLeft: Integer;
ArrowStartTop: Integer;
protected
procedure SetLeft(Value: Integer); override;
procedure SetTop(Value: Integer); override;
procedure SetArrowLeft(Value: Integer); virtual;
procedure SetArrowTop(Value: Integer); virtual;
procedure SetArrowLeftReal(Value: Single); virtual;
procedure SetArrowTopReal(Value: Single); virtual;
procedure SetLeftReal(Value: Single); virtual;
procedure SetTopReal(Value: Single); virtual;
public
constructor Create(AOwner: TPersistent); override;
{destructor Destroy; override;}
procedure AssignTo(Dest: TPersistent); override;
{procedure Assign(Source: TPersistent); override;}
procedure Draw(ACanvas: TCanvas);
{This Draws the TTitle on the given Canvas. It calls DoGeometry, and also
various API functions to create a vertical font if neccessary.}
procedure TracePointerTo(ACanvas: TCanvas; iX, iY: Integer);
published
property ArrowLeft: Integer read FArrowLeft write SetArrowLeft;
property ArrowTop: Integer read FArrowTop write SetArrowTop;
property ArrowLeftReal: Single read FArrowLeftReal write SetArrowLeftReal;
property ArrowTopReal: Single read FArrowTopReal write SetArrowTopReal;
property LeftReal: Single read FLeftReal write SetLeftReal;
property TopReal: Single read FTopReal write SetTopReal;
//Property OnNoteChange: TNotifyEvent read FOnNoteChange write FOnNoteChange;
end;
implementation
uses
Data, Plot;
{Constructor and Destructor:-------------------------------------------------}
{------------------------------------------------------------------------------
Constructor: TRectangle.Create
Description: Standard Constructor for TRectangle
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: initializes component and properties
Known Issues:
------------------------------------------------------------------------------}
Constructor TRectangle.Create(AOwner: TPersistent);
begin
{First call the ancestor:
inherited Create; - TObject.Create does nothing}
FOwner := AOwner;
{we insert the default values that cannot be "defaulted":}
FAlignment := taCenter;
FLeft := 10;
FTop := 10;
SetRight(100);
SetBottom(100);
FVisible := TRUE;
{global change event handler:}
FOnChange := nil;
{we do fire events with a geometry change:}
FireEvents := TRUE;
end;
{------------------------------------------------------------------------------
Destructor: TRectangle.Destroy
Description: standard destructor
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: frees the OnChange event
Known Issues:
------------------------------------------------------------------------------}
Destructor TRectangle.Destroy;
begin
FOnChange := nil;
{then call ancestor:}
inherited Destroy;
end;
{------------------------------------------------------------------------------
Procedure: TRectangle.Assign
Description: standard Assign method
Author: Mat Ballard
Date created: 07/06/2000
Date modified: 07/06/2000 by Mat Ballard
Purpose: implements Assign
Known Issues:
------------------------------------------------------------------------------}
{procedure TRectangle.Assign(Source: TPersistent);
begin
inherited Assign(Source);
FLeft := TRectangle(Source).Left;
FTop := TRectangle(Source).Top;
FRight := TRectangle(Source).Right;
FBottom := TRectangle(Source).Bottom;
end;}
{------------------------------------------------------------------------------
Procedure: TRectangle.AssignTo
Description: standard AssignTo method
Author: Mat Ballard
Date created: 07/06/2000
Date modified: 07/06/2000 by Mat Ballard
Purpose: implements AssignTo
Known Issues:
------------------------------------------------------------------------------}
procedure TRectangle.AssignTo(Dest: TPersistent);
begin
{we DON'T call the ancestor, because TPersistent.AssignTo simply throws an
exception:
inherited AssignTo(Dest);}
TRectangle(Dest).Left := FLeft;
TRectangle(Dest).Top := FTop;
TRectangle(Dest).Right := FRight;
TRectangle(Dest).Bottom := FBottom;
end;
{------------------------------------------------------------------------------
Procedure: TRectangle.AssignToRect
Description: non-standard AssignTo method
Author: Mat Ballard
Date created: 07/06/2001
Date modified: 07/06/2001 by Mat Ballard
Purpose: implements a non-standard AssignTo
Known Issues:
------------------------------------------------------------------------------}
procedure TRectangle.AssignToRect(Dest: TRect);
begin
Dest.Left := FLeft;
Dest.Top := FTop;
Dest.Right := FRight;
Dest.Bottom := FBottom;
end;
{Begin Set and Get Functions and Procedures----------------------------------}
{Get Functions for virtual properties ---------------------------------------}
{------------------------------------------------------------------------------
Function: TRectangle.GetHeight
Description: private property Get function
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: Gets the Height, which is a virtual property
Known Issues:
------------------------------------------------------------------------------}
function TRectangle.GetHeight: Integer;
begin
GetHeight := FBottom - FTop;
end;
{------------------------------------------------------------------------------
Function: TRectangle.GetWidth
Description: private property Get function
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: Gets the Width, which is a virtual property
Known Issues:
------------------------------------------------------------------------------}
function TRectangle.GetWidth: Integer;
begin
GetWidth := FRight - FLeft;
end;
{------------------------------------------------------------------------------
Function: TRectangle.GetMidX
Description: private property Get function
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: Gets the MidX, which is a virtual property
Known Issues:
------------------------------------------------------------------------------}
function TRectangle.GetMidX: Integer;
begin
GetMidX := (FLeft + FRight) div 2;
end;
{------------------------------------------------------------------------------
Function: TRectangle.GetMidY
Description: private property Get function
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: Gets the MidY, which is a virtual property
Known Issues:
------------------------------------------------------------------------------}
function TRectangle.GetMidY: Integer;
begin
GetMidY := (FTop + FBottom) div 2;
end;
{Set Procedures -------------------------------------------------------------}
{------------------------------------------------------------------------------
Procedure: TRectangle.SetAlignment
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the Alignment
Known Issues:
------------------------------------------------------------------------------}
procedure TRectangle.SetAlignment(Value: TAlignment);
begin
if (Value = FAlignment) then exit;
FAlignment := Value;
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TRectangle.SetLeft
Description: protected property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the Left, which also moves the Right, thereby preserving the Width
Known Issues:
------------------------------------------------------------------------------}
procedure TRectangle.SetLeft(Value: Integer);
begin
if (Value = FLeft) then exit;
FRight := FRight + (Value - FLeft);
FLeft := Value;
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TRectangle.SetTop
Description: protected property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the Top, which also also moves the Bottom, thereby preserving the Height
Known Issues:
------------------------------------------------------------------------------}
procedure TRectangle.SetTop(Value: Integer);
begin
if (Value = FTop) then exit;
FBottom := FBottom + (Value - FTop);
FTop := Value;
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TRectangle.SetRight
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the Right
Known Issues:
------------------------------------------------------------------------------}
procedure TRectangle.SetRight(Value: Integer);
begin
if (Value = FRight) then exit;
FRight := Value;
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TRectangle.SetBottom
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the Bottom
Known Issues:
------------------------------------------------------------------------------}
procedure TRectangle.SetBottom(Value: Integer);
begin
if (Value = FBottom) then exit;
FBottom := Value;
DoHandleChange;
end;
{Set procedures for virtual properties ---------------------------------------}
{------------------------------------------------------------------------------
Procedure: TRectangle.SetHeight
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the Height, a virtual property, by moving the Bottom
Known Issues:
------------------------------------------------------------------------------}
procedure TRectangle.SetHeight(Value: Integer);
begin
if ((Value = 0) or (Value = GetHeight)) then exit;
Inc(FBottom, Value - (FBottom - FTop));
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TRectangle.SetWidth
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the Width, a virtual property, by moving the Right
Known Issues:
------------------------------------------------------------------------------}
procedure TRectangle.SetWidth(Value: Integer);
begin
if ((Value = 0) or (Value = GetWidth)) then exit;
Inc(FRight, Value - (FRight - FLeft));
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TRectangle.SetMidX
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the MidX, a virtual property, by moving the Left and Right
Known Issues:
------------------------------------------------------------------------------}
procedure TRectangle.SetMidX(Value: Integer);
var
OldMidX: Integer;
Change: Integer;
begin
if (Value = GetMidX) then exit;
OldMidX := (FRight + FLeft) div 2;
Change := Value - OldMidX;
Inc(FLeft, Change);
Inc(FRight, Change);
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TRectangle.SetMidY
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the MidY, a virtual property, by moving the Top and Bottom
Known Issues:
------------------------------------------------------------------------------}
procedure TRectangle.SetMidY(Value: Integer);
var
OldMidY: Integer;
Change: Integer;
begin
if (Value = GetMidY) then exit;
OldMidY := (FTop + FBottom) div 2;
Change := Value - OldMidY;
Inc(FTop, Change);
Inc(FBottom, Change);
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TRectangle.SetDeltaX
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: moves the Rectangle in the X direction, by changing the Left and Right
Known Issues:
------------------------------------------------------------------------------}
{procedure TRectangle.SetDeltaX(Value: Integer);
begin
if (Value = 0) then exit;
Inc(FLeft, Value);
Inc(FRight, Value);
DoHandleChange;
end;}
{------------------------------------------------------------------------------
Procedure: TRectangle.SetDeltaY
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: moves the Rectangle in the Y direction, by changing the Top and Bottom
Known Issues:
------------------------------------------------------------------------------}
{procedure TRectangle.SetDeltaY(Value: Integer);
begin
if (Value = 0) then exit;
Inc(FTop, Value);
Inc(FBottom, Value);
DoHandleChange;
end;}
{------------------------------------------------------------------------------
Procedure: TRectangle.SetVisible
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the Visibility
Known Issues:
------------------------------------------------------------------------------}
procedure TRectangle.SetVisible(Value: Boolean);
begin
if (FVisible = Value) then exit;
FVisible := Value;
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TRectangle.ClickedOn
Description: Was this TRectangle clicked on ?
Author: Mat Ballard
Date created: 01/22/2001
Date modified: 01/22/2001 by Mat Ballard
Purpose: screen click management
Known Issues:
------------------------------------------------------------------------------}
function TRectangle.ClickedOn(iX, iY: Integer): Boolean;
begin
if ((FLeft <= iX) and
(iX <= FRight) and
(FTop <= iY) and
(iY <= FBottom) and
(FVisible)) then
ClickedOn := TRUE
else
ClickedOn := FALSE;
end;
{------------------------------------------------------------------------------
Procedure: TRectangle.Outline
Description: Draws an Outline around this rectangle
Author: Mat Ballard
Date created: 01/22/2001
Date modified: 01/22/2001 by Mat Ballard
Purpose: gives the user a guide to what they are moving with the mouse
Known Issues:
------------------------------------------------------------------------------}
procedure TRectangle.Outline(ACanvas: TCanvas);
begin
ACanvas.Pen.Color := clBlack;
ACanvas.Pen.Mode := pmNotXOR;
ACanvas.Pen.Style := psDash;
ACanvas.Rectangle(FLeft, FTop, FRight, FBottom);
end;
{------------------------------------------------------------------------------
Procedure: TRectangle.MoveTo
Description: Move the rectangle to a new (Top, Left) location.
Author: Mat Ballard
Date created: 06/12/2001
Date modified: 06/12/2001 by Mat Ballard
Purpose: location / geometry management
Known Issues:
------------------------------------------------------------------------------}
procedure TRectangle.MoveTo(iX, iY: Integer);
begin
if ((FLeft = iX) and (FTop = iY)) then exit;
FRight := FRight + (iX - FLeft);
FLeft := iX;
{Trigger a change event:}
Top := iY;
end;
{------------------------------------------------------------------------------
Procedure: TRectangle.MoveBy
Description: Move the rectangle by (iX, iY) from (Top, Left) to (Top + iX, Left + iY).
Author: Mat Ballard
Date created: 06/12/2001
Date modified: 06/12/2001 by Mat Ballard
Purpose: location / geometry management
Known Issues:
------------------------------------------------------------------------------}
procedure TRectangle.MoveBy(dX, dY: Integer);
begin
if ((dX = 0) and (dY = 0)) then exit;
Inc(FRight, dX);
Inc(FLeft, dX);
{Trigger a change event:}
Top := FTop + dY;
end;
{------------------------------------------------------------------------------
Procedure: TRectangle.DoHandleChange
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/27/2000
Date modified: 02/27/2000 by Mat Ballard
Purpose: all Change Event firing passes through here
Known Issues:
------------------------------------------------------------------------------}
procedure TRectangle.DoHandleChange;
begin
if (FireEvents and assigned(FOnChange) and FVisible) then OnChange(Self);
end;
{TBorder Constructor and Destructor:-------------------------------------------}
{------------------------------------------------------------------------------
Constructor: TBorder.Create
Description: Standard Constructor for TBorder
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: initializes component and properties
Known Issues:
------------------------------------------------------------------------------}
Constructor TBorder.Create(AOwner: TPersistent);
begin
{First call the ancestor:}
inherited Create(AOwner);
{we insert the default values that cannot be "defaulted":}
FRightEx := Right + 10;
FBottomEx := Bottom + 10;
end;
{Begin Get Functions --------------------------------------------------------}
{the "virtual" properties:}
{------------------------------------------------------------------------------
Function: TBorder.GetRightGap
Description: private property Get function
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: Gets the Right Gap
Known Issues:
------------------------------------------------------------------------------}
function TBorder.GetRightGap: Integer;
begin
GetRightGap := FRightEx - Right;
end;
{------------------------------------------------------------------------------
Function: TBorder.GetBottomGap
Description: private property Get function
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: Gets the Bottom Gap
Known Issues:
------------------------------------------------------------------------------}
function TBorder.GetBottomGap: Integer;
begin
GetBottomGap := FBottomEx - Bottom;
end;
{------------------------------------------------------------------------------
Function: TBorder.GetHeightEx
Description: private property Get function
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: Gets the Total Height (Height + BottomGap)
Known Issues:
------------------------------------------------------------------------------}
function TBorder.GetHeightEx: Integer;
begin
GetHeightEx := FBottomEx - Top;
end;
{------------------------------------------------------------------------------
Function: TBorder.GetWidthEx
Description: private property Get function
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: Gets the Total Width (Width + RightGap)
Known Issues:
------------------------------------------------------------------------------}
function TBorder.GetWidthEx: Integer;
begin
GetWidthEx := FRightEx - Left;
end;
{Begin Set Procedures -------------------------------------------------------}
{------------------------------------------------------------------------------
Procedure: TBorder.SetLeft
Description: protected property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the Left, which DOES NOT move the Right and the RightEx, unlike TRectangle.SetLeft
Known Issues:
------------------------------------------------------------------------------}
procedure TBorder.SetLeft(Value: Integer);
begin
if (Value = FLeft) then exit;
FLeft := Value;
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TBorder.SetTop
Description: protected property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the Top, which DOES NOT move the Bottom and BottomEx, unlike TRectangle.SetTop
Known Issues:
------------------------------------------------------------------------------}
procedure TBorder.SetTop(Value: Integer);
begin
if (Value = FTop) then exit;
FTop := Value;
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TBorder.SetRightEx
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the RightEx
Comment: the design philosophy is that changing the RightEx changes the value
of both Right, AND RightEX. If the user changes the RightEx, then that is about
making the whole object bigger.
Known Issues:
------------------------------------------------------------------------------}
procedure TBorder.SetRightEx(Value: Integer);
var
Change: Integer;
begin
if (Value = FRightEx) then exit;
Change := Value - FRightEx;
FRightEx := Value;
Inc(FRight, Change);
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TBorder.SetBottomEx
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the BottomEx
Comments: See comments for SetRightEx
Known Issues:
------------------------------------------------------------------------------}
procedure TBorder.SetBottomEx(Value: Integer);
var
Change: Integer;
begin
if (Value = FBottomEx) then exit;
Change := Value - FBottomEx;
FBottomEx := Value;
Inc(FBottom, Change);
DoHandleChange;
end;
{Begin Set Procedures for virtual properties --------------------------------}
{------------------------------------------------------------------------------
Procedure: TBorder.SetRightGap
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the Right Gap
Comment: the design philosophy is that changing the Right Gap changes the value
of Right, NOT RightEX. If the user changes the gap, then that is about
re-apportioning the available space (Left -> RightEx) between the Right Gap and
the Width (Right-Left)
Known Issues:
------------------------------------------------------------------------------}
procedure TBorder.SetRightGap(Value: Integer);
var
OldRightGap, Change, NewRight: Integer;
begin
if (Value <= 0) then exit;
if (Value = GetRightGap) then exit;
OldRightGap := FRightEx - Right;
Change := Value - OldRightGap;
NewRight := Right - Change;
if (NewRight <= Left) then exit;
Right := NewRight;
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TBorder.SetBottomGap
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the Bottom Gap.
Comment: See comments for SetRightGap
Known Issues:
------------------------------------------------------------------------------}
procedure TBorder.SetBottomGap(Value: Integer);
var
OldBottomGap, Change, NewBottom: Integer;
begin
if (Value <= 0) then exit;
if (Value = GetBottomGap) then exit;
OldBottomGap := FBottomEx - Bottom;
Change := Value - OldBottomGap;
NewBottom := Bottom - Change;
if (NewBottom <= Top) then exit;
Bottom := NewBottom;
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TBorder.SetHeightEx
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the
Comment: the design philosophy is that changing the Total Height changes the value
of Bottom AND BottomEX. If the user changes the Total Height, then that is about
making the Height larger or smaller whilst preserving the BottomGap
Known Issues:
------------------------------------------------------------------------------}
procedure TBorder.SetHeightEx(Value: Integer);
var
OldHeightEx, Change: Integer;
begin
if (Value <= GetBottomGap) then exit;
if (Value = GetHeightEx) then exit;
OldHeightEx := FBottomEx - Top;
Change := Value - OldHeightEx;
Bottom := Bottom + Change;
Inc(FBottomEx, Change);
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TBorder.SetWidthEx
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the WidthEx
Comments: See comment about SetHeightEx
Known Issues:
------------------------------------------------------------------------------}
procedure TBorder.SetWidthEx(Value: Integer);
var
OldWidthEx, Change: Integer;
begin
if (Value <= GetRightGap) then exit;
if (Value = GetWidthEx) then exit;
OldWidthEx := FRightEx - Left;
Change := Value - OldWidthEx;
Right := Right + Change;
Inc(FRightEx, Change);
DoHandleChange;
end;
{Constructor and Destructor:-------------------------------------------------}
{------------------------------------------------------------------------------
Constructor: TAngleRect.Create
Description: Standard Constructor for TRectangle
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: initializes component and properties
Known Issues:
------------------------------------------------------------------------------}
Constructor TAngleRect.Create(AOwner: TPersistent);
begin
{First call the ancestor:
inherited Create; - TObject.Create does nothing}
FOwner := AOwner;
{we insert the default values that cannot be "defaulted":}
FAlignment := taCenter;
FOrigin.x := 100;
FOrigin.y := 100;
FLength := 100;
FBreadth := 50;
FVisible := TRUE;
{global change event handler:}
FOnChange := nil;
{we do fire events with a geometry change:}
FireEvents := TRUE;
Angle := 90;
end;
{------------------------------------------------------------------------------
Destructor: TAngleRect.Destroy
Description: standard destructor
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: frees the OnChange event
Known Issues:
------------------------------------------------------------------------------}
Destructor TAngleRect.Destroy;
begin
FOnChange := nil;
{then call ancestor:}
inherited Destroy;
end;
{------------------------------------------------------------------------------
Procedure: TAngleRect.AssignTo
Description: standard AssignTo method
Author: Mat Ballard
Date created: 07/06/2000
Date modified: 07/06/2000 by Mat Ballard
Purpose: implements AssignTo
Known Issues:
------------------------------------------------------------------------------}
procedure TAngleRect.AssignTo(Dest: TPersistent);
begin
TAngleRect(Dest).Angle := FAngle;
TAngleRect(Dest).Origin := FOrigin;
TAngleRect(Dest).Length := FLength;
TAngleRect(Dest).Breadth := FBreadth;
end;
{------------------------------------------------------------------------------
Procedure: TAngleRect.DoGeometry
Description: works out where the corners of the rectangle are.
Author: Mat Ballard
Date created: 06/08/2001
Date modified: 06/08/2000 by Mat Ballard
Purpose: geometry management
Known Issues:
------------------------------------------------------------------------------}
procedure TAngleRect.DoGeometry;
var
i: Integer;
begin
{Step 1: calculate centre:}
FCentre.x := FOrigin.x + Round(FSin * FLength / 2.0);
FCentre.y := FOrigin.y - Round(FCos * FLength / 2.0);
{Step 2: set up rectangle of corners:}
FPolyRect[0].x := - (FBreadth div 2);
FPolyRect[0].y := - (FLength div 2);
FPolyRect[1].x := FPolyRect[0].x + FBreadth;
FPolyRect[1].y := FPolyRect[0].y;
FPolyRect[2].x := FPolyRect[1].x;
FPolyRect[2].y := FPolyRect[1].y + FLength;
FPolyRect[3].x := FPolyRect[0].x;
FPolyRect[3].y := FPolyRect[2].y;
{Step 3: rotate and translate}
for i := 0 to 3 do
begin
FPolyRect[i] := RotatePoint(FPolyRect[i]);
FPolyRect[i].x := FPolyRect[i].x + FCentre.x;
FPolyRect[i].y := FPolyRect[i].y + FCentre.y;
end;
{Need to close the polyline:}
FPolyRect[4].x := FPolyRect[0].x;
FPolyRect[4].y := FPolyRect[0].y;
{Calculate the positions:}
{Left:}
FLeft := FPolyRect[0].x;
if (FPolyRect[1].x < FLeft) then
FLeft := FPolyRect[1].x;
if (FPolyRect[2].x < FLeft) then
FLeft := FPolyRect[2].x;
if (FPolyRect[3].x < FLeft) then
FLeft := FPolyRect[3].x;
{Top:}
FTop := FPolyRect[0].y;
if (FPolyRect[1].y < FPolyRect[0].y) then
FTop := FPolyRect[1].y;
if (FPolyRect[2].y < FTop) then
FTop := FPolyRect[2].y;
if (FPolyRect[3].y < FTop) then
FTop := FPolyRect[3].y;
{Right}
FRight := FPolyRect[0].x;
if (FPolyRect[1].x > FPolyRect[0].x) then
FRight := FPolyRect[1].x;
if (FPolyRect[2].x > FRight) then
FRight := FPolyRect[2].x;
if (FPolyRect[3].x > FRight) then
FRight := FPolyRect[3].x;
{Bottom:}
FBottom := FPolyRect[0].y;
if (FPolyRect[1].y > FPolyRect[0].y) then
FBottom := FPolyRect[1].y;
if (FPolyRect[2].y > FBottom) then
FBottom := FPolyRect[2].y;
if (FPolyRect[3].y > FBottom) then
FBottom := FPolyRect[3].y;
DoHandleChange;
end;
{------------------------------------------------------------------------------
Function: TAngleRect.RotatePoint
Description: rotates a point about the Centre
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: geometry management
Return Value: TPoint;
Known Issues:
Equations: Rotation by ╪:
[NewX] = [cos╪ sin╪][X]
[NewY] [-sin╪ cos╪][Y]
------------------------------------------------------------------------------}
function TAngleRect.RotatePoint(APoint: TPoint): TPoint;
begin
Result.x := Round(FCos * APoint.x - FSin * APoint.y);
Result.y := Round(FSin * APoint.x + FCos * APoint.y);
end;
{Begin Set and Get Functions and Procedures----------------------------------}
{Set Procedure for REAL properties ---------------------------------------}
{------------------------------------------------------------------------------
Procedure: TAngleRect.SetAngle
Description: standard property Set procedure
Author: Mat Ballard
Date created: 06/06/2001
Date modified: 06/06/2001 by Mat Ballard
Purpose: sets the Angle Property
Known Issues:
------------------------------------------------------------------------------}
procedure TAngleRect.SetAngle(Value: TDegrees);
begin
FAngle := Value;
FAngleRadians := Pi * FAngle / 180;
if (FAngle = 0) then
begin
FSin := 0;
FCos := 1;
FSinM30 := -SIN_30;
FCosM30 := COS_30;
FSinP30 := SIN_30;
FCosP30 := COS_30;
end
else if (FAngle = 90) then
begin
FSin := 1;
FCos := 0;
FSinM30 := SIN_60;
FCosM30 := COS_60;
FSinP30 := SIN_60;
FCosP30 := -COS_60;
end
else if (FAngle = 180) then
begin
FSin := 0;
FCos := -1;
FSinM30 := SIN_30;
FCosM30 := -COS_30;
FSinP30 := -SIN_30;
FCosP30 := -COS_30;
end
else if (FAngle = 270) then
begin
FSin := -1;
FCos := 0;
FSinM30 := -SIN_60;
FCosM30 := -COS_60;
FSinP30 := -SIN_60;
FCosP30 := COS_60;
end
else
begin
{this is twice as fast as calling them individually:}
SinCos(FAngleRadians, FSin, FCos);
{look back along the axis, then 30 degrees less, for the arrow:}
SinCos(FAngleRadians + Pi*(1/2 - 1/6), FSinM30, FCosM30);
{look back along the axis, then 30 degrees more:}
SinCos(FAngleRadians + Pi*(1/2 + 1/6), FSinP30, FCosP30);
end;
DoGeometry;
end;
{------------------------------------------------------------------------------
Procedure: TAngleRect.SetOrigin
Description: private property Set procedure
Author: Mat Ballard
Date created: 06/06/2001
Date modified: 06/06/2001 by Mat Ballard
Purpose: sets the Origin, a virtual property, by moving the Right
Known Issues:
------------------------------------------------------------------------------}
procedure TAngleRect.SetOrigin(Value: TPoint);
begin
if ((FOrigin.x = Value.x) and
(FOrigin.y = Value.y)) then
exit;
FOrigin.x := Value.x;
FOrigin.y := Value.y;
DoGeometry;
end;
{------------------------------------------------------------------------------
Procedure: TAngleRect.SetBreadth
Description: standard property Set procedure
Author: Mat Ballard
Date created: 06/06/2001
Date modified: 06/06/2001 by Mat Ballard
Purpose: sets the Breadth Property
Known Issues:
------------------------------------------------------------------------------}
procedure TAngleRect.SetBreadth(Value: Word);
begin
if (Value = FBreadth) then exit;
FBreadth := Value;
DoGeometry;
end;
{------------------------------------------------------------------------------
Procedure: TAngleRect.SetLength
Description: standard property Set procedure
Author: Mat Ballard
Date created: 06/06/2001
Date modified: 06/06/2001 by Mat Ballard
Purpose: sets the Length Property
Known Issues:
------------------------------------------------------------------------------}
procedure TAngleRect.SetLength(Value: Word);
begin
if (Value = FLength) then exit;
FLength := Value;
DoGeometry;
end;
{------------------------------------------------------------------------------
Procedure: TAngleRect.SetMidX
Description: standard property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 06/06/2001 by Mat Ballard
Purpose: sets the MidX
Known Issues:
------------------------------------------------------------------------------}
procedure TAngleRect.SetMidX(Value: Integer);
begin
if (FCentre.x = Value) then exit;
FCentre.x := Value;
DoGeometry;
end;
{------------------------------------------------------------------------------
Procedure: TAngleRect.SetMidY
Description: standard property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 06/06/2001 by Mat Ballard
Purpose: sets the MidY property
Known Issues:
------------------------------------------------------------------------------}
procedure TAngleRect.SetMidY(Value: Integer);
begin
if (FCentre.y = Value) then exit;
FCentre.y := Value;
DoGeometry;
end;
{Get Functions for VIRTUAL properties ---------------------------------------}
{------------------------------------------------------------------------------
Function: TAngleRect.GetVector
Description: private property Get function
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 06/06/2001 by Mat Ballard
Purpose: Gets the Vector, which is a virtual property
Known Issues:
------------------------------------------------------------------------------}
function TAngleRect.GetVector: TPoint;
begin
Result.x := Round(FSin * FLength);
Result.y := Round(FCos * FLength);
end;
{Set Procedures for VIRTUAL properties ---------------------------------------}
{------------------------------------------------------------------------------
Procedure: TAngleRect.SetCentre
Description: standard property Set procedure
Author: Mat Ballard
Date created: 06/06/2001
Date modified: 06/06/2001 by Mat Ballard
Purpose: sets the Centre Property
Known Issues: we do this by changing the origin
------------------------------------------------------------------------------}
procedure TAngleRect.SetCentre(NewCentre: TPoint);
begin
FOrigin.x := FOrigin.x + (NewCentre.x - FCentre.x);
FOrigin.y := FOrigin.y + (NewCentre.y - FCentre.y);
DoGeometry;
end;
{------------------------------------------------------------------------------
Procedure: TAngleRect.SetLeft
Description: protected property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 06/08/2001 by Mat Ballard
Purpose: sets the Left, which also moves the Right, thereby preserving the Width
Known Issues:
------------------------------------------------------------------------------}
procedure TAngleRect.SetLeft(Value: Integer);
var
OldValue: Integer;
begin
OldValue := FLeft;
if (Value = OldValue) then exit;
FOrigin.x := FOrigin.x + (Value - OldValue);
DoGeometry;
end;
{------------------------------------------------------------------------------
Procedure: TAngleRect.SetTop
Description: protected property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 06/08/2001 by Mat Ballard
Purpose: sets the Top, which also also moves the Bottom, thereby preserving the Height
Known Issues:
------------------------------------------------------------------------------}
procedure TAngleRect.SetTop(Value: Integer);
var
OldValue: Integer;
begin
OldValue := FTop;
if (Value = OldValue) then exit;
FOrigin.y := FOrigin.y + (Value - OldValue);
DoGeometry;
end;
{------------------------------------------------------------------------------
Procedure: TAngleRect.SetRight
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 06/08/2001 by Mat Ballard
Purpose: sets the Right
Known Issues:
------------------------------------------------------------------------------}
procedure TAngleRect.SetRight(Value: Integer);
begin
if (Value = FRight) then exit;
if (FAngle > 180) then
FOrigin.x := FOrigin.x + (Value - FRight);
Width := Width + (Value - FRight)
end;
{------------------------------------------------------------------------------
Procedure: TAngleRect.SetBottom
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the Bottom
Known Issues:
------------------------------------------------------------------------------}
procedure TAngleRect.SetBottom(Value: Integer);
begin
if (Value = FBottom) then exit;
if ((FAngle < 90) or (FAngle > 270)) then
FOrigin.y := FOrigin.y + (Value - FBottom);
Height := Height + (Value - FBottom);
end;
{Set procedures for virtual properties ---------------------------------------}
{------------------------------------------------------------------------------
Procedure: TAngleRect.SetHeight
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the Length or Breadth, depending on the angle
Known Issues:
------------------------------------------------------------------------------}
procedure TAngleRect.SetHeight(Value: Integer);
begin
{All these eventually trigger a DoGeometry:}
case FAngle of
0..44: Length := Round(Abs(FCos * Value));
45..134: Breadth := Round(Abs(FSin * Value));
135..224: Length := Round(Abs(FCos * Value));
225..314: Breadth := Round(Abs(FSin * Value));
315 ..359: Length := Round(Abs(FCos * Value));
end;
end;
{------------------------------------------------------------------------------
Procedure: TAngleRect.SetWidth
Description: private property Set procedure
Author: Mat Ballard
Date created: 06/06/2001
Date modified: 06/06/2001 by Mat Ballard
Purpose: sets the Length or Breadth depending on Angle
Known Issues:
------------------------------------------------------------------------------}
procedure TAngleRect.SetWidth(Value: Integer);
begin
case FAngle of
0..44: Breadth := Round(Abs(FCos * Value));
45..134: Length := Round(Abs(FSin * Value));
135..224: Breadth := Round(Abs(FCos * Value));
225..314: Length := Round(Abs(FSin * Value));
315 ..359: Breadth := Round(Abs(FCos * Value));
end;
end;
{------------------------------------------------------------------------------
Procedure: TAngleRect.SetVector
Description: private property Set procedure
Author: Mat Ballard
Date created: 06/06/2001
Date modified: 06/06/2001 by Mat Ballard
Purpose: sets the Vector, a virtual property
Known Issues:
------------------------------------------------------------------------------}
procedure TAngleRect.SetVector(Value: TPoint);
begin
FLength := Round(Sqrt(Value.x*Value.x + Value.y*Value.y));
FAngle := Round(GetAngle(Value.x, Value.y));
DoGeoMetry;
end;
{------------------------------------------------------------------------------
Procedure: TAngleRect.ClickedOn
Description: Was this TRectangle clicked on ?
Author: Mat Ballard
Date created: 01/22/2001
Date modified: 01/22/2001 by Mat Ballard
Purpose: screen click management
Known Issues:
------------------------------------------------------------------------------}
function TAngleRect.ClickedOn(iX, iY: Integer): Boolean;
begin
if ((FLeft <= iX) and
(iX <= FRight) and
(FTop <= iY) and
(iY <= FBottom) and
(FVisible)) then
ClickedOn := TRUE
else
ClickedOn := FALSE;
end;
{------------------------------------------------------------------------------
Procedure: TAngleRect.MoveTo
Description: Move the rectangle to a new (Top, Left) location.
Author: Mat Ballard
Date created: 06/12/2001
Date modified: 06/12/2001 by Mat Ballard
Purpose: location / geometry management
Known Issues:
------------------------------------------------------------------------------}
procedure TAngleRect.MoveTo(NewX, NewY: Integer);
begin
//if ((FOrigin.x = iX) and (FOrigin.y = iY)) then exit;
if ((FAngle mod 90) = 0) then
begin
FOrigin.x := FOrigin.x + (NewX - FLeft);
FOrigin.y := FOrigin.y + (NewY - FTop);
end
else
begin
FOrigin.x := NewX;
FOrigin.y := NewY;
end;
DoGeometry;
end;
{------------------------------------------------------------------------------
Procedure: TAngleRect.MoveBy
Description: Move the rectangle by (iX, iY) from (Top, Left) to (Top + iX, Left + iY).
Author: Mat Ballard
Date created: 06/12/2001
Date modified: 06/12/2001 by Mat Ballard
Purpose: location / geometry management
Known Issues:
------------------------------------------------------------------------------}
procedure TAngleRect.MoveBy(dX, dY: Integer);
begin
if ((dX = 0) and (dY = 0)) then exit;
Inc(FRight, dX);
Inc(FLeft, dX);
{Trigger a change event:}
Top := FTop + dY;
end;
{------------------------------------------------------------------------------
Procedure: TAngleRect.SetNewGeometry
Description: Initializes the AngleRect
Author: Mat Ballard
Date created: 06/12/2001
Date modified: 06/12/2001 by Mat Ballard
Purpose: location / geometry management
Known Issues:
------------------------------------------------------------------------------}
procedure TAngleRect.SetNewGeometry(NewOrigin: TPoint; NewAngle: TDegrees; NewLength, NewBreadth: Integer);
begin
FOrigin := NewOrigin;
FLength := NewLength;
FBreadth := NewBreadth;
Angle := NewAngle;
end;
{------------------------------------------------------------------------------
Procedure: TAngleRect.Outline
Description: Draws an Outline around this rectangle
Author: Mat Ballard
Date created: 01/22/2001
Date modified: 01/22/2001 by Mat Ballard
Purpose: gives the user a guide to what they are moving with the mouse
Known Issues:
------------------------------------------------------------------------------}
procedure TAngleRect.Outline(ACanvas: TCanvas);
begin
ACanvas.Pen.Color := clBlack;
ACanvas.Pen.Mode := pmNotXOR;
ACanvas.Pen.Style := psDot;
ACanvas.PolyLine(Self.FPolyRect);
end;
{TCaption -------------------------------------------------------------------}
{Constructor and Destructor -------------------------------------------------}
{------------------------------------------------------------------------------
Constructor: TCaption.Create
Description: Standard Constructor for TCaption
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: initializes component and properties
Known Issues:
------------------------------------------------------------------------------}
Constructor TCaption.Create(AOwner: TPersistent);
begin
{First call the ancestor:}
inherited Create(AOwner);
{Create font:}
FFont := TFont.Create;
FFont.Name := sArial;
FFont.Size := SMALL_FONT_SIZE;
end;
destructor TCaption.Destroy;
begin
FFont.Free;
end;
{Begin Set Procedures -------------------------------------------------------}
{------------------------------------------------------------------------------
Procedure: TCaption.SetCaption
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the Caption of TCaption
Known Issues:
------------------------------------------------------------------------------}
procedure TCaption.SetCaption(Value: String);
begin
if (Value = FCaption) then exit;
FCaption := Value;
CreateName;
DoHandleChange;
if assigned(FOnCaptionChange) then OnCaptionChange(Self);
end;
{------------------------------------------------------------------------------
Procedure: TCaption.SetFont
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the Font
Known Issues:
------------------------------------------------------------------------------}
procedure TCaption.SetFont(Value: TFont);
begin
FFont.Assign(Value);
DoHandleChange;
end;
{General purpose methods ------------------------------------------------------}
{------------------------------------------------------------------------------
Procedure: TCaption.CreateName
Description: protected procedure to set a useful name
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the Name, generally in response to a Caption change
Known Issues:
------------------------------------------------------------------------------}
procedure TCaption.CreateName;
begin
{eg: Caption: X Axis
Name: X Axis Caption.}
Name := FCaption + ' ' + sCaption;
end;
{------------------------------------------------------------------------------
Procedure: TCaption.Assign
Description: standard Assign method
Author: Mat Ballard
Date created: 07/06/2000
Date modified: 07/06/2000 by Mat Ballard
Purpose: implements Assign
Known Issues:
------------------------------------------------------------------------------}
{procedure TCaption.Assign(Source: TPersistent);
begin
inherited Assign(Source);
FCaption := TCaption(Source).Caption;
FFont.Assign(TCaption(Source).Font);
end;}
{------------------------------------------------------------------------------
Procedure: TCaption.AssignTo
Description: standard AssignTo method
Author: Mat Ballard
Date created: 07/06/2000
Date modified: 07/06/2000 by Mat Ballard
Purpose: implements AssignTo
Known Issues:
------------------------------------------------------------------------------}
procedure TCaption.AssignTo(Dest: TPersistent);
begin
inherited AssignTo(Dest);
TCaption(Dest).Caption := FCaption;
TCaption(Dest).Font.Assign(FFont);
end;
{TTitle -------------------------------------------------------------------}
{Constructor and Destructor -------------------------------------------------}
{------------------------------------------------------------------------------
Constructor: TTitle.Create
Description: Standard Constructor for TTitle
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: initializes component and properties
Known Issues:
------------------------------------------------------------------------------}
Constructor TTitle.Create(AOwner: TPersistent);
begin
{First call the ancestor:}
inherited Create(AOwner);
FEnvelope.Left := 0;
FEnvelope.Right := 100;
FEnvelope.Top := 90;
FEnvelope.Bottom := 110;
{we don't fire events with a geometry change:}
FireEvents := FALSE;
Self.Height := 20;
end;
{Get methods -----------------------------------------------------------------}
{Set procedures --------------------------------------------------------------}
{------------------------------------------------------------------------------
Procedure: TTitle.SetCaption
Description: protected property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the Caption, which is complicated by the presence of Units.
Known Issues:
------------------------------------------------------------------------------}
procedure TTitle.SetCaption(Value: String);
var
NewValue: String;
begin
if (Pos('(', Value) > 0) then
begin
{There is a "()" in the value, indicating the presence of Units}
NewValue := Trim(GetWord(Value, '('));
FUnits := GetWord(Value, ')');
if (Length(FUnits) = 0) then
FFullCaption := NewValue
else
FFullCaption := NewValue + ' (' + FUnits + ')';
inherited SetCaption(NewValue);
end
else
begin
if (Length(FUnits) = 0) then
FFullCaption := Value
else
FFullCaption := Value + ' (' + FUnits + ')';
inherited SetCaption(Value);
end;
end;
{------------------------------------------------------------------------------
Procedure: TTitle.SetDirection
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the Direction
Known Issues:
------------------------------------------------------------------------------}
procedure TTitle.SetDirection(Value: TDirection);
begin
if (Value = FDirection) then exit;
FDirection := Value;
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TTitle.SetOrientation
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the Orientation
Known Issues:
------------------------------------------------------------------------------}
procedure TTitle.SetOrientation(Value: TOrientation);
begin
if (Value = FOrientation) then exit;
FOrientation := Value;
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TTitle.SetEnvelope
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the Envelope: the screen region around which the Title dances
Known Issues:
------------------------------------------------------------------------------}
procedure TTitle.SetEnvelope(Value: TRect);
begin
if ((Value.Left = FEnvelope.Left) and
(Value.Top = FEnvelope.Top) and
(Value.Right = FEnvelope.Right) and
(Value.Bottom = FEnvelope.Bottom)) then exit;
FEnvelope := Value;
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TTitle.SetUnits
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the Units (eg: Furlongs / Fortnight ^3), and also the FullCaption
Known Issues:
------------------------------------------------------------------------------}
procedure TTitle.SetUnits(Value: String);
begin
if (Value = FUnits) then exit;
FUnits := Value;
if (Length(FUnits) = 0) then
FFullCaption := FCaption
else
FFullCaption := FCaption + ' (' + FUnits + ')';
DoHandleChange;
end;
{Drawing ----------------------------------------------------------------------}
{------------------------------------------------------------------------------
Procedure: TTitle.DoGeometry
Description: TTitle Geometry manager
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the precise screen position of the TTitle.
Known Issues:
------------------------------------------------------------------------------}
procedure TTitle.DoGeometry(ACanvas: TCanvas; TheText: String);
begin
if (FDirection = drHorizontal) then
begin
{BUG BUG BUG: if ACanvas is a metafile canvas, then TextHeight and TextWidth
both return zero in D1!}
Height := Abs(ACanvas.Font.Height);
Width := ACanvas.TextWidth(TheText);
{Note how "neat" this is: when D1 returns 0 for these Text dimensions,
TRectangle rejects them, so Height and Width are unchanged !
Therefore, when we use them below, we use the previous screen values !}
if (FOrientation = orLeft) then
begin
Top := FEnvelope.Top - Height;
if (Alignment = taLeftJustify) then
Left := FEnvelope.Left
else if (Alignment = taRightJustify) then
Left := FEnvelope.Right - Width
else {Alignment = taCenter}
Left := (FEnvelope.Left + FEnvelope.Right - Width) div 2;
end
else {FOrientation = oRight}
begin
Top := FEnvelope.Bottom;
if (Alignment = taLeftJustify) then
Left := FEnvelope.Left
else if (Alignment = taRightJustify) then
Left := FEnvelope.Right - Width
else {Alignment = taCenter}
Left := (FEnvelope.Left + FEnvelope.Right - Width) div 2;
end;
end
else {FDirection = dVertical}
begin
{BUG BUG BUG: if ACanvas is a metafile canvas, then TextHeight and TextWidth
both return zero in D1!}
Width := Abs(ACanvas.Font.Height);
Height := ACanvas.TextWidth(TheText);
if (FOrientation = orLeft) then
begin
Left := FEnvelope.Left - Width;
if (Alignment = taLeftJustify) then
Top := FEnvelope.Bottom - Height
else if (Alignment = taRightJustify) then
Top := FEnvelope.Top
else {Alignment = taCenter}
Top := (FEnvelope.Top + FEnvelope.Bottom - Height) div 2;
end
else {FOrientation = oRight}
begin
Left := FEnvelope.Right;
if (Alignment = taLeftJustify) then
Top := FEnvelope.Bottom - Height
else if (Alignment = taRightJustify) then
Top := FEnvelope.Top
else {Alignment = taCenter}
Top := (FEnvelope.Top + FEnvelope.Bottom - Height) div 2;
end;
end;
end;
{------------------------------------------------------------------------------
Procedure: TTitle.Draw
Description: public Drawing method
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: Draws the Caption, either horizontally or vertically, at the desired position
Known Issues:
------------------------------------------------------------------------------}
procedure TTitle.Draw(ACanvas: TCanvas);
var
iY: Integer;
TheText: String;
begin
if (not Visible) then exit;
if (Length(FCaption) = 0) then exit;
{$IFDEF DELPHI3_UP}
Assert(ACanvas <> nil, 'TTitle.Draw: ' + sACanvasIsNil);
{$ENDIF}
ACanvas.Font.Assign(FFont);
TheText := FCaption;
if (Length(FUnits) > 0) then
TheText := TheText + ' (' + FUnits + ')';
DoGeometry(ACanvas, TheText);
{output text to screen:}
if (FDirection = drHorizontal) then
begin
iY := Top;
while (Pos(#10, TheText) > 0) do
begin
ACanvas.TextOut(Left, iY, GetWord(TheText, #10));
Inc(iY, Abs(ACanvas.Font.Height));
end;
ACanvas.TextOut(Left, iY, TheText);
end
else {FDirection = dVertical}
begin
iY := Left;
while (Pos(#10, TheText) > 0) do
begin
TextOutAngle(ACanvas, 90,
Left, Top + ACanvas.TextWidth(TheText),
GetWord(TheText, #10));
ACanvas.TextOut(Left, iY, GetWord(TheText, #10));
Inc(iY, Abs(ACanvas.Font.Height));
end;
TextOutAngle(ACanvas, 90, Left, Top + ACanvas.TextWidth(TheText), TheText);
end;
end;
{------------------------------------------------------------------------------
Procedure: TTitle.Assign
Description: standard Assign method
Author: Mat Ballard
Date created: 07/06/2000
Date modified: 07/06/2000 by Mat Ballard
Purpose: implements Assign
Known Issues:
------------------------------------------------------------------------------}
{procedure TTitle.Assign(Source: TPersistent);
begin
inherited Assign(Source);
FDirection := TTitle(Source).Direction;
FOrientation := TTitle(Source).Orientation;
FUnits := TTitle(Source).Units;
end;}
{------------------------------------------------------------------------------
Procedure: TTitle.AssignTo
Description: standard AssignTo method
Author: Mat Ballard
Date created: 07/06/2000
Date modified: 07/06/2000 by Mat Ballard
Purpose: implements AssignTo
Known Issues:
------------------------------------------------------------------------------}
procedure TTitle.AssignTo(Dest: TPersistent);
begin
inherited AssignTo(Dest);
TTitle(Dest).Direction := FDirection;
TTitle(Dest).Orientation := FOrientation;
TTitle(Dest).Units := FUnits;
end;
{TLegend ----------------------------------------------------------------------}
{------------------------------------------------------------------------------
Constructor: TCaption.Create
Description: Standard Constructor for TCaption
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: initializes component and properties
Known Issues:
------------------------------------------------------------------------------}
Constructor TLegend.Createlist(AOwner: TPersistent; SeriesList: TList);
begin
{First call the ancestor:}
inherited Create(AOwner);
FSeriesList := SeriesList;
{Create font:}
FFont := TFont.Create;
FFont.Name := sArial;
FFont.Size := SMALL_FONT_SIZE;
FCheckBoxes := TRUE;
end;
destructor TLegend.Destroy;
begin
FFont.Free;
end;
{Get functions ----------------------------------------------------------------}
{------------------------------------------------------------------------------
Function: TLegend.GetHit
Description: Interprets mouse click position
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: Gets the region of the line of the Legend under the input position
Known Issues:
------------------------------------------------------------------------------}
function TLegend.GetHit(iX, iY: Integer; var TheRect: TRect): Integer;
var
SeriesWidth,
TheHit,
TheOffset: Integer;
begin
if (FDirection = drHorizontal) then
begin
SeriesWidth := FCheckWidth + FLineWidth + FStringWidth + 5;
TheHit := (iX - Left) div SeriesWidth;
TheRect.Left := Left + TheHit * SeriesWidth;
TheRect.Right := TheRect.Left + SeriesWidth;
TheRect.Top := Top;
TheRect.Bottom := Bottom;
TheOffset := (iX - Left) mod SeriesWidth;
end
else
begin {dVertical}
TheHit := (iY - Top) div FFontHeight;
TheRect.Left := Left;
TheRect.Right := Right;
TheRect.Top := Top + TheHit * FFontHeight;
TheRect.Bottom := TheRect.Top + FFontHeight;
TheOffset := iX - Left;
end;
if (TheOffset <= FCheckWidth) then
TSeries(FSeriesList.Items[TheHit]).Visible :=
not TSeries(FSeriesList.Items[TheHit]).Visible;
GetHit := TheHit;
end;
function TLegend.GetItemWidth: Integer;
begin
GetItemWidth := FCheckWidth + FLineWidth + FStringWidth;
end;
{Set procedures ---------------------------------------------------------------}
{------------------------------------------------------------------------------
Procedure: TLegend.SetCheckBoxes
Description: private property Set procedure
Author: Mat Ballard
Date created: 04/12/2001
Date modified: 04/12/2001 by Mat Ballard
Purpose: sets whether or not the CheckBoxes are visible
Known Issues:
------------------------------------------------------------------------------}
procedure TLegend.SetCheckBoxes(Value: Boolean);
begin
if (Value = FCheckboxes) then exit;
FCheckboxes := Value;
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TLegend.SetDirection
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the Direction
Known Issues:
------------------------------------------------------------------------------}
procedure TLegend.SetDirection(Value: TDirection);
begin
if (Value = FDirection) then exit;
FDirection := Value;
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TLegend.SetFont
Description: private property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the Font
Known Issues:
------------------------------------------------------------------------------}
procedure TLegend.SetFont(Value: TFont);
begin
FFont.Assign(Value);
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TLegend.Draw
Description: draws the legend
Author: Mat Ballard
Date created: 04/19/2001
Date modified: 04/19/2001 by Mat Ballard
Purpose: screen drawing
Known Issues:
------------------------------------------------------------------------------}
procedure TLegend.Draw(ACanvas: TCanvas; SeriesIncrement: Integer);
var
Chars,
i,
iX,
iMaxChars,
MaxChars,
LineY,
TextY: Integer;
{$IFDEF LINUX}
//ARect: TRect;
{$ENDIF}
procedure DoGeometry;
begin
{Allow for symbols and lines:}
FStringWidth := ACanvas.TextWidth(
TSeries(FSeriesList.Items[iMaxChars]).Name);
FLineWidth := 2 * FStringWidth div 5;
FFontHeight := ACanvas.TextHeight('Ap');
if (FCheckBoxes) then
FCheckWidth := 7*FFontHeight div 10
else
FCheckWidth := 0;
if (FDirection = drHorizontal) then
begin
Height := FFontHeight;
{ <-----LineWidth---->
<Check><Line><Symbol><Line><Text---StringWidth--->}
Width := FSeriesList.Count *
(FCheckWidth + FLineWidth + FStringWidth + 5);
end
else
begin
Height := FSeriesList.Count * FFontHeight;
Width := FCheckWidth + FLineWidth + FStringWidth + 5;
end;
end;
procedure DrawCheck(Value: Boolean; X, Y, Size: Integer);
begin
ACanvas.Pen.Color := clBlack;
ACanvas.Pen.Width := 1;
ACanvas.Pen.Style := psSolid;
ACanvas.Brush.Color := clWhite;
ACanvas.Brush.Style := bsSolid;
ACanvas.Rectangle(X, Y, X + Size, Y + Size);
ACanvas.Pen.Color := clBtnShadow;
ACanvas.MoveTo(X + Size-2, Y+1);
ACanvas.LineTo(X+1, Y+1);
ACanvas.LineTo(X+1, Y + Size-1);
ACanvas.Pen.Color := clBtnFace;
ACanvas.MoveTo(X + Size - 2, Y+1);
ACanvas.LineTo(X + Size - 2, Y + Size - 2);
ACanvas.LineTo(X+1, Y + Size - 2);
{ACanvas.Pen.Color := clBlack;
ACanvas.MoveTo(X + Size - 3, Y+2);
ACanvas.LineTo(X+2, Y+2);
ACanvas.LineTo(X+2, Y + Size - 3);}
if (Value) then
begin
ACanvas.Pen.Color := clBlack;
ACanvas.Pen.Width := 2;
ACanvas.MoveTo(X+2, Y + Size div 2 +1);
ACanvas.LineTo(X + Size div 2, Y + Size - 3);
ACanvas.LineTo(X + Size -3, Y + 2);
{ACanvas.MoveTo(X+3, Y + Size div 2);
ACanvas.LineTo(X + Size div 2, Y + Size - 2);
ACanvas.LineTo(X + Size -3, Y + 2);}
end;
end;
begin
{$IFDEF DELPHI3_UP}
Assert(ACanvas <> nil, 'TLegend.Draw: ' + sACanvasIsNil);
{$ENDIF}
if (not Self.Visible) then exit;
if (FSeriesList.Count = 0) then exit;
ACanvas.Font.Assign(Self.Font);
MaxChars := 0;
iMaxChars := -1;
for i := 0 to FSeriesList.Count-1 do
begin
Chars := Length(TSeries(FSeriesList.Items[i]).Name);
if (MaxChars < Chars) then
begin
MaxChars := Chars;
iMaxChars := i;
end;
end;
if (iMaxChars < 0) then exit;
DoGeometry;
LineY := Self.Top + Self.FontHeight div 2;
TextY := Self.Top;
i := 0;
if (Self.Direction = drVertical) then
begin
while i < FSeriesList.Count do
//for i := 0 to SeriesList.Count-1 do
begin
DrawCheck(TSeries(FSeriesList.Items[i]).Visible,
Self.Left, LineY-FCheckWidth div 2, FCheckWidth);
ACanvas.Pen.Assign(TSeries(FSeriesList.Items[i]).Pen);
ACanvas.MoveTo(Self.Left + FCheckWidth+1, LineY);
ACanvas.LineTo(Self.Left + FCheckWidth + FLineWidth, LineY);
ACanvas.Brush.Assign(TSeries(FSeriesList.Items[i]).Brush);
TSeries(FSeriesList.Items[i]).DrawSymbol(ACanvas,
Self.Left + FCheckWidth + FLineWidth div 2, LineY);
ACanvas.Brush.Style := bsClear;
{output text to screen:}
ACanvas.Font.Color := ACanvas.Pen.Color;
ACanvas.TextOut(Self.Left + FCheckWidth + FLineWidth+1, TextY,
TSeries(FSeriesList.Items[i]).Name);
Inc(LineY, Self.FontHeight);
Inc(TextY, Self.FontHeight);
Inc(i, SeriesIncrement);
end;
end
else {Horizontal}
begin
{Note: in Horizontal mode, the size of each series name is:}
{<---LineWidth---><---StringWidth---><-LineWidth->}
{<-Symbol + Line-><-Name of Series--><--Space---->}
LineY := Self.Top + Self.FontHeight div 2;
TextY := Self.Top;
iX := Self.Left;
while i < FSeriesList.Count do
//for i := 0 to SeriesList.Count-1 do
begin
DrawCheck(TSeries(FSeriesList.Items[i]).Visible,
iX, LineY - FCheckWidth div 2, FCheckWidth);
ACanvas.Pen.Assign(TSeries(FSeriesList.Items[i]).Pen);
ACanvas.MoveTo(iX + FCheckWidth+1, LineY);
ACanvas.LineTo(iX + FCheckWidth + FLineWidth, LineY);
ACanvas.Brush.Assign(TSeries(FSeriesList.Items[i]).Brush);
TSeries(FSeriesList.Items[i]).DrawSymbol(ACanvas,
iX + FCheckWidth + FLineWidth div 2, LineY);
ACanvas.Brush.Style := bsClear;
{output text to screen:}
ACanvas.Font.Color := ACanvas.Pen.Color;
ACanvas.TextOut(iX + FCheckWidth + FLineWidth +1, TextY,
TSeries(FSeriesList.Items[i]).Name);
iX := iX + FCheckWidth + FLineWidth + FStringWidth + 5;
Inc(i, SeriesIncrement);
end; {for}
Self.Width := iX - Self.Left;
Self.Height := Self.FontHeight;
end; {if}
end;
{TNote ------------------------------------------------------------------------}
procedure TNote.AssignTo(Dest: TPersistent);
begin
inherited AssignTo(Dest);
TNote(Dest).ArrowLeft := FArrowLeft;
TNote(Dest).ArrowTop := FArrowTop;
TNote(Dest).ArrowLeftReal := FArrowLeftReal;
TNote(Dest).ArrowTopReal := FArrowTopReal;
TNote(Dest).LeftReal := FLeftReal;
TNote(Dest).TopReal := FTopReal;
end;
constructor TNote.Create(AOwner: TPersistent);
{var
StartPoint: TPoint;}
begin
inherited Create(AOwner);
FOwner := AOwner;
{a note can only ever be a note:}
Tag := Ord(soNote);
{StartPoint := TPlot(AOwner).ScreenToClient(Mouse.CursorPos);
ArrowLeft := StartPoint.X;
ArrowTop := StartPoint.Y;}
Caption := InputBox(sNewNote1, sNewNote2, sNewNote1);
end;
{destructor TNote.Destroy;
begin
end;}
procedure TNote.Draw(ACanvas: TCanvas);
var
TextSize: TSize;
{$IFDEF LINUX}
//ARect: TRect;
{$ENDIF}
begin
if (not Visible) then exit;
if (Length(Caption) = 0) then exit;
{$IFDEF DELPHI3_UP}
Assert(ACanvas <> nil, 'TNote.Draw: ' + sACanvasIsNil);
{$ENDIF}
ACanvas.Font.Assign(FFont);
ACanvas.Pen.Color := FFont.Color;
{we do the geometry;
note that if a Zoom-in has occurred, then the note position changes:}
FLeft := TPlot(FOwner).XAxis.FofX(FLeftReal);
FTop := TPlot(FOwner).YAxis.FofY(FTopReal);
FArrowLeft := TPlot(FOwner).XAxis.FofX(FArrowLeftReal);
FArrowTop := TPlot(FOwner).YAxis.FofY(FArrowTopReal);
TextSize := ACanvas.TextExtent(Caption
{$IFDEF LINUX}
, 0
{$ENDIF}
);
Width := TextSize.cx;
Height := TextSize.cy;
if (FArrowLeft < Left) then
ArrowStartLeft := Left
else if (FArrowLeft > Left+Width) then
ArrowStartLeft := Left + Width
else
ArrowStartLeft := Left + Width div 2;
if (FArrowTop < Top) then
ArrowStartTop := Top
else if (FArrowTop > Top+Height) then
ArrowStartTop := Top + Height
else
ArrowStartTop := Top + Height div 2;
if ((FArrowLeft < Left) or
(FArrowLeft > Left+Width) or
(FArrowTop < Top) or
(FArrowTop > Top+Height)) then
begin
ACanvas.MoveTo(ArrowStartLeft, ArrowStartTop);
ACanvas.LineTo(FArrowLeft, FArrowTop);
end;
{output text to screen:}
{$IFDEF MSWINDOWS}
ACanvas.TextOut(Left, Top, Caption);
{$ENDIF}
{$IFDEF LINUX}
ACanvas.TextOut(Left, Top {+ Abs(ACanvas.Font.Height)}, Caption);
//ACanvas.TextRect(ARect, Left, Top, Caption, TOPLEFT_ALIGN);
{$ENDIF}
end;
{------------------------------------------------------------------------------
Procedure: TNote.TracePointerTo
Description: Moves the end of the note pointer to X, Y
Author: Mat Ballard
Date created: 11/23/2000
Date modified: 11/23/2000 by Mat Ballard
Purpose: manages movement of the note pointer
Known Issues:
------------------------------------------------------------------------------}
procedure TNote.TracePointerTo(ACanvas: TCanvas; iX, iY: Integer);
begin
{rub out the old line:}
ACanvas.Pen.Mode := pmNotXOR;
if ((FArrowLeft < Left) or
(FArrowLeft > Left+Width) or
(FArrowTop < Top) or
(FArrowTop > Top+Height)) then
begin
ACanvas.MoveTo(ArrowStartLeft, ArrowStartTop);
ACanvas.LineTo(FArrowLeft, FArrowTop);
end;
{go to new coordinates:}
ArrowLeft := iX;
ArrowTop := iY;
{draw the new one:}
ACanvas.MoveTo(ArrowStartLeft, ArrowStartTop);
ACanvas.LineTo(FArrowLeft, FArrowTop);
end;
{------------------------------------------------------------------------------
Procedure: TNote.SetArrowLeft
Description: protected property Set procedure
Author: Mat Ballard
Date created: 11/15/2000
Date modified: 11/15/2000 by Mat Ballard
Purpose: sets the ArrowLeft, which also re-calculates the RealArrowLeft
Known Issues:
------------------------------------------------------------------------------}
procedure TNote.SetArrowLeft(Value: Integer);
begin
if (FArrowLeft = Value) then exit;
FArrowLeft := Value;
FArrowLeftReal := TPlot(FOwner).XAxis.XofF(FArrowLeft);
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TNote.SetArrowTop
Description: protected property Set procedure
Author: Mat Ballard
Date created: 11/15/2000
Date modified: 11/15/2000 by Mat Ballard
Purpose: sets the ArrowTop, which also re-calculates the RealArrowTop
Known Issues:
------------------------------------------------------------------------------}
procedure TNote.SetArrowTop(Value: Integer);
begin
if (FArrowTop = Value) then exit;
FArrowTop := Value;
FArrowTopReal := TPlot(FOwner).YAxis.YofF(FArrowTop);
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TNote.SetLeft
Description: protected property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the (Screen)Left, which also re-calculates the LeftReal
Known Issues:
------------------------------------------------------------------------------}
procedure TNote.SetLeft(Value: Integer);
begin
if (Value = FLeft) then exit;
FLeft := Value;
FLeftReal := TPlot(FOwner).XAxis.XofF(FLeft);
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TNote.SetTop
Description: protected property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the (Screen)Top, which also re-calculates the TopReal
Known Issues:
------------------------------------------------------------------------------}
procedure TNote.SetTop(Value: Integer);
begin
if (Value = FTop) then exit;
FTop := Value;
FTopReal := TPlot(FOwner).YAxis.YofF(FTop);
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TNote.SetLeftReal
Description: protected property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the (Data)LeftReal, which also re-calculates the Left
Known Issues:
------------------------------------------------------------------------------}
procedure TNote.SetLeftReal(Value: Single);
begin
if (FLeftReal = Value) then exit;
FLeftReal := Value;
FLeft := TPlot(FOwner).XAxis.FofX(FLeftReal);
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TNote.SetTopReal
Description: protected property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the (Data)TopReal, which also re-calculates the Top
Known Issues:
------------------------------------------------------------------------------}
procedure TNote.SetTopReal(Value: Single);
begin
if (FTopReal = Value) then exit;
FTopReal := Value;
FTop := TPlot(FOwner).YAxis.FofY(FTopReal);
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TNote.SetArrowLeftReal
Description: protected property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the (Data)ArrowLeftReal, which also re-calculates the Left
Known Issues:
------------------------------------------------------------------------------}
procedure TNote.SetArrowLeftReal(Value: Single);
begin
if (FArrowLeftReal = Value) then exit;
FArrowLeftReal := Value;
FLeft := TPlot(FOwner).XAxis.FofX(FArrowLeftReal);
DoHandleChange;
end;
{------------------------------------------------------------------------------
Procedure: TNote.SetArrowTopReal
Description: protected property Set procedure
Author: Mat Ballard
Date created: 02/25/2000
Date modified: 02/25/2000 by Mat Ballard
Purpose: sets the (Data)ArrowTopReal, which also re-calculates the Top
Known Issues:
------------------------------------------------------------------------------}
procedure TNote.SetArrowTopReal(Value: Single);
begin
if (FArrowTopReal = Value) then exit;
FArrowTopReal := Value;
FTop := TPlot(FOwner).YAxis.FofY(FArrowTopReal);
DoHandleChange;
end;
end.