Opět vidíte, že název výstupního souboru je nastaven pevně, takže si budete muset kód mírně upravit. Když si trochu zaexperimentujete s parametry u funkce Rect (při přiřazování do proměnné R), můžete docílit toho, že invertován bude pouze výřez obrázku, který určíte danými souřadnicemi. Sice mě honem nenapadá, k čemu by se toho dalo v praxi využít, ale ta možnost zde každopádně je.

Inverze barev bitmapy

K dalším běžným funkcím programů pracujících s obrázky patří funkce invertování obrázku neboli vytvoření negativu. Ukážeme si velmi jednoduchý postup:
procedure TForm1.Button1Click(Sender: TObject);
var
R: TRect;
Bmp: TBitmap;
begin
if Form1.OpenPictureDialog1.Execute then
begin
Bmp := TBitmap.Create;
Bmp.LoadFromFile(Form1.OpenPictureDialog1.FileName);
with Bmp do
begin
R := Rect(0, 0, Width, Height);
InvertRect(Canvas.Handle, R);
end;
Bmp.SaveToFile('inverze.bmp');
Bmp.Free;
end;
end;

Příklad

používá dialog na otevření souboru s obrázkem – OpenPictureDialog, takže jej přidejte na formulář. Jak vidíte, pro jednoduchost je též nastaven napevno název výstupního souboru i jeho kvalita, takže si oba parametry nezapomeňte příslušným způsobem přizpůsobit.
A jak bude vypadat opačná konverze? Velmi podobně a pravděpodobně byste na ni přišli sami, ale pro úplnost zde máte příklad:
procedure JpegToBmp(Jpg: TJpegImage; PF: TPixelFormat; var Bmp: TBitmap);
begin
Bmp.Assign(Jpg);
Bmp.PixelFormat := PF;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
Bmp : TBitmap;
JPG : TJpegImage;
begin
if Form1.OpenPictureDialog1.Execute then
begin
Bmp := TBitmap.Create;
JPG := TJpegImage.Create;
Jpg.LoadFromFile(Form1.OpenPictureDialog1.FileName);
JpegToBmp(jpg, pf24bit, bmp);
Bmp.SaveToFile('vystup.bmp');
JPG.Free;
Bmp.Free;
end;
end;
Ukázku jsme si drobně vylepšili o možnost nastavení požadované barevné hloubky výsledného BMP souboru (viz druhý parametr funkce). V nápovědě naleznete výčet ostatních hodnot, kterých může tato proměnná nabývat, a u samotného typu TBitmap či TJpegImage najdete řadu dalších vlastností a parametrů k experimentování.

Funkce tedy bude vypadat takto:

procedure BmpToJpeg(Bmp: TBitmap; Q: TJpegQualityRange; var Jpg: TJpegImage);
begin
Jpg.CompressionQuality := Q;
Jpg.Assign(Bmp);
end;
Požadovaná kvalita Q (či chcete-li kompresní faktor), která – jak jistě víte – ovlivňuje výsledný vzhled a velikost souboru, může nabývat hodnot od 1 do 100, přičemž čím nižší je hodnota, tím menší je výsledný soubor (pochopitelně na úkor kvality obrazu). Tuto jednoduchou funkci poté využijeme například takto:
procedure TForm1.Button1Click(Sender: TObject);
var
Bmp : TBitmap;
JPG : TJpegImage;
begin
if Form1.OpenPictureDialog1.Execute then
begin
Bmp := TBitmap.Create;
JPG := TJpegImage.Create;
Bmp.LoadFromFile(Form1.OpenPictureDialog1.FileName);
BmpToJpeg(Bmp, 30, JPG);
JPG.SaveToFile('vystup.jpg');
JPG.Free;
Bmp.Free;
end;
end;

Převod souboru BMP do formátu JPEG a naopak

Tento převod je vlastně velmi snadný, ačkoliv se možná na první pohled může zdát opak. Nebudeme totiž všechno od základu programovat sami, což by bylo asi v tomto konkrétním případě nad rámec našeho článku, ale využijeme již funkcí a knihoven, které nám Delphi nabízejí. Hlavní práci v tomto případě tedy udělá knihovna Jpeg, takže ji jako obvykle přidejte do projektu. Pro samotnou konverzi obrázku BMP do formátu JPEG si vytvoříme jednoduchou funkci, jejímiž parametry jsou zdrojový soubor, dále výsledná požadovaná kompresní kvalita souboru JPEG po konverzi a název výstupního souboru.

prohlížeč obrázků

V našem seriálu jsme se doposud zabývali různými tipy ze všech možných oblastí, velká část z nich se týkala například práce se soubory či složkami, takže již máte jistý drobný základ pro vytvoření kupříkladu vlastního jednoduchého souborového manažeru. Po dnešním dílu si budete možná moci vytvořit primitivní prohlížeč obrázků, protože si ukážeme několik základních funkcí s nimi.

kod

procedure TForm1.Button1Click(Sender: TObject);
var
Picture: TPicture;
Desktop: TCanvas;
X, Y: Integer;
begin
Picture := TPicture.Create;
Desktop := TCanvas.Create;
Picture.LoadFromFile('c:\obrazek.bmp');
Desktop.Handle := GetWindowDC(0);
X := 100;
Y := 100;
Desktop.Draw(X, Y, Picture.Graphic);
ReleaseDC(0, Desktop.Handle);
Picture.Free;
Desktop.Free;
end;

Ale vraťme

se k našemu příkladu. Tento velmi jednoduchý postup načte obrázek (bitmapu) a poté jej zobrazí na požadovaných souřadnicích desktopu. Pochopitelně nedochází k žádnému překreslování, takže jakmile místo na ploše, kde se obrázek nachází, překryjete například oknem nějaké aplikace, obrázek jednoduše zmizí.
A teď se už můžete pustit do experimentování a hraní a vytvořit si například vhodným střídáním obrázků zajímavou animaci či jiný efekt.

Umístění obrázku na pracovní plochu

Ne, tento tip se nebude v žádném případě týkat tapety pracovní plochy, i když k tomu možná nadpis trochu svádí. Ukážeme si něco, co bude zřejmě opět patřit spíše do kategorie legrácek na odreagování a experimentování než k vážnému použití. Naučíme se umístit na libovolné souřadnice pracovní plochy obrázek. Berte to jako menší úvod do příštího pokračování našeho seriálu, kdy se trošku zaměříme na grafiku a témata s ní související.

Nejprve tedy vytvořte a zkompilujte resources soubor s tímto obsahem:
TESTDOC RCDATA "test.rtf"
Soubor test.rtf pochopitelně musí být při kompilaci dostupný, takže si vytvořte nějaký takový testovací dokument, třeba ve WordPadu či Wordu. Pak jej již obvyklým způsobem přidáme do našeho projektu:
.
.
.
implementation

{$R *.DFM}
{$R textres.res}
.
.
.
A zbývá nám hlavní část: zobrazit dokument uživateli. K tomu použijeme jak jinak než komponentu RichEdit, kterou umístěte na formulář. Dokument pak do ní načteme tímto způsobem:
procedure TForm1.Button1Click(Sender: TObject);
var
rs : TResourceStream;
begin
rs := TResourceStream.Create(hinstance, 'TESTDOC', RT_RCDATA);
try
Richedit1.PlainText := False;
Richedit1.Lines.LoadFromStream(rs);
finally
rs.Free;
end;
end;

Uložení a načtení RTF souboru z resources

Práci s resources jsme si už ukazovali v poslední době dvakrát a tento příklad popisuje, jak s pomocí resources přímo do souboru naší aplikace přidat dokumenty ve formátu RTF. Postup vytváření souboru resources je opět stejný, takže jej zkrátíme a nebudeme již detailně popisovat (zájemce o detailní postup odkazuji například na 32. díl seriálu) a ukážeme si hlavně způsob, jak takto "v aplikaci uložený" dokument zobrazit uživateli.

CommDlg

K příkladu potřebujeme knihovnu CommDlg. Celý příklad funguje tak, že si zjistíme "identifikační čísla" jednotlivých prvků (tedy kromě tlačítek, na ně lze odkazovat "rovnou") a na jejich základě pak přepíšeme jejich popisky přímo v dialogu, k čemuž nám bude nápomocná funkce SendMessage. Čísla jednotlivých prvků najdete ve zdrojovém kódu v konstantách a samotný kód je umístěn v události OnShow příslušného OpenDialogu.
.
.
.
uses CommDlg;
.
.
.

procedure TForm1.OpenDialog1Show(Sender: TObject);

const
LB_FILETYPES_ID = 1089;
LB_FILENAME_ID = 1090;
LB_DRIVES_ID = 1091;

Str1 = '&Otevřít';
Str2 = '&Storno';
Str3 = '&Typ souboru';
Str4 = '&Název';
Str5 = 'S&ložka';

var hOpenDialog: HWND;

begin
hOpenDialog := GetParent(OpenDialog1.Handle);
SendMessage(hOpenDialog, CDM_SETCONTROLTEXT, idOk, Longint(PChar(Str1)));
SendMessage(hOpenDialog, CDM_SETCONTROLTEXT, idCancel, Longint(PChar(Str2)));
SendMessage(hOpenDialog, CDM_SETCONTROLTEXT, LB_FILETYPES_ID, Longint(PChar(Str3)));
SendMessage(hOpenDialog, CDM_SETCONTROLTEXT, LB_FILENAME_ID, Longint(PChar(Str4)));
SendMessage(hOpenDialog, CDM_SETCONTROLTEXT, LB_DRIVES_ID, Longint(PChar(Str5)));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
OpenDialog1.Execute;
end;

Drobná úprava dialogu pro otevření souboru

Chcete-li mít svoji aplikaci upravenu do posledního detailu přesně podle vašich představ včetně každého Labelu a tlačítka, možná vám vaši snahu kazí některé systémové dialogy, kde toho na první pohled moc změnit nelze (alespoň po vizuální stránce). Jistě, můžete si vytvořit své vlastní dialogy, ale možná bude snadnější přece jen upravit ty standardní. Jeden z nejčastěji používaných systémových dialogů je ten na výběr souboru a jeho drobnou úpravu si právě teď ukážeme. Úprava bude spočívat ve změně popisků u nejdůležitějších objektů v dialogu, tedy tlačítek "Otevřít" a "Storno", a dále popisky u typu souboru, názvu souboru a složky. Poslední věc, která zbývá, je titulek samotného okna dialogu, ale ten – jak jistě dobře víte – lze nastavit v Object Inspectoru.

Pohyblivý text v titulkovém pruhu

Začneme opět něčím vizuálním. Ukážeme si, jak velmi jednoduchým až primitivním způsobem s využitím Timeru animovat (či chcete-li rolovat) text v titulkovém pruhu okna. Jaká je možnost využití takového efektu? Buď pouze pro efekt samotný a nebo v případě příliš dlouhého textu v titulku.
Umístěte tedy na formulář Timer a nastavte vhodný časový interval. To je velmi důležité i s ohledem na délku titulku. Zbytek kódu, tedy hlavně událost OnTimer, vypadá takto:
.
.
.
private
{ Private declarations }
Titulek : String;
.
.
.

procedure TForm1.FormCreate(Sender: TObject);
begin
Titulek := ' Sem umístěte text vašeho titulkového pruhu aplikace ';
end;


procedure TForm1.Timer1Timer(Sender: TObject);
var
i : Integer;
begin
Application.Title := Titulek;
Form1.Caption := Titulek;
For i := 1 to Length(Titulek) do Titulek[i] := Application.Title[i+1];
Titulek[Length(Titulek)] := Application.Title[1];
end;
Nezapomeňte vložit před i za text titulku vhodnou mezeru, aby došlo k dostatečnému oddělení.

sloučení souborů

Následuje funkce pro sloučení souborů. V parametru stačí specifikovat první z množiny souborů a jako výstupní parametr funkce dostanete zprávu o úspěšném provedení sloučení s kontrolou (v případě, že existuje kontrolní soubor), bez kontroly (pokud kontrolní soubor není k dispozici) či chybové hlášení, pokud součty nesouhlasí. Jak bylo již řečeno, kontrolu CRC musíte doplnit sami.
function Sloucit(FileName: String): String;
var
Source, Target : TFileStream;
Count : Integer;
Rect : LongInt;
Line, FName, AName, Size, CRC, CRC32, Dir, Files : String;
F : textFile;
begin
CRC := copy(FileName,1,Length(FileName)-3)+'crc';
Dir := ExtractFilePath(FileName);
Files := ExtractFileName(FileName);
Count := 0;
if FileExists(CRC) then
begin
AssignFile(F, CRC);
Reset(F);
while not EOF(F) do
begin
ReadLn(F, Line);
if copy(Line, 1, 8) = 'filename' then FName := copy(Line,10,Length(Line));
if copy(Line, 1, 4) = 'size' then Size := copy(Line, 6, Length(Line));
if copy(Line, 1, 5) = 'crc32' then CRC32 := copy(Line, 7, Length(Line));
end;
CloseFile(F);
end
else
begin
FName := copy(Files, 1, length(Files)-3) + 'out';
Size := '0';
CRC32 := '0';
end;
Target := TFileStream.Create(Dir + FName, fmCreate);
Rect := 0;
repeat
inc(Count);
AName := copy(Files, 1, length(Files)- 3);
AName := AName + copy('000',1,3-Length(IntToStr(Count)))+IntTostr(Count);
Source := TFileStream.Create(Dir + AName, fmOpenRead);
try
Rect := rect + Target.CopyFrom(Source, Source.Size);
except
Result := Format('Chyba při čtení svazku %s.',[FName]);
Source.Free;
Target.Free;
Exit;
end;
Source.Free;
AName := copy(Files, 1, length(Files)- 3);
AName := AName + copy('000',1,3-Length(IntToStr(Count+1)))+IntTostr(Count+1);
until not(FileExists(Dir + AName));
Target.Free;
if Rect = StrToInt(Size) then Result := 'Soubory byly úspěšně sloučeny (CRC souhlasí).'
else
begin
if (Size > '0') then Result := 'Chybná velikost sloučeného souboru.'
else Result := 'Soubory byly úspěšně sloučeny (bez CRC kontroly).';
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Form1.OpenDialog1.Execute;
ShowMessage(Sloucit(Form1.Opendialog1.FileName));
end;

Druhá část, funkce na sloučení souboru, celkem logicky provádí opačný postup. Po specifikování prvního souboru jsou jednotlivé soubory spojeny a je provedena kontrola na základě kontrolního souboru (kontrola CRC je opět vynechána).
Procedura na rozdělení souboru s ukázkou následného použití tedy vypadá takto:
procedure Rozdelit(FileName: String; part:integer);
var
Source, Target : TFileStream;
Fname, Ext : String;
Count, Rest,
Size : Integer;
F : TextFile;
begin
Source := TFileStream.Create(FileName, fmOpenRead);
Fname := copy(FileName,1,Length(FileName) - 4);
Count := 0;
Size := Source.Size;
if Source.Size <= Part then
begin
ShowMessageFmt('Vybraný soubor je menší než %d bajtů. Není třeba jej dělit.',[Part]);
Exit;
end;
repeat
Rest := 0;
Inc(Count);
Ext := copy('000', 1, 3 - Length(IntToStr(count))) + IntToStr(Count);
Target := TFilestream.Create(Fname + '.' + Ext, fmCreate);
try
if (count * Part) <= Size then Rest := Target.CopyFrom(Source, Part)
else Rest := Target.CopyFrom(Source,Size mod Part);
except
end;
Target.Free;
until Rest <> Part;
AssignFile(f, Fname + '.crc');
Rewrite(f);
WriteLn(f,'filename='+ExtractFileName(FileName));
WriteLn(f,'size='+IntToStr(Size));
WriteLn(f,'crc32=');
CloseFile(f);
Source.Free;
ShowMessageFmt('Soubor byl rozdělen na %d souborů',[count]);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Form1.OpenDialog1.Execute;
Rozdelit(Form1.Opendialog1.FileName, 307200);
end;
Jak vidíte, je využit dialog na otevření souboru a je tedy třeba jej přidat na formulář. Specifikovaný soubor bude rozdělen na soubory o velikosti 300 kB.

Co tedy přesně dělají naše dvě funkce? Ta první rozdělí soubor specifikovaný parametrem na soubory požadované velikosti (v bytech, rovněž součástí parametrů) a taktéž vytvoří kontrolní soubor, obsahující původní název souboru před rozdělením, jeho původní velikost a taktéž CRC. Kvůli zjednodušení a zkrácení příkladu je však výpočet CRC vynechán. Funkci na jeho výpočet můžete nalézt ve 14. dílu našeho seriálu a do naší ukázky si ji snadno doplníte sami. Soubor je rozdělen, přičemž přípony souborů jsou číslovány automaticky.

Rozdělení a sloučení souboru

Jistě dobře znáte tuto užitečnou funkci z některého souborového manažeru (opět musím zmínit oblíbený Windows Commander). Pokud je potřeba velký soubor přenést například po disketách (používá je dnes ještě vůbec někdo?) či poslat poštou, často jej musíme vhodně rozdělit na několik souborů menších. Obvykle se k tomu také používá komprimačních programů.

Formátování diskety

I další z dnešních tipů souvisí s prací s disky, tedy konkrétně s disketami. Naučíme se, jak je zformátovat. Přesněji řečeno, nebude se jednat o přímý fyzický přístup k disketě (sektor po sektoru), ale využijeme funkce systémové knihovny shell32.dll a tím pádem se po požadavku o formátování zobrazí známý systémový dialog, kde lze měnit další parametry. Jak uvidíte přímo v naší ukázce, lze tyto parametry předem nastavit.
Zdrojový kód tedy vypadá takto (pozor na umístění deklarace funkce SHFormatDrive):
.
.
.
private
{ Private declarations }

public
{ Public declarations }
end;
.
.
.

function SHFormatDrive(Handle: HWND; Drive, ID, Options: Word): LongInt; stdcall; external 'shell32.dll' name 'SHFormatDrive'

.
.
.

procedure TForm1.Button1Click(Sender: TObject);

const
SHFMT_ID_DEFAULT = $FFFF;
SHFMT_OPT_QUICKFORMAT = $0000;
SHFMT_OPT_FULL = $0001;
SHFMT_OPT_SYSONLY = $0002;
SHFMT_ERROR = $FFFFFFFF;
SHFMT_CANCEL = $FFFFFFFE;
SHFMT_NOFORMAT = $FFFFFFFD;
var
retCode: LongInt;
begin
retCode := SHFormatDrive(Handle, 0, SHFMT_ID_DEFAULT, SHFMT_OPT_QUICKFORMAT);
if retCode < 0 then ShowMessage('Disk nebyl zformátován !');
end;
Úpravou parametrů (viz. konstanty) docílíte toho, že ve formátovacím dialogu, který se objeví, budou předem navoleny dané možnosti.

Formátování diskety

I další z dnešních tipů souvisí s prací s disky, tedy konkrétně s disketami. Naučíme se, jak je zformátovat. Přesněji řečeno, nebude se jednat o přímý fyzický přístup k disketě (sektor po sektoru), ale využijeme funkce systémové knihovny shell32.dll a tím pádem se po požadavku o formátování zobrazí známý systémový dialog, kde lze měnit další parametry. Jak uvidíte přímo v naší ukázce, lze tyto parametry předem nastavit.
Zdrojový kód tedy vypadá takto (pozor na umístění deklarace funkce SHFormatDrive):
.
.
.
private
{ Private declarations }

public
{ Public declarations }
end;
.
.
.

function SHFormatDrive(Handle: HWND; Drive, ID, Options: Word): LongInt; stdcall; external 'shell32.dll' name 'SHFormatDrive'

.
.
.

procedure TForm1.Button1Click(Sender: TObject);

const
SHFMT_ID_DEFAULT = $FFFF;
SHFMT_OPT_QUICKFORMAT = $0000;
SHFMT_OPT_FULL = $0001;
SHFMT_OPT_SYSONLY = $0002;
SHFMT_ERROR = $FFFFFFFF;
SHFMT_CANCEL = $FFFFFFFE;
SHFMT_NOFORMAT = $FFFFFFFD;
var
retCode: LongInt;
begin
retCode := SHFormatDrive(Handle, 0, SHFMT_ID_DEFAULT, SHFMT_OPT_QUICKFORMAT);
if retCode < 0 then ShowMessage('Disk nebyl zformátován !');
end;
Úpravou parametrů (viz. konstanty) docílíte toho, že ve formátovacím dialogu, který se objeví, budou předem navoleny dané možnosti.

příklad

Z prvního příkladu si hned odvodíme další funkci. Jejím úkolem bude vypsat typ parametrem zadané jednotky. Konstanty budou stejné.
function DriveType(Drive: String): String;
const
DRIVE_UNKNOWN = 0;
DRIVE_NO_ROOT_DIR = 1;
DRIVE_REMOVABLE = 2;
DRIVE_FIXED = 3;
DRIVE_REMOTE = 4;
DRIVE_CDROM = 5;
DRIVE_RAMDISK = 6;
var
{strDriveType : String;}
intDriveType : Integer;
begin
if Drive[Length(Drive)] <> '\' then Drive := Drive + ':\';
intDriveType := GetDriveType(PChar(Drive));
Case intDriveType of
DRIVE_UNKNOWN : DriveType := 'Neznámý typ disku';
DRIVE_NO_ROOT_DIR : DriveType := 'Disk není naformátován';
DRIVE_REMOVABLE : DriveType := 'Výměnný disk';
DRIVE_FIXED : DriveType := 'Lokální disk';
DRIVE_REMOTE : DriveType := 'Síťový disk';
DRIVE_CDROM : DriveType := 'CD ROM';
DRIVE_RAMDISK : DriveType := 'RAM disk';
end;
end;

procedure List_Drives;
const
DRIVE_UNKNOWN = 0;
DRIVE_NO_ROOT_DIR = 1;
DRIVE_REMOVABLE = 2;
DRIVE_FIXED = 3;
DRIVE_REMOTE = 4;
DRIVE_CDROM = 5;
DRIVE_RAMDISK = 6;
var
r : LongWord;
Drives : array[0..128] of char;
pDrive : pchar;
begin
r := GetLogicalDriveStrings(SizeOf(Drives), Drives);
if r = 0 then exit;
if r > sizeof(Drives) then
raise Exception.Create(SysErrorMessage(ERROR_OUTOFMEMORY));
pDrive := Drives;
while pDrive^ <> #0 do
begin
if GetDriveType(pDrive) = DRIVE_FIXED then Form1.ComboBox1.Items.Add(pDrive);
inc(pDrive, 4);
end;
end;

Výpis disků v systému včetně rozpoznání jejich typu

Následující dvě ukázky mají podobný základ. Ta první má za úkol vypsat disky požadovaných typů (viz. dále) do připraveného ComboBoxu, úkolem druhé funkce je zase zjistit typ daného disku. V obou případech je typem disku myšleno to, zda se jedná o lokální disk, síťový disk, jednotku CDROM atd.. Typy těchto disků jsou uvedeny jako konstanty.
Následující procedura tedy do předem připraveného ComboBoxu vypíše všechny pevné lokální disky instalované v systému. Pokud budete chtít vypsat jiné typy jednotek (nebo všechny), není nic jednoduššího než upravit příslušnou konstantu v podmínce (zde DRIVE_FIXED) na požadovaný typ disku.