alscreensnap.pas

又一个用delphi开发的网页截屏控件,嵌入在网页中使用.

{
  ALScreenSnap v1.02

  (C)2001 Andrew Leigh
  http://www.alphalink.com.au/~leigh/components

  Description:
    This component allows a form to snap to the edges of the screen when dragged
    and released.

  History:
    v1.0  17-Jul-1999 Initial release.
    v1.01 20-Nov-1999 Fixed access violation when destroying component at design
                      time. Will now raise exception if owner is not a form and
                      will only allow one instance per form.
    v1.02 15-Dec-2001 Will now work properly under the new Windows XP interface
                      style.
}

unit ALScreenSnap;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ShellAPI;

type
  TALScreenSnap = class(TComponent)
  private
    OldWndProc, NewWndProc: Pointer;
    fActive: Boolean;
    fThreshold: Integer;
    procedure NewWndMethod(var Msg: TMessage);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Active: Boolean    read fActive    write fActive    default True;
    property Threshold: Integer read fThreshold write fThreshold default 30;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('ALComps', [TALScreenSnap]);
end;

{ TALScreenSnap }

constructor TALScreenSnap.Create(AOwner: TComponent);
var
  i: Integer;
begin
  // Only allow one instance per form
  for i := 0 to AOwner.ComponentCount-1 do
    if AOwner.Components[i] is TALScreenSnap then
      raise Exception.Create('TALScreenSnap component cannot be duplicated in ' + AOwner.Name);

  inherited;

  // Check if the owner is a form
  if (Owner = nil) or not(AOwner is TForm) then
    raise Exception.Create('Owner of TALScreenSnap component must be a form');

  // Form subclassing
  if not(csDesigning in ComponentState) then
  begin
    NewWndProc := MakeObjectInstance(NewWndMethod);
    OldWndProc := Pointer(SetWindowLong(TForm(Owner).Handle, gwl_WndProc, Longint(NewWndProc)));
  end
  else
  begin
    NewWndProc := nil;
    OldWndProc := nil;
  end;

  fActive := True;
  fThreshold := 30;
end;

destructor TALScreenSnap.Destroy;
begin
  if Assigned(NewWndProc) then
    FreeObjectInstance(NewWndProc);

  inherited;
end;

procedure TALScreenSnap.NewWndMethod(var Msg: TMessage);
var
  Pabd: AppBarData;
  ScreenWidth, ScreenHeight: Integer;
  ScreenRect, TaskBarRect: TRect;
begin
  if (Msg.Msg = WM_EXITSIZEMOVE) and Active then
  begin
    Pabd.cbSize := SizeOf(APPBARDATA);
    SHAppBarMessage(ABM_GETTASKBARPOS, Pabd);
    TaskBarRect := Pabd.rc;

    ScreenWidth := GetSystemMetrics(SM_CXSCREEN);
    ScreenHeight := GetSystemMetrics(SM_CYSCREEN);
    ScreenRect := Rect(0, 0, ScreenWidth, ScreenHeight);

    if (TaskBarRect.Left < 1) and (TaskBarRect.Bottom >= ScreenHeight) and (TaskBarRect.Right >= ScreenWidth) then
      // Bottom
      ScreenRect.Bottom := TaskBarRect.Top
    else if (TaskBarRect.Top < 1) and (TaskBarRect.Left < 1) and (TaskBarRect.Right >= ScreenWidth) then
      // Top
      ScreenRect.Top := TaskBarRect.Bottom
    else if (TaskBarRect.Left < 1) and (TaskBarRect.Top < 1) and (TaskBarRect.Bottom >= ScreenHeight) then
      // Left
      ScreenRect.Left := TaskBarRect.Right
    else if (TaskBarRect.Right >= ScreenWidth) and (TaskBarRect.Top < 1) and (TaskBarRect.Bottom >= ScreenHeight) then
      // Right
      ScreenRect.Right := TaskBarRect.Left;

    // Position form
    if TForm(Owner).Left < ScreenRect.Left + fThreshold then
      TForm(Owner).Left := ScreenRect.Left;
    if TForm(Owner).Top < ScreenRect.Top + fThreshold then
      TForm(Owner).Top := ScreenRect.Top;
    if TForm(Owner).Left+TForm(Owner).Width > ScreenRect.Right-fThreshold then
      TForm(Owner).Left := ScreenRect.Right-TForm(Owner).Width;
    if TForm(Owner).Top+TForm(Owner).Height > ScreenRect.Bottom-fThreshold then
      TForm(Owner).Top := ScreenRect.Bottom-TForm(Owner).Height;
  end;

  Msg.Result := CallWindowProc(OldWndProc, TForm(Owner).Handle, Msg.Msg, Msg.WParam, Msg.LParam);
end;

end.