Delphi 截屏控件

Delphi Tips
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
   begin
     RegisterComponents('ALComps', [TALScreenSnap]);
   end;
   { TALScreenSnap }
   constructor TALScreenSnap.Create(AOwner: TComponent);
   var
     i: Integer;
     // 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
       NewWndProc := nil;
       OldWndProc := nil;
     fActive := True;
     fThreshold := 30;
   destructor TALScreenSnap.Destroy;
     if Assigned(NewWndProc) then
       FreeObjectInstance(NewWndProc);
   procedure TALScreenSnap.NewWndMethod(var Msg: TMessage);
     Pabd: AppBarData;
     ScreenWidth, ScreenHeight: Integer;
     ScreenRect, TaskBarRect: TRect;
     if (Msg.Msg = WM_EXITSIZEMOVE) and Active then
       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;
     Msg.Result := CallWindowProc(OldWndProc, TForm(Owner).Handle, Msg.Msg, Msg.WParam, Msg.LParam);
   end.