Набор исходных модулей для проведения практических занятий

Муниципальное Автономное Общеобразовательное Учреждение

Средняя общеобразовательная школа №111

г. Перми

Исходные модули

для практических занятий в среде Delphi

Учитель информатики

высшей категории,

Червякова Надежда Ильинична

Пермь, 2015

Практика 1

// Работа кнопок

unit UnitKnopka;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

type

TFormKnopka = class(TForm)

Button1: TButton;

Button2: TButton;

Label1: TLabel;

Button3: TButton;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

FormKnopka: TFormKnopka;

implementation

{$R *.dfm}

procedure TFormKnopka.Button1Click(Sender: TObject);

begin

formKnopka.Label1.Visible:=True;

end;

procedure TFormKnopka.Button2Click(Sender: TObject);

begin

formKnopka.Label1.Visible:=False;

end;

procedure TFormKnopka.Button3Click(Sender: TObject);

begin

Close;

end;

end.

Практика 2

// Меняется цвет формы при нажатии левой клавиши мыши

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs;

type

TForm1 = class(TForm)

procedure FormClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormClick(Sender: TObject);

begin

{Form1.Color:=clred;}

{Color:=rgb(Random(256),Random(256),Random(256)) }

If color=clred then color:=clgreen else color:=clred;

end;

end.

// Щелчком мыши меняется вид курсора

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs;

type

TForm1 = class(TForm)

procedure FormDblClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormDblClick(Sender: TObject);

begin

If Cursor=0 then cursor:=-21 else cursor:=cursor+1;

end;

end.

Практика 3

//кривые

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs;

type

TForm1 = class(TForm)

procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

{canvas.LineTo(x,y);}

if ssleft in shift then canvas.LineTo(x,y)

else canvas.MoveTo(x,y);

end;

end.

// Ломаные

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs;

type

TForm1 = class(TForm)

procedure FormDblClick(Sender: TObject);

procedure FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

draw:boolean;

implementation

{$R *.dfm}

procedure TForm1.FormDblClick(Sender: TObject);

begin

draw:=not draw;

end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

If draw then canvas.LineTo(x,y) else

canvas.MoveTo(x,y);

end;

end.

// Отрезки

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs;

type

TForm1 = class(TForm)

procedure FormClick(Sender: TObject);

procedure FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure FormMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormClick(Sender: TObject);

begin

{with canvas do

begin

pen.Color:=clred;

pen.Style:=psDash;

moveto(10,10);

lineto(300,300);

end; }

end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

canvas.MoveTo(x,y);

end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

canvas.LineTo(x,y);

end;

end.

Практика 4

/ Прямоугольники

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs;

type

TForm1 = class(TForm)

procedure FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure FormMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

x1,y1:integer;

implementation

{$R *.dfm}

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

x1:=x;

y1:=y;

end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

canvas.Rectangle(x1,y1,x,y);

end;

end.

Практика 5

// картинки

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, jpeg, ExtCtrls;

type

TForm1 = class(TForm)

RadioButton1: TRadioButton;

Button1: TButton;

Image1: TImage;

Image2: TImage;

Image3: TImage;

RadioButton2: TRadioButton;

RadioButton3: TRadioButton;

procedure Button1Click(Sender: TObject);

procedure RadioButton1Click(Sender: TObject);

procedure RadioButton2Click(Sender: TObject);

procedure RadioButton3Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

begin

close;

end;

procedure TForm1.RadioButton1Click(Sender: TObject);

begin

Image1.Visible:=true;

Image2.Visible:=false;

Image3.Visible:=false;

end;

procedure TForm1.RadioButton2Click(Sender: TObject);

begin

Image2.Visible:=true;

Image1.Visible:=false;

Image3.Visible:=false;

end;

procedure TForm1.RadioButton3Click(Sender: TObject);

begin

Image3.Visible:=true;

Image2.Visible:=false;

Image1.Visible:=false;

end;

end.

Практика 6

//Решение квадратного уравнения

unit UnitKv;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls;

type

TFormKvUr = class(TForm)

Panel1: TPanel;

Edit_a: TEdit;

Edit_b: TEdit;

Edit_c: TEdit;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Panel2: TPanel;

Label4: TLabel;

Button1: TButton;

Label5: TLabel;

Edit_d: TEdit;

Panel3: TPanel;

Label6: TLabel;

Button2: TButton;

Label7: TLabel;

Edit_x1: TEdit;

Label8: TLabel;

Edit_x2: TEdit;

Lb_otvet: TLabel;

Button3: TButton;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

FormKvUr: TFormKvUr;

a,b,c,d,x1,x2:Real;

implementation

{$R *.dfm}

procedure TFormKvUr.Button1Click(Sender: TObject);

begin

a:=StrToFloat(Edit_a.Text);

b:=StrToFloat(Edit_b.Text);

c:=StrToFloat(Edit_c.Text);

D:=b*b-4*a*c;

Edit_d.Text:=floatToStr(d);

end;

procedure TFormKvUr.Button2Click(Sender: TObject);

begin

If D>=0 then

Begin

X1:=(-b-sqrt(D))/(2*a);

Edit_x1.Text:=floattoStr(x1);

X2:=(-b+sqrt(d))/(2*a);

Edit_x2.Text:=FloatToStr(X2);

end

else

lb_Otvet.Visible:=True;

end;

procedure TFormKvUr.Button3Click(Sender: TObject);

begin

close;

end;

end.

Практика 7

// Калькулятор

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

Button2: TButton;

Button3: TButton;

Button4: TButton;

Button5: TButton;

Edit1: TEdit;

Button6: TButton;

Button7: TButton;

Button8: TButton;

Button9: TButton;

Button10: TButton;

Button11: TButton;

Button12: TButton;

Button13: TButton;

Button14: TButton;

Button15: TButton;

Button16: TButton;

Button17: TButton;

Button18: TButton;

Button19: TButton;

Button20: TButton;

Button21: TButton;

Button22: TButton;

procedure Button4Click(Sender: TObject);

procedure Button5Click(Sender: TObject);

procedure Button6Click(Sender: TObject);

procedure Button7Click(Sender: TObject);

procedure Button11Click(Sender: TObject);

procedure Button12Click(Sender: TObject);

procedure Button9Click(Sender: TObject);

procedure Button10Click(Sender: TObject);

procedure Button13Click(Sender: TObject);

procedure Button14Click(Sender: TObject);

procedure Button8Click(Sender: TObject);

procedure Button19Click(Sender: TObject);

procedure Button16Click(Sender: TObject);

procedure Button17Click(Sender: TObject);

procedure Button18Click(Sender: TObject);

procedure Button20Click(Sender: TObject);

procedure Button21Click(Sender: TObject);

procedure Button22Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

r1,r2:real;

p,s:boolean;

oper:char;

implementation

{$R *.dfm}

procedure TForm1.Button4Click(Sender: TObject);

begin

if p then edit1.Text:='0';

p:=false;

if Edit1.text<>'0' then

Edit1.Text:=Edit1.Text+'1'

else Edit1.Text:='1';

end;

procedure TForm1.Button5Click(Sender: TObject);

begin

begin

if p then edit1.Text:='0';

p:=false;

if Edit1.text<>'0' then

Edit1.Text:=Edit1.Text+'2'

else Edit1.Text:='2';

end;

end;

procedure TForm1.Button6Click(Sender: TObject);

begin

begin

if p then edit1.Text:='0';

p:=false;

if Edit1.text<>'0' then

Edit1.Text:=Edit1.Text+'3'

else Edit1.Text:='3';

end;

end;

procedure TForm1.Button7Click(Sender: TObject);

begin

begin

if p then edit1.Text:='0';

p:=false;

if Edit1.text<>'0' then

Edit1.Text:=Edit1.Text+'0'

else Edit1.Text:='0';

end;

end;

procedure TForm1.Button11Click(Sender: TObject);

begin

begin

if p then edit1.Text:='0';

p:=false;

if Edit1.text<>'0' then

Edit1.Text:=Edit1.Text+','

else Edit1.Text:=',';

end;

end;

procedure TForm1.Button12Click(Sender: TObject);

begin

begin

if p then edit1.Text:='0';

p:=false;

if Edit1.text<>'0' then

Edit1.Text:=Edit1.Text+'7'

else Edit1.Text:='7';

end;

end;

procedure TForm1.Button9Click(Sender: TObject);

begin

begin

if p then edit1.Text:='0';

p:=false;

if Edit1.text<>'0' then

Edit1.Text:=Edit1.Text+'5'

else Edit1.Text:='5';

end;

end;

procedure TForm1.Button10Click(Sender: TObject);

begin

begin

if p then edit1.Text:='0';

p:=false;

if Edit1.text<>'0' then

Edit1.Text:=Edit1.Text+'6'

else Edit1.Text:='6';

end;

end;

procedure TForm1.Button13Click(Sender: TObject);

begin

begin

if p then edit1.Text:='0';

p:=false;

if Edit1.text<>'0' then

Edit1.Text:=Edit1.Text+'8'

else Edit1.Text:='8';

end;

end;

procedure TForm1.Button14Click(Sender: TObject);

begin

begin

if p then edit1.Text:='0';

p:=false;

if Edit1.text<>'0' then

Edit1.Text:=Edit1.Text+'9'

else Edit1.Text:='9';

end;

end;

procedure TForm1.Button8Click(Sender: TObject);

begin

begin

if p then edit1.Text:='0';

p:=false;

if Edit1.text<>'0' then

Edit1.Text:=Edit1.Text+'4'

else Edit1.Text:='4';

end;

end;

procedure TForm1.Button19Click(Sender: TObject);

begin

if not(p) then r2:=StrToFloat(Edit1.Text);

If p then r2:=r1;

case oper of

'+':Edit1.Text:=FloatToStr(r1+r2);

'-':Edit1.Text:=FloatToStr(r1-r2);

'*':Edit1.Text:=FloatToStr(r1*r2);

'/': If r2<>0 then

Edit1.Text:=FloatToStr(r1/r2)

else Edit1.Text:='Error';

{'sqr':Edit1.Text:=FloatToStr(r1*r1);

'sqrt':Edit1.Text:=FloatToStr(sqrt(r1)); }

end;

p:=true

end;

procedure TForm1.Button16Click(Sender: TObject);

begin

r1:=strtofloat(Edit1.Text);

p:=true;

oper:='+'

end;

procedure TForm1.Button17Click(Sender: TObject);

begin

r1:=strtofloat(Edit1.Text);

p:=true;

oper:='-'

end;

procedure TForm1.Button18Click(Sender: TObject);

begin

r1:=strtofloat(Edit1.Text);

p:=true;

oper:='*'

end;

procedure TForm1.Button20Click(Sender: TObject);

begin

r1:=strtofloat(Edit1.Text);

p:=true;

oper:='/'

end;

procedure TForm1.Button21Click(Sender: TObject);

begin

{r1:=strtofloat(Edit1.Text);

p:=true;

oper:='sqrt' }

end;

procedure TForm1.Button22Click(Sender: TObject);

begin

{r1:=strtofloat(Edit1.Text);

p:=true;

oper:='sqr' }

end;

end.

Практика 8

//Пункты меню

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Menus, ExtCtrls;

type

TForm1 = class(TForm)

MainMenu1: TMainMenu;

FileItem: TMenuItem;

OpenItem: TMenuItem;

SaveAsItem: TMenuItem;

CloseItem: TMenuItem;

ExitItem: TMenuItem;

N1: TMenuItem;

ViewItem: TMenuItem;

HalfSizeItem: TMenuItem;

NormalSizeItem: TMenuItem;

DoubleSizeItem: TMenuItem;

Image1: TImage;

OpenDialog1: TOpenDialog;

SaveDialog1: TSaveDialog;

procedure ExitItemClick(Sender: TObject);

procedure HalfSizeItemClick(Sender: TObject);

procedure NormalSizeItemClick(Sender: TObject);

procedure DoubleSizeItemClick(Sender: TObject);

procedure OpenItemClick(Sender: TObject);

procedure CloseItemClick(Sender: TObject);

procedure SaveAsItemClick(Sender: TObject);

private

Procedure Commands(Enable:Boolean);

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

Procedure Tform1.Commands(Enable:Boolean);

Begin

SaveAsItem.Enabled:=Enable;

CloseItem.Enabled:=Enable;

HalfSizeItem.Enabled:=Enable;

NormalSizeItem.Enabled:=Enable;

DoubleSizeItem.Enabled:=Enable;

end;

procedure TForm1.ExitItemClick(Sender: TObject);

begin

close;

end;

procedure TForm1.HalfSizeItemClick(Sender: TObject);

begin

HalfSizeItem.Checked:=True;

with Image1 do

Begin

AutoSize:=False;

Width:=Width div 2;

Height:=Height div 2;

end;

end;

procedure TForm1.NormalSizeItemClick(Sender: TObject);

begin

NormalSizeItem.Checked:=True;

Image1.AutoSize:=True;

end;

procedure TForm1.DoubleSizeItemClick(Sender: TObject);

begin

DoubleSizeItem.Checked:=True;

with Image1 do

Begin

AutoSize:=False;

Width:=width*2;

Height:=height*2;

end;

end;

procedure TForm1.OpenItemClick(Sender: TObject);

begin

If OpenDialog1.Execute then

begin

Image1.Picture.LoadFromFile(OpenDialog1.FileName);

Commands(true);

NormalSizeItem.Click;

end; end;

procedure TForm1.CloseItemClick(Sender: TObject);

begin

with Image1 do

begin

AutoSize:=False;

Width:=0;

Height:=0;

end;

Commands(False);

end;

procedure TForm1.SaveAsItemClick(Sender: TObject);

begin

If Savedialog1.Execute then

Image1.Picture.SaveToFile(SaveDialog1.FileName);

end;

end.

Практика 9

// Тест с выбором ответа

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls, ComCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

Button2: TButton;

PageControl1: TPageControl;

TabSheet1: TTabSheet;

TabSheet2: TTabSheet;

TabSheet3: TTabSheet;

TabSheet4: TTabSheet;

TabSheet5: TTabSheet;

TabSheet6: TTabSheet;

TabSheet7: TTabSheet;

TabSheet8: TTabSheet;

TabSheet9: TTabSheet;

TabSheet10: TTabSheet;

RadioGroup1: TRadioGroup;

RadioGroup2: TRadioGroup;

RadioGroup3: TRadioGroup;

RadioGroup4: TRadioGroup;

RadioGroup5: TRadioGroup;

RadioGroup6: TRadioGroup;

RadioGroup7: TRadioGroup;

RadioGroup8: TRadioGroup;

RadioGroup9: TRadioGroup;

procedure Button2Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);

begin

close;

end;

procedure TForm1.Button1Click(Sender: TObject);

const

MarkText:array[0..1] of string=('Верных ответов-','Неверных - ');

Var

Markv,Markn:integer;

Begin

Markv:=0;Markn:=0;

If RadioGroup1.ItemIndex=Radiogroup1.Tag then inc(Markv)

else inc(markn);

If RadioGroup2.ItemIndex=Radiogroup2.Tag then inc(Markv)

else inc(markn);

If RadioGroup3.ItemIndex=Radiogroup3.Tag then inc(Markv)

else inc(markn);

If RadioGroup4.ItemIndex=Radiogroup4.Tag then inc(Markv)

else inc(markn);

If RadioGroup5.ItemIndex=Radiogroup5.Tag then inc(Markv)

else inc(markn);

If RadioGroup6.ItemIndex=Radiogroup6.Tag then inc(Markv)

else inc(markn);

If RadioGroup7.ItemIndex=Radiogroup7.Tag then inc(Markv)

else inc(markn);

If RadioGroup8.ItemIndex=Radiogroup8.Tag then inc(Markv)

else inc(markn);

If RadioGroup9.ItemIndex=Radiogroup9.Tag then inc(Markv)

else inc(markn);

ShowMessage(MarkText[0]+IntToStr(markv)+MarkText[1]+IntToStr(markn));

end;

begin

end.

Пример 10

// Движение планет

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls, jpeg;

var

X,Y:real;

type

TForm1 = class(TForm)

Image1: TImage;

Image2: TImage;

Timer1: TTimer;

Button1: TButton;

procedure Timer1Timer(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

var

X0,Y0:integer;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);

begin

timer1.Tag:=timer1.tag+5;

if timer1.tag=360 then timer1.Tag:=0;

X:=100*Cos(timer1.Tag/180*pi);

Y:=100*sin(timer1.Tag/180*pi);

image2.;

image2.;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

close;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

X0:=image1.left+image1.width div 2;

Y0:=image1.top+image1.height div 2;

end;

end.

Пример 11

// Пуля разбивает большой шар на маленькие

unit UnitPulya;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ExtCtrls, StdCtrls, Buttons;

type

TFormPulya = class(TForm)

Shape1: TShape;

Shape2: TShape;

Shape3: TShape;

Shape4: TShape;

Shape5: TShape;

Shape6: TShape;

Shape7: TShape;

Shape8: TShape;

Shape9: TShape;

Shape10: TShape;

Image1: TImage;

Timer1: TTimer;

bbt_Pusk: TButton;

Label1: TLabel;

Timer2: TTimer;

BitBtn2: TBitBtn;

Button1: TButton;

procedure Timer1Timer(Sender: TObject);

procedure Timer2Timer(Sender: TObject);

procedure bbt_PuskClick(Sender: TObject);

procedure BitBtn2Click(Sender: TObject);

procedure Image1Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

FormPulya: TFormPulya;

implementation

{$R *.dfm}

procedure TFormPulya.Timer1Timer(Sender: TObject);

begin

If Image1.Left>Shape2.Left-Image1.Width then

begin

Image1.Visible:=False;

Timer2.Enabled:=True;

Timer2.Interval:=10;

Shape1.Visible:=False;

Timer1.Enabled:=False;

end

else

Image1.;

end;

procedure TFormPulya.Timer2Timer(Sender: TObject);

begin

If Shape2.Left>=460 then

begin

Shape2.Visible:=False;

Shape3.Visible:=False;

Shape4.Visible:=False;

Shape5.Visible:=False;

Shape6.Visible:=False;

Shape7.Visible:=False;

Shape8.Visible:=False;

Shape9.Visible:=False;

Label1.Visible:=True;

Bbt_Pusk.Visible:=True;

Timer2.Enabled:=False;

Shape2.;

Shape2.;

Shape3.;

Shape3.;

Shape4.;

Shape4.;

Shape5.;

Shape5.;

Shape6.;

Shape6.;

Shape7.;

Shape7.;

Shape8.;

Shape8.;

Shape9.;

Shape9.;

end

else

begin

Shape2.Visible:=True;

Shape3.Visible:=True;

Shape4.Visible:=True;

Shape5.Visible:=True;

Shape6.Visible:=True;

Shape7.Visible:=True;

Shape8.Visible:=True;

Shape9.Visible:=True;

Shape2.;

Shape3.;

Shape4.;

Shape5.;

Shape6.;

Shape6.;

Shape7.;

Shape7.;

Shape8.;

Shape8.;

Shape9.;

Shape9.;

end;

end;

procedure TFormPulya.bbt_PuskClick(Sender: TObject);

begin

Label1.Visible:=False;

bbt_Pusk.Visible:=False;

Timer1.Enabled:=True;

Timer1.Interval:=10;

Image1.Visible:=true;

Shape1.Visible:=True;

Shape2.Visible:=True;

Image1.;

end;

procedure TFormPulya.BitBtn2Click(Sender: TObject);

begin

Bitbtn2.Visible:=False;

Timer1.Enabled:=True;

Timer1.Interval:=20;

end;

procedure TFormPulya.Image1Click(Sender: TObject);

begin

image1.;

end;

procedure TFormPulya.Button1Click(Sender: TObject);

begin

close;

end;

end.

Практика 12

// Текстовый редактор(демонстрация меню редактора)

unit UnitDocument;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Menus, StdCtrls, ComCtrls, Clipbrd;

type

TFormDocument = class(TForm)

MainMenu1: TMainMenu;

File1: TMenuItem;

Edit1: TMenuItem;

Format1: TMenuItem;

RichEdit1: TRichEdit;

New1: TMenuItem;

Open1: TMenuItem;

Close1: TMenuItem;

Save1: TMenuItem;

SaveFileDialog: TSaveDialog;

FontDialog1: TFontDialog;

PrintDialog1: TPrintDialog;

PrinterSetupDialog1: TPrinterSetupDialog;

PopupMenu1: TPopupMenu;

Save_as: TMenuItem;

Print1: TMenuItem;

Print_Setup1: TMenuItem;

N1: TMenuItem;

Exit1: TMenuItem;

Cut1: TMenuItem;

Copy1: TMenuItem;

Paste1: TMenuItem;

Delete1: TMenuItem;

N2: TMenuItem;

SelectAll: TMenuItem;

Left1: TMenuItem;

Right1: TMenuItem;

Center1: TMenuItem;

WordWrap1: TMenuItem;

Font1: TMenuItem;

OpenFileDialog: TOpenDialog;

procedure New1Click(Sender: TObject);

procedure Open1Click(Sender: TObject);

procedure Save1Click(Sender: TObject);

procedure Close1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure Save_asClick(Sender: TObject);

procedure Print1Click(Sender: TObject);

procedure Print_Setup1Click(Sender: TObject);

procedure Exit1Click(Sender: TObject);

procedure Edit1Click(Sender: TObject);

procedure Cut1Click(Sender: TObject);

procedure Copy1Click(Sender: TObject);

procedure Paste1Click(Sender: TObject);

procedure Delete1Click(Sender: TObject);

procedure SelectAllClick(Sender: TObject);

procedure Format1Click(Sender: TObject);

procedure WordWrap1Click(Sender: TObject);

procedure Font1Click(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

private

{ Private declarations }

PathName:string;

public

{ Public declarations }

Procedure Open(const AFileName:string);

end;

var

FormDocument: TFormDocument;

implementation

uses UnitEdit;

{$R *.dfm}

procedure TFormDocument.New1Click(Sender: TObject);

begin

FormEdit.NewClick(Sender);

end;

procedure TFormDocument.Open1Click(Sender: TObject);

begin

FormEdit.OpenClick(Sender);

end;

procedure TFormDocument.Open(const AFileName:string);

begin

PathName:=AFileName;

Caption:=ExtractFileName(AFileName);

with RichEdit1 do

Begin

Lines.LoadFromFile(PathName);

SelStart:=0;

Modified:=False;

end;

end;

procedure TFormDocument.Save1Click(Sender: TObject);

begin

If PathName=Self.Caption Then

Save_asClick(Sender)

Else

Begin

RichEdit1.Lines.SaveToFile(PathName);

RichEdit1.Modified:=False;end;

end;

procedure TFormDocument.Close1Click(Sender: TObject);

begin

close;

end;

procedure TFormDocument.FormCreate(Sender: TObject);

begin

PathName:=Self.Caption;

end;

procedure TFormDocument.Save_asClick(Sender: TObject);

begin

SaveFileDialog.FileName:=PathName;

If SaveFileDialog.Execute Then

Begin

PathName:=SaveFileDialog.FileName;

Caption:=ExtractFileName(PathName);

Save1Click(Sender);

end;

end;

procedure TFormDocument.Print1Click(Sender: TObject);

begin

If PrintDialog1.Execute Then

RichEdit1.Print(PathName);

end;

procedure TFormDocument.Print_Setup1Click(Sender: TObject);

begin

PrinterSetupDialog1.Execute;

end;

procedure TFormDocument.Exit1Click(Sender: TObject);

begin

FormEdit.ExitClick(Sender);

end;

procedure TFormDocument.Edit1Click(Sender: TObject);

Var

HasSelection:boolean;

begin

Paste1.Enabled:=Clipboard.HasFormat(Cf_text);

{Paste2.Enabled:=Paste1.Enabled; }

HasSelection:=RichEdit1.SelLength>0;

Cut1.Enabled:=HasSelection;

{Cut2.Enabled:=HasSelection;}

Copy1.Enabled:=HasSelection;

{Copy2.Enabled:=HasSelection; }

Delete1.Enabled:=HasSelection;

end;

procedure TFormDocument.Cut1Click(Sender: TObject);

begin

RichEdit1.CutToClipboard;

end;

procedure TFormDocument.Copy1Click(Sender: TObject);

begin

RichEdit1.CopyToClipBoard;

end;

procedure TFormDocument.Paste1Click(Sender: TObject);

begin

RichEdit1.PasteFromClipBoard;

end;

procedure TFormDocument.Delete1Click(Sender: TObject);

begin

RichEdit1.ClearSelection;

end;

procedure TFormDocument.SelectAllClick(Sender: TObject);

begin

RichEdit1.SelectAll;

end;

procedure TFormDocument.Format1Click(Sender: TObject);

begin

Left1.Checked:=False;

Right1.Checked:=False;

Center1.Checked:=False;

With Sender as TmenuItem do Checked:=True;

with RichEdit1.Paragraph do

If Left1.Checked then

Alignment:=taRightJustify

else if center1.Checked then

Alignment:=taCenter;

end;

procedure TFormDocument.WordWrap1Click(Sender: TObject);

begin

with RichEdit1 do

Begin

WordWrap:=not WordWrap;

If WordWrap then

ScrollBars:=ssVertical

Else

ScrollBars:=ssBoth;

WordWrap1.Checked:=WordWrap;

end;

end;

procedure TFormDocument.Font1Click(Sender: TObject);

begin

FontDialog1.Font:=RichEdit1.Font;

If FontDialog1.Execute then

RichEdit1.SelAttributes.Assign(FontDialog1.Font);

end;

procedure TFormDocument.FormClose(Sender: TObject;

var Action: TCloseAction);

begin

Action:=caFree;

end;

procedure TFormDocument.FormCloseQuery(Sender: TObject;

var CanClose: Boolean);

const

SwarningText='сохранить изменения в %s?';

begin

If RichEdit1.Modified Then

Begin

case MessageDlg(Format(SwarningText,[PathName]),

mtConfirmation,[mbyes,mbNo,mbCancel],0) of

idYes:save1Click(Self);

idCancel:CanClose:=False;

end;

end;

end;

end.

Практика 13

// Игра "Жизнь"

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ComCtrls, ToolWin, ImgList, Grids, ExtCtrls;

type

TLifeForm = class(TForm)

ToolBar1: TToolBar;

RandomTbt: TToolButton;

NewTBt: TToolButton;

ToolButton1: TToolButton;

FadeTBt: TToolButton;

ToolButton2: TToolButton;

RunTBt: TToolButton;

StopTBt: TToolButton;

ImageList1: TImageList;

lifeSGd: TStringGrid;

Timer1: TTimer;

procedure FormCreate(Sender: TObject);

procedure RandomTbtClick(Sender: TObject);

procedure NewTBtClick(Sender: TObject);

procedure FadeTBtClick(Sender: TObject);

procedure RunTBtClick(Sender: TObject);

procedure StopTBtClick(Sender: TObject);

procedure lifeSGdSelectCell(Sender: TObject; ACol, ARow: Integer;

var CanSelect: Boolean);

procedure lifeSGdDrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

private

{ Private declarations }

public

procedure OneStep;

{ Public declarations }

end;

const

mx=50;

my=25;

var

LifeForm: TLifeForm;

Fade:boolean;

implementation

{$R *.dfm}

procedure TLifeForm.FormCreate(Sender: TObject);

var i,j:integer;

begin

timer1.Enabled:=false;

Fade:=false;

For i:=0 to MX-1 do

for j:=0 to MY-1 do LifeSGd.Cells[i,j]:='0';

end;

procedure TLifeForm.RandomTbtClick(Sender: TObject);

Var x,y:integer;

begin

Randomize;

For y:=0 to MY-1 do

For x:=0 to MX-1 do

LifeSGd.Cells[x,y]:=IntToStr(Random(2));

end;

procedure TLifeForm.NewTBtClick(Sender: TObject);

Var y,x:integer;

begin

For y:=0 to MY-1 do

For x:=0 to MX-1 do LifeSGd.Cells[x,y]:='0';

Timer1.Enabled:=False;

end;

procedure TLifeForm.FadeTBtClick(Sender: TObject);

begin

Fade:=not(Fade);

FadeTBt.Down:=Fade;

end;

procedure TLifeForm.RunTBtClick(Sender: TObject);

begin

Timer1.Enabled:=True;

RunTBt.Down:=True;

StopTbt.Down:=False;

end;

procedure TLifeForm.StopTBtClick(Sender: TObject);

begin

Timer1.Enabled:=False;

StopTBt.Down:=True;

RunTBt.Down:=False;

end;

procedure TLifeForm.lifeSGdSelectCell(Sender: TObject; ACol, ARow: Integer;

var CanSelect: Boolean);

begin

If LifeSGd.Cells[Acol,Arow]='1'

then LifeSGd.Cells[Acol,Arow]:='0'

else LifeSGd.Cells[Acol,Arow]:='1';

end;

procedure TLifeForm.lifeSGdDrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

begin

LifeSGD.Canvas.Brush.Color:=clWhite;

case StrToInt(LifeSGD.Cells[Acol,Arow]) of

1: LifeSGD.Canvas.Brush.Color:=clBlue;

2: If Fade then LifeSGd.Canvas.Brush.Color:=clBlue-13000;

3: if Fade then LifeSGd.Canvas.Brush.Color:=clBlue-17000;

end;

LifeSGd.Canvas.FillRect(Rect);

end;

procedure TlifeForm.OneStep;

const

Dx:array[1..8] of integer=(-1,0,1,1,1,0,-1,-1);

Dy:array[1..8] of integer=(-1,-1,-1,0,1,1,1,0);

var

i,j,k,count:integer;

a:array[0..mx,0..my] of byte;

begin

FillChar(a,SizeOf(a),0);

for i:=1 to MX-1 do

For j:=1 to my-1 do

begin

count:=0;

For k:=1 to 8 do

If LifeSGd.Cells[i+DX[k],j+DY[k]]='1' then Inc(count);

case count of

0..1,4..8:A[i,j]:=0;

2:if LifeSGd.Cells[i,j]='1' then a[i,j]:=1

else A[i,j]:=0;

3:A[i,j]:=1;

end;

end;

For i:=0 to MX-1 do

For j:=0 to MY-1 do

If A[i,j]=1 then LifeSGd.Cells[i,j]:='1'

else if (LifeSGd.Cells[i,j]='1')

then LifeSGd.Cells[i,j]:='2'

else if (LifeSGd.Cells[i,j]='2')

Then LifeSGd.Cells[i,j]:='3'

else LifeSGd.Cells[i,j]:='0';

end;

end.

Практика 14

// Игра "Блоки"

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Grids, StdCtrls, ExtCtrls, ImgList, Spin;

type

TForm1 = class(TForm)

sg: TStringGrid;

btnNewGame: TButton;

ImageList1: TImageList;

SpinEdit1: TSpinEdit;

Label1: TLabel;

Timer1: TTimer;

procedure FormCreate(Sender: TObject);

procedure btnNewGameClick(Sender: TObject);

procedure sgDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;

State: TGridDrawState);

procedure Timer1Timer(Sender: TObject);

procedure sgMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

C:array [0..5,0..5] of byte;

b:boolean;

x,y:byte;

N:byte;

bShowAll:boolean;

bNewGame:boolean;

bC:array [1..18] of boolean;

b1:boolean;

bShow2:boolean;

x1,y1,x2,y2:byte;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

var i:integer;

begin

bNewGame:=false;

bShowAll:=false;

for i:=0 to 5 do

begin

sg.ColWidths[i]:=50;

sg.RowHeights[i]:=50;

end;

end;

procedure TForm1.btnNewGameClick(Sender: TObject);

var b:boolean;

i,j:integer;

N:integer;

x,y:integer;

begin

for i:=0 to 5 do

for j:=0 to 5 do

C[i,j]:=0;

for i:=1 to 18 do

bC[i]:=false;

for N:=1 to 18 do

begin

b:=false;

Randomize;

while not b do

begin

x:=random(6);

y:=random(6);

if C[x,y]=0 then

begin

C[x,y]:=N;

b:=true;

end;

end;

b:=false;

while not b do

begin

x:=random(6);

y:=random(6);

if C[x,y]=0 then

begin

C[x,y]:=N;

b:=true;

end;

end;

end;

bShowAll:=true;

sg.Repaint;

Timer1.Interval:=1000*strtoint(SpinEdit1.Text);

Timer1.Enabled:=true;

end;

procedure TForm1.sgDrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

begin

if bShowAll then

begin

ImageList1.Draw(sg.Canvas,Rect.Left-2,Rect.Top-2,C[ACol,ARow]);

exit;

end;

if not bNewGame then

exit;

if b1 then

if (ACol=x1) and (ARow=y1) then

begin

ImageList1.Draw(sg.Canvas,Rect.Left-2,Rect.Top-2,C[ACol,ARow]);

exit;

end;

if bShow2 then

if (ACol=x2) and (ARow=y2) then

begin

ImageList1.Draw(sg.Canvas,Rect.Left-2,Rect.Top-2,C[ACol,ARow]);

exit;

end;

if not bC[C[ACol,ARow]] then

ImageList1.Draw(sg.Canvas,Rect.Left-2,Rect.Top-2,0)

else

ImageList1.Draw(sg.Canvas,Rect.Left-2,Rect.Top-2,C[ACol,ARow]);

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

Timer1.Enabled:=false;

bShowAll:=false;

bNewGame:=true;

sg.Repaint;

b1:=false;

end;

procedure TForm1.sgMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var ACol,ARow:integer;

begin

if not bNewGame then

exit;

sg.MouseToCell(x,y,ACol,ARow);

if b1 and (ACol=x1) and (ARow=y1) then

exit;

if bShow2 and (ACol=x2) and (ARow=y2) then

exit;

if bC[C[ACol,ARow]] then

exit;

if b1 then

begin

bShow2:=true;

x2:=ACol;

y2:=ARow;

sg.Repaint;

Sleep(800);

b1:=false;

bShow2:=false;

if C[x1,y1]=C[x2,y2] then

bC[C[x1,y1]]:=true;

sg.Repaint;

end

else

begin

x1:=ACol;

y1:=ARow;

b1:=true;

sg.Repaint;

end;

end;

end.

Практика 15

// Графики функций

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls, jpeg;

type

TForm1 = class(TForm)

Button1: TButton;

Button2: TButton;

Image1: TImage;

procedure Button2Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

uses Unit2, Unit3;

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);

begin

close;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Form2.Show;

end;

end.

Практика 16

// Drag and Drop

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Buttons, ExtCtrls;

type

TForm1 = class(TForm)

Shape1: TShape;

BitBtn1: TBitBtn;

Shape2: TShape;

Shape3: TShape;

procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure Shape1MouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1; x0,y0:integer;

f:boolean=false;

implementation

{$R *.dfm}

procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

x0:=x; y0:=y;

f:=true;

end;

procedure TForm1.Shape1MouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

if f then

begin

with shape1 do

begin

;

;

end;

f:=false;

end;

end;

end.

procedure TForm1.Shape2MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

x0:=x; y0:=y;

f:=true;

end;

procedure TForm1.Shape2MouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

if f then

begin

with shape2 do

begin

;

;

end;

f:=false;

end;

end;