home *** CD-ROM | disk | FTP | other *** search
/ Chestnut's Multimedia Mania / MM_MANIA.ISO / graphics / paintoop / ctool.pas < prev    next >
Pascal/Delphi Source File  |  1989-11-16  |  27KB  |  839 lines
  1. {$B-,F-,I+,R+}
  2.  
  3. unit CTool;
  4.  
  5. { Define TTool - a class for drawing tools }
  6.  
  7. { Copyright 1989
  8.   Scott Bussinger
  9.   110 South 131st Street
  10.   Tacoma, WA  98444
  11.   (206)531-8944
  12.   Compuserve 72247,2671 }
  13.  
  14. interface
  15.  
  16. uses Crt,Graph,CObject,CMouse,CWindow,CStyle;
  17.  
  18. type TToolPanePtr = ^TToolPane;
  19.      TToolPane = object(TPaneWindow)
  20.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  21.        procedure Anchor; virtual;                { Set the anchor point for the tool }
  22.        procedure ClearAnchor; virtual;           { The anchor should be broken }
  23.        procedure Draw; virtual;                  { Draw using the tool }
  24.        procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for this pane }
  25.        procedure Idle; virtual;                  { Let a text tool look at the keyboard }
  26.        function Select: boolean; virtual;        { Select this pane }
  27.        procedure SetCursor; virtual;             { Set the mouse cursor for the tool }
  28.        procedure Track; virtual;                 { Track the mouse }
  29.        end;
  30.  
  31. type TEraserToolPtr = ^TEraserTool;
  32.      TEraserTool = object(TToolPane)
  33.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  34.        procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for an eraser }
  35.        function Select: boolean; virtual;        { Select an eraser }
  36.        end;
  37.  
  38. type TQuitToolPtr = ^TQuitTool;
  39.      TQuitTool = object(TToolPane)
  40.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  41.        procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for quitting }
  42.        function Select: boolean; virtual;        { Select to quit }
  43.        end;
  44.  
  45. type TModalToolPane = object(TToolPane)
  46.        fAnchored: boolean;
  47.        fAnchorPointX: integer;
  48.        fAnchorPointY: integer;
  49.        fDrawAnchored: boolean;
  50.        fDrawPointX: integer;
  51.        fDrawPointY: integer;
  52.        fTrackPointX: integer;
  53.        fTrackPointY: integer;
  54.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  55.        procedure Anchor; virtual;                { Set the anchor point for the tool }
  56.        procedure ClearAnchor; virtual;           { The anchor should be broken }
  57.        procedure Draw; virtual;                  { Draw using the tool }
  58.        function Select: boolean; virtual;        { Select this pane }
  59.        procedure Track; virtual;                 { Track the mouse }
  60.        end;
  61.  
  62. type TPenToolPtr = ^TPenTool;
  63.      TPenTool = object(TModalToolPane)
  64.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  65.        procedure Anchor; virtual;                { Set the anchor point for a pen }
  66.        procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for a pen }
  67.        procedure Track; virtual;                 { Track the mouse }
  68.        end;
  69.  
  70. type TPaintBucketToolPtr = ^TPaintBucketTool;
  71.      TPaintBucketTool = object(TModalToolPane)
  72.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  73.        procedure Draw; virtual;                  { Draw with a paint bucket }
  74.        procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for a paint bucket }
  75.        procedure SetCursor; virtual;             { Set the mouse cursor for a paint bucket }
  76.        end;
  77.  
  78. type TRubberBandToolPane = object(TModalToolPane)
  79.        fRectangleTrack: boolean;
  80.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  81.        procedure ClearAnchor; virtual;           { The anchor should be broken }
  82.        procedure Track; virtual;                 { Track the mouse }
  83.        end;
  84.  
  85. type TRectangleRubberBandToolPane = object(TRubberBandToolPane)
  86.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  87.        end;
  88.  
  89. type TLineToolPtr = ^TLineTool;
  90.      TLineTool = object(TRubberBandToolPane)
  91.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  92.        procedure Draw; virtual;                  { Draw using the line tool }
  93.        procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for a line tool }
  94.        end;
  95.  
  96. type TBoxToolPtr = ^TBoxTool;
  97.      TBoxTool = object(TRectangleRubberBandToolPane)
  98.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  99.        procedure Draw; virtual;                  { Draw with a box }
  100.        procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for a box tool }
  101.        end;
  102.  
  103. type TFilledBoxToolPtr = ^TFilledBoxTool;
  104.      TFilledBoxTool = object(TRectangleRubberBandToolPane)
  105.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  106.        procedure Draw; virtual;                  { Draw with a filled box }
  107.        procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for a filled box tool }
  108.        end;
  109.  
  110. type TCircleToolPtr = ^TCircleTool;
  111.      TCircleTool = object(TRubberBandToolPane)
  112.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  113.        procedure Draw; virtual;                  { Draw with a circle }
  114.        procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for a circle tool }
  115.        end;
  116.  
  117. type TFilledCircleToolPtr = ^TFilledCircleTool;
  118.      TFilledCircleTool = object(TRubberBandToolPane)
  119.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  120.        procedure Draw; virtual;                  { Draw with a filled circle }
  121.        procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for a filled circle tool }
  122.        end;
  123.  
  124. type TEllipseToolPtr = ^TEllipseTool;
  125.      TEllipseTool = object(TRectangleRubberBandToolPane)
  126.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  127.        procedure Draw; virtual;                  { Draw with an ellipse }
  128.        procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for an ellipse tool }
  129.        end;
  130.  
  131. type TFilledEllipseToolPtr = ^TFilledEllipseTool;
  132.      TFilledEllipseTool = object(TRectangleRubberBandToolPane)
  133.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  134.        procedure Draw; virtual;                  { Draw with a filled ellipse }
  135.        procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for a filled ellipse tool }
  136.        end;
  137.  
  138. type TTextToolPtr = ^TTextTool;
  139.      TTextTool = object(TRectangleRubberBandToolPane)
  140.        fEntryEnabled: boolean;
  141.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  142.        procedure Draw; virtual;                  { Draw with a text tool }
  143.        procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for a text tool }
  144.        procedure Idle; virtual;                  { Let the text tool look at the keyboard }
  145.        function Select: boolean; virtual;        { Select the text tool }
  146.        end;
  147.  
  148. type TToolWindow = object(TMultipanedWindow)
  149.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  150.        procedure ChangePane(Pane: integer); virtual; { Change to a new active pane }
  151.        function CreatePane(Pane: integer;Bordered: boolean;X1,Y1,X2,Y2: real): TPaneWindowPtr; virtual;
  152.        end;
  153.  
  154. implementation
  155.  
  156. var CurrentTrackLineStyle: word;
  157.  
  158. constructor TToolPane.Init(Bordered: boolean;
  159.                            X1,Y1,X2,Y2: real);
  160.   { Initialize a new window }
  161.   begin
  162.   TPaneWindow.Init(Bordered,X1,Y1,X2,Y2)
  163.   end;
  164.  
  165. procedure TToolPane.Anchor;
  166.   { Set the anchor point for the tool }
  167.   begin
  168.   CurrentCanvas^.Activate
  169.   end;
  170.  
  171. procedure TToolPane.ClearAnchor;
  172.   { The anchor should be broken }
  173.   begin
  174.   end;
  175.  
  176. procedure TToolPane.Draw;
  177.   { Draw using the tool }
  178.   begin
  179.   CurrentCanvas^.Activate;
  180.   ClearAnchor
  181.   end;
  182.  
  183. procedure TToolPane.DrawIcon(Marked: boolean);
  184.   { Draw the icon for this tool }
  185.   var Viewport: ViewportType;
  186.   begin
  187.   TPaneWindow.DrawIcon(Marked);
  188.   GetViewSettings(Viewport);
  189.   with Viewport do
  190.     begin
  191.     if Marked                                    { Choose the background color for the icon }
  192.      then
  193.       ChangeColor(SystemColor)
  194.      else
  195.       ChangeColor(SystemBackground);
  196.     Bar(0,0,X2-X1,Y2-Y1);
  197.     GraphCheck;
  198.     if Marked                                    { Choose the foreground color for the icon }
  199.      then
  200.       ChangeColor(SystemBackground)
  201.      else
  202.       ChangeColor(SystemColor)
  203.     end
  204.   end;
  205.  
  206. procedure TToolPane.Idle;
  207.   { Normally this does nothing }
  208.   begin
  209.   end;
  210.  
  211. function TToolPane.Select: boolean;
  212.   { Select this pane }
  213.   begin
  214.   Select := TPaneWindow.Select;
  215.   Select := false;
  216.   ClearAnchor
  217.   end;
  218.  
  219. procedure TToolPane.SetCursor;
  220.   { Set the mouse cursor for the tool }
  221.   begin
  222.   Mouse.SetCursor(PenCursor)                     { The default tool cursor is a pen }
  223.   end;
  224.  
  225. procedure TToolPane.Track;
  226.   { Track the mouse }
  227.   begin
  228.   CurrentCanvas^.Activate
  229.   end;
  230.  
  231. constructor TEraserTool.Init(Bordered: boolean;
  232.                            X1,Y1,X2,Y2: real);
  233.   { Initialize a new window }
  234.   begin
  235.   TToolPane.Init(Bordered,X1,Y1,X2,Y2)
  236.   end;
  237.  
  238. procedure TEraserTool.DrawIcon(Marked: boolean);
  239.   { Draw the icon for an eraser tool }
  240.   begin
  241.   TToolPane.DrawIcon(Marked);
  242.   FitText(Triplex,'C')
  243.   end;
  244.  
  245. function TEraserTool.Select: boolean;
  246.   { Clear the drawing window }
  247.   begin
  248.   Select := TToolPane.Select;
  249.   Mouse.Hide;                                    { Keep the display clean }
  250.   ClearViewport
  251.   end;
  252.  
  253. constructor TQuitTool.Init(Bordered: boolean;
  254.                            X1,Y1,X2,Y2: real);
  255.   { Initialize a new window }
  256.   begin
  257.   TToolPane.Init(Bordered,X1,Y1,X2,Y2)
  258.   end;
  259.  
  260. procedure TQuitTool.DrawIcon(Marked: boolean);
  261.   { Draw the icon for the quitting tool }
  262.   begin
  263.   TToolPane.DrawIcon(Marked);
  264.   FitText(Triplex,'Q')
  265.   end;
  266.  
  267. function TQuitTool.Select: boolean;
  268.   { Quit the program }
  269.   begin
  270.   Select := TToolPane.Select;
  271.   halt                                           { This one's easy -- just quit }
  272.   end;
  273.  
  274. constructor TModalToolPane.Init(Bordered: boolean;
  275.                                 X1,Y1,X2,Y2: real);
  276.   { Initialize a window }
  277.   begin
  278.   TToolPane.Init(Bordered,X1,Y1,X2,Y2);
  279.   fAnchored := false;
  280.   fDrawAnchored := false;
  281.   ClearAnchor
  282.   end;
  283.  
  284. procedure TModalToolPane.Anchor;
  285.   { Set the anchor point for the tool }
  286.   var Viewport: ViewportType;
  287.   begin
  288.   GetViewSettings(Viewport);
  289.   Mouse.DisableTextCursor;
  290.   Mouse.Hide;                                    { Keep the display clean }
  291.   TToolPane.Anchor;
  292.   with Viewport do
  293.     begin
  294.     fAnchorPointX := Mouse.GetLocationX - X1;
  295.     fAnchorPointY := Mouse.GetLocationY - Y1
  296.     end;
  297.   fAnchored := true;
  298.   fTrackPointX := fAnchorPointX;
  299.   fTrackPointY := fAnchorPointY
  300.   end;
  301.  
  302. procedure TModalToolPane.ClearAnchor;
  303.   { The anchor should be broken }
  304.   begin
  305.   TToolPane.ClearAnchor;
  306.   fAnchored := false
  307.   end;
  308.  
  309. procedure TModalToolPane.Draw;
  310.   { Draw using the tool }
  311.   var Viewport: ViewportType;
  312.   begin
  313.   GetViewSettings(Viewport);
  314.   fDrawAnchored := fAnchored;
  315.   Mouse.Hide;                                    { Keep the display clean }
  316.   TToolPane.Draw;
  317.   with Viewport do
  318.     begin
  319.     fDrawPointX := Mouse.GetLocationX - X1;
  320.     fDrawPointY := Mouse.GetLocationY - Y1
  321.     end
  322.   end;
  323.  
  324. function TModalToolPane.Select: boolean;
  325.   { Is this a modal tool? }
  326.   begin
  327.   Select := TToolPane.Select;
  328.   Select := true;
  329.   Mouse.DisableTextCursor                        { Turn the text cursor off }
  330.   end;
  331.  
  332. procedure TModalToolPane.Track;
  333.   { Track the mouse }
  334.   var Viewport: ViewportType;
  335.   begin
  336.   GetViewSettings(Viewport);
  337.   Mouse.Hide;                                    { Keep the display clean }
  338.   TToolPane.Track;
  339.   with Viewport do
  340.     begin
  341.     fTrackPointX := Mouse.GetLocationX - X1;
  342.     fTrackPointY := Mouse.GetLocationY - Y1
  343.     end
  344.   end;
  345.  
  346. constructor TRubberBandToolPane.Init(Bordered: boolean;
  347.                                      X1,Y1,X2,Y2: real);
  348.   { Initialize a window }
  349.   begin
  350.   TModalToolPane.Init(Bordered,X1,Y1,X2,Y2);
  351.   fRectangleTrack := false
  352.   end;
  353.  
  354. procedure XorRubberBand(Rectangular: boolean;
  355.                         StartX,StartY,EndX,EndY: integer);
  356.   { Draw/Undraw a rubberband cursor }
  357.   var SaveStatus: GraphicsStatus;
  358.   begin
  359.   Mouse.Hide;                                    { Keep the display clean }
  360.   GetGraphicsStatus(SaveStatus);
  361.   SetLineStyle(UserBitLn,CurrentTrackLineStyle,NormWidth);
  362.   ChangeWriteMode(XorPut);                       { Temporarily switch to XOR mode }
  363.   ChangeColor(SystemWhite);
  364.   if Rectangular                                 { Get rid of previous track }
  365.    then
  366.     Rectangle(StartX,StartY,EndX,EndY)
  367.    else
  368.     begin
  369.     MoveTo(StartX,StartY);
  370.     LineTo(EndX,EndY)
  371.     end;
  372.   SetGraphicsStatus(SaveStatus)
  373.   end;
  374.  
  375. procedure TRubberBandToolPane.ClearAnchor;
  376.   { The anchor should be broken }
  377.   begin
  378.   if fAnchored then
  379.     XorRubberBand(fRectangleTrack,fAnchorPointX,fAnchorPointY,fTrackPointX,fTrackPointY);
  380.   TModalToolPane.ClearAnchor
  381.   end;
  382.  
  383. procedure TRubberBandToolPane.Track;
  384.   { Track the mouse }
  385.   var PreviousTrackPointX: integer;
  386.       PreviousTrackPointY: integer;
  387.   begin
  388.   PreviousTrackPointX := fTrackPointX;
  389.   PreviousTrackPointY := fTrackPointY;
  390.   TModalToolPane.Track;
  391.   if fAnchored and ((PreviousTrackPointX<>fTrackPointX) or (PreviousTrackPointY<>fTrackPointY)) then { Have we moved? }
  392.     begin
  393.     XorRubberBand(fRectangleTrack,fAnchorPointX,fAnchorPointY,PreviousTrackPointX,PreviousTrackPointY);
  394.     if ((fAnchorPointX<>fTrackPointX) or (fAnchorPointY<>fTrackPointY)) then
  395.       XorRubberBand(fRectangleTrack,fAnchorPointX,fAnchorPointY,fTrackPointX,fTrackPointY)
  396.     end
  397.   end;
  398.  
  399. constructor TRectangleRubberBandToolPane.Init(Bordered: boolean;
  400.                                               X1,Y1,X2,Y2: real);
  401.   { Initialize a window }
  402.   begin
  403.   TModalToolPane.Init(Bordered,X1,Y1,X2,Y2);
  404.   fRectangleTrack := true
  405.   end;
  406.  
  407. constructor TPenTool.Init(Bordered: boolean;
  408.                           X1,Y1,X2,Y2: real);
  409.   { Initialize a new window }
  410.   begin
  411.   TModalToolpane.Init(Bordered,X1,Y1,X2,Y2)
  412.   end;
  413.  
  414. procedure TPenTool.Anchor;
  415.   { Move current position to mouse location }
  416.   begin
  417.   TModalToolPane.Anchor;
  418.   MoveTo(fAnchorPointX,fAnchorPointY)
  419.   end;
  420.  
  421. procedure TPenTool.DrawIcon(Marked: boolean);
  422.   { Draw the icon for the pen tool }
  423.   var Viewport: ViewportType;
  424.   begin
  425.   TModalToolPane.DrawIcon(Marked);
  426.   GetViewSettings(Viewport);
  427.   with Viewport do
  428.     begin
  429.     MoveTo(   (X2-X1) div 8,  7*(Y2-Y1) div 8);
  430.     LineTo(   (X2-X1) div 3,  3*(Y2-Y1) div 10);
  431.     LineTo(48*(X2-X1) div 100,3*(Y2-Y1) div 10);
  432.     LineTo(58*(X2-X1) div 100,  (Y2-Y1) div 2);
  433.     LineTo( 5*(X2-X1) div 8,    (Y2-Y1) div 2);
  434.     LineTo( 7*(X2-X1) div 8,    (Y2-Y1) div 8)
  435.     end
  436.   end;
  437.  
  438. procedure TPenTool.Track;
  439.   { Leave a trail of dots by drawing a line to the current location }
  440.   begin
  441.   TModalToolPane.Track;
  442.   if fAnchored then
  443.     LineTo(fTrackPointX,fTrackPointY)
  444.   end;
  445.  
  446. constructor TPaintBucketTool.Init(Bordered: boolean;
  447.                                   X1,Y1,X2,Y2: real);
  448.   { Initialize a new window }
  449.   begin
  450.   TModalToolpane.Init(Bordered,X1,Y1,X2,Y2)
  451.   end;
  452.  
  453. procedure TPaintBucketTool.Draw;
  454.   { Start a Flood Fill at the current location }
  455.   begin
  456.   TModalToolPane.Draw;
  457.   if fDrawAnchored then
  458.     FloodFill(fDrawPointX,fDrawPointY,GetColor)
  459.   end;
  460.  
  461. procedure TPaintBucketTool.DrawIcon(Marked: boolean);
  462.   { Draw the icon for a paint bucket }
  463.   var Viewport: ViewportType;
  464.   begin
  465.   TModalToolPane.DrawIcon(Marked);
  466.   GetViewSettings(Viewport);
  467.   with Viewport do
  468.     begin
  469.     MoveTo(2*(X2-X1) div 10,5*(Y2-Y1) div 10);
  470.     LineTo(7*(X2-X1) div 10,2*(Y2-Y1) div 10);
  471.     LineTo(8*(X2-X1) div 10,5*(Y2-Y1) div 10);
  472.     LineTo(3*(X2-X1) div 10,8*(Y2-Y1) div 10);
  473.     LineTo(2*(X2-X1) div 10,5*(Y2-Y1) div 10);
  474.     LineTo(8*(X2-X1) div 10,5*(Y2-Y1) div 10);
  475.     LineTo(8*(X2-X1) div 10,8*(Y2-Y1) div 10);
  476.     FloodFill(3*(X2-X1) div 10,6*(Y2-Y1) div 10,GetColor)
  477.     end
  478.   end;
  479.  
  480. procedure TPaintBucketTool.SetCursor;
  481.   { Set a special cursor for a paint bucket tool }
  482.   begin
  483.   Mouse.SetCursor(BucketCursor)
  484.   end;
  485.  
  486. constructor TLineTool.Init(Bordered: boolean;
  487.                            X1,Y1,X2,Y2: real);
  488.   { Initialize a new window }
  489.   begin
  490.   TRubberBandToolPane.Init(Bordered,X1,Y1,X2,Y2)
  491.   end;
  492.  
  493. procedure TLineTool.Draw;
  494.   { Draw a straight line }
  495.   begin
  496.   TRubberBandToolPane.Draw;
  497.   if fDrawAnchored then
  498.     begin
  499.     MoveTo(fAnchorPointX,fAnchorPointY);
  500.     LineTo(fDrawPointX,fDrawPointY)
  501.     end
  502.   end;
  503.  
  504. procedure TLineTool.DrawIcon(Marked: boolean);
  505.   { Draw the icon for the line tool }
  506.   var Viewport: ViewportType;
  507.   begin
  508.   TRubberBandToolPane.DrawIcon(Marked);
  509.   GetViewSettings(Viewport);
  510.   with Viewport do
  511.     begin
  512.     MoveTo(2*(X2-X1) div 10,8*(Y2-Y1) div 10);
  513.     LineTo(8*(X2-X1) div 10,2*(Y2-Y1) div 10);
  514.     MoveTo(2*(X2-X1) div 10,5*(Y2-Y1) div 10);
  515.     LineTo(8*(X2-X1) div 10,5*(Y2-Y1) div 10)
  516.     end
  517.   end;
  518.  
  519. constructor TBoxTool.Init(Bordered: boolean;
  520.                           X1,Y1,X2,Y2: real);
  521.   { Initialize a new window }
  522.   begin
  523.   TRectangleRubberBandToolPane.Init(Bordered,X1,Y1,X2,Y2)
  524.   end;
  525.  
  526. procedure TBoxTool.Draw;
  527.   { Draw a rectangle }
  528.   begin
  529.   TRectangleRubberBandToolPane.Draw;
  530.   if fDrawAnchored then
  531.     Rectangle(fAnchorPointX,fAnchorPointY,fDrawPointX,fDrawPointY)
  532.   end;
  533.  
  534. procedure TBoxTool.DrawIcon(Marked: boolean);
  535.   { Draw the icon for the box tool }
  536.   var Viewport: ViewportType;
  537.   begin
  538.   TRectangleRubberBandToolPane.DrawIcon(Marked);
  539.   GetViewSettings(Viewport);
  540.   with Viewport do
  541.     Rectangle(2*(X2-X1) div 10,2*(Y2-Y1) div 10,8*(X2-X1) div 10,8*(Y2-Y1) div 10)
  542.   end;
  543.  
  544. constructor TFilledBoxTool.Init(Bordered: boolean;
  545.                           X1,Y1,X2,Y2: real);
  546.   { Initialize a new window }
  547.   begin
  548.   TRectangleRubberBandToolPane.Init(Bordered,X1,Y1,X2,Y2)
  549.   end;
  550.  
  551. procedure TFilledBoxTool.Draw;
  552.   { Draw a filled rectangle }
  553.   begin
  554.   TRectangleRubberBandToolPane.Draw;
  555.   if fDrawAnchored then
  556.     Bar(fAnchorPointX,fAnchorPointY,fDrawPointX,fDrawPointY)
  557.   end;
  558.  
  559. procedure TFilledBoxTool.DrawIcon(Marked: boolean);
  560.   { Draw the icon for the filled box tool }
  561.   var Viewport: ViewportType;
  562.   begin
  563.   TRectangleRubberBandToolPane.DrawIcon(Marked);
  564.   GetViewSettings(Viewport);
  565.   with Viewport do
  566.     Bar(2*(X2-X1) div 10,2*(Y2-Y1) div 10,8*(X2-X1) div 10,8*(Y2-Y1) div 10)
  567.   end;
  568.  
  569. constructor TCircleTool.Init(Bordered: boolean;
  570.                              X1,Y1,X2,Y2: real);
  571.   { Initialize a new window }
  572.   begin
  573.   TRubberBandToolPane.Init(Bordered,X1,Y1,X2,Y2)
  574.   end;
  575.  
  576. procedure TCircleTool.Draw;
  577.   { Draw a circle }
  578.   var CenterX,CenterY: integer;
  579.       XRadius,YRadius: integer;
  580.   begin
  581.   TRubberBandToolPane.Draw;
  582.   if fDrawAnchored then
  583.     begin
  584.     CenterX := (fAnchorPointX+fDrawPointX) div 2;
  585.     CenterY := (fAnchorPointY+fDrawPointY) div 2;
  586.     XRadius := round(sqrt(sqr(longint(fAnchorPointX-fDrawPointX)) +
  587.                           sqr(AspectRatio*longint(fAnchorPointY-fDrawPointY))) / 2.0);
  588.     YRadius := round(XRadius * AspectRatio);
  589.     Ellipse(CenterX,CenterY,0,360,XRadius,YRadius)
  590.     end
  591.   end;
  592.  
  593. procedure TCircleTool.DrawIcon(Marked: boolean);
  594.   { Draw the icon for a circle tool }
  595.   const RadiusSize = 0.35;
  596.   var Viewport: ViewportType;
  597.       XRadius: integer;
  598.       YRadius: integer;
  599.   begin
  600.   TRubberBandToolPane.DrawIcon(Marked);
  601.   GetViewSettings(Viewport);
  602.   with Viewport do
  603.     begin
  604.     XRadius := round(RadiusSize*(X2-X1));
  605.     YRadius := round(XRadius*AspectRatio);
  606.     Ellipse((X2-X1) div 2,(Y2-Y1) div 2,0,360,XRadius,YRadius)
  607.     end
  608.   end;
  609.  
  610. constructor TFilledCircleTool.Init(Bordered: boolean;
  611.                                    X1,Y1,X2,Y2: real);
  612.   { Initialize a new window }
  613.   begin
  614.   TRubberBandToolPane.Init(Bordered,X1,Y1,X2,Y2)
  615.   end;
  616.  
  617. procedure TFilledCircleTool.Draw;
  618.   { Draw a filled circle }
  619.   var CenterX,CenterY: integer;
  620.       XRadius,YRadius: integer;
  621.   begin
  622.   TRubberBandToolPane.Draw;
  623.   if fDrawAnchored then
  624.     begin
  625.     CenterX := (fAnchorPointX+fDrawPointX) div 2;
  626.     CenterY := (fAnchorPointY+fDrawPointY) div 2;
  627.     XRadius := round(sqrt(sqr(longint(fAnchorPointX-fDrawPointX)) +
  628.                           sqr(AspectRatio*longint(fAnchorPointY-fDrawPointY))) / 2.0);
  629.     YRadius := round(XRadius * AspectRatio);
  630.     FillEllipse(CenterX,CenterY,XRadius,YRadius)
  631.     end
  632.   end;
  633.  
  634. procedure TFilledCircleTool.DrawIcon(Marked: boolean);
  635.   { Draw the icon for a filled circle tool }
  636.   const RadiusSize = 0.35;
  637.   var Viewport: ViewportType;
  638.       XRadius: integer;
  639.       YRadius: integer;
  640.   begin
  641.   TRubberBandToolPane.DrawIcon(Marked);
  642.   GetViewSettings(Viewport);
  643.   with Viewport do
  644.     begin
  645.     XRadius := round(RadiusSize*(X2-X1));
  646.     YRadius := round(XRadius*AspectRatio);
  647.     FillEllipse((X2-X1) div 2,(Y2-Y1) div 2,XRadius,YRadius)
  648.     end
  649.   end;
  650.  
  651. constructor TEllipseTool.Init(Bordered: boolean;
  652.                               X1,Y1,X2,Y2: real);
  653.   { Initialize a new window }
  654.   begin
  655.   TRectangleRubberBandToolPane.Init(Bordered,X1,Y1,X2,Y2)
  656.   end;
  657.  
  658. procedure TEllipseTool.Draw;
  659.   { Draw an ellipse }
  660.   var CenterX,CenterY: integer;
  661.       XRadius,YRadius: integer;
  662.   begin
  663.   TRectangleRubberBandToolPane.Draw;
  664.   if fDrawAnchored then
  665.     begin
  666.     CenterX := (fAnchorPointX+fDrawPointX) div 2;
  667.     CenterY := (fAnchorPointY+fDrawPointY) div 2;
  668.     XRadius := abs(fAnchorPointX-CenterX);
  669.     YRadius := abs(fAnchorPointY-CenterY);
  670.     Ellipse(CenterX,CenterY,0,360,XRadius,YRadius)
  671.     end
  672.   end;
  673.  
  674. procedure TEllipseTool.DrawIcon(Marked: boolean);
  675.   { Draw the icon for the ellipse tool }
  676.   var Viewport: ViewportType;
  677.   begin
  678.   TRectangleRubberBandToolPane.DrawIcon(Marked);
  679.   GetViewSettings(Viewport);
  680.   with Viewport do
  681.     Ellipse((X2-X1) div 2,(Y2-Y1) div 2,0,360,(X2-X1) div 3,(Y2-Y1) div 3)
  682.   end;
  683.  
  684. constructor TFilledEllipseTool.Init(Bordered: boolean;
  685.                                     X1,Y1,X2,Y2: real);
  686.   { Initialize a new window }
  687.   begin
  688.   TRectangleRubberBandToolPane.Init(Bordered,X1,Y1,X2,Y2)
  689.   end;
  690.  
  691. procedure TFilledEllipseTool.Draw;
  692.   { Draw a filled ellipse }
  693.   var CenterX,CenterY: integer;
  694.       XRadius,YRadius: integer;
  695.   begin
  696.   TRectangleRubberBandToolPane.Draw;
  697.   if fDrawAnchored then
  698.     begin
  699.     CenterX := (fAnchorPointX+fDrawPointX) div 2;
  700.     CenterY := (fAnchorPointY+fDrawPointY) div 2;
  701.     XRadius := abs(fAnchorPointX-CenterX);
  702.     YRadius := abs(fAnchorPointY-CenterY);
  703.     FillEllipse(CenterX,CenterY,XRadius,YRadius)
  704.     end
  705.   end;
  706.  
  707. procedure TFilledEllipseTool.DrawIcon(Marked: boolean);
  708.   { Draw the icon for a filled ellipse tool }
  709.   var Viewport: ViewportType;
  710.   begin
  711.   TRectangleRubberBandToolPane.DrawIcon(Marked);
  712.   GetViewSettings(Viewport);
  713.   with Viewport do
  714.     FillEllipse((X2-X1) div 2,(Y2-Y1) div 2,(X2-X1) div 3,(Y2-Y1) div 3)
  715.   end;
  716.  
  717. constructor TTextTool.Init(Bordered: boolean;
  718.                            X1,Y1,X2,Y2: real);
  719.   { Initialize a new window }
  720.   begin
  721.   TRectangleRubberBandToolPane.Init(Bordered,X1,Y1,X2,Y2)
  722.   end;
  723.  
  724. procedure TTextTool.Draw;
  725.   { Setup for text entry }
  726.   var DontCare: integer;
  727.       Ch: char;
  728.       Height: integer;
  729.       Left: integer;
  730.       Top: integer;
  731.       Width: integer;
  732.   begin
  733.   TRectangleRubberBandToolPane.Draw;
  734.   if fDrawAnchored then
  735.     begin
  736.     Height := abs(fAnchorPointY-fDrawPointY);
  737.     if Height < 5 then                           { Always pick a minimum height }
  738.       Height := 5;
  739.     Width := abs(fAnchorPointX-fDrawPointX);
  740.     if Width < 5 then                            { Always pick a minimum width }
  741.       Width := 5;
  742.     SetFont(CurrentFont,Height,Width);
  743.     if fAnchorPointX < fDrawPointX
  744.      then
  745.       Left := fAnchorPointX
  746.      else
  747.       Left := fDrawPointX;
  748.     if fAnchorPointY < fDrawPointY
  749.      then
  750.       Top := fAnchorPointY
  751.      else
  752.       Top := fDrawPointY;
  753.     MoveTo(Left,Top);                            { Move the current position to the top left corner }
  754.     Mouse.SetTextCursor(Height);                 { Turn on the text cursor }
  755.     Mouse.EnableTextCursor;
  756.     fEntryEnabled := true;                       { Allow text entry now }
  757.     while keypressed do                          { Clear the keyboard buffer }
  758.       Ch := ReadKey
  759.     end
  760.   end;
  761.  
  762. procedure TTextTool.DrawIcon(Marked: boolean);
  763.   { Draw the icon for the text tool }
  764.   begin
  765.   TRectangleRubberBandToolPane.DrawIcon(Marked);
  766.   FitText(Triplex,'Abc');
  767.   end;
  768.  
  769. procedure TTextTool.Idle;
  770.   { Watch the keyboard }
  771.   var Ch: char;
  772.   begin
  773.   TRectangleRubberBandToolPane.Idle;
  774.   if fEntryEnabled then
  775.     Mouse.EnableTextCursor;
  776.   if keypressed then
  777.     begin
  778.     Ch := ReadKey;
  779.     if Ch = #0                                   { Clear function keys }
  780.      then
  781.       Ch := ReadKey
  782.      else
  783.       if (Ch>=' ') and fEntryEnabled then
  784.         begin
  785.         Mouse.Hide;
  786.         CurrentCanvas^.Activate;
  787.         OutText(Ch)
  788.         end
  789.     end
  790.   end;
  791.  
  792. function TTextTool.Select: boolean;
  793.   { Turn off text entry until a size is selected }
  794.   begin
  795.   Select := TRectangleRubberBandToolPane.Select;
  796.   fEntryEnabled := false
  797.   end;
  798.  
  799. constructor TToolWindow.Init(Bordered: boolean;
  800.                              X1,Y1,X2,Y2: real);
  801.   { Initialize a tool selection window }
  802.   begin
  803.   TMultipanedWindow.Init(false,X1,Y1,X2,Y2);
  804.   Partition(Bordered,X1,Y1,X2,Y2,2,6)
  805.   end;
  806.  
  807. procedure TToolWindow.ChangePane(Pane: integer);
  808.   { Change to a new active pane }
  809.   begin
  810.   fPane[fCurrentPane]^.DrawIcon(false);          { Turn off the previous icon }
  811.   TMultipanedWindow.ChangePane(Pane);            { Change the current pane }
  812.   fPane[fCurrentPane]^.DrawIcon(true)            { Turn on the new icon }
  813.   end;
  814.  
  815. function TToolWindow.CreatePane(Pane: integer;
  816.                                 Bordered: boolean;
  817.                                 X1,Y1,X2,Y2: real): TPaneWindowPtr;
  818.   { Create a new tool pane }
  819.   begin
  820.   case Pane of
  821.     0: CreatePane := new(TPenToolPtr,Init(Bordered,X1,Y1,X2,Y2));
  822.     1: CreatePane := new(TLineToolPtr,Init(Bordered,X1,Y1,X2,Y2));
  823.     2: CreatePane := new(TBoxToolPtr,Init(Bordered,X1,Y1,X2,Y2));
  824.     3: CreatePane := new(TFilledBoxToolPtr,Init(Bordered,X1,Y1,X2,Y2));
  825.     4: CreatePane := new(TCircleToolPtr,Init(Bordered,X1,Y1,X2,Y2));
  826.     5: CreatePane := new(TFilledCircleToolPtr,Init(Bordered,X1,Y1,X2,Y2));
  827.     6: CreatePane := new(TEllipseToolPtr,Init(Bordered,X1,Y1,X2,Y2));
  828.     7: CreatePane := new(TFilledEllipseToolPtr,Init(Bordered,X1,Y1,X2,Y2));
  829.     8: CreatePane := new(TTextToolPtr,Init(Bordered,X1,Y1,X2,Y2));
  830.     9: CreatePane := new(TPaintBucketToolPtr,Init(Bordered,X1,Y1,X2,Y2));
  831.     10: CreatePane := new(TEraserToolPtr,Init(Bordered,X1,Y1,X2,Y2));
  832.     11: CreatePane := new(TQuitToolPtr,Init(Bordered,X1,Y1,X2,Y2))
  833.     end
  834.   end;
  835.  
  836. begin
  837. CurrentTrackLineStyle := $6666
  838. end.
  839.