Dnes budeme přichytávat okno formuláře k okrajím pracovní plochy. Tato funkce se stává poměrně oblíbeným vylepšením uživatelského prostředí řady programů a proto si ukážeme, jak na to.
Věřím, že jistě všichni víte, o čem je vlastně řeč. Mnoho programů (namátkou třeba populární Winamp) umožňuje uživateli nastavit, že když přesouváte okno aplikace po pracovní ploše a přiblížíte se k některému okraji, okno aplikace se automaticky "přichytí" k tomuto okraji. Pokud tedy chce uživatel umístit okno například do pravého horního rohu pracovní plochy, nemusí se složitě strefovat a má práci velmi usnadněnou. Přesně touto funkcí se dnes budeme zabývat.
Celá věc se dá udělal různými způsoby (jako ostatně většina věcí), ale jako obvykle jsem se snažil o pokud možno co nejjednodušší a také nejkratší kód. Slovní popis celého principu je poměrně logický a jasný. Sledujeme pohyb okna (prostřednictvím zpráv systému) a když se okno přiblíží k některému z okrajů plochy na námi definovanou vzdálenost (v našem případě je to 10 bodů), posuneme okno tak, aby se daného okraje dotýkalo (přichytíme jej).
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.
Jak vidíte, ještě než dojde k samotnému testování a případnému přesouvání (přichycování) okna, uloží se nejprve původní rozměry okna, které jsou na konci celé procedury opět na okno aplikovány. Kdyby jsme to neudělali, okno by mělo tendenci během přichycování či "odtrhávání" od okraje plochy měnit svoje rozměry.
Příklad je tedy velmi jednoduchý a jistě sami přijdete na mnohá zlepšení. Určitě by se například slušelo uložit hodnoty tolerance okrajů do konstant pro snadnější modifikaci. Další drobná vada, kterou byste časem jistě objevili, je to, že pokud změníte polohu nabídky Start až po spuštění aplikace, nebude se k menu přichytávat správně. To je celkem samozřejmé, protože rozměry plochy zjišťujeme v události OnCreate. Pokud by tedy přichytávání mělo být ještě o něco dokonalejší, museli bychom hlídat i případnou změnu polohy nabídky Start (či její automatické schovávání) a také rozlišení obrazovky. Ale to již ponechám na vašem uvážení a každý jistě zvládne úpravu kódu tak, jak bude potřebovat.