Saturday, April 19, 2008

Kromě samotné procedury, která hlídá pohyb okna, ještě přidáme do programu jeden krátký řádek kódu do události OnCreate formuláře. Ten zjistí rozměry pracovní plochy, abychom věděli, jestli se okno aplikace přiblížilo k okraji nebo ne. Zároveň se tím vyřeší i "problém" s nabídkou Start a bez ohledu na to, na kterém okraji plochy ji máte umístěnu a zda máte nastaveno automatické schovávání, okno naší aplikace se k ní stejně přichytí.
Celý kód jednoduchého formuláře, který se přichycuje k okrajím plochy, tedy vypadá takto:
unit Unit1;

interface

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

type
TWMMoving = record
Msg: Cardinal;
Side: Longint;
Coord: PRect;
Unused: longint;
end;

TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure WMMoving(var Message: TWMMoving); message WM_MOVING;
public
{ Public declarations }
Desktop: TRect;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMMoving(var Message: TWMMoving);
var
OriginalWidth, OriginalHeight: integer;
begin
OriginalWidth := Width;
OriginalHeight := Height;
if (WindowState = wsNormal) and Visible then
begin
if (Message.Coord.Left < (Desktop.Left + 10)) then Message.Coord.Left := Desktop.Left;
if (Message.Coord.Top < (Desktop.Top + 10)) then Message.Coord.Top := Desktop.Top;
if (Message.Coord.Bottom > (Desktop.Bottom - 10)) then Message.Coord.Top := Desktop.Bottom - Height;
if (Message.Coord.Right > (Desktop.Right - 10)) then Message.Coord.Left := Desktop.Right - Width;
end;
Message.Coord.Right := Message.Coord.Left + OriginalWidth;
Message.Coord.Bottom := Message.Coord.Top + OriginalHeight;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
SystemParametersInfo(SPI_GETWORKAREA, 0, @Desktop, 0);
end;

end.