Tipy a triky v Delphi, díl 196. - opět kreslíme

V našem seriálu už jsme kreslili mnohokrát. Tentokrát si vyrobíme něco jako základ kreslícího programu. Cílem bude aplikace, jejíž okno bude představovat kreslící plátno. Tažením myši pak budeme kreslit jednoduché šipky, které budou správně orientovány podle směru kreslení a ve správném úhlu bude nejen samotné "tělo", tedy čára, ale i samotná špička. Dnes v tom bude tedy i trochu matematiky, ale většinu toho za nás naštěstí udělá knihovna Math.

Na prázdný formulář si nejprve připravíme komponentu Image. Ta nám bude sloužit jako kreslící plátno, protože se sama postará o překreslování svého obsahu a nemusíme se tím tak vůbec zabývat. Nastavte požadované rozměry plátna a můžeme se pustit do kreslení.

Od uživatele vlastně dostaneme dva údaje prostřednictvím myši. Prvním je bod, kde začal kreslit, druhým údajem je pak pochopitelně bod konečný. Nic víc. Jeho počáteční kliknutí (resp. stisknutí tlačítka myši a jeho držení) si tedy poznamenáme prostřednictvím události OnMouseDown komponenty Image. Do připravené proměnné typu TPoint si uložíme souřadnice počátečního bodu.

Druhá událost, která nás zajímá, je OnMouseUp, tedy okamžik, kdy uživatel opět pustí tlačítko. Tím získáme koncový bod šipky a můžeme se pustit do samotného kreslení.

Nakreslit čáru, tedy tělo šipky, je dílem okamžiku a stačí nám k tomu pouze funkce LineTo. Pokud chceme opravdu jen čáru, jsme hotovi. Stejný případ se týká i čtyřúhelníku a dalších obrazců, které lze vykreslit standardními funkce jen se znalostí souřadnic krajních bodů. Pokud však chceme šipku, musíme kreslit ještě trošku "ručně".

Nejprve si určíme úhel, který budou jednotlivá "ramena" šipky svírat. Ten je v našem případě 45 stupňů, ale můžete si parametr pochopitelně přizpůsobit. Dále se musíme rozhodnout, jakou délku bude šipka mít. Opět záleží na vás, v našem příkladu je použita pro názornost poněkud naddimenzovaná délka 20 pixelů.

Teď už zbývá jen nakreslit pomocí připravených hodnot šipky. Poměrně primitivně zjistíme, jakým směrem bude šipka směřovat porovnáním souřadnic obou koncových bodů a podle toho pak šipku vykreslíme opět pomocí LineTo.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
              Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
              Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  BeginPoint: TPoint;


implementation
{$R *.dfm}

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
  BeginPoint.X := X;
  BeginPoint.Y := Y;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  B, deltaX, deltaY: Extended;
begin
  Image1.Canvas.PenPos := BeginPoint;
  Image1.Canvas.LineTo(X, Y);
  if BeginPoint.X <> X then
  begin
    if (BeginPoint.X > X) then
    B := DegToRad(135) - ArcTan((BeginPoint.Y - Y) / (BeginPoint.X - X))
                          else
    B := DegToRad(45) - ArcTan((BeginPoint.Y - Y) / (BeginPoint.X - X));
    deltaX := 20 * Cos(B);
    deltaY := 20 * Sin(B);
    if (BeginPoint.X > X) then
    begin
      Image1.Canvas.PenPos := Point(X, Y);
      Image1.Canvas.LineTo(X - Trunc(deltaX), Y + Trunc(deltaY));
      Image1.Canvas.PenPos := Point(X, Y);
      Image1.Canvas.LineTo(X + Trunc(deltaY), Y + Trunc(deltaX));
    end
    else
    begin
      Image1.Canvas.PenPos := Point(X, Y);
      Image1.Canvas.LineTo(X - Trunc(deltaX), Y + Trunc(deltaY));
      Image1.Canvas.PenPos := Point(X, Y);
      Image1.Canvas.LineTo(X - Trunc(deltaY), Y - Trunc(deltaX));
    end;
  end
  else
  begin
    if BeginPoint.Y > Y then
    begin
      Image1.Canvas.PenPos := Point(X, Y);
      Image1.Canvas.LineTo(X + 10, Y + 10);
      Image1.Canvas.PenPos := Point(X, Y);
      Image1.Canvas.LineTo(X - 10, Y + 10);
    end
    else
    begin
      Image1.Canvas.PenPos := Point(X, Y);
      Image1.Canvas.LineTo(X + 10, Y - 10);
      Image1.Canvas.PenPos := Point(X, Y);
      Image1.Canvas.LineTo(X - 10, Y - 10);
    end;
  end;
end;
end.

Věřím, že většina věcí je jasná ze zdrojového kódu a zbytek jistě odhalíte experimentováním s parametry. Je pravda, že šipka nevypadá kdovíjak krásně, ale jistě si ji dokážete vyšperkovat k obrazu svému. Příklad má ještě jednu podstatnou slabinu, resp. uživatelskou nepřívětivost. Během "kreslení", tedy ve fázi, kdy uživatel určí počátek a tažením myši se sune do koncového bodu, není vidět žádná pomocná vodící stopa jak jsme na to většinou zvyklí z grafických programů. To už ale máte za domácí úkol.

Pokusný projekt pro Delphi 7 opět můžete stahovat zde.