[Back to OOP SWAG index]  [Back to Main SWAG index]  [Original]

{************************************************}
{                                                }
{   Turbo Pascal for Windows                     }
{   Tips & Techniques Demo Program               }
{   Copyright (c) 1991 by Borland International  }
{                                                }
{************************************************}

Program Rubberband;

uses WinTypes, WinProcs, WObjects;

type
  TApp  = object (TApplication)
    procedure InitMainWindow; virtual;
  end;

  PRubberWin = ^TRubberWin;
  TRubberWin = object(TWindow)
    DC : HDC;
    PS : TPaintStruct;
    ABrush: hBrush;
    APen: hPen;
    OTrack, Track : boolean;
    NextX, NextY, OrgX, OrgY, PrevX, PrevY, X, Y, SX, SY : longint;
    procedure Destroy; virtual;
    procedure SetupWindow; virtual;
    procedure WMLButtonDown(var Message: TMessage);
      virtual wm_First + wm_LButtonDown;
    procedure WMLButtonUp(var Message: TMessage);
      virtual wm_First + wm_LButtonUp;
    procedure WMMouseMove(var Message: TMessage);
      virtual wm_First + wm_MouseMove;
  end;

procedure TApp.InitMainWindow;
begin
  MainWindow := New(PRubberWin, Init(Nil,'RUBBER BAND'));
end;

procedure TRubberWin.Destroy;
begin
  TWindow.Destroy;
  DeleteObject(ABrush);
  DeleteObject(APen);
end;

procedure TRubberWin.SetupWindow;
begin
  Track := False;
  OTrack := True;
  OrgX := 0;
  OrgY := 0;
  PrevX := 0;
  PrevY := 0;
  X := 0;
  Y := 0;
  SX := 0;
  SY := 0;
  ABrush := CreateSolidBrush(RGB(255, 0, 0));
  APen := CreatePen(ps_Solid, 1, RGB(0, 0, 255));
end;

procedure TRubberWin.WMLButtonDown(var Message: TMessage);
begin
  Track := True;
  with Message do
  begin
    PrevX := lParamLo;
    PrevY := lParamHi;
    OrgX := PrevX;
    OrgY := PrevY;

    if OTrack then
    begin
      SX := lParamLo;
      SY := lParamHi;
      OTrack := False;
    end;
    SetCapture(HWindow);
  end;
end;

procedure TRubberWin.WMLButtonUp(var Message: TMessage);
var
  OldPen: HPen;
  OldBrush: HBrush;
begin
  Track := False;
  OTrack := True;
  ReleaseCapture;
  X := integer(Message.lParamLo);
  Y := integer(Message.lParamHi);
  DC := GetDC(HWindow);
  OldPen := SelectObject(DC, APen);
  OldBrush := SelectObject(DC, ABrush);
  if (OrgX <> X) or (OrgY <> Y) then
    Ellipse(DC, OrgX, OrgY, X, Y);
  SelectObject(DC, OldPen);
  SelectObject(DC, OldBrush);
  ReleaseDC(HWindow, DC);
end;

procedure TRubberWin.WMMouseMove(var Message: TMessage);
begin
  if Track then
  begin
    NextX := integer(Message.lParamLo);
    NextY := integer(Message.lParamHi);
    if (NextX <> PrevX) or (NextY <> PrevY) then
    begin
      DC := GetDC(HWindow);
      SetROP2(DC, r2_NOT);
      SelectObject(DC, GetStockObject(null_Brush));
      Ellipse(DC, OrgX, OrgY, PrevX, PrevY);
      PrevX := NextX;
      PrevY := NextY;
      Ellipse(DC, SX, SY, PrevX, PrevY);
      ReleaseDC(HWindow, DC);
    end;
  end;
end;

var
  App: TApp;

begin
  App.Init('Rubber Band');
  App.Run;
  App.Done;
end.

[Back to OOP SWAG index]  [Back to Main SWAG index]  [Original]