A component to prevent your form to be placed out of visible area

Mirror

A component to prevent your form to be placed out of visible area (Views: 3)

Problem/Question/Abstract:

Just put this component on your form and set as active and your form will not be moved out of screen visible area.

Answer:

unit ScreenSnap;

interface

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

type
  TNoOutScreen =
    class(TComponent)
  private
    OldWndProc: Pointer;
    NewWndProc: Pointer;
    FDistance: Integer;
    procedure NewWndMethod(var Msg: TMessage);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Distance: Integer read FDistance write FDistance default 30;
  end;

procedure Register;

implementation

constructor TNoOutScreen.Create(AOwner: TComponent);
begin
  inherited;
  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;
  FDistance := 30;
end;

destructor TNoOutScreen.Destroy;
begin
  if (Assigned(NewWndProc)) then
    FreeObjectInstance(NewWndProc);
  inherited;
end;

procedure TNoOutScreen.NewWndMethod(var Msg: TMessage);
var
  Pabd: APPBARDATA;
  ScreenWidth: Integer;
  ScreenHeight: Integer;
  ScreenRect: TRect;
  TaskBarRect: TRect;
begin
  if (Msg.Msg = WM_EXITSIZEMOVE) then
  begin
    Pabd.cbSize := SizeOf(APPBARDATA);
    SHAppBarMessage(ABM_GETTASKBARPOS, Pabd);
    ScreenWidth := GetSystemMetrics(SM_CXSCREEN);
    ScreenHeight := GetSystemMetrics(SM_CYSCREEN);
    ScreenRect := Rect(0, 0, ScreenWidth, ScreenHeight);
    TaskBarRect := Pabd.rc;
    if ((TaskBarRect.Left = -2) and (TaskBarRect.Bottom = (ScreenHeight + 2)) and
      (TaskBarRect.Right = (ScreenWidth + 2))) then
      ScreenRect.Bottom := TaskBarRect.Top
    else if ((TaskBarRect.Top = -2) and (TaskBarRect.Left = -2) and (TaskBarRect.Right
      = (ScreenWidth + 2))) then
      ScreenRect.Top := TaskBarRect.Bottom
    else if ((TaskBarRect.Left = -2) and (TaskBarRect.Top = -2) and
                 (TaskBarRect.Bottom = (ScreenHeight + 2))) then
      ScreenRect.Left := TaskBarRect.Right
    else if ((TaskBarRect.Right = (ScreenWidth + 2)) and (TaskBarRect.Top = -2) and
      (TaskBarRect.Bottom = (ScreenHeight + 2))) then
      ScreenRect.Right := TaskBarRect.Left;
    if (TForm(Owner).Left < (ScreenRect.Left + FDistance)) then
      TForm(Owner).Left := ScreenRect.Left;
    if (TForm(Owner).Top < (ScreenRect.Top + FDistance)) then
      TForm(Owner).Top := ScreenRect.Top;
    if ((TForm(Owner).Left + TForm(Owner).Width) > (ScreenRect.Right - FDistance))
      then
      TForm(Owner).Left := ScreenRect.Right - TForm(Owner).Width;
    if ((TForm(Owner).Top + TForm(Owner).Height) > (ScreenRect.Bottom - FDistance))
      then
      TForm(Owner).Top := ScreenRect.Bottom - TForm(Owner).Height;
  end;
  Msg.Result := CallWindowProc(OldWndProc, TForm(Owner).Handle, Msg.Msg, Msg.WParam,
    Msg.LParam);
end;

procedure Register;
begin
  RegisterComponents('Christian', [TNoOutScreen]);
end;

end.

<< Back to main page