Создать программу, в которой при нажатии на кнопку выводится на печать страница перечеркнутая до диагонали линиями красного цвета

uses

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

Dialogs, Buttons, StdCtrls, ExtCtrls,printers;

type

TForm1 = class(TForm)

Button1: TButton;

BitBtn1: TBitBtn;

procedure Button1Click(Sender: TObject);

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

begin

printer.begindoc;

with form1.Canvas do

begin

pen.Color:=clred;

pen.Width:=2;

clientheight:=338;

clientwidth:=316;

Printer.canvas.lineto (316,338);

lineto(316,338);

Printer.canvas.lineto (316,0);

moveto(316,0);

Printer.canvas.lineto (0,338);

lineto(0,338);

end;

printer.enddoc;

end;

 

Нарисовать прямоугольник красного цвета

Shape1: TShape;

Timer1: TTimer;

procedure FormCreate(Sender: TObject);

mplementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

with shape1 do

begin

shape:=stRectangle;

brush.Color:=clred;

pen.Color:=clred;

end;

end;

end.

 

 

Найти сумму элементов матрицы

TForm1 = class(TForm)

StringGrid1: TStringGrid;

Edit1: TEdit;

Edit2: TEdit;

Button1: TButton;

Memo1: TMemo;

procedure Button1Click(Sender: TObject);

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

var s,i,j:integer;

begin

s:=0;

for i:=0 to 3 do

begin

for j:=0 to 3 do

s:=s+strtoint(stringgrid1.Cells[j,i]);

end;

Memo1.Lines.Add(inttostr(s));

end;

end.

Найти сумму элементов выше главной диагонали

procedure TForm1.Button1Click(Sender: TObject);

var s,i,j:integer;

begin

s:=0;

for i:=0 to 3 do

begin

for j:=0 to 3 do

if (i<j) then

s:=s+strtoint(stringgrid1.Cells[j,i]);

end;

Memo1.Lines.Add(inttostr(s));

end;

end.

Сумма элементов ниже главной диагонали

procedure TForm1.Button1Click(Sender: TObject);

var s,i,j:integer;

begin

s:=0;

for i:=0 to 3 do

begin

for j:=0 to 3 do

if (i>j) then

s:=s+strtoint(stringgrid1.Cells[j,i]);

end;

Memo1.Lines.Add(inttostr(s));

end;

end.

На главной диагонали сумма

procedure TForm1.Button1Click(Sender: TObject);

var s,i,j:integer;

begin

s:=0;

for i:=0 to 3 do

begin

for j:=0 to 3 do

if (i=j) then

s:=s+strtoint(stringgrid1.Cells[j,i]);

end;

Memo1.Lines.Add(inttostr(s));

end;

end.

СУММУ ЭЛЕМЕНТОВ Выше побочной

procedure TForm1.Button1Click(Sender: TObject);

var s,i,j:integer;

begin

s:=0;

for i:=0 to 3 do

begin

for j:=0 to 3 do

if ((i+j)<3) then

s:=s+strtoint(stringgrid1.Cells[j,i]);

end;

Memo1.Lines.Add(inttostr(s));

end;

СУММУ ЭЛЕМЕНТОВ Ниже побочной

procedure TForm1.Button1Click(Sender: TObject);

var s,i,j:integer;

begin

s:=0;

for i:=0 to 3 do

begin

for j:=0 to 3 do

if ((i+j)>3) then

s:=s+strtoint(stringgrid1.Cells[j,i]);

end;

Memo1.Lines.Add(inttostr(s));

end;

Поменять атрибуты файла

Button1: TButton;

Button2: TButton;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

mplementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

var fileattr:integer;

begin

fileattr:=filegetattr('C:\Documents and Settings\bista\Рабочий стол\ержан19,04,09.doc');

if fileattr and fareadonly=0 then

filesetattr('C:\Documents and Settings\bista\Рабочий стол\ержан19,04,09.doc',fileattr+fareadonly);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

filesetreadonly('C:\Documents and Settings\bista\Рабочий стол\ержан19,04,09.doc',

false);

end;

end.

Нарисовать треугольник, закрашенный зеленым цветом

procedure TForm1.Button2Click(Sender: TObject);

var a:array [0..2]of TPoint;

begin

a[0].X:=random(10)+100;

a[0].Y:=random(10)+100;

a[1].X:=random(30)+150;

a[1].Y:=random(30)+100;

a[2].X:=random(25)+200;

a[2].Y:=(25)+200;

form1.Canvas.Brush.Color:=clgreen;

form1.Canvas.Polygon(a);

end;

3.Нарисовать многоугольник

procedure TForm1.Button6Click(Sender: TObject);

var pt4:array [1..4] of Tpoint;

begin

pt4[1]:=point(10,10);

pt4[2]:=point(200,260);

pt4[3]:=point(360,200);

pt4[4]:=point(280,130);

form1.Canvas.Brush.Color:=clblue;

form1.Canvas.Polygon(pt4);

end;

end.

25.Цвета и их коды(2 лаба)

TForm1 = class(TForm)

ListBox1: TListBox;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

BitBtn1: TBitBtn;

Button1: TButton;

procedure BitBtn1Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure ListBox1Click(Sender: TObject);

implementation

{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);

begin

close;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

case listBox1.ItemIndex of

0: Label3.Caption:= 'черный ОООООО';

1: Label3.Caption:=' белый FFFFFF';

2: Label3.Caption:=' красный FFOOOO';

3: Label3.Caption:=' зеленый OOFFOO';

4: Label3.Caption:= 'бирюзовый OOFFFF';

5: Label3.Caption:=' синий OOOOFF';

6: Label3.Caption:=' фиолетовый FFOOFF';

7: Label3.Caption:= ' желтый FFFFOO';

8: Label3.Caption:= 'коричневый 996633';

9: Label3.Caption:= ' оранжевый FF8000';

10: Label3.Caption:= ' липовый 8000FF';

11: Label3.Caption:=' серый АОАОАО';

end;

end;

end.

Массив с помощью Combobox(поменять местами максимальный и минимальльный элементы)

ComboBox1: TComboBox;

ComboBox2: TComboBox;

Button1: TButton;

Button2: TButton;

Button3: TButton;

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure ComboBox1KeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure Button3Click(Sender: TObject);

var

Form1: TForm1; i, max, min, maxi,mini:integer;

a:array[1..10] of integer;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

i:=0;

comboBox1.Clear;

combobox2.Clear;

combobox1.TabOrder:=0;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

combobox1.items.add(combobox1.Text);

i:=i+1;

a[i]:=strtoint(combobox1.Text);

combobox1.SetFocus;

end;

procedure TForm1.Button2Click(Sender: TObject);

var k:integer;

begin

max:=a[1]; maxi:=1; min:=a[1]; mini:=1;

for k:=2 to 10 do

begin

if max<a[k] then

begin

max:=a[k];

maxi:=i;

end;

if min>a[k] then

begin

min:=a[k];

mini:=i;

end;

end;

a[maxi]:=min;

a[mini]:=max;

for k:=1 to 10 do

combobox2.Items.Add(inttostr(a[k]));

combobox2.DroppedDown:=true;

end;

procedure TForm1.ComboBox1KeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

if key=13 then button1.SetFocus;

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

close;

end;

end.

Массив- найти сумму элементов на главной матрице

ComboBox1: TComboBox;

ComboBox2: TComboBox;

Button1: TButton;

Button2: TButton;

Button3: TButton;

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure ComboBox1KeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure Button3Click(Sender: TObject);

var

Form1: TForm1; i, max, min, maxi,mini:integer;

a:array[1..10] of integer;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

i:=0;

comboBox1.Clear;

combobox2.Clear;

combobox1.TabOrder:=0;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

combobox1.items.add(combobox1.Text);

i:=i+1;

a[i]:=strtoint(combobox1.Text);

combobox1.SetFocus;

end;

procedure TForm1.Button2Click(Sender: TObject);

var s,k:integer;

begin

for k:=1 to 10 do

combobox2.Items.Add(inttostr(a[k]));

combobox2.DroppedDown:=true;

end;

procedure TForm1.ComboBox1KeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

if key=13 then button1.SetFocus;

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

close;

end;

end.

Решить квадратное уравнение

TForm1 = class(TForm)

Edit1: TEdit;

Edit2: TEdit;

Edit3: TEdit;

Memo1: TMemo;

Button1: TButton;

procedure Button1Click(Sender: TObject);

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

var a,b,c,x,y,d:real;

begin

a:=Strtofloat(Edit1.Text);

b:=Strtofloat(Edit2.Text);

c:=Strtofloat(Edit3.Text);

D:= sqr(b)-4*a*c;

if (D>0) then

begin

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

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

Memo1.Lines.Add(floattostr(x));

Memo1.Lines.Add(floattostr(y))

end

else if(D<0) then

Memo1.Lines.Add('нету решений')

else

x:= (-b)/(2*a);

y:= (-b)/(2*a);

Memo1.Lines.Add(floattostr(x));

Memo1.Lines.Add(floattostr(y));

end;

end.

Провести линию из точки в точку и рядом вывести стиль линии

begin

with Canvas do

begin

Pen.Style:=psSolid;

Moveto(10,20)

Lineto(200,20)

Textout(220,20,’solid’)

Создать текстовый редактор он позволяет сохранить открыть и изменить характеристики шрифта

TForm1 = class(TForm)

OpenDialog1: TOpenDialog;

SaveDialog1: TSaveDialog;

OpenPictureDialog1: TOpenPictureDialog;

SavePictureDialog1: TSavePictureDialog;

FontDialog1: TFontDialog;

Memo1: TMemo;

Button1: TButton;

Button2: TButton;

Button3: TButton;

Button4: TButton;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

begin

with openDialog1 do

begin

if not Execute then exit;

memo1.lines.loadFromFile(FileName)

end;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

with

saveDialog1 do

begin

if not Execute then exit;

memo1.lines.savetoFile(FileName)

end;

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

with fontDialog1 do

begin

if not Execute then exit;

memo1.font:=font;

end;

end;

procedure TForm1.Button4Click(Sender: TObject);

begin

close;

end;

end.