Barevné řádky v ListView

Velmi podobný příklad jako předchozí je i ten následující. Ukážeme si, jak měnit barevné pozadí jednotlivých řádků u komponenty ListView. Nejprve ji tedy umístíme na formulář, položku ViewStyle v Object Inspectoru nastavíme na vsReport a poté již jen přidáme kód do události OnCustomDrawItem takto:

procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
with ListView1.Canvas.Brush do
begin
case Item.Index of
0: Color := clYellow;
1: Color := clGreen;
2: Color := clRed;
end;
end;
end;

Jak vidíte, kód je velmi jednoduchý. Zde jsou pro ukázku změněny barvy u prvních tří položek.

procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Items.AddObject('Červený řádek', Pointer(clRed));
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
ListBox1.Items.AddObject('Zelený řádek', Pointer(clGreen));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ListBox1.Style := lbOwnerDrawFixed;
end;

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
with Control as TListBox do
begin
Canvas.FillRect(Rect);
Canvas.Font.Color := TColor(Items.Objects[Index]);
Canvas.TextOut(Rect.Left + 2, Rect.Top, Items[Index]);
end;
end;

Barevné položky v Listboxu

Velice jednoduchým způsobem můžeme docílit toho, aby každá položka (řádek) v komponentě Listbox měla jinou barvu. Takto upravený seznam nejenže vypadá lépe, ale působí také daleko přehledněji, než když jsou všechny položky stejné.
Umístěte si na formulář ListBox dvě tlačítka, která nám poslouží pro demonstraci funkčnosti. První tlačítko přidá do ListBoxu položku v červené barvě, druhé tlačítko v zelené. Je též potřeba nastavit u ListBoxu v Object Inspectoru vlastnost ListBox.Style na lbOwnerDrawFixed, což ale u našeho příkladu dělat nemusíte, protože je to nastaveno automaticky v události OnCreate hlavního formuláře.

procedure PrintGrid(sGrid: TStringGrid; sTitle: String);
var
X1, X2 : Integer;
Y1, Y2 : Integer;
TmpI : Integer;
F : Integer;
TR : TRect;
begin
Printer.Title := sTitle;
Printer.BeginDoc;
Printer.Canvas.Pen.Color := 0;
Printer.Canvas.Font.Name := 'Times New Roman';
Printer.Canvas.Font.Size := 12;
Printer.Canvas.Font.Style := [fsBold, fsUnderline];
Printer.Canvas.TextOut(0, 100, Printer.Title);
For F:=1 to sGrid.ColCount - 1 do
begin
X1 := 0;
For TmpI := 1 to (F-1) do
X1:=X1 + 5 * (sGrid.ColWidths[TmpI]);
Y1 := 300;
X2 := 0;
For TmpI := 1 to F do
X2 := X2 + 5 * (sGrid.ColWidths[TmpI]);
Y2 := 450;
TR := Rect(X1, Y1, X2-30, Y2);
Printer.Canvas.Font.Style := [fsBold];
Printer.Canvas.Font.Size := 7;
Printer.Canvas.TextRect(TR, X1 + 50, 350, sGrid.Cells[F, 0]);
Printer.Canvas.Font.Style := [];
For TmpI := 1 to sGrid.RowCount-1 do
begin
Y1 := 150 * TmpI + 300;
Y2 := 150 * (TmpI+1) + 300;
TR := Rect(X1, Y1, X2-30, Y2);
Printer.Canvas.TextRect(TR, X1 + 50, Y1 + 50, sGrid.Cells[F, TmpI]);
end;
end;
Printer.EndDoc;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
PrintGrid(StringGrid1, 'Titulek tabulky');
end;

Tisk tabulky

Na závěr tu máme ukázku tisku tabulky, přesněji řečeno dat uložených v komponentě StringGrid. Už asi nemá cenu připomínat, že opět využijeme knihovny Printers. Na formulář umístěte komponentu StrindGrid, naplňte ji daty a o zbytek se postará následující funkce, jež má dva parametry – StringGrid, který se bude tisknout, a titulek, který bude vytištěn nad tabulkou. Když si prohlédnete zdrojový kód, jistě pro vás nebude problém upravit si výsledný vytištěný vzhled tabulky tak, jak vám vyhovuje. Můžete k tomu využít i poznatky z předchozích příkladů.

procedure TForm1.Button50Click(Sender: TObject);
const
X = 800;
Y = 600;
var
ScaleX, ScaleY : Integer;
RR : TRect;
begin
with Printer do
begin
BeginDoc;
try
ScaleX := GetDeviceCaps(Handle,logPixelsX) div PixelsPerInch;
ScaleY := GetDeviceCaps(Handle,logPixelsY) div PixelsPerInch;
RR := Rect(X, Y, Image1.picture.width * scaleX + X, Image1.Picture.Height * ScaleY + Y);
Canvas.StretchDraw(RR,Image1.Picture.Graphic);
finally
EndDoc;
end;
end;
end;
Konstanty X a Y určují polohu obrázku na stránce. V samotném kódu jsou jednak zjištěny parametry rozlišení tiskárny a na základě toho jsou přepočítány souřadnice na základě rozměrů obrázku.

Tisk obrázků

Když jsme si ukázali, jak tisknout text a jednoduchou grafiku v podobě čar, ukažme si nyní, jak tisknout již hotové obrázky. I zde máme na výběr z několika možností. Opět použijeme co možná nejjednodušší způsob s pomocí knihovny Printers. Příklad pro zjednodušení předpokládá, že máte na formuláři umístěnu komponentu Image, v níž je načten obrázek, který chcete tisknout. Samozřejmě že způsob, jak určit, který obrázek se má tisknout, si můžete zvolit podle sebe (například výběrem daného souboru přes dialog otevření souboru a podobně), zde je pro zjednodušení použita komponenta Image.

Totéž se týká velikosti fontu písma, i když zde je to již nutno brát s určitou rezervou (písmo bude vždy o něco málo menší, než nastavíte, záleží na použitém fontu). Druhou věcí, se kterou je nutné počítat, jsou obrácené souřadnice osy y. Protože horní okraj papíru má nulové souřadnice, musí být souřadnice na ose y záporné, protože jinak bychom kreslili "nad" horní okraj papíru místo na něj. Souřadnice na ose y prostě rostou od horního okraje papíru směrem k dolnímu, ale v záporném smyslu. Deset centimetrů od horního okraje tedy není 1000, nýbrž -1000. Možná to vysvětluji zbytečně podrobně, věřím, že to každý ihned pochopil. :)
Abych nezapomněl, pochopitelně i v tomto případě je nutné použít knihovnu Printers.

procedure TForm1.Button1Click(Sender: TObject);
begin
printer.BeginDoc;
SetMapMode(printer.Canvas.Handle, MM_LOMETRIC);
with printer.Canvas do
begin
Rectangle(250,-100,1460,-1310);
Font.Height:=100;
Font.Name:='Verdana';
TextOut(600,-600,'Zkušební tisk');
end;
printer.EndDoc;
end;
Jak vidíte, kód je velmi jednoduchý a jedná se vlastně o kreslení, na které jste asi zvyklí, s tím rozdílem, že probíhá na papíře a nikoliv na monitoru. Je třeba si uvědomit jen dvě věci. Tou první je, že veškeré jednotky odpovídají desetině milimetru, takže například parametr "250" ve funkci Rectangle odpovídá 2,5 cm (vzdálenost od levého okraje + asi 2 milimetry rezerva pro tiskárnu).

Konečně začínáme tisknout

A nyní se již konečně dostáváme k samotnému tisku. Tisknout lze samozřejmě celou řadou způsobů, ale my se budeme držet jednoduchosti. V následující ukázce se pokusíme vytisknout přední stranu obalu na CD s jednoduchým popiskem. Ponechme teď stranou, jak by měl být opravdový obal skutečně velký, pro náš příklad jsem zvolil rozměry 12,1 x 12,1 cm, což se myslím reálu blíží dostatečně. Ten jeden milimetr v každém rozměru je tam zcela úmyslně, protože si ukážeme, že není sebemenší problém tisknout s touto (a lepší) přesností. Popisek je umístěn přibližně (!!) uprostřed našeho pomyslného obalu. Zde je tedy kód:

function GetDefaultPrinter : string;
var
ResStr : array[0..255] of char;
begin
GetProfileString('Windows','device','',ResStr,255);
Result := StrPas(ResStr);
end;

procedure SetDefaultPrinter(NewDefPrinter : string);
var
ResStr : array[0..255] of char;
begin
StrPCopy(ResStr,NewdefPrinter);
WriteProfileString ('windows', 'device', ResStr);
StrCopy (ResStr, 'windows');
SendMessage (HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(@ResStr));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption := GetDefaultPrinter;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Combobox1.Items.Clear;
Combobox1.Items.AddStrings(Printer.Printers);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
SetDefaultPrinter(Combobox1.Text);
end;

Zjištění a nastavení aktuální tiskárny

Jestliže máte k dispozici více tiskáren (například při práci v síti), jistě se vám bude hodit následující tip. Ukážeme si jak zjistit, která z tiskáren je nastavena jako výchozí, a také jak ze seznamu dostupných tiskáren jednu vybrat a nastavit ji jako výchozí. Znovu již tradičně využijeme knihovnu Printers a také Messages. První funkce nám zjistí aktuální výchozí tiskárnu, druhá zase zajistí, že tiskárna předaná parametrem bude zvolena jako výchozí. Samotné použití je vidět ze zdrojového kódu. Na formulář přidejte dvě tlačítka, Label a ComboBox. Po stisknutí prvního tlačítka se do Labelu vypíše aktuální výchozí tiskárna, po stisknutí druhého tlačítka bude tiskárna, která je zvolena v ComboBoxu, nastavena jako výchozí. Samotný ComboBox je vyplněn dostupnými tiskárnami v události OnCreate formuláře.

Rozlišení tiskárny

Následující velmi krátký příklad zjišťuje, jaké je rozlišení výchozí tiskárny v DPI (bodech na palec). Musím bohužel konstatovat, že alespoň na mé tiskárně mi výsledek nepřipadal správný, ale třeba budete mít více štěstí. Opět budeme potřebovat knihovnu Printers. Takže zde je kód:
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(IntToStr(GetDeviceCaps(Printer.Handle, LOGPIXELSX)) + ' x '+IntToStr(GetDeviceCaps(Printer.Handle, LOGPIXELSY))+ ' DPI');
end;

DM1 := nil;
DM2 := nil;
Sz := DocumentProperties(0, 0, Device, DM1^, DM2^, 0);
GetMem(DM1, Sz);
DocumentProperties(0, 0, Device, DM1^, DM2^, DM_OUT_BUFFER);
if DM1^.dmColor >1 then ShowMessage('Tiskárna podporuje více barev')
else ShowMessage('Tiskárna podporuje jen černou a bílou');
if DM1^.dmFields and DM_COLOR <> 0 then ShowMessage('Tiskárna podporuje barevný tisk')
else ShowMessage('Tiskárna nepodporuje barevný tisk');
FreeMem(DM1);
end;
end;
Příště se pustíme do samotného tisku a ukážeme si některá další zajímavá nastavení a vlastnosti tiskárny a tisku všeobecně.

Podporuje tiskárna barevný tisk?

Na závěr si dnes ukážeme, jak zjistit další neméně zajímavou a důležitou vlastnost tiskárny – zda může tisknout barevně. I v tomto případě nám pomůže knihovna Printers.
procedure TForm1.Button1Click(Sender: TObject);
var
Device, Driver, Port: array[0..255] of Char;
DM1, DM2 : PDeviceMode;
Sz: Integer;
DevMode: THandle;
begin
Printer.PrinterIndex := -1;
Printer.GetPrinter(Device, Driver, Port, DevMode);
if DevMode <> 0 then
begin

procedure TForm1.Button1Click(Sender: TObject);
type
TPaperName = array [0..63] of Char;
TPaperNameArray = array [1..High(Integer) div SizeOf(TPaperName)] of TPaperName;
PPaperNameArray = ^TPaperNameArray;
var
Device, Driver, Port : array[0..255] of Char;
hDevMode : THandle;
i, CountPaperFormats : Integer;
pPaperFormats : pPaperNameArray;
begin
Memo1.Lines.Clear;
Printer.GetPrinter(Device, Driver, Port, hDevmode);
CountPaperformats := WinSpool.DeviceCapabilities(Device, Port, DC_PAPERNAMES, Nil, Nil);
if CountPaperformats > 0 then
begin
GetMem(pPaperformats, CountPaperformats * SizeOf(TPaperName));
try
WinSpool.DeviceCapabilities(Device, Port, DC_PAPERNAMES, PChar(pPaperFormats), Nil);
for i := 1 to CountPaperformats do Memo1.Lines.Add(pPaperformats^[i]);
finally
FreeMem(pPaperFormats);
end;
end;
end;

Jaké formáty papíru tiskárna podporuje?

Zajímavým parametrem tiskárny je též seznam podporovaných médií (či chcete-li podporovaných rozměrů papíru), na které je tiskárna schopna tisknout. Právě jejich seznam se teď naučíme zjišťovat. Opět využijeme knihovny Printers a také knihovny WinSpool, jejíž funkce DeviceCapabilities nám právě s použitím vhodného parametru "prozradí" názvy jednotlivých typů papíru. Jejich seznam budeme pro změnu vypisovat do komponenty Memo, takže je nutno ji přidat na formulář.

Výpis tiskáren instalovaných v systému

Problematikou tiskáren a tisku obecně jsme se v našem seriálu dosud nezabývali a je to možná škoda. Proto si teď ukážeme několik tipů a příště v tom možná ještě budeme částečně pokračovat. Nejprve tedy výpis instalovaných tiskáren. V tom nám pomůže knihovna Printers; celý kód je vlastně velice jednoduchý. Předpokladem je, že máte někde na formuláři umístěn ListBox, kam se budou instalované tiskárny vypisovat. Součástí výpisu je též port tiskárny. A zde je tedy jednoduchý výpis:
procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Items := Printer.Printers;
ListBox1.ItemIndex := Printer.PrinterIndex;
end;