Power-Programmierung/CD1.mdf/pascal/library/dos/grafik/paintoop/ctool.pas

Pascal/Delphi Source File | 1989-11-16 | 26.3 KB | 839 lines

{$B-,F-,I+,R+}

unit CTool;

{ Define TTool - a class for drawing tools }

{ Copyright 1989
  Scott Bussinger
  110 South 131st Street
  Tacoma, WA  98444
  [phone]
  Compuserve 72247,2671 }

interface

uses Crt,Graph,CObject,CMouse,CWindow,CStyle;

type TToolPanePtr = ^TToolPane;
     TToolPane = object(TPaneWindow)
       constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
       procedure Anchor; virtual;                { Set the anchor point for the tool }
       procedure ClearAnchor; virtual;           { The anchor should be broken }
       procedure Draw; virtual;                  { Draw using the tool }
       procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for this pane }
       procedure Idle; virtual;                  { Let a text tool look at the keyboard }
       function Select: boolean; virtual;        { Select this pane }
       procedure SetCursor; virtual;             { Set the mouse cursor for the tool }
       procedure Track; virtual;                 { Track the mouse }
       end;

type TEraserToolPtr = ^TEraserTool;
     TEraserTool = object(TToolPane)
       constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
       procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for an eraser }
       function Select: boolean; virtual;        { Select an eraser }
       end;

type TQuitToolPtr = ^TQuitTool;
     TQuitTool = object(TToolPane)
       constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
       procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for quitting }
       function Select: boolean; virtual;        { Select to quit }
       end;

type TModalToolPane = object(TToolPane)
       fAnchored: boolean;
       fAnchorPointX: integer;
       fAnchorPointY: integer;
       fDrawAnchored: boolean;
       fDrawPointX: integer;
       fDrawPointY: integer;
       fTrackPointX: integer;
       fTrackPointY: integer;
       constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
       procedure Anchor; virtual;                { Set the anchor point for the tool }
       procedure ClearAnchor; virtual;           { The anchor should be broken }
       procedure Draw; virtual;                  { Draw using the tool }
       function Select: boolean; virtual;        { Select this pane }
       procedure Track; virtual;                 { Track the mouse }
       end;

type TPenToolPtr = ^TPenTool;
     TPenTool = object(TModalToolPane)
       constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
       procedure Anchor; virtual;                { Set the anchor point for a pen }
       procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for a pen }
       procedure Track; virtual;                 { Track the mouse }
       end;

type TPaintBucketToolPtr = ^TPaintBucketTool;
     TPaintBucketTool = object(TModalToolPane)
       constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
       procedure Draw; virtual;                  { Draw with a paint bucket }
       procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for a paint bucket }
       procedure SetCursor; virtual;             { Set the mouse cursor for a paint bucket }
       end;

type TRubberBandToolPane = object(TModalToolPane)
       fRectangleTrack: boolean;
       constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
       procedure ClearAnchor; virtual;           { The anchor should be broken }
       procedure Track; virtual;                 { Track the mouse }
       end;

type TRectangleRubberBandToolPane = object(TRubberBandToolPane)
       constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
       end;

type TLineToolPtr = ^TLineTool;
     TLineTool = object(TRubberBandToolPane)
       constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
       procedure Draw; virtual;                  { Draw using the line tool }
       procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for a line tool }
       end;

type TBoxToolPtr = ^TBoxTool;
     TBoxTool = object(TRectangleRubberBandToolPane)
       constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
       procedure Draw; virtual;                  { Draw with a box }
       procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for a box tool }
       end;

type TFilledBoxToolPtr = ^TFilledBoxTool;
     TFilledBoxTool = object(TRectangleRubberBandToolPane)
       constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
       procedure Draw; virtual;                  { Draw with a filled box }
       procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for a filled box tool }
       end;

type TCircleToolPtr = ^TCircleTool;
     TCircleTool = object(TRubberBandToolPane)
       constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
       procedure Draw; virtual;                  { Draw with a circle }
       procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for a circle tool }
       end;

type TFilledCircleToolPtr = ^TFilledCircleTool;
     TFilledCircleTool = object(TRubberBandToolPane)
       constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
       procedure Draw; virtual;                  { Draw with a filled circle }
       procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for a filled circle tool }
       end;

type TEllipseToolPtr = ^TEllipseTool;
     TEllipseTool = object(TRectangleRubberBandToolPane)
       constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
       procedure Draw; virtual;                  { Draw with an ellipse }
       procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for an ellipse tool }
       end;

type TFilledEllipseToolPtr = ^TFilledEllipseTool;
     TFilledEllipseTool = object(TRectangleRubberBandToolPane)
       constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
       procedure Draw; virtual;                  { Draw with a filled ellipse }
       procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for a filled ellipse tool }
       end;

type TTextToolPtr = ^TTextTool;
     TTextTool = object(TRectangleRubberBandToolPane)
       fEntryEnabled: boolean;
       constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
       procedure Draw; virtual;                  { Draw with a text tool }
       procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for a text tool }
       procedure Idle; virtual;                  { Let the text tool look at the keyboard }
       function Select: boolean; virtual;        { Select the text tool }
       end;

type TToolWindow = object(TMultipanedWindow)
       constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
       procedure ChangePane(Pane: integer); virtual; { Change to a new active pane }
       function CreatePane(Pane: integer;Bordered: boolean;X1,Y1,X2,Y2: real): TPaneWindowPtr; virtual;
       end;

implementation

var CurrentTrackLineStyle: word;

constructor TToolPane.Init(Bordered: boolean;
                           X1,Y1,X2,Y2: real);
  { Initialize a new window }
  begin
  TPaneWindow.Init(Bordered,X1,Y1,X2,Y2)
  end;

procedure TToolPane.Anchor;
  { Set the anchor point for the tool }
  begin
  CurrentCanvas^.Activate
  end;

procedure TToolPane.ClearAnchor;
  { The anchor should be broken }
  begin
  end;

procedure TToolPane.Draw;
  { Draw using the tool }
  begin
  CurrentCanvas^.Activate;
  ClearAnchor
  end;

procedure TToolPane.DrawIcon(Marked: boolean);
  { Draw the icon for this tool }
  var Viewport: ViewportType;
  begin
  TPaneWindow.DrawIcon(Marked);
  GetViewSettings(Viewport);
  with Viewport do
    begin
    if Marked                                    { Choose the background color for the icon }
     then
      ChangeColor(SystemColor)
     else
      ChangeColor(SystemBackground);
    Bar(0,0,X2-X1,Y2-Y1);
    GraphCheck;
    if Marked                                    { Choose the foreground color for the icon }
     then
      ChangeColor(SystemBackground)
     else
      ChangeColor(SystemColor)
    end
  end;

procedure TToolPane.Idle;
  { Normally this does nothing }
  begin
  end;

function TToolPane.Select: boolean;
  { Select this pane }
  begin
  Select := TPaneWindow.Select;
  Select := false;
  ClearAnchor
  end;

procedure TToolPane.SetCursor;
  { Set the mouse cursor for the tool }
  begin
  Mouse.SetCursor(PenCursor)                     { The default tool cursor is a pen }
  end;

procedure TToolPane.Track;
  { Track the mouse }
  begin
  CurrentCanvas^.Activate
  end;

constructor TEraserTool.Init(Bordered: boolean;
                           X1,Y1,X2,Y2: real);
  { Initialize a new window }
  begin
  TToolPane.Init(Bordered,X1,Y1,X2,Y2)
  end;

procedure TEraserTool.DrawIcon(Marked: boolean);
  { Draw the icon for an eraser tool }
  begin
  TToolPane.DrawIcon(Marked);
  FitText(Triplex,'C')
  end;

function TEraserTool.Select: boolean;
  { Clear the drawing window }
  begin
  Select := TToolPane.Select;
  Mouse.Hide;                                    { Keep the display clean }
  ClearViewport
  end;

constructor TQuitTool.Init(Bordered: boolean;
                           X1,Y1,X2,Y2: real);
  { Initialize a new window }
  begin
  TToolPane.Init(Bordered,X1,Y1,X2,Y2)
  end;

procedure TQuitTool.DrawIcon(Marked: boolean);
  { Draw the icon for the quitting tool }
  begin
  TToolPane.DrawIcon(Marked);
  FitText(Triplex,'Q')
  end;

function TQuitTool.Select: boolean;
  { Quit the program }
  begin
  Select := TToolPane.Select;
  halt                                           { This one's easy -- just quit }
  end;

constructor TModalToolPane.Init(Bordered: boolean;
                                X1,Y1,X2,Y2: real);
  { Initialize a window }
  begin
  TToolPane.Init(Bordered,X1,Y1,X2,Y2);
  fAnchored := false;
  fDrawAnchored := false;
  ClearAnchor
  end;

procedure TModalToolPane.Anchor;
  { Set the anchor point for the tool }
  var Viewport: ViewportType;
  begin
  GetViewSettings(Viewport);
  Mouse.DisableTextCursor;
  Mouse.Hide;                                    { Keep the display clean }
  TToolPane.Anchor;
  with Viewport do
    begin
    fAnchorPointX := Mouse.GetLocationX - X1;
    fAnchorPointY := Mouse.GetLocationY - Y1
    end;
  fAnchored := true;
  fTrackPointX := fAnchorPointX;
  fTrackPointY := fAnchorPointY
  end;

procedure TModalToolPane.ClearAnchor;
  { The anchor should be broken }
  begin
  TToolPane.ClearAnchor;
  fAnchored := false
  end;

procedure TModalToolPane.Draw;
  { Draw using the tool }
  var Viewport: ViewportType;
  begin
  GetViewSettings(Viewport);
  fDrawAnchored := fAnchored;
  Mouse.Hide;                                    { Keep the display clean }
  TToolPane.Draw;
  with Viewport do
    begin
    fDrawPointX := Mouse.GetLocationX - X1;
    fDrawPointY := Mouse.GetLocationY - Y1
    end
  end;

function TModalToolPane.Select: boolean;
  { Is this a modal tool? }
  begin
  Select := TToolPane.Select;
  Select := true;
  Mouse.DisableTextCursor                        { Turn the text cursor off }
  end;

procedure TModalToolPane.Track;
  { Track the mouse }
  var Viewport: ViewportType;
  begin
  GetViewSettings(Viewport);
  Mouse.Hide;                                    { Keep the display clean }
  TToolPane.Track;
  with Viewport do
    begin
    fTrackPointX := Mouse.GetLocationX - X1;
    fTrackPointY := Mouse.GetLocationY - Y1
    end
  end;

constructor TRubberBandToolPane.Init(Bordered: boolean;
                                     X1,Y1,X2,Y2: real);
  { Initialize a window }
  begin
  TModalToolPane.Init(Bordered,X1,Y1,X2,Y2);
  fRectangleTrack := false
  end;

procedure XorRubberBand(Rectangular: boolean;
                        StartX,StartY,EndX,EndY: integer);
  { Draw/Undraw a rubberband cursor }
  var SaveStatus: GraphicsStatus;
  begin
  Mouse.Hide;                                    { Keep the display clean }
  GetGraphicsStatus(SaveStatus);
  SetLineStyle(UserBitLn,CurrentTrackLineStyle,NormWidth);
  ChangeWriteMode(XorPut);                       { Temporarily switch to XOR mode }
  ChangeColor(SystemWhite);
  if Rectangular                                 { Get rid of previous track }
   then
    Rectangle(StartX,StartY,EndX,EndY)
   else
    begin
    MoveTo(StartX,StartY);
    LineTo(EndX,EndY)
    end;
  SetGraphicsStatus(SaveStatus)
  end;

procedure TRubberBandToolPane.ClearAnchor;
  { The anchor should be broken }
  begin
  if fAnchored then
    XorRubberBand(fRectangleTrack,fAnchorPointX,fAnchorPointY,fTrackPointX,fTrackPointY);
  TModalToolPane.ClearAnchor
  end;

procedure TRubberBandToolPane.Track;
  { Track the mouse }
  var PreviousTrackPointX: integer;
      PreviousTrackPointY: integer;
  begin
  PreviousTrackPointX := fTrackPointX;
  PreviousTrackPointY := fTrackPointY;
  TModalToolPane.Track;
  if fAnchored and ((PreviousTrackPointX<>fTrackPointX) or (PreviousTrackPointY<>fTrackPointY)) then { Have we moved? }
    begin
    XorRubberBand(fRectangleTrack,fAnchorPointX,fAnchorPointY,PreviousTrackPointX,PreviousTrackPointY);
    if ((fAnchorPointX<>fTrackPointX) or (fAnchorPointY<>fTrackPointY)) then
      XorRubberBand(fRectangleTrack,fAnchorPointX,fAnchorPointY,fTrackPointX,fTrackPointY)
    end
  end;

constructor TRectangleRubberBandToolPane.Init(Bordered: boolean;
                                              X1,Y1,X2,Y2: real);
  { Initialize a window }
  begin
  TModalToolPane.Init(Bordered,X1,Y1,X2,Y2);
  fRectangleTrack := true
  end;

constructor TPenTool.Init(Bordered: boolean;
                          X1,Y1,X2,Y2: real);
  { Initialize a new window }
  begin
  TModalToolpane.Init(Bordered,X1,Y1,X2,Y2)
  end;

procedure TPenTool.Anchor;
  { Move current position to mouse location }
  begin
  TModalToolPane.Anchor;
  MoveTo(fAnchorPointX,fAnchorPointY)
  end;

procedure TPenTool.DrawIcon(Marked: boolean);
  { Draw the icon for the pen tool }
  var Viewport: ViewportType;
  begin
  TModalToolPane.DrawIcon(Marked);
  GetViewSettings(Viewport);
  with Viewport do
    begin
    MoveTo(   (X2-X1) div 8,  7*(Y2-Y1) div 8);
    LineTo(   (X2-X1) div 3,  3*(Y2-Y1) div 10);
    LineTo(48*(X2-X1) div 100,3*(Y2-Y1) div 10);
    LineTo(58*(X2-X1) div 100,  (Y2-Y1) div 2);
    LineTo( 5*(X2-X1) div 8,    (Y2-Y1) div 2);
    LineTo( 7*(X2-X1) div 8,    (Y2-Y1) div 8)
    end
  end;

procedure TPenTool.Track;
  { Leave a trail of dots by drawing a line to the current location }
  begin
  TModalToolPane.Track;
  if fAnchored then
    LineTo(fTrackPointX,fTrackPointY)
  end;

constructor TPaintBucketTool.Init(Bordered: boolean;
                                  X1,Y1,X2,Y2: real);
  { Initialize a new window }
  begin
  TModalToolpane.Init(Bordered,X1,Y1,X2,Y2)
  end;

procedure TPaintBucketTool.Draw;
  { Start a Flood Fill at the current location }
  begin
  TModalToolPane.Draw;
  if fDrawAnchored then
    FloodFill(fDrawPointX,fDrawPointY,GetColor)
  end;

procedure TPaintBucketTool.DrawIcon(Marked: boolean);
  { Draw the icon for a paint bucket }
  var Viewport: ViewportType;
  begin
  TModalToolPane.DrawIcon(Marked);
  GetViewSettings(Viewport);
  with Viewport do
    begin
    MoveTo(2*(X2-X1) div 10,5*(Y2-Y1) div 10);
    LineTo(7*(X2-X1) div 10,2*(Y2-Y1) div 10);
    LineTo(8*(X2-X1) div 10,5*(Y2-Y1) div 10);
    LineTo(3*(X2-X1) div 10,8*(Y2-Y1) div 10);
    LineTo(2*(X2-X1) div 10,5*(Y2-Y1) div 10);
    LineTo(8*(X2-X1) div 10,5*(Y2-Y1) div 10);
    LineTo(8*(X2-X1) div 10,8*(Y2-Y1) div 10);
    FloodFill(3*(X2-X1) div 10,6*(Y2-Y1) div 10,GetColor)
    end
  end;

procedure TPaintBucketTool.SetCursor;
  { Set a special cursor for a paint bucket tool }
  begin
  Mouse.SetCursor(BucketCursor)
  end;

constructor TLineTool.Init(Bordered: boolean;
                           X1,Y1,X2,Y2: real);
  { Initialize a new window }
  begin
  TRubberBandToolPane.Init(Bordered,X1,Y1,X2,Y2)
  end;

procedure TLineTool.Draw;
  { Draw a straight line }
  begin
  TRubberBandToolPane.Draw;
  if fDrawAnchored then
    begin
    MoveTo(fAnchorPointX,fAnchorPointY);
    LineTo(fDrawPointX,fDrawPointY)
    end
  end;

procedure TLineTool.DrawIcon(Marked: boolean);
  { Draw the icon for the line tool }
  var Viewport: ViewportType;
  begin
  TRubberBandToolPane.DrawIcon(Marked);
  GetViewSettings(Viewport);
  with Viewport do
    begin
    MoveTo(2*(X2-X1) div 10,8*(Y2-Y1) div 10);
    LineTo(8*(X2-X1) div 10,2*(Y2-Y1) div 10);
    MoveTo(2*(X2-X1) div 10,5*(Y2-Y1) div 10);
    LineTo(8*(X2-X1) div 10,5*(Y2-Y1) div 10)
    end
  end;

constructor TBoxTool.Init(Bordered: boolean;
                          X1,Y1,X2,Y2: real);
  { Initialize a new window }
  begin
  TRectangleRubberBandToolPane.Init(Bordered,X1,Y1,X2,Y2)
  end;

procedure TBoxTool.Draw;
  { Draw a rectangle }
  begin
  TRectangleRubberBandToolPane.Draw;
  if fDrawAnchored then
    Rectangle(fAnchorPointX,fAnchorPointY,fDrawPointX,fDrawPointY)
  end;

procedure TBoxTool.DrawIcon(Marked: boolean);
  { Draw the icon for the box tool }
  var Viewport: ViewportType;
  begin
  TRectangleRubberBandToolPane.DrawIcon(Marked);
  GetViewSettings(Viewport);
  with Viewport do
    Rectangle(2*(X2-X1) div 10,2*(Y2-Y1) div 10,8*(X2-X1) div 10,8*(Y2-Y1) div 10)
  end;

constructor TFilledBoxTool.Init(Bordered: boolean;
                          X1,Y1,X2,Y2: real);
  { Initialize a new window }
  begin
  TRectangleRubberBandToolPane.Init(Bordered,X1,Y1,X2,Y2)
  end;

procedure TFilledBoxTool.Draw;
  { Draw a filled rectangle }
  begin
  TRectangleRubberBandToolPane.Draw;
  if fDrawAnchored then
    Bar(fAnchorPointX,fAnchorPointY,fDrawPointX,fDrawPointY)
  end;

procedure TFilledBoxTool.DrawIcon(Marked: boolean);
  { Draw the icon for the filled box tool }
  var Viewport: ViewportType;
  begin
  TRectangleRubberBandToolPane.DrawIcon(Marked);
  GetViewSettings(Viewport);
  with Viewport do
    Bar(2*(X2-X1) div 10,2*(Y2-Y1) div 10,8*(X2-X1) div 10,8*(Y2-Y1) div 10)
  end;

constructor TCircleTool.Init(Bordered: boolean;
                             X1,Y1,X2,Y2: real);
  { Initialize a new window }
  begin
  TRubberBandToolPane.Init(Bordered,X1,Y1,X2,Y2)
  end;

procedure TCircleTool.Draw;
  { Draw a circle }
  var CenterX,CenterY: integer;
      XRadius,YRadius: integer;
  begin
  TRubberBandToolPane.Draw;
  if fDrawAnchored then
    begin
    CenterX := (fAnchorPointX+fDrawPointX) div 2;
    CenterY := (fAnchorPointY+fDrawPointY) div 2;
    XRadius := round(sqrt(sqr(longint(fAnchorPointX-fDrawPointX)) +
                          sqr(AspectRatio*longint(fAnchorPointY-fDrawPointY))) / 2.0);
    YRadius := round(XRadius * AspectRatio);
    Ellipse(CenterX,CenterY,0,360,XRadius,YRadius)
    end
  end;

procedure TCircleTool.DrawIcon(Marked: boolean);
  { Draw the icon for a circle tool }
  const RadiusSize = 0.35;
  var Viewport: ViewportType;
      XRadius: integer;
      YRadius: integer;
  begin
  TRubberBandToolPane.DrawIcon(Marked);
  GetViewSettings(Viewport);
  with Viewport do
    begin
    XRadius := round(RadiusSize*(X2-X1));
    YRadius := round(XRadius*AspectRatio);
    Ellipse((X2-X1) div 2,(Y2-Y1) div 2,0,360,XRadius,YRadius)
    end
  end;

constructor TFilledCircleTool.Init(Bordered: boolean;
                                   X1,Y1,X2,Y2: real);
  { Initialize a new window }
  begin
  TRubberBandToolPane.Init(Bordered,X1,Y1,X2,Y2)
  end;

procedure TFilledCircleTool.Draw;
  { Draw a filled circle }
  var CenterX,CenterY: integer;
      XRadius,YRadius: integer;
  begin
  TRubberBandToolPane.Draw;
  if fDrawAnchored then
    begin
    CenterX := (fAnchorPointX+fDrawPointX) div 2;
    CenterY := (fAnchorPointY+fDrawPointY) div 2;
    XRadius := round(sqrt(sqr(longint(fAnchorPointX-fDrawPointX)) +
                          sqr(AspectRatio*longint(fAnchorPointY-fDrawPointY))) / 2.0);
    YRadius := round(XRadius * AspectRatio);
    FillEllipse(CenterX,CenterY,XRadius,YRadius)
    end
  end;

procedure TFilledCircleTool.DrawIcon(Marked: boolean);
  { Draw the icon for a filled circle tool }
  const RadiusSize = 0.35;
  var Viewport: ViewportType;
      XRadius: integer;
      YRadius: integer;
  begin
  TRubberBandToolPane.DrawIcon(Marked);
  GetViewSettings(Viewport);
  with Viewport do
    begin
    XRadius := round(RadiusSize*(X2-X1));
    YRadius := round(XRadius*AspectRatio);
    FillEllipse((X2-X1) div 2,(Y2-Y1) div 2,XRadius,YRadius)
    end
  end;

constructor TEllipseTool.Init(Bordered: boolean;
                              X1,Y1,X2,Y2: real);
  { Initialize a new window }
  begin
  TRectangleRubberBandToolPane.Init(Bordered,X1,Y1,X2,Y2)
  end;

procedure TEllipseTool.Draw;
  { Draw an ellipse }
  var CenterX,CenterY: integer;
      XRadius,YRadius: integer;
  begin
  TRectangleRubberBandToolPane.Draw;
  if fDrawAnchored then
    begin
    CenterX := (fAnchorPointX+fDrawPointX) div 2;
    CenterY := (fAnchorPointY+fDrawPointY) div 2;
    XRadius := abs(fAnchorPointX-CenterX);
    YRadius := abs(fAnchorPointY-CenterY);
    Ellipse(CenterX,CenterY,0,360,XRadius,YRadius)
    end
  end;

procedure TEllipseTool.DrawIcon(Marked: boolean);
  { Draw the icon for the ellipse tool }
  var Viewport: ViewportType;
  begin
  TRectangleRubberBandToolPane.DrawIcon(Marked);
  GetViewSettings(Viewport);
  with Viewport do
    Ellipse((X2-X1) div 2,(Y2-Y1) div 2,0,360,(X2-X1) div 3,(Y2-Y1) div 3)
  end;

constructor TFilledEllipseTool.Init(Bordered: boolean;
                                    X1,Y1,X2,Y2: real);
  { Initialize a new window }
  begin
  TRectangleRubberBandToolPane.Init(Bordered,X1,Y1,X2,Y2)
  end;

procedure TFilledEllipseTool.Draw;
  { Draw a filled ellipse }
  var CenterX,CenterY: integer;
      XRadius,YRadius: integer;
  begin
  TRectangleRubberBandToolPane.Draw;
  if fDrawAnchored then
    begin
    CenterX := (fAnchorPointX+fDrawPointX) div 2;
    CenterY := (fAnchorPointY+fDrawPointY) div 2;
    XRadius := abs(fAnchorPointX-CenterX);
    YRadius := abs(fAnchorPointY-CenterY);
    FillEllipse(CenterX,CenterY,XRadius,YRadius)
    end
  end;

procedure TFilledEllipseTool.DrawIcon(Marked: boolean);
  { Draw the icon for a filled ellipse tool }
  var Viewport: ViewportType;
  begin
  TRectangleRubberBandToolPane.DrawIcon(Marked);
  GetViewSettings(Viewport);
  with Viewport do
    FillEllipse((X2-X1) div 2,(Y2-Y1) div 2,(X2-X1) div 3,(Y2-Y1) div 3)
  end;

constructor TTextTool.Init(Bordered: boolean;
                           X1,Y1,X2,Y2: real);
  { Initialize a new window }
  begin
  TRectangleRubberBandToolPane.Init(Bordered,X1,Y1,X2,Y2)
  end;

procedure TTextTool.Draw;
  { Setup for text entry }
  var DontCare: integer;
      Ch: char;
      Height: integer;
      Left: integer;
      Top: integer;
      Width: integer;
  begin
  TRectangleRubberBandToolPane.Draw;
  if fDrawAnchored then
    begin
    Height := abs(fAnchorPointY-fDrawPointY);
    if Height < 5 then                           { Always pick a minimum height }
      Height := 5;
    Width := abs(fAnchorPointX-fDrawPointX);
    if Width < 5 then                            { Always pick a minimum width }
      Width := 5;
    SetFont(CurrentFont,Height,Width);
    if fAnchorPointX < fDrawPointX
     then
      Left := fAnchorPointX
     else
      Left := fDrawPointX;
    if fAnchorPointY < fDrawPointY
     then
      Top := fAnchorPointY
     else
      Top := fDrawPointY;
    MoveTo(Left,Top);                            { Move the current position to the top left corner }
    Mouse.SetTextCursor(Height);                 { Turn on the text cursor }
    Mouse.EnableTextCursor;
    fEntryEnabled := true;                       { Allow text entry now }
    while keypressed do                          { Clear the keyboard buffer }
      Ch := ReadKey
    end
  end;

procedure TTextTool.DrawIcon(Marked: boolean);
  { Draw the icon for the text tool }
  begin
  TRectangleRubberBandToolPane.DrawIcon(Marked);
  FitText(Triplex,'Abc');
  end;

procedure TTextTool.Idle;
  { Watch the keyboard }
  var Ch: char;
  begin
  TRectangleRubberBandToolPane.Idle;
  if fEntryEnabled then
    Mouse.EnableTextCursor;
  if keypressed then
    begin
    Ch := ReadKey;
    if Ch = #0                                   { Clear function keys }
     then
      Ch := ReadKey
     else
      if (Ch>=' ') and fEntryEnabled then
        begin
        Mouse.Hide;
        CurrentCanvas^.Activate;
        OutText(Ch)
        end
    end
  end;

function TTextTool.Select: boolean;
  { Turn off text entry until a size is selected }
  begin
  Select := TRectangleRubberBandToolPane.Select;
  fEntryEnabled := false
  end;

constructor TToolWindow.Init(Bordered: boolean;
                             X1,Y1,X2,Y2: real);
  { Initialize a tool selection window }
  begin
  TMultipanedWindow.Init(false,X1,Y1,X2,Y2);
  Partition(Bordered,X1,Y1,X2,Y2,2,6)
  end;

procedure TToolWindow.ChangePane(Pane: integer);
  { Change to a new active pane }
  begin
  fPane[fCurrentPane]^.DrawIcon(false);          { Turn off the previous icon }
  TMultipanedWindow.ChangePane(Pane);            { Change the current pane }
  fPane[fCurrentPane]^.DrawIcon(true)            { Turn on the new icon }
  end;

function TToolWindow.CreatePane(Pane: integer;
                                Bordered: boolean;
                                X1,Y1,X2,Y2: real): TPaneWindowPtr;
  { Create a new tool pane }
  begin
  case Pane of
    0: CreatePane := new(TPenToolPtr,Init(Bordered,X1,Y1,X2,Y2));
    1: CreatePane := new(TLineToolPtr,Init(Bordered,X1,Y1,X2,Y2));
    2: CreatePane := new(TBoxToolPtr,Init(Bordered,X1,Y1,X2,Y2));
    3: CreatePane := new(TFilledBoxToolPtr,Init(Bordered,X1,Y1,X2,Y2));
    4: CreatePane := new(TCircleToolPtr,Init(Bordered,X1,Y1,X2,Y2));
    5: CreatePane := new(TFilledCircleToolPtr,Init(Bordered,X1,Y1,X2,Y2));
    6: CreatePane := new(TEllipseToolPtr,Init(Bordered,X1,Y1,X2,Y2));
    7: CreatePane := new(TFilledEllipseToolPtr,Init(Bordered,X1,Y1,X2,Y2));
    8: CreatePane := new(TTextToolPtr,Init(Bordered,X1,Y1,X2,Y2));
    9: CreatePane := new(TPaintBucketToolPtr,Init(Bordered,X1,Y1,X2,Y2));
    10: CreatePane := new(TEraserToolPtr,Init(Bordered,X1,Y1,X2,Y2));
    11: CreatePane := new(TQuitToolPtr,Init(Bordered,X1,Y1,X2,Y2))
    end
  end;

begin
CurrentTrackLineStyle := $6666
end.