Все программы, код которых выложен здесь, являются работоспособными. На момент написания программ использовалась среда PascalABC.Net 3.0.

Штамп текста

Комментарии к коду

M - смещение по осям X и Y

uses GraphABC;
const
  M = 20;

type
  TStamp = class
  private 
    _X, _Y: integer;
    _Text: string;
  public 
    property X: integer read _X write _X;
    property Y: integer read _Y write _Y;
    property Text: string read _Text write _Text;
    
    constructor(cx, cy: integer; txt: string);
    begin
      X := cx;
      Y := cy;
      Text := txt;
    end;
    
    procedure Stamp() := TextOut(X, Y, Text);
  end;

begin
  SetWindowIsFixedSize(true);
  ClearWindow(clBlack);
  
  var Stamp1 := new TStamp(100, 100, 'Hello world!');
  
  SetBrushColor(ARGB(0, 0, 0, 0));
  for var i := 0 to 10 do
  begin
    Stamp1.X := Stamp1.X + M;
    Stamp1.Y := Stamp1.Y + M;
    
    SetFontColor(clRandom());
    Stamp1.Stamp();
  end;
end.

Штамп прямоугольника

uses GraphABC;
const
  M = 20;

type
  TStamp = class
  private 
    _X, _Y, _X1, _Y1: integer;
    _Text: string;
  public 
    property X: integer read _X write _X;
    property Y: integer read _Y write _Y;
    property X1: integer read _X1 write _X1;
    property Y1: integer read _Y1 write _Y1;
    property Text: string read _Text write _Text;
    
    constructor(cx, cy, cx1, cy1: integer; txt: string);
    begin
      X := cx;
      Y := cy;
      X1 := cx1;
      Y1 := cy1;
      Text := txt;
    end;
    
    procedure Stamp();
    begin
      DrawRectangle(X, Y, X1, Y1);
      DrawTextCentered(X, Y, X1, Y1, Text);
    end;
  end;

begin
  SetWindowIsFixedSize(true);
  ClearWindow(clBlack);
  
  var Stamp1 := new TStamp(10, 10, 190, 190, 'Hello world!');
  
  SetFontColor(clWhite);
  for var i := 0 to 10 do
  begin
    Stamp1.X := Stamp1.X + M;
    Stamp1.Y := Stamp1.Y + M;
    Stamp1.X1 := Stamp1.X1 + M;
    Stamp1.Y1 := Stamp1.Y1 + M;
    
    SetPenColor(clRandom());
    Stamp1.Stamp();
  end;
end.

Штамп фрактального прямоугольника

uses GraphABC;
type
  TStamp = class
  private
    _X, _Y, _X1, _Y1: integer;
    
    _UseIterations: boolean;
    _Iterations: integer;
    _DecSpeed: integer;
    _MinSquare: integer;
    
    procedure DecSize(var cx, cy, cx1, cy1: integer);
    begin
      Inc(cx, _DecSpeed);
      Inc(cy, _DecSpeed);
      Dec(cx1, _DecSpeed);
      Dec(cy1, _DecSpeed);
    end;
  
  public 
    property X: integer read _X write _X;
    property Y: integer read _Y write _Y;
    property X1: integer read _X1 write _X1;
    property Y1: integer read _Y1 write _Y1;
    
    property UseIterations: boolean read _UseIterations write _UseIterations;
    property Iterations: integer read _Iterations write _Iterations;
    property DecSpeed: integer read _DecSpeed write _DecSpeed;
    property MinSquare: integer read _MinSquare write _MinSquare;
    
    constructor(cx, cy, cx1, cy1: integer);
    begin
      X := cx;
      Y := cy;
      X1 := cx1;
      Y1 := cy1;
    end;
    
    procedure Stamp();
    begin
      var cx := X;
      var cy := Y;
      var cx1 := X1;
      var cy1 := Y1;
      if UseIterations then
        for var i := 0 to Iterations - 1 do
        begin
          DrawRectangle(cx, cy, cx1, cy1);
          DecSize(cx, cy, cx1, cy1);
        end
      else
        while Abs(cx1 - cx) * Abs(cy1 - cy) >= MinSquare do
        begin
          DrawRectangle(cx, cy, cx1, cy1);
          DecSize(cx, cy, cx1, cy1);
        end;
    end;
  end;

begin
  var Stamp1 := new TStamp(100, 100, 400, 400);
  Stamp1.UseIterations := false;
  Stamp1.DecSpeed := 20;
  Stamp1.MinSquare := 9000;
  Stamp1.Stamp();
end.