Mega Code Archive
A component to prevent your form to be placed out of visible area
<![CDATA[
Title: A component to prevent your form to be placed out of visible area.
Question: 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 If ( TForm( Owner ).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.
]]>