Учебный курс Программирование на Delphi. Модуль 15

Работа с графикой

Пример 1

• Условие.

Вывести 8 квадратов с разным тиром заливки

• Код программы:

unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs;
type
 TForm1 = class(TForm)
   procedure FormPaint(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormPaint(Sender: TObject);
const
bsname :array[1..8] of string=('bssolid','bsclear','bshorizontal','bsvertical',
'bsfdiagonal','bsbdiagonale','bscross','bsdiagcross');
var
x,y:integer;
w,h:integer;
bs:tbrushstyle;
k:integer;
i,j:integer;
begin
w:=50;h:=50;
y:=20;
for i:=1 to 2 do begin
x:=10;
for j:=1 to 4 do begin
k:=j+(i-1)*4;
case k of
1: bs:=bssolid;
2: bs:=bsclear;
3: bs:=bshorizontal;
4: bs:=bsvertical;
5: bs:=bsfdiagonal;
6: bs:=bsbdiagonal;
7: bs:=bscross;
8: bs:=bsdiagcross;
end;
canvas.Brush.Color:=clred;
canvas.Brush.Style:=bs;
canvas.Rectangle(x,y,x+w,y+h);
canvas.TextOut(x,y-15,bsname[k]);
x:=x+w+30;
end;
y:=y+h+30;
end;end;
end.

• Форма с резултатом работы программы

Пример 2

• Условие.

Построить график функции sin(x)*Exp^x/5

• Код программы:

unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs;
type
 TForm1 = class(TForm)
   procedure FormPaint(Sender: TObject);
   procedure FormResize(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
function f(x:real):real;
begin
f:=2*sin(x)*exp(x/5);
end;
procedure gr;
var
x1,x2:real;
y1,y2:real;
x:real;
y:real;
dx:real;
l,b:integer;
w,h:integer;
mx,my:real;
x0,y0:integer;
begin
l:=10;
b:=Form1.clientheight-20;
h:=Form1.clientheight-40;
w:=Form1.clientwidth-40;
x1:=0; x2:=25; dx:=0.0001;
y1:=f(x1);
y2:=f(x1);
x:=x1;
repeat
y:=f(x);
if y<y1 then y1:=y;
if y>y2 then y2:=y;
x:=x+dx;
until (x>=x2);
my:=h/(abs(y2-y1));
mx:=w/(abs(x2-x1));
x0:=l;
y0:=b-abs(round(y1*my));
with form1.canvas do begin
moveto(l,b); lineto(l,b-h);
moveto(x0,y0); lineto(x0+w,y0);
textout(l+5,b-h,floattostrf(y2,ffgeneral,6,3));
textout(l+5,b,floattostrf(y1,ffgeneral,6,3));
x:=x1;
repeat
y:=f(x);
pixels[x0+round(x*mx),y0-round(y*my)]:=clred;
x:=x+dx;
until (x>=x2);
end;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
gr;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
form1.Canvas.FillRect(rect(0,0,clientwidth,clientheight));
gr;
end;
end.

• Форма с резултатом работы программы

Пример 3

• Условие.

Нарисовать звезду. События нажатия кнопки мыши: если левая цвет звезды красный если правая цвет звезды черный

• Код программы:

unit Stars_;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;
type
 TForm1 = class(TForm)
   procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
 private
   { Private declarations }
 public
   { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
procedure StarLine(x0,y0,r: integer; Canvas: TCanvas);
   // x0,y0 - координаты центра звезды
   // r - радиус звезды
var
    p : array[1..11] of TPoint; // массив координат лучей и впадин
   a: integer;   // угол между осью ОХ и прямой, соединяющей
                 // центр звезды и конец луча или впадину
   i: integer;
begin
   a := 18; // строим от правого гор. луча
   for i:=1 to 10 do
      begin
         if (i mod 2 = 0) then
            begin // впадина
              p[i].x := x0+Round(r/2*cos(a*2*pi/360));
              p[i].y:=y0-Round(r/2*sin(a*2*pi/360));
            end
         else
            begin // луч
              p[i].x:=x0+Round(r*cos(a*2*pi/360));
              p[i].y:=y0-Round(r*sin(a*2*pi/360));
            end;
         a := a+36;
      end;
   p[11].X := p[1].X; // чтобы замкнуть контур звезды
   p[11].Y := p[1].Y;
   Canvas.Polyline(p); // начертить звезду
end;
// нажатие кнопки мыши
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
                              Shift: TShiftState; X, Y: Integer);
begin
 if Button = mbLeft  // нажата левая кнопка?
    then Form1.Canvas.Pen.Color := clBlack
    else Form1.Canvas.Pen.Color := clRed;
 StarLine(x, y, 30,Form1.Canvas);
end;
end.