Zmenšení okna na velikost titulkového pruhu

Dnešní aplikace mají samozřejmě kromě svého hlavního okna spousty dalších, a tak je někdy obrazovka hezky zaplněna a i na velkých monitorech mírně nepřehledná. Pokud nechcete okna jednoduše minimalizovat, mám pro vás následující možnost. Což takhle kdyby se okno např. po stisku pravého tlačítka myši na titulkovém pruhu aplikace "zmenšilo" nebo chcete-li vyrolovalo (i když v našem příkladu o animaci nepůjde) nahoru a byl vidět právě jen a pouze onen titulkový pruh?

repeat

if form2.height+(maxy div 5)>=maxy then form2.height:=maxy
else form2.height:=form2.Height+(maxy div 5);

if form2.Width+(maxx div 5)>=maxx then form2.width:=maxx
else form2.width:=form2.Width+(maxx div 5);

form2.Left:=(screen.Width-form2.Width) div 2;
form2.Top:=(screen.Height-form2.Height) div 2;

sleep(10);

until (form2.width=maxx) and (form2.height=maxy);
end;

V našem příkladu

se po stisku tlačítka objeví další okno výše popsaným způsobem. Úplně stejně můžete zařídit, aby se okno animovalo i při jeho uzavření, ale samozřejmě musíte použít opačný postup, tj. z původní velikosti jej zmenšovat, až úplně zmizí.
Zde tedy malá ukázka, kterou se můžete nechat inspirovat při vlastních pokusech:
procedure TForm1.Button1Click(Sender: TObject);

var maxx,maxy:integer;

begin
maxx:=form2.width;
maxy:=form2.height;
form2.width:=112;
form2.height:=27;
form2.Left:=(screen.Width-form2.Width) div 2;
form2.Top:=(screen.Height-form2.Height) div 2;
form2.show;

Animace okna při jeho otevření/zavření

Dalším efektem, kterým můžeme odlišit naše aplikace, bude animování okna při jeho objevení nebo zavření. Princip je vlastně velice jednoduchý. Nejprve zjistíme, jak má být okno velké, a poté měníme jeho rozměry od maličkého okna až do onoho požadovaného rozměru vždy po malém kroku a po vhodném časovém intervalu, aby vznikl dojem určité "animace". Fantazii se meze nekladou, a tak si můžete vymyslet spoustu jiných způsobů, jak se má okno objevit (např. narolovat z jedné ze čtyř stran, v kruhu apod.). Vše záleží jen na vašich nápadech, protože princip je opravdu jednoduchý.

Opět se jedná o událost OnCreate:

procedure TForm1.FormCreate(Sender: TObject);
var
f: HRGN;
begin
f := CreateRoundRectRgn(0, 0, clientwidth, clientheight, 40, 40);
SetWindowRgn(Handle,f,True);
end;
Poslední dva parametry funkce CreateRoundRectRgn nás zajímají nejvíce, protože určují výšku a šířku elipsy (či kruhu), která tvoří rohy okna. Opět se vyplatí experimentovat, než si definitivně zvolíte dané parametry.

Obdélníkové okno se zakulacenými rohy

Další z možností jak změnit tvar okna je ponechat původní základní obdélníkový tvar a zakulatit pouze rohy. Tato změna není tak radikální jako v předchozím příkladě a vypadá poměrně efektně. Navíc je použitelná téměř pro všechny aplikace, což se o kulatém (eliptickém) okně říci nedá. Pro vše ostatní, jako je přesun okna, titulkový pruh nebo barva okna, platí totéž co v předchozím příkladě, takže nyní již jen samotný kód.

A to je vlastně všechno.

Snad jen malý dodatek. Protože okno ztratí svoje původní viditelné ohraničení, může se stát, že při přesunu přes jinou aplikaci okno najednou jakoby "zmizí", což je dáno samozřejmě stejnou barvou podkladu, jako mají jiná okna (hovoříme-li o "standardních" aplikacích). Řešením je prostě změna barvy vašeho okna, což je ale asi celkem předpokládaný postup, protože když už upravujeme tvar okna, pravděpodobně se asi ani nespokojíme s originální unifikovanou barvou oken a ovládacích prvků.
Pouhé eliptické okno a změna barvy sice úplně tak dokonalá změna, jako jsou skiny, není, ale jako jednoduché a rychlé řešení v určitých typech aplikací může stačit.

Zbývá nám zařídit,

aby šlo okno uchopit za libovolnou část. Tedy za libovolnou část podkladu, pochopitelně nelze uchopit okno např. za tlačítko. Opět k tomu využijeme zpráv systému a donutíme Windows "myslet si", že klikáme na titulkový pruh. Vlastní kód vypadá takto:
public
{ Public declarations }
procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;


procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);
begin
inherited;
if M.Result = htClient then M.Result := htCaption;
end;

Nejprve tedy změna

tvaru okna. Stačí, když do události OnCreate příslušného okna přidáte následující kód:
procedure TForm1.FormCreate(Sender: TObject);
var
region: HRgn;
begin
region:=CreateEllipticRgn(1, 1, 500, 200);
SetWindowRgn(handle, region, true);
end;
Parametry funkce CreateEllipticRgn si již upravte sami podle potřeby, mírnému experimentování se pravděpodobně nevyhnete.

Ve vlastnostech formuláře proto nastavíme, aby se horní titulek vůbec nezobrazoval, a druhou zjevnou nevýhodu plynoucí z tohoto řešení – nemožnost přesunu okna – odstraníme dalším trikem, který se naučíme. Trik způsobí, že okno půjde přemístit "uchopením" za jeho libovolnou (téměř) část. Tlačítka na uzavření nebo minimalizování aplikace musíte přidat sami, což však již není žádný problém.

Pokud pomineme

dnes moderní skinovatelné aplikace, které toto pravidlo úmyslně porušují, je to celkem nuda. Tento fádní tvar však můžeme poměrně snadno nabourat, i když to nebude skin. Pozměníme jen tvar okna na tvar elipsy (kruhu). To má však jednu zjevnou nevýhodu – horní titulkový pruh s názvem aplikace a ovládacími tlačítky je z obou stran jaksi "uříznutý", a proto titulek ani tlačítka nejsou úplně vidět.

Kulaté okno

A je to tady. Tento tip se objevuje v různých diskusních skupinách a fórech a dalo by se říci, že je to již natolik známé a "provařené" téma, že snad ani nemá cenu se jím zabývat. Ale proč ne, každý nemůže číst všechno, a proto ti, kteří o něm ještě nejsou informováni, nechť pokračují ve čtení. Ostatní mohou také, samozřejmě. :)
Oč se tedy jedná ? Každý ví, že běžná okna ve Windows mají tvar obdélníku nebo čtverce, proto také název "okno".

function ZeSchranky : string;
begin
if Clipboard.HasFormat(CF_TEXT) then result := Clipboard.AsText
else result := 'schranka je prazdna !';
end;
end;


procedure SmazSchranku;
begin
Clipboard.Clear;
end;
V proceduře pro vložení dat do schránky můžete podle potřeby zvětšit pole pro vkládané znaky. Ve funkci pro získání obsahu schránky je při nalezení prázdné schránky vrácena varovná hláška, což samozřejmě v reálné aplikaci nepoužijete a je to zde uvedeno pouze pro zpřehlednění a objasnění zdrojového kódu.

Práce se schránkou Windows – text

Na závěr si dnes ukážeme, jak zkopírovat do schránky požadovaný text nebo jak ze schránky získat ten, který je tam aktuálně uložen. Budeme k tomu používat knihovnu ClipBrd a napíšeme si jednu proceduru a jednu funkci pro zápis a čtení, jejichž parametrem bude řetězec, který buď zapisujeme, nebo který se nám naopak vrací. Napíšeme si rovněž proceduru na smazání obsahu schránky.
procedure DoSchranky(VkladanyText: string);
var
A: array[0..255] of char;
begin
StrPCopy(A, VkladanyText);
Clipboard.SetTextBuf(A);
end;

V konstantě

je uložena cesta k adresáři se soubory. Nejprve se ListView přepne do módu "Report" (čímž nám připomíná obdobný výpis souborů z různých souborových manažerů) a přidají se dva sloupce pro jméno a typ. Poté se procházejí všechny soubory v daném adresáři a postupně se zjišťuje název souboru, jeho typ a konečně i samotná ikona, která se uloží do ImageListu a příslušný index je přiřazen k danému souboru.
Tento způsob je vhodný spíše pro zjišťování údajů o menším množství souborů (i když náš příklad může svádět k opaku), protože pokud byste chtěli vytvořit nějaký souborový manažer, vyžádala by si tato funkce jisté (zejména rychlostní) optimalizace.

Zobrazení souborů včetně jejich asociovaných ikon

Další věcí, kterou se dnes naučíme, bude zobrazení ikony daného souboru (případně příslušné asociované ikony) a informace o typu souboru. V naší ukázce se soubory ze zvoleného adresáře vypíší do ListView, a to včetně ikon a informací. Pro fungování příkladu musíte na formulář přidat zmiňovaný ListView a ImageList, kam se ukládají ikony, a také bude potřeba knihovna ShellApi, takže již ani nebudu připomínat, kam ji máte napsat.
procedure ZobrazSoubory;
const
sPath = 'c:\windows\';
var
i: integer;
Icon: TIcon;
SearchRec: TSearchRec;
ListItem: TListItem;
FileInfo: SHFILEINFO;
begin
ListView1.SmallImages := ImageList1;
ListView1.ViewStyle := vsReport;
ListView1.Columns.add;
ListView1.Columns.add;
Icon := TIcon.Create;
try
ListView1.items.BeginUpdate;
i := FindFirst(sPath + '*.*', faAnyFile, SearchRec);
while i = 0 do
begin
application.ProcessMessages;
with ListView1 do
begin
if ((SearchRec.Attr and FaDirectory <> FaDirectory) and (SearchRec.Attr and FaVolumeId <> FaVolumeID)) then
begin
ListItem := ListView1.items.add;
SHGetFileInfo(PChar(sPath + SearchRec.Name), 0, FileInfo, SizeOf(FileInfo), SHGFI_DISPLAYNAME);
Listitem.Caption := FileInfo.szDisplayName;
SHGetFileInfo(PChar(sPath + SearchRec.Name), 0, FileInfo, SizeOf(FileInfo), SHGFI_TYPENAME);
ListItem.SubItems.Add(FileInfo.szTypeName);
SHGetFileInfo(PChar(sPath + SearchRec.Name), 0, FileInfo, SizeOf(FileInfo), SHGFI_ICON);
icon.handle := FileInfo.hIcon;
ListItem.ImageIndex := ImageList1.AddIcon(Icon);
end;
end;
i := FindNext(SearchRec);
end;
finally
ListView1.items.EndUpdate;
Icon.Free;
end;
end;