2010. március 27., szombat
A component to prevent your form to be placed out of visible area
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.
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése