Учебный курс Программирование на Delphi. Модуль 15: различия между версиями
Материал из Wiki Mininuniver
Перейти к навигацииПерейти к поиску| Строка 65: | Строка 65: | ||
*'''Условие.''' | *'''Условие.''' | ||
Построить график функции sin(x)*Exp<sup>x/5</sup> | Построить график функции sin(x)*Exp<sup>x/5</sup> | ||
| + | *'''Код программы:''' | ||
| + | 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. | ||
| + | *'''Форма с резултатом работы программы''' | ||
| + | |||
| + | |||
| + | <center>[[Изображение:Форма-г.JPG]]</center> | ||
| + | |||
| + | ==Пример 3== | ||
| + | *'''Условие.''' | ||
| + | Нарисовать звезду. События нажатия кнопки мыши: | ||
| + | если левая цвет звезды красный | ||
| + | если правая цвет звезды черный | ||
*'''Код программы:''' | *'''Код программы:''' | ||
Версия 09:53, 1 марта 2008
Пример 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)*Expx/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
- Условие.
Нарисовать звезду. События нажатия кнопки мыши: если левая цвет звезды красный если правая цвет звезды черный
- Код программы: