Thursday, November 30, 2006

Zamezení obnovení velikosti okna poklepáním na titulkový pruh

Tento tip malinko souvisí s tím předchozím. Opět se týká změny ovladatelnosti okna, opět využijeme zprávy systému. A použití? Těžko říci, to ponechám na vás.
.
.
.
private
procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
.
.
.
procedure TForm1.WMSysCommand(var Message: TWMSysCommand);
begin
with Message do
if CmdType and $FFF0 = SC_RESTORE then Result := 0
else inherited;
end;

Minimalizace aplikace i s modálními formuláři

Jistě dobře víte, co to modální režim znamená. Někdy jsou tato okna až otravná, když nejdou minimalizovat. My si teď ukážeme, jak se dá minimalizovat aplikace (minimalizací jejího hlavního formuláře) i v tom případě, že některé modální formuláře (dialogy) obsahuje. Jak jinak v podobných případech, i zde využijeme systém zpráv Windows.
.
.
.
private
procedure WMSyscommand(var Msg: TWmSysCommand); message WM_SYSCOMMAND;

.
.
.
procedure TForm1.WMSysCommand(var Msg: TWmSysCommand);
begin
case (Msg.CmdType and $FFF0) of
SC_MINIMIZE:
begin
Msg.Result := 0;
EnableWindow(Application.Handle, True);
Aplication.Minimize;
end;
else inherited;
end;
end;

Tuesday, November 28, 2006

Vytvoření virtuálního disku

Máte-li rozsáhlý disk, můžete se v jeho obsahu snadno ztratit i v tom případě, že jej máte rozdělen na několik oblastí. Pokud potřebujete kupříkladu často přistupovat do jednoho (třeba i více zanořeného) adresáře, může se hodit vytvoření virtuálního disku. Jak se to dá udělat programově nám ukazuje náš příklad:
procedure TForm1.Button35Click(Sender: TObject);
begin
if DefineDosDevice(DDD_RAW_TARGET_PATH, 'X:', PChar('c:\')) then ShowMessage('Virtuální disk "X" byl vytvořen.')
else ShowMessage('Při vytváření virtuálního disku došlo k chybě.');
end;

Sunday, November 26, 2006

Jméno přihlášeného uživatele

Následující jednoduchá funkce nám zjistí jméno právě přihlášeného uživatele. To můžete využít pro řadu účelů jako třeba ukládání různých konfigurací pro jednotlivé uživatele a podobně.
function UserName: String;
var
User : PChar;
i : DWord;
begin
i := 1024;
user := StrAlloc(Succ(i));
if GetUserName(User, i) then Result := StrPas(User)
else Result := 'Žádný';
end;

procedure TForm1.Button34Click(Sender: TObject);
begin
ShowMessage(UserName);
end;

Thursday, November 23, 2006

Jak nastartovaly Windows?

Ne vždycky se podaří systému nastartovat v pořádku a někdy je nutno použít nouzový režim. Pokud je však vaše aplikace „citlivá“ na podobný stav, kdy je systém nastartován jen s omezenými prostředky a nezbytným minimem ovladačů, může se nám hodit podobný stav detekovat a aplikaci případně zakázat start.
procedure TForm1.Button33Click(Sender: TObject);
begin
case (GetSystemMetrics(SM_CLEANBOOT)) of
0 : ShowMessage('Window nastartovaly běžným způsobem');
1 : ShowMessage('Nouzový režim');
2 : ShowMessage('Nouzový režim s prací v síti');
else
ShowMessage('Nelze zjistit');
end;
end;

Wednesday, November 22, 2006

procedure TForm1.FormCreate(Sender: TObject);
begin
ProgressBar1.Parent := Button1;
ProgressBar1.Width := Button1.Width-7;
ProgressBar1.Height := Button1.Height-7;
ProgressBar1.Left := 3;
ProgressBar1.Top := 3;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i : byte;
begin
Button1.Enabled := false;
if ProgressBar1.Visible then Exit;
ProgressBar1.Position := 0;
ProgressBar1.Visible := True;
for i := 0 to 99 do
begin
Sleep(100);
ProgressBar1.Position := ProgressBar1.Position + 1;
Application.ProcessMessages;
end;
ProgressBar1.Visible := False;
Button1.Enabled := true;
end;

Tuesday, November 21, 2006

Jak vidíte v kódu,

ProgressBar je umístěn uvnitř tlačítka tak, aby kolem něj vznikl decentní okraj. Jeho velikost si samozřejmě můžete upravit dle vlastních potřeb. Nezapomeňte také ze všeho nejdříve nastavit v Object Inspectoru u použitého ProgressBaru vlasnost Visible na False. Jinak fantazii se meze nekladou, takto můžete použít i jiný něž jen standardní ProgressBar (pokud máte třeba nějaký hezčí jako komponentu), protože toto řešení je poměrně univerzální. A když se to vezme do důsledku, můžete takto (s jistými specifickými omezeními) vlastně kombinovat řadu komponent, které spolu na první pohled nemají moc souvislostí. Chce to jen nápad.

Monday, November 20, 2006

Ukazatel průběhu uvnitř tlačítka

Nejprve si tedy ukážeme jednu zajímavou kombinaci dvou komponent. Umístíme ukazatel průběhu – ProgressBar – přímo do tlačítka. Výsledný efekt je poměrně zajímavý a můžete tak ušetřit někdy drahocené místo na formuláři, který je již přeplněn dalšími vizuálními komponentami.
Po stisknutí tlačítka se uvnitř něj objeví běžný ProgressBar, který indikuje daný průběh a po jeho ukončení zmizí a objeví se opět původní vnitřek tlačítka – jeho nadpis. V naší ukázce je pro demonstraci funkčnosti použit cyklus s funkcí Sleep, kterou v ostré aplikaci samozřejmě nahradíte činností, kterou má vaše aplikace vykonávat.

Sunday, November 19, 2006

Jak vidíte,

kromě samotného zobrazovaného textu je neméně důležitou součástí i pauza mezi jednotlivými "úhozy". Zde je pro jednoduchost použita funkce Sleep doplněná o Application.ProcessMessages, aby při vypisování nedošlo ke "kousnutí" programu. Samozřejmě můžete použít jinou konstrukci, experimentovat s délkou pauzy a podobně. Pozorní čtenáři možná přijdou na jednu drobnou vadu na kráse celého efektu. Jelikož je využívána pro zjednodušení komponenta Edit, může do ní uživatel během vypisování textu samozřejmě psát a celý efekt tak zkazit. Při vhodné úpravě parametrů sice není vizuálně poznat, že se jedná o Edit, přesto musíte s touto možností počítat, a pokud jste perfekcionisté, ošetřit tuto situaci v kódu. Předem upozorňuji, že nastavení vlastnosti na ReadOnly problém neřeší, protože pak se samozřejmě zakáže i naše automatické vypisování a z celého efektu nezbude nic. :)

Friday, November 17, 2006

A zde je samotný kód:

procedure TForm1.Button5Click(Sender: TObject);
var Cnt : integer;
Txt : string;
begin
txt := 'Sem doplňte váš vlastní text, který bude vypisován';
for cnt := 1 to length(txt) do
begin
Edit2.Perform(WM_CHAR, Ord(Txt[Cnt]), 0);
Edit2.Update;
if Cnt < Length(txt) then
begin
Sleep(50);
Application.ProcessMessages;
end;
end;
end;

Thursday, November 16, 2006

Efektní vypisování textu pomocí komponenty Edit

Na závěr si teď ukážeme zajímavý efekt s vypisováním textu. Nevím, jak jej nazvat, tak ho alespoň popíšu, protože ho jistě znáte a vybaví se vám. Jedná se o postupné vypisování daného textu znak po znaku, připomínající psaní na psacím stroji nebo snad dálnopisu. Vše se bude vypisovat do komponenty edit, se kterou si můžete dokonale vyhrát. Nejprve bych doporučil změnit barvu podkladu textu na barvu samotného okna, poté ještě nastavte v Object Inspectoru vlasnost BorderStyle na BsNone, takže již není komponenta vůbec vidět. Ještě nastavte vhodnou velikost (délku) podle délky vypisovaného textu. Pokud bude délka řekněme podstatně kratší než text, získáme navíc ještě efekt horizontálního scrollování. Případně upravte font.

Wednesday, November 15, 2006

Pomocí této funkce můžeme dosáhnout u požadovaných objektů zalomení řádku. Daný objekt je předáván jako parametr a musí být typu TButtonControl. Nejvhodnější bude umístit toto nastavení přímo do události OnCreate hlavního formuláře:
procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.Caption:='Tlačítko s popisem na více řádek';
Zalomit(Button1);
end;
Pochopitelně musíte dané tlačítko či radiobutton dostatečně zvětšit na výšku, aby se tam kompletní text vešel. Jinak bude vidět samozřejmě jen část.

Monday, November 13, 2006

Zalomení textu u tlačítek na více řádků

Pokud potřebujete u komponent třídy TButton, jako je samotné tlačítko, ale také CheckBox a RadioButton, zalomit delší text popisku na více řádek, pomůže vám v tom následující užitečná funkce:
function Zalomit(CTRL: TButtonControl): boolean;
var style : dword;
begin
style := GetWindowLong(CTRL.Handle, GWL_STYLE);
SetLastError(0);
SetWindowLong(CTRL.Handle, GWL_STYLE, Style or BS_MULTILINE);
Result := (GetLastError = 0);
if result then CTRL.Repaint;
end;

Sunday, November 12, 2006

Zde je tedy zdrojový kód,

parametrem funkce je znovu rok, na výstupu se nám vrátí datum opět v podobě TDateTime.
function Velikonoce(Rok : integer) : TDateTime;
var R1, R2, R3, X, Y, Z: Double;
Tmp : integer;

begin
R1 := Rok mod 19;
R2 := Rok mod 4;
R3 := Rok mod 7;
X := 19 * R1 + 24;
Y := X - (Int(x / 30) * 30);
Z:=(5 + 2 * R2 + 4 * R3 + 6 * Y);
Tmp := Trunc((Z - (Int(Z / 7) *7)) + Y + 22);
if Tmp <= 31 then Result := EncodeDate(Rok, 3, Tmp)
else
begin
if Tmp -31 >= 26 then Tmp := 19
else Dec(Tmp, 31);
Result := EncodeDate(Rok, 4, Tmp);
end;
end;

Saturday, November 11, 2006

Tak to byla taková menší rozcvička. Následující výpočet již bude značně složitější. Ukážeme si jak vypočítat, na jaký den pro daný rok připadají Velikonoce, což je údaj, který se neustále mění, a pokud vytváříte například nějakou aplikaci typu kalendáře, tento výpočet se vám jistě bude hodit. Nechtějte po mně ovšem teoretické vysvětlení algoritmu, protože se vám rovnou přiznám, že nejsem žádný astronom.

Friday, November 10, 2006

Přestupný rok a Velikonoce

Když už jsme se trošku zabývali časem, ukažme si dva výpočty z opravdu reálného života. Opět je jistě řada z vás bude znát. Alespoň ten první.
Nejprve tedy výpočet přestupného roku, který se nám může někdy v našich aplikacích hodit. Funkce je opravdu jednoduchá, parametrem je požadovaný rok:
function JePrestupny(Rok: integer) : boolean;
begin
Result := ((Rok mod 4 =0) and (Rok mod 100 <>0)) or (Rok mod 400 = 0);
end;

Thursday, November 09, 2006

Převod času v milisekundách na TDateTime

Možná vám bude tento tip připadat jako zbytečný, ale mnozí začátečníci se často potýkají s problémem vzájemných převodů různých časových jednotek, a jelikož je této oblasti v Delphi věnován poměrně velký počet funkcí, snadno se v nich může člověk ztratit. Pro náš příklad jsem vybral velice častý případ, kdy údaj v milisekundách potřebujeme zobrazit jako běžný čas převedením na typ TDateTime, se kterým se pak již pracuje poněkud pohodlněji než s milisekundami. V naší ukázce si necháme zobrazit v tomto standardním tvaru čas od startu systému.
procedure TForm1.Button1Click(Sender: TObject);
var DT : TDAteTime;
begin
DT := TimeStampToDateTime(MSecsToTimeStamp(GetTickCount));
ShowMessage(FormatDateTime('d hh:nn:ss', DT));
end;
Místo funkce GetTickCount můžete samozřejmě doplnit požadovaný čas v milisekundách, který bude poté převeden.

Wednesday, November 08, 2006

Jak vidíte,

o vše se postarají pouze dva parametry. Jeden uvádí barvu, kterou chcete nastavit, a druhý zase prvek, jehož parametry měníme. Tyto konstanty můžete například vyčíst při nastavování barev čehokoliv v Object Inspectoru. V naší ukázce měníme barvu titulku u aktivní aplikace.
Je třeba si uvědomit, že tím dojde ke změně barvy globálně v celém systému, takže se změní barvy nejen naší aplikace, ale i všech ostatních prvků.

Tuesday, November 07, 2006

Změna barev objektů v systému

Jistě víte, že se barvy většiny prvků v systému, jako je třeba titulek oken, barvy posuvníků či editačních polí a podobně, dají celkem bez problému nastavit přes ovládací panely k obrazu svému. Nyní si však ukážeme, jak se toho dá docílit též programově.
procedure TForm1.Button1Click(Sender: TObject);
var CIndex : Integer;
CValue : Longint;
begin
CIndex := COLOR_ACTIVECAPTION;
CValue := clGreen;
SetSysColors(2, CIndex, CValue);
PostMessage(HWND_BROADCAST, WM_SYSCOLORCHANGE, 0, 0);
end;

Monday, November 06, 2006

Virtuální paměť

A následují příklady pro tytéž parametry u virtuální paměti.
Nejprve celková velikost virtuální paměti:
procedure TForm1.Button1Click(Sender: TObject);
var mem:TMemoryStatus;
begin
GlobalMemoryStatus(mem);
ShowMessage(FormatFloat('#,###" kB"', Mem.dwTotalVirtual / 1024));
end;
A na úplný závěr ještě zbývá volná virtuální paměť:
procedure TForm1.Button1Click(Sender: TObject);
var mem:TMemoryStatus;
begin
GlobalMemoryStatus(mem);
ShowMessage(FormatFloat('#,###" kB"', Mem.dwAvailVirtual / 1024));
end;

Friday, November 03, 2006

Zjištění celkové fyzické paměti

K tomuto příkladu snad není třeba zvláštních úvodů. Následující kód prostě zobrazí celkové množství fyzické paměti v systému v kB.
procedure TForm1.Button1Click(Sender: TObject);
var mem:TMemoryStatus;
begin
GlobalMemoryStatus(mem);
ShowMessage(FormatFloat('#,###" kB"', Mem.dwTotalPhys / 1024));
end;
Volná fyzická paměť
A tento příklad pro změnu zobrazí volnou fyzickou paměť.
procedure TForm1.Button1Click(Sender: TObject);
var mem:TMemoryStatus;
begin
GlobalMemoryStatus(mem);
ShowMessage(FormatFloat('#,###" kB"', Mem.dwAvailPhys / 1024));
end;

Thursday, November 02, 2006

Smazání souboru do koše

Teď si ukážeme jeden ze způsobů, jak vybraný soubor smazat do Koše (Recycle Bin). Pomůže nám k tomu knihovna ShellAPI. Důležitý je příznak FOF_ALLOWUNDO, který právě zajistí to, že soubor nebude smazán přímo, ale bude použit Koš.
function DoKose(const filename : string) : boolean;
var FileOp : TSHFileOpStruct;
begin
if integer(GetFileAttributes(PChar(Filename))) <> -1 then
begin
ZeroMemory(@FileOp, SizeOf(FileOp));
FileOp.wFunc := FO_DELETE;
FileOp.pFrom := PChar(Filename);
FileOp.fFlags := FOF_ALLOWUNDO or FOF_SILENT or FOF_NOCONFIRMATION;
Result:=(SHFileOperation(FileOp)=0);
end
else
Result := False;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if DoKose('c:\soubor.txt') then ShowMessage('Soubor byl přesunut do Koše');
end;