Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue27/controls/Dragunit.pas

Pascal/Delphi Source File | 1997-09-17 | 7.3 KB | 251 lines

unit Dragunit;

{ Main unit of sample application to demonstrate the use of the functions
  FindTopMostWinControlAtPos and GetTopMostControlAtScreenCoords from the
  accompanying "Controls Demystified" article.

  This application is a simple game. The user should try to figure out the
  rules for him/herself but the aim is to order the button captions by
  holding down the mouse button and dragging them from one button to another.
  You can drop a caption on a disabled button, but you can't drag from one.
  To make things a bit harder the source button's Enabled property will
  always take the inverse of the Enabled property of the target button.

  Please note that Delphi comes complete with a simple event driven drag
  and drop mechanism which is generally preferable to the method used here.
  However, this method does give you more control and also allows you to
  have disabled controls as drop targets.

  Author: Glenn Lawrence
          Principal Consultant
          AIMTec Pty Ltd  "Advanced Interactive Media Technologies"
          www.aimtec.com.au

  Copyright (c) 1997 AIMTec Pty Ltd.
}

interface

uses
  Wintypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, MMsystem;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    Button10: TButton;
    Button11: TButton;
    Button12: TButton;
    PnlDisplay: TPanel;
    PnlControls: TPanel;
    BtnStart: TSpeedButton;
    LblTimer: TLabel;
    Timer1: TTimer;
    procedure ButtonMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ButtonMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BtnStartClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    MoveCount : Integer;
    StartTime : Longint;
    procedure CheckCompleted;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{ FindTopMostWinControlAtPos

  This function is described in the accompanying magazine article.

  It returns the top most windowed control at the given screen location.
}
function FindTopMostWinControlAtPos
(
  parent: TWinControl;     { The parent at the top of the control tree }
  pt: TPoint               { The "hit" test point in screen coordinates }
): TWinControl;
var i: integer; c: TControl;
begin
  Result := nil;

  if parent.Visible then
  begin
    i := parent.ControlCount -1;
    while (i >= 0) and (Result = nil) do  { Check children first }
    begin
      c := parent.Controls[i];
      if c is TWinControl then  { Recursively descend }
        Result := FindTopMostWinControlAtPos(c as TWinControl, pt);
      i := i -1;
    end;

    if Result = nil then  { Check parent control last }
    begin
      pt := parent.ScreenToClient(pt);  { Convert point to local coords }
      if
        (pt.X >= 0) and (pt.X < parent.Width)
        and
        (pt.Y >= 0) and (pt.Y < parent.Height)
      then
        Result := parent; { Found it! }
    end;
  end;
end;

{ GetTopMostControlAtScreenCoords

  This function is described in the accompanying magazine article.

  It returns the top most control at the given screen location,
  optionally allowing or ignoring disabled controls.
}
function GetTopMostControlAtScreenCoords
(
  pt: TPoint;              { Screen coords for "hit" test }
  allow_disabled : boolean { Indicates if disabled controls are included }
): TControl;
var wc : TWinControl;
begin
  Result := FindDragTarget(pt, allow_disabled);

  if (Result <> nil) and (Result is TWinControl) and allow_disabled then
  begin
    { Check for disabled child windowed controls }
    wc := FindTopMostWinControlAtPos((Result as TWinControl), pt);
    if wc = nil then abort; { Can't happen - honest guv! }
    pt := wc.ScreenToClient(pt);   { Convert to local coords }
    Result := wc.ControlAtPos(pt, True);
    if Result = nil then
      Result := wc;
  end;
end;

{ All following code belongs to the example application }

procedure SwapButtonCaptions(btn1, btn2: TButton);
var text: String;
begin
  text := btn1.Caption;
  btn1.Caption := btn2.Caption;
  btn2.Caption := text;
end;

procedure TForm1.CheckCompleted;
var i: integer; ok : Boolean;
begin
  { NB: This function relies on the there being *only* buttons on
    Panel1 and also that their order in the DFM file reflects the
    order they appear on the screen. If you were to move buttons around
    then this wouldn't necessarily be the case, so I don't recommend
    this as a standard technique. It does however demonstrate a use
    of the Controls array property described in the magazine article. }

  ok := True;
  for i := 0 to Panel1.ControlCount -1 do
    ok := ok and ((Panel1.Controls[i] as TButton).Caption = IntToStr(i + 1));

  if ok then
  begin
    Timer1.Enabled := False;
    Panel1.Enabled := False;
    MessageBeep(MB_ICONEXCLAMATION);
    PnlDisplay.Caption := 'You did it in ' + IntToStr(MoveCount) + ' moves !';
  end;
end;

{ Event handlers follow ... }

procedure TForm1.FormCreate(Sender: TObject);
begin
  Randomize;
end;

procedure TForm1.BtnStartClick(Sender: TObject);
var i: integer;
begin
  MoveCount := 0;
  BtnStart.Caption := 'Restart !';
  Timer1.Enabled := True;
  Panel1.Enabled := True;
  PnlDisplay.Caption := 'Drag the buttons into order';

  for i := 0 to Panel1.ControlCount -1 do
    Panel1.Controls[i].Enabled := True;

  for i := 0 to 500 do  { Mix 'em up! }
  begin
    SwapButtonCaptions
    (
       Panel1.Controls[Random(Panel1.ControlCount)] as TButton,
       Panel1.Controls[Random(Panel1.ControlCount)] as TButton
    );
  end;

  StartTime := TimeGetTime;
end;

procedure TForm1.ButtonMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Screen.Cursor := crDrag;
  SetCaptureControl(Sender as TControl);
end;

procedure TForm1.ButtonMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  drop_point: TPoint;
  drop_target: TControl;
  source_button, target_button : TButton;
begin
  Screen.Cursor := crDefault;
  SetCaptureControl(nil);
  drop_point.X := X;
  drop_point.Y := Y;
  drop_point := (Sender as TControl).ClientToScreen(drop_point);
  drop_target := GetTopMostControlAtScreenCoords(drop_point, True);

  if drop_target <> Sender then
  begin
    if (drop_target = nil) or not (drop_target is TButton) then
      MessageBeep(MB_ICONHAND)  { Not a valid drop target! }
    else
    begin
      MoveCount := MoveCount +1;
      PnlDisplay.Caption := 'Move ' + IntToStr(MoveCount);
      source_button := Sender as TButton;
      target_button := drop_target as TButton;
      SwapButtonCaptions(source_button, target_button);
      source_button.Enabled := not target_button.Enabled;
      CheckCompleted;
    end;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  LblTimer.Caption := Format('%1.1f', [(TimeGetTime - StartTime) / 1000]);
end;

end.