PC World Komputer 1998 April A/Pcwk4a98.iso/PROGRAM/DELPHI16/Calmira/Src/VCL/FORMDRAG.PAS

Pascal/Delphi Source File | 1997-02-18 | 10KB | 330 lines

{*********************************************************}
{                                                         }
{    Calmira Visual Component Library 1.0                 }
{    by Li-Hsin Huang,                                    }
{    released into the public domain January 1997         }
{                                                         }
{*********************************************************}

unit FormDrag;

{ TFormDrag component }

{ TFormDrag lets the user move and resize a form with a non-resizable
  border, typically bsSingle.  It can simulate a "solid" drag like
  Windows95, or for slower machines, it can use hollow boxes instead.
  Just drop the component onto your form, and it is ready to use.

  Windows 3.x is generally not up to dynamically resizing the controls
  during dragging, so TFormDrag hides all the controls and shows them
  when the dragging has stopped.

  Note that you should not re-assign the following event handlers
  of TForm at run-time: OnMouseMove, OnMouseDown, OnMouseUp,
  OnPaint and OnResize.

  TFormDrag prevents some of these events from occuring when it
  takes over the dragging, so that you need not be concerned with
  any side effects -- just pretend the component is not there and
  program normally.

  DragWidth
    The size of the square in the bottom right corner reserved for
    resizing the form.

  Hollow
    Determines if the form is resized during dragging, or a hollow
    rectangle used to represent the form's dimensions.

  MinWidth, MinHeight, MaxWidth, MaxHeight
    Constrains the size of the form

  AllowMove, AllowSize
    Enables the two operations of this component

  DragState (run-time and read only)
    Indicates what kind of dragging is taking place.  Check this to
    avoid executing code that could disrupt the operation.
}

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs;

type
  TFormDragState = (fdNone, fdSolidMove, fdSolidSize, fdHollowMove, fdHollowSize);

  TFormDrag = class(TComponent)
  private
    { Private declarations }
    FMouseMove : TMouseMoveEvent;
    FMouseDown : TMouseEvent;
    FMouseUp   : TMouseEvent;
    FPaint     : TNotifyEvent;
    FResize    : TNotifyEvent;
    FDragState : TFormDragState;
    FDragWidth : Integer;
    FMinWidth  : Integer;
    FMinHeight : Integer;
    FMaxWidth  : Integer;
    FMaxHeight : Integer;
    FAllowMove : Boolean;
    FAllowSize : Boolean;
    FHollow    : Boolean;
    xofs, yofs : Integer;
    FormRect   : TRect;
    procedure HandleMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure HandleMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure HandleMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  protected
    { Protected declarations }
    procedure Loaded; override;
    procedure StartHollowDrag;
    procedure InverseRect;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    property DragState : TFormDragState read FDragState;
  published
    { Published declarations }
    property DragWidth : Integer read FDragWidth write FDragWidth default 16;
    property Hollow    : Boolean read FHollow write FHollow default False;
    property MinWidth  : Integer read FMinWidth write FMinWidth default 0;
    property MinHeight : Integer read FMinHeight write FMinHeight default 0;
    property MaxWidth  : Integer read FMaxWidth write FMaxWidth default High(Integer);
    property MaxHeight : Integer read FMaxHeight write FMaxHeight default High(Integer);
    property AllowMove : Boolean read FAllowMove write FAllowMove default True;
    property AllowSize : Boolean read FAllowSize write FAllowSize default True;
  end;

procedure Register;


implementation

uses MiscUtil;

var
  { GDI objects used for drawing the resize boxes }
  InversePen : HPen;

constructor TFormDrag.Create(AOwner: TComponent);
begin
  if not (AOwner is TForm) then
    raise EInvalidOperation.Create('TFormDrag can only be placed on a form');

  inherited Create(AOwner);
  FDragState := fdNone;
  FDragWidth := 16;
  FHollow    := False;
  FMaxWidth  := High(Integer);
  FMaxHeight := High(Integer);
  FAllowMove := True;
  FAllowSize := True;
end;


procedure TFormDrag.Loaded;
begin
  { The form's handlers must not be touched during design time,
    otherwise incorrect events will be saved }

  inherited Loaded;
  if not (csDesigning in ComponentState) then
    with Owner as TForm do begin
      { Save the form's original handlers... }
      FMouseMove := OnMouseMove;
      FMouseDown := OnMouseDown;
      FMouseUp   := OnMouseUp;
      FPaint     := OnPaint;
      FResize    := OnResize;

      { ...and make the form call our handlers instead }
      OnMouseMove := HandleMouseMove;
      OnMouseDown := HandleMouseDown;
      OnMouseUp   := HandleMouseUp;
    end;
end;


procedure TFormDrag.StartHollowDrag;
begin
  { Create a suitable pen and set up the screen device context
    ready for drawing }
  InversePen := CreatePen(PS_SOLID, 1, ColorToRGB(clBlack));
  { Obtain and draw the initial rectangle }
  FormRect := TForm(Owner).BoundsRect;
  InverseRect;
end;


procedure TFormDrag.InverseRect;
var
  ScreenDC: HDC;
  OldPen     : HPen;
  OldRop2    : Integer;
begin
  { Draws an inverse rectangle on the screen device context, the
    coordinates specified by FormRect.  The rectangle is two
    pixels thick but it is faster to draw two thin ones than to
    use a thick pen }

  ScreenDC := GetDC(0);
  OldRop2 := SetRop2(ScreenDC, R2_NOT);
  OldPen := SelectObject(ScreenDC, InversePen);

  with FormRect do begin
    MoveTo(ScreenDC, Left, Top);
    LineTo(ScreenDC, Right-1, Top);
    LineTo(ScreenDC, Right-1, Bottom-1);
    LineTo(ScreenDC, Left, Bottom-1);
    LineTo(ScreenDC, Left, Top);

    MoveTo(ScreenDC, Left-1, Top-1);
    LineTo(ScreenDC, Right, Top-1);
    LineTo(ScreenDC, Right, Bottom);
    LineTo(ScreenDC, Left-1, Bottom);
    LineTo(ScreenDC, Left-1, Top-1);
  end;

  SetRop2(ScreenDC, OldRop2);
  SelectObject(ScreenDC, OldPen);
  ReleaseDC(0,ScreenDC);
end;



procedure TFormDrag.HandleMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  { During a solid drag, the form has its dimensions set each time the mouse
    is moved.  During a hollow drag, the previous rectangle must be erased
    (by drawing over it) before drawing the new one }

  with Owner as TForm do
    case DragState of
      fdNone :
        if AllowSize then begin
          if (X > ClientWidth-DragWidth) and (Y > ClientHeight-DragWidth) then begin
            Cursor := crSizeNWSE;
            Exit;
          end
          else begin
            Cursor := crDefault;
          end;
          if Assigned(FMouseMove) then FMouseMove(Sender, Shift, X, Y);
        end;

      fdSolidMove :
        SetBounds(Left+X-xofs, Top+Y-yofs, Width, Height);

      fdSolidSize :
        SetBounds(Left, Top,
          Range(X+xofs, MinWidth, MaxWidth),
          Range(Y+yofs, MinHeight, MaxHeight));

      fdHollowMove:
        begin
          InverseRect;
          FormRect := Bounds(Left+X-xofs, Top+Y-yofs, Width, Height);
          InverseRect;
        end;

      fdHollowSize:
        begin
          InverseRect;
          FormRect := Bounds(Left, Top, Range(X+xofs, MinWidth, MaxWidth),
            Range(Y+yofs, MinHeight, MaxHeight));
          InverseRect;
        end;
    end {case};
end;


procedure TFormDrag.HandleMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var i: Integer;
begin
  with Owner as TForm do
  if (Button = mbLeft) and not (ssDouble in Shift)
   and (WindowState <> WsMaximized) then begin
    if (X > ClientWidth-DragWidth) and (Y > ClientHeight-DragWidth) and AllowSize then begin
      { Start a resize operation }
      xofs := Width - X;
      yofs := Height - Y;

      if Hollow then begin
        FDragState := fdHollowSize;
        StartHollowDrag;
      end
      else begin
        { Suppress OnPaint and OnResize }
        FDragState := fdSolidSize;
        OnPaint := nil;
        OnResize := nil;
        for i := 0 to ControlCount-1 do Controls[i].Hide;
        Canvas.Brush.Color := Color;
        Canvas.FillRect(Rect(0, 0, ClientWidth, ClientHeight));
      end;
    end
    else if AllowMove then begin
      { Start a move operation }
      xofs := X;
      yofs := Y;
      if Hollow then begin
        FDragState := fdHollowMove;
        StartHollowDrag;
      end
      else FDragState := fdSolidMove;
    end
    else if Assigned(FMouseDown) then
      { trigger form's original OnMouseDown event }
      FMouseDown(Sender, Button, Shift, X, Y);
  end
  else if Assigned(FMouseDown) then
     FMouseDown(Sender, Button, Shift, X, Y);
end;


procedure TFormDrag.HandleMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var i: Integer;
begin
  if (Button = mbLeft) and (FDragState <> fdNone) then
  with Owner as TForm do begin
    { End the drag operation }
    if FDragState = fdSolidSize then begin
      { Tell the form that it has just been resized, and force it
        to paint if required.  }
      FDragState := fdNone;
      if Assigned(FResize) then FResize(Owner);
      if Assigned(FPaint) then FPaint(Owner);
      OnResize := FResize;
      OnPaint := FPaint;
      for i := 0 to ControlCount-1 do Controls[i].Show;
    end
    else if FDragState in [fdHollowSize, fdHollowMove] then begin
      { Set the new coordinates of the form and clean up the
        graphics stuff }
      ReleaseCapture;
      InverseRect;
      BoundsRect := FormRect;
      DeleteObject(InversePen);
    end;
    FDragState := fdNone;
  end
  else
    if Assigned(FMouseUp) then FMouseUp(Sender, Button, Shift, X, Y);
end;

procedure Register;
begin
  RegisterComponents('Samples', [TFormDrag]);
end;


end.