Přesouvání okna za celou jeho plochu - Builder.cz - Informacni server o programovani

19. listopadu 2001, 00.00 | Dnes si ukážeme, jak přesouvat okno za celou jeho plochu, a to dokonce dvěma způsoby.

Předpokládám, že všichni čtenáři znají program WinAmp a všimli si na něm jedné zajímavé vlastnosti - že jeho okno lze přesouvat po obrazovce nejen přetahováním za titulní lištu, ale za jakoukoliv část okna. No a jelikož čtenáři jsou zajisté programátory, možná přemýšleli nad tím, jak něco takového umožnit ve své aplikaci. No a pokud se výsledku nedobrali, stačí si přečíst tento článek, kde výsledného efektu docílíme dokonce dvěma způsoby.

Když uživatel pohne myší nebo přímo stiskne tlačítko nad nějakým oknem, Windows tomuto oknu pošlou zprávu WM_NCHITTEST. Očekávají, že jako výsledek se vrátí konstanta reprezentující oblast okna, nad kterou je myš. Oblastí se myslí např. rám (rozlišují se levý, pravý,...), titulní lišta, menu a další - pro kompletní přehled zabruste do nápovědy Win32 API. Windows se na základě vrácené hodnoty rozhodují, jaký zobrazí kurzor myši a také třeba jaká akce se má vykonávat při tažení okna.

Nám tedy stačí toto hlášení odchytit, což se udělá pomocí metody formuláře s klauzulí message WM_NCHITTEST v deklaraci. V této proceduře se pak zavolá její zděděná verze (pomocí klíčového slova inherited), která korektně nastaví výsledek. Pak již jen stačí otestovat, zda je kurzor myši nad klientskou oblastí okna a pokud ano, nalhat Windows, že je nad titulkem. Důsledky si už jistě dokážete domyslet. Zde je kód:

...
{ v deklaraci formuláře }
private
  { Private declarations }
  procedure NCHitTest(var M: TWMNCHitTest); message WM_NCHITTEST;

...
{ vlastní procedura }
procedure TForm1.NCHitTest(var M: TWMNCHitTest);
begin
  inherited;
  if M.Result = HTCLIENT then
     M.Result := HTCAPTION;
end;

Někoho možná předchozí způsob neuspokojil (pokud nemá rád programování ve Win32 API, například), a tak mám v záloze ještě jednu alternativu, jak celou věc řešit. Stačí nám napsat tři procedury "pověšené" na události formuláře OnMouseDown, OnMouseUp a OnMouseMove. Také si deklarujeme následující tři proměnné (buď jako pole formuláře nebo "obyčejně" pomocí var - pro naše účely je to zcela lhostejné):

...
private
  { Private declarations }
  OldX, OldY: Integer;
  FormDragging: Boolean;
...

Při stisknutí tlačítka myši (OnMouseDown) nastavíme FormDragging na True (díky čemuž budeme vědět, že uživatel táhne formulář) a také inicializujeme hodnoty OldX a OldY podle aktuální pozice myši. Během pohybu myši (OnMouseOver) postupně obnovujeme pozici formuláře podle toho, jak uživatel hýbe kurzorem - samozřejmě jen pokud je FormDragging True. Při uvolnění tlačítka (OnMouseUp) pak tuto proměnnou nastavíme zpět na False.

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  OldX := X;
  OldY := Y;
  FormDragging := True;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if FormDragging then
  begin
    Left := Left + (X - OldX);
    Top := Top + (Y - OldY);
  end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FormDragging := False;
end;

Všimněte si, že OldX a OldY nemusíme během události OnMouseMove nijak obnovovat na aktuální pozici - díky tomu, že se nám formulář "hýbe pod rukama", vše probíhá samo od sebe.

Obě dvě představené metody, jak docílit přetahování formuláře za celou jeho plochu, jsou stejně dobré, a je jen na vás, jakou z nich si v případě potřeby ve své aplikaci vyberete.