Zobrazení upozornění před logovacím dialogem

Ve Windows existuje možnost drobnou úpravou registru zajistit to, že se ještě před samotným dialogem pro přihlášení do systému zobrazí okno s textem, které tak může uživatele upozornit na různé události. Po potvrzení dialogu kliknutím na OK pak již pokračuje přihlášení zcela běžným způsobem. Má to tu výhodu, že takto můžete jednak upozornit všechny "legální" uživatele daného systému na nějakou důležitou věc (lépe řečeno vaše aplikace může ohlásit nějakou událost), ale můžete také na cokoliv upozornit (varovat) uživatele, kteří na daném počítači svůj účet nemají.
Postup by měl fungovat ve všech Windows, i když musím přiznat, že mně osobně to na systémech 9x nepracovalo. Pod Windows 2000 však vše pracovalo bezvadně a koneckonců má tato funkce pro systémy NT/2000/XP mnohem větší opodstatnění než pro systémy 9x, které nejsou víceuživatelské v pravém slova smyslu.
Nyní tedy již k samotné implementaci v Delphi. Jelikož jsme v našem seriálu už prováděli úpravy registrů nesčetněkrát, zřejmě by stačilo pouze uvést, kterou větev a klíč upravit, ale pro jistotu si uvedeme celý kód. Snad nemusím připomínat, že je třeba do projektu přidat jednotku Registry.
procedure TForm1.Button1Click(Sender: TObject);
var
key: string;
Reg: TRegIniFile;
begin
key := '\Software\Microsoft\Windows NT\CurrentVersion\Winlogon';
Reg := TRegIniFile.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.CreateKey(Key);
if Reg.OpenKey(Key, False) then
begin
Reg.WriteString(key, 'LegalNoticeCaption', 'Titulek zobrazeného okna');
Reg.WriteString(key, 'LegalNoticeText', 'Vlastní zobrazovaný text');
end;
finally
Reg.Free;
end;
end;
Pro systémy 9x musíte vynechat v textu klíče NT, takže klíč pak vypadá takto:
'\Software\Microsoft\Windows\CurrentVersion\Winlogon'
Zobrazovaný text může mít 256 znaků, u systémů NT s posledním service packem (a zřejmě tím pádem u všech systému 2000 a XP) až 1024 znaků.

V jednom z předchozích dílů jsme se zabývali načítáním informací ze souboru WAV a dnes se na to podíváme z poněkud opačné stránky, protože budeme tyto zvukové soubory programově vytvářet.
Procedura, která nám k tomu poslouží, na základě požadovaných parametrů vygeneruje příslušný zvuk do souboru WAV, který pak můžete již běžným způsobem přehrát. Mezi parametry procedury patří jednak frekvence zvuku pro oba kanály, dále pak délka vygenerovaného zvuku (či spíše tónu) a konečně jméno výstupního souboru. Do seznamu použitých jednotek ještě přidejte knihovnu MMSystem, kterou budeme potřebovat.
procedure CreateWave(LeftFreq, RightFreq: Single; Duration: Cardinal; const FileName: String);
const
BitsPerSample = 16;
NumChannels = 2;
SampleRate = 44100;
var
ChunkSize: Integer;
DataSize: Integer;
Factor: Single;
Format: TWaveFormatEx;
FourCC: array[0..3] of Char;
I: Integer;
NumSamples: Integer;
L: SmallInt;
R: SmallInt;
WaveStream: TFileStream;
begin
WaveStream := TFileStream.Create(FileName, fmCreate);
try
FourCC := 'RIFF';
WaveStream.Write(FourCC, SizeOf(FourCC));
NumSamples := (SampleRate * Duration) div 1000;
DataSize := (BitsPerSample shr 3) * NumChannels * NumSamples;
ChunkSize := DataSize + SizeOf(TWaveFormatEx) + 20;
WaveStream.Write(ChunkSize, SizeOf(ChunkSize));
FourCC := 'WAVE';
WaveStream.Write(FourCC, SizeOf(FourCC));
FourCC := 'fmt ';
WaveStream.Write(FourCC, SizeOf(FourCC));
ChunkSize := SizeOf(TWaveFormatEx);
WaveStream.Write(ChunkSize, SizeOf(ChunkSize));
with Format do
begin
wFormatTag := WAVE_FORMAT_PCM;
nChannels := NumChannels;
nSamplesPerSec := SampleRate;
wBitsPerSample := BitsPerSample;
nBlockAlign := nChannels * wBitsPerSample shr 3;
nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
cbSize := 0
end;
WaveStream.Write(Format, SizeOf(Format));
FourCC := 'data';
WaveStream.Write(FourCC, SizeOf(FourCC));
ChunkSize := DataSize;
WaveStream.Write(ChunkSize, SizeOf(ChunkSize));
for I := 0 to 999 do
begin
Factor := Exp(- 0.005 * (1000 - I));
L := Round(Factor * 32767 * Sin(2 * Pi * LeftFreq * I / SampleRate));
R := Round(Factor * 32767 * Sin(2 * Pi * RightFreq * I / SampleRate));
WaveStream.Write(L, SizeOf(L));
WaveStream.Write(R, SizeOf(R))
end;
for I := 1000 to NumSamples - 1001 do
begin
L := Round(32767 * Sin(2 * Pi * LeftFreq * I / SampleRate));
R := Round(32767 * Sin(2 * Pi * RightFreq * I / SampleRate));
WaveStream.Write(L, SizeOf(L));
WaveStream.Write(R, SizeOf(R))
end;
for I := NumSamples - 1000 to NumSamples - 1 do
begin
Factor := Exp(0.005 * (NumSamples - 1001 - I));
L := Round(Factor * 32767 * Sin(2 * Pi * LeftFreq * I / SampleRate));
R := Round(Factor * 32767 * Sin(2 * Pi * RightFreq * I / SampleRate));
WaveStream.Write(L, SizeOf(L));
WaveStream.Write(R, SizeOf(R))
end;
WaveStream.Position := 0;
finally
WaveStream.Free
end
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
CreateWave(500, 100, 1000, 'test.wav');
end;
Pohledem do části konstant zdrojového kódu si můžete všimnout, jaké parametry bude výsledný soubor mít.
Konkrétní příklad použití vidíte hned za procedurou v události OnClick tlačítka, kdy po jeho stisknutí bude vygenerován testovací soubor o délce jedné sekundy s příslušnými parametry pro levý a pravý kanál. Výsledný "zvuk" sice vzdáleně připomíná spíše nějaké vrčení elektromotoru, ale jsem si jist, že při troše experimentování něco zajímavého vytvoříte.

Po spuštění naší ukázkové aplikace se vám zobrazí prázdný formulář. Stačí kliknout kamkoliv na jeho plochu a na tomto místě se vytvoří Label s jednoduchým textem, obsahující informace u původních souřadnicích textu (tedy před tím, než s ním začnete hýbat).
Jak vidíte, kód je uveden opět jako celá jednotka, takže stačí, když si vytvoříte nový projekt a celý tento kód umístíte do vytvořené jednotky. Pak již zbývá jen přiřadit událost OnClick formuláře a vše je hotovo.
Zkuste s kódem trošku experimentovat a uvidíte, že se dá tohoto jednoduchého postupu využít k různým účelům. Přesunovat takto můžete i jiné komponenty, třeba tlačítka, ale to již ponechám na vaší fantazii.

Pro zvýšení "efektu" je barva Labelu během přetahování změněna na červenou (z původní modré). K přesunování textu můžete použít libovolné tlačítko na myši, ale pokud by vám to nevyhovovalo, jistě pro vás nebude problém kód upravit tak, aby přesun reagoval například jen na pravé tlačítko, neboť identifikace tlačítka je součástí parametrů procedur pro pohyb (či přesněji řečeno události pro stisk a uvolnění tlačítka). Do nich pak stačí vložit na začátek jednoduchou podmínku:
if Button = mbRight then
begin
.
.
.
end;
Do těla této podmínky pak vložíte zbytek kódu události.

Po dvou dílech, ve kterých jsme se zabývali soubory MP3, se dnes podíváme opět na něco jiného. Tentokrát budeme pomocí myši posouvat text po formuláři.
Poněkud zamlžený úvod si hned podrobněji vysvětlíme. Příklad, který si teď ukážeme, bude dělat jednoduchou věc. Po kliknutí na formulář se na daném místě objeví textový popisek (Label). Tento Label pak budeme moci po formuláři libovolně přesunovat myší ve stylu drag and drop. Takovýchto Labelů si budete moci na formulář "naklikat" kolik budete chtít, protože jsou vytvářeny až za běhu programu.
unit Unit1;

interface

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

type
TForm1 = class(TForm)
procedure FormClick(Sender: TObject);
private
{ Private declarations }
downX, downY: Integer;
dragging: Boolean;
procedure ControlMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure ControlMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

type
TMCapture = Class(TControl);


procedure TForm1.FormClick(Sender: TObject);
var
pt: TPoint;
begin
GetCursorPos( pt );
pt := ScreenToClient( pt );
with TLabel.Create( Self ) do
begin
SetBounds(pt.x, pt.y, width, height);
Caption := Format('Souřadnice %d, %d', [pt.x, pt.y]);
Color := clBlue;
Font.Color := clWhite;
Autosize := True;
Parent := Self;
OnMouseDown := ControlMouseDown;
OnMouseUp := ControlMouseUp;
OnMouseMove := ControlMouseMove;
end;
end;

procedure TForm1.ControlMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
downX := X;
downY := Y;
dragging := True;
with TMCapture(Sender) do
begin
MouseCapture := True;
Color := clRed;
end;
end;

procedure TForm1.ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if dragging then
with Sender as TControl do
begin
Left := X - downX + Left;
Top := Y - downY + Top;
end;
end;

procedure TForm1.ControlMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if dragging then
begin
dragging := False;
with TMCapture(Sender) do
begin
MouseCapture := False;
Color := clBlue;
end;
end;
end;

end.