unit MouseLin;
{ Object used to draw something during the period the mouse button is pressed
  and the mouse moves. makeback.bat}
{
  (C) 2000 - 2001 Jindrich Jindrich, Pavel Pisa, PiKRON Ltd.

  Originators of the CHROMuLAN project:

  Jindrich Jindrich - http://www.jindrich.com
                      http://orgchem.natur.cuni.cz/Chromulan/
                      software developer, project coordinator
  Pavel Pisa        - http://cmp.felk.cvut.cz/~pisa
                      embeded software developer
  PiKRON Ltd.       - http://www.pikron.com
                      project initiator, sponsor, instrument developer

  The CHROMuLAN project is distributed under the GNU General Public Licence.
  See file COPYING for details.

  Originators reserve the right to use and publish sources
  under different conditions too. If third party contributors
  do not accept this condition, they can delete this statement
  and only GNU license will apply.
}

interface
uses Windows, Classes, Graphics;

type
  TGraphObjType = (otVerticalLine, otHorizontalLine, otVerticalColumn);

  TMouseLineMode = (mmVertical, mmHorizontal, mmCross, mmRectangle,
    mmVerticalColumn, mmGraphObject);
    { mmVertical - vertical line with X = Start(X,..), Update(X,..), Stop(X,..)
      mmHorizontal - horizontal line with Y = Start(..,Y),
      mmCross - both mmVertical and mmHorizontal
      mmRectangle - rectangle from Start(X,Y) to Update(X,Y) and Stop(X,Y)
      mmVerticalColumn - column with bsBDiagonal brush, start.X at Mouse.dge on start,
                         other at current
      mmGraphObject - moving object of fixed size (ObjSize) of type specified in
                     the ObjectType property in Limits, starting object's
                     position in ObjStart, moving relatively to FStart}

  TMouseLine = class(TObject)
  private
    { info used for drawing vertical line that follows mouse move }
    FMode: TMouseLineMode;
      { what to draw }
    FCanvas: TCanvas;
      { where the line should be drawn }
    FStart: TPoint;
      { where the line was started to be drawn }
    FStop: TPoint;
      { Where the line was stopped to be drawn }
    F: TPoint;
      { where to draw now; (if >=0) }
    FLast: TPoint;
      { where was drawn last time (if >= 0) }
    FLimits: TRect;
      { Maximal and minimal values allowed for X,Y }
    FIsOn:boolean;
      { Drawing of lines switched on? (even if Off, then if LastPos.X,Y >= 0 then
        it should be cleared) }
    FDrawn: boolean;
      { Was the object drawn? If true, then FLast holds the value of F used
        to draw it. }
    FObjType: TGraphObjType;
      { What type of object should be drawn in FMode = mmObject }
    FObjStart: TPoint;
      { What was the position of object to be moved at the Start
        (left top corner) }
    FObjSize: TPoint;
      { What is the size of the object }
    FObjStop: TPoint;
      { What was the position of the object moved at the Stop }
    FObjLast: TPoint;
      { at what position was the object drawn last time }
    {v0.21}
    FSuspended: integer;
    {/v0.21}
    procedure Draw;
    procedure CheckLimits;
      { Called after F.X assigned to new values supplied by public methods,
        so that it is always in FLimits }
  public
    constructor Create(ACanvas: TCanvas);
    procedure SetLimits(ALeft, ATop, ARight, ABottom{AWidth, AHeight}: integer);
      { Limits for drawing. }
    procedure Start(AStartX, AStartY: integer);
      { Start drawing (upon mouse down) }
    procedure Update(AX, AY: integer);
      { Update mouse moves, in mouse move }
    procedure Stop(AX, AY: integer);
      { Stop drawing, upon mouse up }
    procedure GetResult(var AStart: TPoint; var AStop: TPoint);
      { return start and stop positions of mouse }

    procedure SetObj(AObjType: TGraphObjType; const AStart: TPoint; const ASize: TPoint);
    procedure GetObj(var AStart: TPoint; var ASize: TPoint; var AStop: TPoint);
    {v0.21}
    procedure Suspend;
    procedure Resume;
    {/v0.21}

    property Mode: TMouseLineMode read FMode write FMode;
    property IsOn:boolean read FIsOn;
    property ObjType: TGraphObjType read FObjType write FObjType;
  end;

implementation

procedure TMouseLine.Draw;
var bs:TBrushStyle;
  r:TRect;
begin
  with FCanvas do begin
    Pen.Mode := pmNotXor;

    bs := Brush.Style;
    Brush.Style := bsClear;

    case FMode of
      mmGraphObject: begin
        Brush.Style := bsBDiagonal;
        Brush.Color := clBlack;
        if FDrawn then begin
          Rectangle(FObjLast.X, FObjLast.Y, FObjLast.X + FObjSize.X,
              FObjLast.Y + FObjSize.Y);
          FDrawn := false;
        end else begin
          Rectangle(FObjStop.X, FObjStop.Y, FObjStop.X + FObjSize.X,
            FObjStop.Y + FObjSize.Y);
          FObjLast := FObjStop;
          FDrawn := true;
        end;
      end;

      mmRectangle: begin
        if FDrawn then begin
          if (FStart.X <> FLast.X) or (FStart.Y <> FLast.Y) then begin
            Rectangle(FStart.X, FStart.Y, FLast.X, FLast.Y);
          end;
          FDrawn := false;
        end else begin
          if (FStart.X <> F.X) or (FStart.Y <> F.Y) then begin
            Rectangle(FStart.X, FStart.Y, F.X, F.Y);
          end;
          FLast := F;
          FDrawn := true;
        end;
      end;

      mmVerticalColumn: begin
        r.Left := FStart.X;
        r.Top := FLimits.Top;
        r.Bottom := FLimits.Bottom;
        Brush.Style := bsBDiagonal;
        Brush.Color := clBlack;
        if FDrawn then begin
          if (FStart.X <> FLast.X) or (FStart.Y <> FLast.Y) then begin
            {r.Right := FLast.X;
            FillRect(r);}
            Rectangle(FStart.X, FLimits.Top, FLast.X, FLimits.Bottom);
          end;
          FDrawn := false;
        end else begin
          if (FStart.X <> F.X) or (FStart.Y <> F.Y) then begin
            {r.Right := F.X;
            FillRect(r);}
            Rectangle(FStart.X, FLimits.Top, F.X, FLimits.Bottom);
          end;
          FLast := F;
          FDrawn := true;
        end;
      end;

      mmVertical: begin
        with FCanvas do begin
          Pen.Color := clBlack;
          if FDrawn then begin
            MoveTo(FLast.X, FLimits.Top);
            LineTo(FLast.X, FLimits.Bottom);
            FDrawn := false;
          end else begin
            MoveTo(F.X, FLimits.Top);
            LineTo(F.X, FLimits.Bottom);
            FLast := F;
            FDrawn := true;
          end;
        end;
      end;

      mmHorizontal: begin
        with FCanvas do begin
          Pen.Color := clBlack;
          if FDrawn then begin
            MoveTo(FLimits.Left, FLast.Y);
            LineTo(FLimits.Right, FLast.Y);
            FDrawn := false;
          end else begin
            MoveTo(FLimits.Left, F.Y);
            LineTo(FLimits.Right, F.Y);
            FLast := F;
            FDrawn := true;
          end;
          Pen.Mode := pmCopy;
        end;

      end;

      mmCross: begin
        with FCanvas do begin
          Pen.Color := clBlack;
          if FDrawn then begin
            MoveTo(FLast.X, FLimits.Top);
            LineTo(FLast.X, FLimits.Bottom);
            MoveTo(FLimits.Left, FLast.Y);
            LineTo(FLimits.Right, FLast.Y);
            FDrawn := false;
          end else begin
            MoveTo(F.X, FLimits.Top);
            LineTo(F.X, FLimits.Bottom);
            MoveTo(FLimits.Left, F.Y);
            LineTo(FLimits.Right, F.Y);
            FLast := F;
            FDrawn := true;
          end;
        end;
      end;

    end;
    Pen.Mode := pmCopy;
    Brush.Style := bs;
  end;
end;

constructor TMouseLine.Create(ACanvas: TCanvas);
begin
  FMode := mmRectangle;
  FCanvas := ACanvas;
  FStart.X := -1;
  FStop.X := -1;
  FLast.X := -1;
  FLimits := FCanvas.ClipRect;
  FIsOn := false;
  FDrawn := false;
  {v0.21}
  FSuspended := 0;
  {/v0.21}
end;

procedure TMouseLine.SetLimits(ALeft, ATop, ARight, ABottom{AWidth, AHeight}: integer);
begin
  FLimits.Left := ALeft;
  FLimits.Top := ATop;
  FLimits.Right := ARight;{ALeft + AWidth;}
  FLimits.Bottom := ABottom;{ATop + AHeight;}
end;

procedure TMouseLIne.CheckLimits;
begin
  if F.X < FLimits.Left then
    F.X := FLimits.Left;
  if F.X > FLimits.Right then
    F.X := FLimits.Right;
  if F.Y < FLimits.Top then
    F.Y := FLimits.Top;
  if F.Y > FLimits.Bottom then
    F.Y := FLimits.Bottom;
  if FMode = mmGraphObject then begin
    FObjStop.X := FObjStart.X + (F.X - FStart.X);
    if FObjStop.X + FObjSize.X > FLimits.Right then
      FObjStop.X := FLimits.Right - FObjSize.X;
    if FObjStop.X < FLimits.Left then
      FObjStop.X := FLimits.Left;

    FObjStop.Y := FObjStart.Y + (F.Y - FStart.Y);
    if FObjStop.Y + FObjSize.Y > FLimits.Bottom then
      FObjStop.Y := FLimits.Bottom - FObjSize.Y;
    if FObjStop.Y < FLimits.Top then
      FObjStop.Y := FLimits.Top;
  end;
end;

procedure TMouseLine.Start(AStartX, AStartY: integer);
begin
  if FIsOn then
    Stop(F.X, F.Y);
  {v0.21}
  FSuspended := 0;
  if FDrawn then
    Draw;
  {/v0.21}
  FStart.X := AStartX;
  FStart.Y := AStartY;
  F.X := AStartX;
  F.Y := AStartY;
  CheckLimits;
  FIsOn := true;
  Draw;
end;

procedure TMouseLine.Update(AX, AY: integer);
begin
  if not FIsOn then
    exit;
  {v0.21}
  if FSuspended > 0 then
    exit;
  {/v0.21}
  Draw;
  F.X := AX;
  F.Y := AY;
  CheckLimits;
  Draw;
end;

procedure TMouseLine.Stop(AX, AY: integer);
begin
  if not FIsOn then
    exit;
  if FDrawn then
    Draw;
  F.X := AX;
  F.Y := AY;
  CheckLimits;
  FStop.X := F.X;
  FStop.Y := F.Y;
  FIsOn := false;
  {v0.21}
  FSuspended := 0;
  {/v0.21}
end;

procedure TMouseLine.GetResult(var AStart: TPoint; var AStop: TPoint);
begin
  AStart := FStart;
  AStop := FStop;
end;

procedure TMouseLine.SetObj(AObjType: TGraphObjType; const AStart: TPoint; const ASize: TPoint);
begin
  FObjType := AObjType;
  FObjStart := AStart;
  FObjSize := ASize;
end;

procedure TMouseLine.GetObj(var AStart: TPoint; var ASize: TPoint; var AStop: TPoint);
begin
  AStart := FObjStart;
  ASize := FObjSize;
  AStop := FObjStop;
end;

{v0.21}
procedure TMouseLine.Suspend;
begin
  inc(FSuspended);
  if not FIsOn then
    exit;
  if FDrawn then
    Draw;
end;

procedure TMouseLine.Resume;
begin
  dec(FSuspended);
  if not FIsOn then
    exit;
  if FSuspended > 0 then
    exit;
  if not FDrawn then
    Draw;
end;
{/v0.21}


end.
