Umíme to s Delphi, 21. díl – tisk v Delphi, pokračování

V minulém díle seriálu jsme se zaměřili na tisk jako takový, popsali jsme si jej z obecnějšího hlediska a podívali jsme se na tisk formulářů, na velmi důležitou třídu TPrinter, na její vlastnosti a události. Nastínili jsme také jeden problém – rozdílnou velikost tištěných objektů na obrazovce a na tiskárně. Dnes téma tisku uzavřeme: vysvětlíme si tisk textu a vyřešíme problém z minulého dílu. Vše budou (jako vždy) doplňovat názorné příklady.

Tisk textu

Pokud chceme tisknout čistě jen text, tedy žádné formuláře, ovládací prvky, apod., není úplně nejvhodnější používat plátno. Ne že by to nešlo (možná si vzpomenete na metodu plátna OutText), ale není to příliš pohodlné.

Jednodušším způsobem je nahlížet na tiskárnu jako na textový soubor. Pak vlastně zapisujeme do souboru, což je vcelku triviální úkol, ale místo na disk se naše data posílají na tiskárnu.

V následujícím příkladu budeme tisknout textové soubory. Uživatel bude moci soubor vybrat pomocí standardního dialogového okna OpenDialog, po vybrání se mu soubor zobrazí v komponentě Memo a po stisku tlačítka Tisk se obsah této komponenty (a tedy příslušného textového souboru) vytiskne.

Je opět nezbytné zařadit jednotku Printers do sekce Uses! Pro demonstraci se v příkladu vyskytují dvě tlačítka pro výběr fontu – pro výběr fontu na obrazovce a na tiskárně. Můžete si vyzkoušet, že tyto dvě volby jsou na sobě zcela nezávislé a že tedy můžete velmi jednoduše tisknout jiným fontem, než jaký vidíte na monitoru.

Nastavení úvodních vlastností je opět provedeno v rámci ošetření události OnCreate formuláře.

V příkladu jsou použity následující komponenty (v závorce uvádím jejich názvy, formulář se jmenuje frmHlavni):

  • 1x Memo (Memo),
  • 1x OpenDialog (dlgOpen),
  • 1x PrintDialog (dlgPrint),
  • 1x PrinterSetupDialog (dlgSetup),
  • 1x FontDialog (dlgFont),
  • 6x Button (btnTisk, btnOtevri, btnNastav, btnKonec, btnFontO, btnFontT).
Možný vzhled běžící aplikace ukazuje následující obrázek:

Následují zdrojové kódy hlavního modulu aplikace. Všimněte si úplně stejné práce s tiskárnou jako se souborem od okamžiku, kdy jsme ji asociovali pomocí příkazu AssignPrn. Na závěr je nutné soubor zavřít pomocí CloseFile. V tomto příkladu nejsou testovány a ošetřovány chyby (např. chyba při otvírání souboru, apod.)!

unit Hlavni;

interface

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

type
  TfrmHlavni = class(TForm)
    dlgOpen: TOpenDialog;
    dlgPrint: TPrintDialog;
    dlgSetup: TPrinterSetupDialog;
    Memo: TMemo;
    btnOtevri: TButton;
    btnNastav: TButton;
    btnTisk: TButton;
    btnKonec: TButton;
    btnFontO: TButton;
    dlgFont: TFontDialog;
    btnFontT: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btnOtevriClick(Sender: TObject);
    procedure btnNastavClick(Sender: TObject);
    procedure btnTiskClick(Sender: TObject);
    procedure btnFontOClick(Sender: TObject);
    procedure btnFontTClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmHlavni: TfrmHlavni;

implementation

{$R *.DFM}

procedure TfrmHlavni.FormCreate(Sender: TObject);
begin
  frmHlavni.Caption := `Tisk textu`;

  btnOtevri.Caption := `&Otevøít`;
  btnNastav.Caption := `&Nastavení`;
  btnTisk.Caption := `&Tisk`;
  btnKonec.Caption := `&Konec`;
  btnFontT.Caption := `T&iskárna`;
  btnFontO.Caption := `O&brazovka`;
end;

procedure TfrmHlavni.btnOtevriClick(Sender: TObject);
begin
  if dlgOpen.Execute then
    Memo.Lines.LoadFromFile(dlgOpen.FileName);
end;

procedure TfrmHlavni.btnNastavClick(Sender: TObject);
begin
  dlgSetup.Execute;
end;

procedure TfrmHlavni.btnTiskClick(Sender: TObject);
var
  Soubor: TextFile;
  I: Integer;

begin
  if dlgPrint.Execute then begin
    AssignPrn(Soubor);
    Rewrite(Soubor);

    For I := 0 To Memo.Lines.Count - 1 do
      WriteLn(Soubor, Memo.Lines[I]);

    CloseFile(Soubor);
  end;
end;

procedure TfrmHlavni.btnFontOClick(Sender: TObject);
begin
  if dlgFont.Execute then
    Memo.Font := dlgFont.Font;
end;

procedure TfrmHlavni.btnFontTClick(Sender: TObject);
begin
  if dlgFont.Execute then
    Printer.Canvas.Font := dlgFont.Font;

end;

procedure TfrmHlavni.btnKonecClick(Sender: TObject);
begin
  Application.Terminate;
end;

end.

Poznámka

Velmi často není vůbec nutné se o tisk nějakým způsobem starat, protože příslušná komponenta vše „zvládne“ sama. Příkladem budiž komponenta RichEdit a její metoda Print, která vytiskne její obsah bez jakýchkoliv dalších programátorových zásahů.

Velikost tisku na tiskárně a na obrazovce

V jednom z příkladů uvedených v minulém díle seriálu jsme si ukázali typický problém, který se vyskytuje při tisku grafických objektů v Delphi (a vůbec ve Windows). Monitor a tiskárna jsou dvě zcela odlišná zařízení, mají různá rozlišení, a proto nelze předpokládat, že při použití stejných číselných hodnot obdržíme dva stejně velké obrázky.

Modifikujme zmíněný příklad (vykreslující černé kruhy) tak, aby velikost objektu lezoucího z tiskárny byla identická jako v případě objektu na obrazovce. Abychom toho dosáhli, přestaneme uvádět průměr kruhu v obrazovkových pixelech a začneme tak činit v palcích (inches). Proměnná Prumer bude nadále celočíselná (bude udávat pixely), ale při tisku na tiskárnu ji budeme vždy přepočítávat na palce. Rozlišení tiskárny se totiž uvádí v jednotkách nazvaných dpi (dots per inch, bodů na palec).

Obrazovkové pixely zjistíme snadno – existuje totiž vlastnost formuláře PixelsPerInch, která udává počet obrazovkových pixelů na palec. Tato vlastnost tedy souvisí kromě jiného s nastaveným rozlišením monitoru, které právě používáte.

„Pixely“ z tiskárny (nejde zde o pixely v pravém slova smyslu, ale získané body si zjednodušeně můžete představit jako základní zobrazovací elementy) zjistíme pomocí funkce GetDeviceCaps, která zjišťuje nejrůznější informace o zadaném zařízení.

Pak už pomocí dvou získaných údajů (tedy pixely obrazovky a „pixely“ tiskárny) můžeme s hodnotou průměru pracovat vždy podle aktuálního zařízení a problém s rozdílnými velikostmi je vyřešen.

Poznámka:

Popis funkce GetDeviceCaps nehledejte ve standardní nápovědě Delphi. Jde totiž o funkci Windows API, takže její popis naleznete pouze v knihovně MSDN, případně i v Delphi pomocí volby Help - Windows SDK (ale musíte ji mít nainstalovanou). GetDeviceCaps má následující syntaxi:

int GetDeviceCaps(

    HDC hdc, // handle kontextu zařízení
    int nIndex // index (označení) informace, kterou chceme získat
  );

Prvním parametrem funkce je tedy handle kontextu zařízení (v našem případě handle plátna tiskárny), druhý parametr označuje informaci, kterou chceme získat.

Popišme si tedy změny našeho předchozího příkladu, které je nutno udělat za účelem vyřešení problému rozdílných velikostí objektů:

Událost OnClick tlačítka btnClick:

procedure TfrmHlavni.btnTiskClick(Sender: TObject);
var BodyX, BodyY: Double;
begin
  if dlgPrint.Execute then
    with Printer do begin
      BeginDoc;
      Canvas.Pen.Mode := pmBlack;
      BodyX := GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSX);
      BodyY := GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSY);

      Canvas.Ellipse(0, 0,
        Round(Prumer / frmHlavni.PixelsPerInch * BodyX),
        Round(Prumer / frmHlavni.PixelsPerInch * BodyY));

      EndDoc;
    end;        // with
end;

Hodnota (Prumer / frmHlavni.PixelsPerInch) udává vlastně průměr vykreslovaného kruhu v palcích. Protože chceme, aby na tiskárně byl kruh stejně veliký (tj. stejný počet palců), vynásobíme tuto hodnotu počtem „pixelů“ (bodů), které na tiskárně představují právě jeden palec. Tento počet zjistíme pomocí funkce GetDeviceCaps. Následně vykreslíme kruh na plátno tiskárny (Printer.Canvas).

Používáme dvě pomocné proměnné: BodyX a BodyY. Ty obsahují počet „pixelů“ (nejmenších zobrazitelných bodů) na palec zadaného zařízení, v našem případě tedy plátna tiskárny.

Událost OnClick posuvníku udPrumer:

procedure TfrmHlavni.udPrumerClick(Sender: TObject; Button: TUDBtnType);
begin
  Prumer := udPrumer.Position;
  lblPrumer.Caption := `Prumer: ` + Format(`%2.2f`, [Prumer / PixelsPerInch]);

  ...
end;

Jedinou změnou v této metodě je změna zapisování průměru. Oproti celočíselné hodnotě v pixelech používáme reálné číslo se dvěma desetinnými místy udávající hodnotu v palcích. Funkce Format slouží jen ke správnému zobrazení této hodnoty.

Událost OnCreate hlavního formuláře:

procedure TfrmHlavni.FormCreate(Sender: TObject);
begin
  ...
  Prumer := 50;
  lblPrumer.Caption := `Prumer: ` + Format(`%2.2f`, [Prumer / PixelsPerInch]);

  ...
  end;          // with

Také v této metodě pouze pozměníme zápis počáteční hodnoty průměru: místo pixelů použijeme přepočet na palce a funkci Format.

Nyní si uvedeme celý zdrojový kód změněného příkladu:

unit Hlavni;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Spin, ComCtrls, Printers;

type
  TfrmHlavni = class(TForm)
    lblInfo: TLabel;
    btnNastav: TButton;
    btnTisk: TButton;
    dlgPrint: TPrintDialog;
    dlgSetup: TPrinterSetupDialog;
    Image: TImage;
    btnKonec: TButton;
    lblPrumer: TLabel;
    udPrumer: TUpDown;
    procedure btnNastavClick(Sender: TObject);
    procedure btnTiskClick(Sender: TObject);
    procedure btnKonecClick(Sender: TObject);
    procedure udPrumerClick(Sender: TObject; Button: TUDBtnType);
    procedure FormCreate(Sender: TObject);
  private
      Prumer: Integer;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmHlavni: TfrmHlavni;

implementation

{$R *.DFM}

procedure TfrmHlavni.btnNastavClick(Sender: TObject);
begin
  dlgSetup.Execute;
end;

procedure TfrmHlavni.btnTiskClick(Sender: TObject);
var BodyX, BodyY: Double;
begin
  if dlgPrint.Execute then
    with Printer do begin
      BeginDoc;
      Canvas.Pen.Mode := pmBlack;
      BodyX := GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSX);
      BodyY := GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSY);

      Canvas.Ellipse(0, 0,
        Round(Prumer / frmHlavni.PixelsPerInch * BodyX),
        Round(Prumer / frmHlavni.PixelsPerInch * BodyY));

      EndDoc;
    end;        // with
end;

procedure TfrmHlavni.btnKonecClick(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TfrmHlavni.udPrumerClick(Sender: TObject; Button: TUDBtnType);
begin
  Prumer := udPrumer.Position;
  lblPrumer.Caption := `Prumer: ` + Format(`%2.2f`, [Prumer / PixelsPerInch]);

  with Image.Canvas do begin
    Pen.Mode := pmWhite;
    Rectangle(0, 0, Image.Width, Image.Height);
    Pen.Mode := pmBlack;

    Ellipse(
      (Image.Width - Prumer) div 2,
      (Image.Height - Prumer) div 2,
      (Image.Width + Prumer) div 2,
      (Image.Height + Prumer) div 2);
  end;          // with
end;

procedure TfrmHlavni.FormCreate(Sender: TObject);
begin
  frmHlavni.Caption := `Tisk èerného kruhu`;
  lblInfo.Caption := `Zvolte prùmìr kruhu:`;

  btnNastav.Caption := `&Nastavit`;
  btnTisk.Caption := `&Tisk`;
  btnKonec.Caption := `&Konec`;

  udPrumer.Position := 50;
  udPrumer.Max := 110;
  Prumer := 50;
  lblPrumer.Caption := `Prumer: ` + Format(`%2.2f`, [Prumer / PixelsPerInch]);

  with Image do begin
    Canvas.Pen.Mode := pmBlack;
    Canvas.Ellipse(
      (Width - Prumer) div 2, (Height - Prumer) div 2,
      (Width + Prumer) div 2, (Height + Prumer) div 2);
  end;          // with

end;

end.

Diskuze (1) Další článek: Jak změnit startovací obrazovku Windows 2000

Témata článku: Software, Windows, Programování, Stejná metoda, Spin, Získané údaje, Private, Díl, Tisk, Triviální nastavení, Pokračování, Reálné číslo, DEL, Format, Inch, Rozdílná velikost, Button


Určitě si přečtěte

Co je TikTok: Svérázná sociální síť chytla mladé uživatele, už jich má už 1,5 miliardy

Co je TikTok: Svérázná sociální síť chytla mladé uživatele, už jich má už 1,5 miliardy

** Sociální síť TikTok získala stamiliony uživatelů a stále roste ** Jaký obsah na ní najdete a co můžete v jejím rámci čekat? ** Je to zábava pro mladé, nebo platforma pro úchyláky?

Karel Kilián | 34

Pojďme programovat elektroniku: Rádiový čip, který má skoro každá bezdrátová myš

Pojďme programovat elektroniku: Rádiový čip, který má skoro každá bezdrátová myš

** Bezdrátové myši řídí čip od Nordic Semiconductors ** Jeho rádiové vysílače si před lety oblíbila i komunita kutilů ** Dnes si je vyzkoušíme v praxi

Jakub Čížek | 9

Zorin OS 15: Vyzkoušejte další hezký a nenáročný linux pro mamku a taťku

Zorin OS 15: Vyzkoušejte další hezký a nenáročný linux pro mamku a taťku

** Ačkoliv je grafických linuxů plný internet, stále vládnou Windows ** Jeden z nich se jmenuje Zorin OS a nedávno se dočkal aktualizace ** Dělají jej dva kluci z Irska a je fakt hezký

Jakub Čížek | 116

Už desítky let se pokoušíme odposlouchávat mozek. Rusům se podařil kousek, ze kterého vám spadne brada

Už desítky let se pokoušíme odposlouchávat mozek. Rusům se podařil kousek, ze kterého vám spadne brada

** K odposlechu mozků používáme EEG ** To má ale žalostné informační rozlišení ** Rusům pomohla počítačová neuronová síť

Jakub Čížek | 29


Aktuální číslo časopisu Computer

Megatest: 20 powerbank s USB-C

Test: mobily do 3 500 Kč

Radíme s výběrem routeru

Tipy na nejlepší vánoční dárky