ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/PASCAL/QP_PAINT.ZIP/PAINT.PAS

Pascal/Delphi Source File | 1989-05-22 | 5.5 KB | 109 lines

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

program Paint;

{ Quick Paint graphics and object demonstration program }

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

{ Here's the complete object hierarchy:

  TObject - Ancestor of all object types
    ├── TMouse - Access to mouse hardware
    └── TWindow - A rectangular window on screen
          ├── TDrawingWindow - A window scaled to coordinates of 0.00 to 1.00
          │     └── TPaneWindow - A window with an icon
          │           ├── TColorPane - A pane showing a selectable drawing color
          │           ├── TFillPane - A pane showing a selectable fill mask
          │           ├── TLinePane - A pane showing a selectable line style
          │           ├── TFontPane - A pane showing a selectable text font
          │           ├── TColorStylePane - A pane showing the current drawing color
          │           ├── TFillStylePane - A pane showing the current fill mask
          │           ├── TLineStylePane - A pane showing the current line style
          │           ├── TFontStylePane - A pane showing the current text font
          │           └── TToolPane - A pane showing a selectable drawing tool
          │                 ├── TEraserTool - A tool to clear the drawing window
          │                 ├── TQuitTool - A tool to quit the program
          │                 └── TModalToolPane - Tools that change the current drawing tool
          │                       ├── TPenTool - A freehand drawing tool
          │                       ├── TPaintBucketTool - An area fill tool
          │                       └── TRubberBandToolPane - A tool that shows a rubberband cursor
          │                             ├── TLineTool - A straight line drawing tool
          │                             ├── TCircleTool - A circle drawing tool
          │                             ├── TFilledCircleTool - A circle drawing tool with area fill
          │                             └── TRectangularRubberBandToolPane - A tool that shows a rectangular rubberband cursor
          │                                   ├── TBoxTool - A rectangle drawing tool
          │                                   ├── TFilledBoxTool - A rectangle drawing tool with area fill
          │                                   ├── TEllipseTool - An ellipse drawing tool
          │                                   ├── TFilledEllipseTool - An ellipse drawing tool with area fill
          │                                   └── TTextTool - A text entry tool
          └── TMultipanedWindow - A window made up of an array of smaller panes
                ├── TColorWindow - A window for choosing the drawing color
                ├── TFillWindow - A window for choosing the fill mask
                ├── TLineWindow - A window for choosing the line style
                ├── TFontWindow - A window for choosing the current font
                ├── TStyleWindow - A window for showing the current styles
                └── TToolWindow - A window for choosing the current drawing tool
  }

uses CObject,CMouse,CWindow,CStyle,CTool,MSGraph,Dos;

var DrawingWindow: TDrawingWindow;
    StyleWindow: TStyleWindow;
    Tool: TToolPane;
    ToolWindow: TToolWindow;

procedure CreateAllWindows;
  { Create all of the windows on the screen }
  begin
  new(DrawingWindow);
  DrawingWindow.Init(true,0.11,0.06,0.99,0.84);
  CurrentCanvas := DrawingWindow;
  CurrentCanvas.Clear;                           { Start drawing window in black }

  new(ToolWindow);
  ToolWindow.Init(true,0.005,0.06,0.105,0.66);

  new(StyleWindow);
  StyleWindow.Init(true,0.005,0.70,0.99,0.99);

  _SetViewport(round(0.11*VideoConfig.NumXPixels),0, { Display a screen title }
               VideoConfig.NumXPixels,round(0.05*VideoConfig.NumYPixels));
  _SetWindow(false,0.00,0.00,1.00,1.00);
  FitText(Roman,'Quick Paint')
  end;

begin
CreateAllWindows;                                { Initialize all of the windows for the display }
repeat
  Mouse.Show;                                    { A tight polling loop to keep track of mouse }
  Mouse.Update;
  Tool := TToolPane(ToolWindow.CurrentPane);     { Get current painting tool so we can send messages based on mouse action }
  if Mouse.GetButton(Left) = Idle then           { Let a text tool look at keyboard at every opportunity }
    Tool.Idle;
  if DrawingWindow.CheckMouse                    { Are we in the big drawing window? }
   then
    begin
    Tool.SetCursor;                              { Have the tool change to the appropriate cursor shape }
    case Mouse.GetButton(Left) of
      Pressed: Tool.Anchor;                      { Anchor a tool when the button is first pressed }
      Held: Tool.Track;                          { Some tools leave a trace after the mouse, or have a rubberband cursor }
      Released: Tool.Draw                        { Letting go of the mouse button is the final trigger }
      else
      end
    end
   else
    begin
    Tool.ClearAnchor;                            { We moved outside of the drawing window, so disable any pending tool }
    if not ToolWindow.CheckMouse and             { Check the tool window }
       not StyleWindow.CheckMouse then           { Check the drawing style window }
      Mouse.SetCursor(DefaultCursor)             { Change back to the normal cursor if not in any other window }
    end
until false                                      { Repeat forever (actually until HALT in QuitTool) }
end.