unit Main;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    Panel1: TPanel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    BitBtn5: TBitBtn;
    BitBtn6: TBitBtn;
    BitBtn7: TBitBtn;
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure BitBtn6Click(Sender: TObject);
    procedure BitBtn7Click(Sender: TObject);

  private
    x1 : Integer;
    y1 : Integer;
    x2 : Integer;
    y2 : Integer;

  public

  end;

var
  Form1: TForm1;

implementation
{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
	Close();
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
var
	fn     : String;

begin
	fn := 'trawa.bmp';
	Image1.Picture.LoadFromFile(fn);
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
var
	fn     : String;

begin
   if Image1.Picture <> Nil then
   begin
      fn := 'trawa2.bmp';
      Image1.Picture.SaveToFile(fn);

      if FileExists(fn) then
      begin
   	   ShowMessage('Plik: ' + fn + ' utworzony prawidłowo');
      end;
   end;
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
begin
	Image1.Stretch := true;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
	x1 := X;
   y1 := Y;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
   MySrc  : TRect;
   MyDest : TRect;

begin
	x2 := X;
   y2 := Y;

   MySrc  := Rect(x1, y1, x2, y2);
   MyDest := MySrc;

	//wyczyść obszar
	Image2.Picture := Nil;
   Image2.Canvas.CopyRect(MyDest, Image1.Canvas, MySrc);
   Image2.Invalidate();
end;

procedure TForm1.BitBtn5Click(Sender: TObject);
var
	OldBkMode : Integer;
	f         : TFont;

begin
	OldBkMode := SetBkMode(Image1.Canvas.Handle, TRANSPARENT);

   try
      f       := TFont.Create();
      f.Name  := 'Times New Roman CE';
      f.Size  := 14;
      f.Color := clRed;

      Image1.Canvas.Font := f;

      Image1.Canvas.TextOut(20, 10, 'Tekst pisany funkcją TextOut()');

      SetBkMode(Image1.Canvas.Handle, OldBkMode);
   finally
	   FreeAndNil(f);
   end;
end;

procedure TForm1.BitBtn6Click(Sender: TObject);
var
	R : TRect;
	f : TFont;

begin
	f       := TFont.Create();
   f.Name  := 'Arial';
   f.Size  := 14;
   f.Style := [fsBold];
   f.Color := clNavy;
   Image1.Canvas.Font := f;

	// określ prostokąt w ramach którego wyświetlany będzie tekst
	R := Rect(20, 60, 290, 100);   
	// tło przeźroczyste
	Image1.Canvas.Brush.Style := bsClear;
	Image1.Canvas.TextRect(R, 20, 60, 'Tekst pisany przez TextRect(...)');
	// Image1.Canvas.Rectangle(R);
end;

procedure TForm1.BitBtn7Click(Sender: TObject);
var
	R         : TRect;
	OldBkMode : Integer;
   txt       : String;
	f         : TFont;

begin
	OldBkMode := SetBkMode(Image1.Canvas.Handle, TRANSPARENT);
	R := Rect(40, 180, 300, 220);
	txt := 'Tekst pisany funkcją DrawText';

	f       := TFont.Create();
   f.Name  := 'Times New Roman CE';
   f.Size  := 18;
   f.Color := clWhite;

	Image1.Canvas.Font := f;

   DrawText(Image1.Canvas.Handle,
            PAnsiChar(txt),
            -1,
            &R,
            DT_NOCLIP or DT_SINGLELINE or DT_CENTER or DT_VCENTER );

   FreeAndNil(f);

	SetBkMode(Image1.Canvas.Handle, OldBkMode);
   Image1.Invalidate();
end;

end.

