Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Яску Иван.doc
Скачиваний:
7
Добавлен:
02.09.2019
Размер:
3.95 Mб
Скачать

Приложение а

Листинг программы

program Gauss;

uses //в модуле "Forms" содержится класс "Application" необходимый для

Forms, //быстрого конструирования окна и его запуска. (стандартный метод)

Unit1 in 'Unit1.pas' {Form1},// окно "заставка"

Unit2 in 'Unit2.pas' {Form2}, //главное окно программы

Unit3 in 'Unit3.pas' {Form3}, //окно "О программе"

Unit4 in 'Unit4.pas' {Form4}, //окно выбора цвета

Unit5 in 'Unit5.pas' {Form5}; //окно печати

{$R Gauss.res} //подключение ресурсов (в данном случае одной иконки)

Begin

Application.Initialize; // инициализация О.С. для создания окна.

Application.CreateForm(TForm1, Form1); //создание окна "заставка"

Application.CreateForm(TForm2, Form2); //создание главного окна программы

Application.CreateForm(TForm3, Form3); //создание окна "О программе"

Application.CreateForm(TForm4, Form4); //создание окна выбора цвета

Application.CreateForm(TForm5, Form5); //создание окна печати

Application.Run;// запуск главного цикла программы

end.

{----------------------------------------------------------------------------------------------------------------------}

// окно "заставка"

unit Unit1;

interface

uses

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

Dialogs, StdCtrls, Buttons, ExtCtrls, jpeg;

type

TForm1 = class(TForm)

Panel1: TPanel;

Panel2: TPanel;

BitBtn1: TBitBtn;

Timer1: TTimer;

Timer3: TTimer;

Timer4: TTimer;

Image1: TImage;

Image2: TImage;

Image3: TImage;

Image4: TImage;

Edit1: TEdit;

Timer2: TTimer;

Timer5: TTimer;

Label1: TLabel;

Label2: TLabel;

procedure BitBtn1Click(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure Timer4Timer(Sender: TObject);

procedure Timer3Timer(Sender: TObject);

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

Y: Integer);

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

Y: Integer);

procedure Timer2Timer(Sender: TObject);

procedure Timer5Timer(Sender: TObject);

private

{ Private declarations }

Public

{ Public declarations }

end;

var

Form1: TForm1;

Implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);

begin

form1.Hide;

form2.Show;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

Var s,s2:string;

begin

s:='************************Решение систем линейных'+

' уравнений методом Гаусса************************';

tag:=tag+1;

edit1.Text:=edit1.Text+s[tag];

if tag=200 then

begin

edit1.Visible:=false;

label1.Visible:=true;

timer2.Enabled:=true;

tag:=0;

timer3.Enabled:=true;

timer1.Enabled:=false;

end;

end;

procedure TForm1.Timer4Timer(Sender: TObject);

Var k:integer;

begin

k:=form1.AlphaBlendValue;

form1.AlphaBlendValue:=k+5;

if form1.AlphaBlendValue=255 then

begin

timer1.Enabled:=true;

timer4.Enabled:=false;

end;

end;

procedure TForm1.Timer3Timer(Sender: TObject);

begin

tag:=tag+1;

case tag of

1: begin

image4.Visible:=false;

image2.Visible:=true;

end;

2: begin

image2.Visible:=false;

image3.Visible:=true;

end;

3: begin

image3.Visible:=false;

image4.Visible:=true;

tag:=0;

end;

end;

end;

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

Y: Integer);

begin

BitBtn1.Font.Color:=clBlue;

end;

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

Y: Integer);

begin

BitBtn1.Font.Color:=clWindowText;

end;

procedure TForm1.Timer2Timer(Sender: TObject);

Var

x:integer;

begin

x:=label1.Left;

label1.Left:=x+1;

case label1.Left of

200:label1.Font.Color:=clYellow;

400:label1.Font.Color:=clLime;

600:label1.Font.Color:=clWindow;

800:label1.Font.Color:=clYellow;

1030:begin

timer5.Enabled:=true;

label1.Left:=-1040;

label1.Font.Color:=clWindow;

timer2.Enabled:=false;

end;

end;

end;

procedure TForm1.Timer5Timer(Sender: TObject);

Var x:integer;

begin

x:=label2.Left;

label2.Left:=x+1;

case label2.Left of

200:label2.Font.Color:=clYellow;

400:label2.Font.Color:=clLime;

600:label2.Font.Color:=clWindow;

800:label2.Font.Color:=clYellow;

1030:begin

timer2.Enabled:=true;

label2.Left:=-1040;

label2.Font.Color:=clWindow;

timer5.Enabled:=false;

end;

end;

end;

end.

{----------------------------------------------------------------------------------------------------------------------}

//главное окно программы

unit Unit2;

interface

uses

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

Dialogs, StdCtrls, Grids, ExtCtrls, Buttons, ActnList, Menus,Printers,

jpeg;

type

TForm2 = class(TForm)

Panel1: TPanel;

Panel2: TPanel;

ComboBox1: TComboBox;

BitBtn1: TBitBtn;

s2: TStringGrid;

BitBtn2: TBitBtn;

MainMenu1: TMainMenu;

N11: TMenuItem;

ActionList1: TActionList;

Open: TAction;

OpenDialog1: TOpenDialog;

SaveDialog1: TSaveDialog;

Save: TAction;

AutoZap: TAction;

Print: TAction;

N1: TMenuItem;

N2: TMenuItem;

N31: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

N5: TMenuItem;

N6: TMenuItem;

Image2: TImage;

Image3: TImage;

Image1: TImage;

s1: TStringGrid;

Yadro: TAction;

PopupMenu1: TPopupMenu;

N7: TMenuItem;

Label1: TLabel;

Bevel1: TBevel;

N8: TMenuItem;

N9: TMenuItem;

N10: TMenuItem;

Label2: TLabel;

ComboBox2: TComboBox;

PopupMenu2: TPopupMenu;

N12: TMenuItem;

SpeedButton1: TSpeedButton;

SpeedButton2: TSpeedButton;

SpeedButton3: TSpeedButton;

SpeedButton4: TSpeedButton;

SpeedButton5: TSpeedButton;

SpeedButton6: TSpeedButton;

SpeedButton7: TSpeedButton;

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

procedure BitBtn2Click(Sender: TObject);

procedure ComboBox1Select(Sender: TObject);

procedure OpenExecute(Sender: TObject);

procedure SaveExecute(Sender: TObject);

procedure N5Click(Sender: TObject);

procedure N6Click(Sender: TObject);

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

Shift: TShiftState);

procedure YadroExecute(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure SpeedButton5Click(Sender: TObject);

procedure N8Click(Sender: TObject);

procedure N10Click(Sender: TObject);

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

Y: Integer);

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

Y: Integer);

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

Y: Integer);

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

Y: Integer);

procedure ComboBox2Select(Sender: TObject);

procedure AutoZapExecute(Sender: TObject);

procedure PrintExecute(Sender: TObject);

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

Shift: TShiftState);

procedure N12Click(Sender: TObject);

procedure SpeedButton6Click(Sender: TObject);

procedure SpeedButton7Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form2: TForm2;

implementation

uses Unit1, Unit3, Unit4, Unit5;

{$R *.dfm}

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

begin

form1.Close;

end;

procedure TForm2.BitBtn2Click(Sender: TObject);

Var // Процедура очистки

i,j,c:integer;

begin

for i:=1 to s1.colcount-1 do

for j:= 1 to s1.rowcount-1 do

s1.Cells[i,j]:=' ';

for c:=0 to s2.ColCount do

s2.cells[c,1]:=' ';

end;

procedure TForm2.ComboBox1Select(Sender: TObject);

Var n,i,j:integer; //Процедура построения таблицы

begin

n:=ComboBox1.ItemIndex+1;

S1.ColCount:=n+2;

i:=0;

for j:=1 to n do

s1.Cells[j,i]:='Ai'+inttostr(j);

s1.Cells[n+1,0]:='Bi';

for i:=1 to n do

begin

s2.ColCount:=n;

s2.RowCount:=2;

s2.Cells[i-1,0]:='X'+inttostr(i);

S2.Visible:=true;

end;

combobox2.Visible:=true;

end;

procedure TForm2.OpenExecute(Sender: TObject);

const k=122850; //Максимальное количество вводимых символов

Var

f:textfile;

z:array[1..k] of real;

i,j,c,n,m:integer;

begin

OpenDialog1.Title:='Открытие коэффициентов из текстового файла';

if Not OpenDialog1.Execute then // Получение имя файла, с помощью

//стандартного диалогового окна

exit; //Пользователь отказался выбрать файл

AssignFile(F,OpenDialog1.FileName); //Попытка открытия файла

Try

Reset(f);

except //Файл нельзя открыть:

MessageBeep(mb_ok);

ShowMessage('Невозможно открыть файл '+

OpenDialog1.FileName);

exit;

end;

i:=1;

while not eof (f) and (i<=k) do

begin

try

read(f,z[i]);

except

APPLICATION.MessageBox('Ошибка чтения из файла','Ошибка',mb_iconhand +

mb_ok);

exit;

end;

inc(i);

end;

CloseFile(f);

n:=ComboBox1.ItemIndex+1;

m:=combobox2.ItemIndex+1;

c:=1;

for i:=1 to m do

for j:=1 to n+1 do

begin

s1.Cells[j,i]:=floattostr(z[c]);

inc(c);

end;

end;

procedure TForm2.SaveExecute(Sender: TObject);

const k=122850;

Var

z:array[1..k]of real;

f:textfile;

i,j,c,n,m:integer;

begin

savedialog1.Title:='Сохранение коэффициентов в текстовый файл';

if not SaveDialog1.Execute then //Пользователь отказался выбрать файл

exit;

AssignFile(F,SaveDialog1.FileName); //Попытка открытия файла

try

rewrite(f);

except

MessageBeep(mb_ok);

ShowMessage('Невозможно открыть файл'+

SaveDialog1.FileName);

exit;

end;

n:=ComboBox1.ItemIndex+1;

m:=combobox2.ItemIndex+1;

c:=1;

for i:=1 to m do

for j:=1 to n+1 do

begin

try

z[c]:=strtofloat(s1.Cells[j,i]);

except

APPLICATION.MessageBox('Не все поля заполнены','Ошибка',mb_iconhand +

mb_ok);

exit;

end;

inc(c);

end;

for i:=1 to n*m+m do

begin

try

Write(f,z[i]:15:10)

Except

APPLICATION.MessageBox('Ошибка записи в файл','Ошибка',mb_iconhand +

mb_ok);

exit;

end;

end;

CloseFile(f);

end;

procedure TForm2.N5Click(Sender: TObject);

begin

close;

end;

procedure TForm2.N6Click(Sender: TObject);

begin

form3.Showmodal;

end;

procedure TForm2.s1KeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState); //процедура перемещения по таблице

Var n,m:integer;

begin

n:=combobox1.ItemIndex+1;

m:=combobox2.ItemIndex+1;

if s1.row<> m then

begin

if s1.Col<=n

then

if key=13 then s1.Col:=s1.Col+1

else

else

if key=13 then

begin

s1.Col:=1;

s1.Row:=s1.Row+1;

end;

end

else

if s1.col<>n+1 then

if key=13 then s1.Col:=s1.Col+1

else

else

if key=13 then

Yadro.Execute;

end;

procedure TForm2.YadroExecute(Sender: TObject);

Var

maxabs,v,s,c,b:real;

n,i,j,l,k,m:integer;

str:string;

x:array[1..350] of real;

a:array[1..350,1..351] of real;

w:array[1..350]of real;

z:array[1..350]of real;

begin

str:='';

n:=ComboBox1.ItemIndex+1; //Получение количества неизвестных

m:=combobox2.ItemIndex+1; //Получение количества уравнений

if n>m then

begin

try //начало защищённого блока 1

for i:=0 to n-m-1 do

x[i+1]:=strtofloat(s2.Cells[i,1]); //считывание значений корней

except

for j:=1 to n-m do

str:=str+' x'+inttostr(j); //наполнение строки

showMessage('Бесконечное множество решений, введите'+str);

exit;

end; //конец защищённого блока 1

for i:=1 to m do

try //начало защищённого блока 2

begin

z[i]:=strtofloat(s1.Cells[n+1,i]); //считывание свободных членов

s:=0;

for l:=1 to n-m do

begin

w[l]:=strtofloat(s1.Cells[l,i]);//считывание коэффициентов при неизвестных

s:=s+x[l]*w[l];

end;

s1.Cells[n+1,i]:=floattostr(z[i]-s); //переопределение свободных членов

end;

except

APPLICATION.MessageBox('Не все поля заполнены',

'Ошибка',mb_iconHand +

mb_ok);

exit;

end; //конец защищённого блока 2

for i:=1 to m do //считывание переопределённой системы

for j:=(n-m)+1 to n+1 do

a[i,j-(n-m)]:=strtofloat(s1.Cells[j,i]);

for i:=1 to m do

s1.Cells[n+1,i]:=floattostr(z[i]); //возвращение свободных членов в исходное

n:=m; //изменение кол-ва неизвестных //состояние

end

else

begin

if n<m then

exit;

for i:=1 to m do

for j:=1 to n+1 do

try

a[i,j]:=strtofloat(s1.Cells[j,i]);//считывание системы

except

APPLICATION.MessageBox('Не все поля заполнены',

'Ошибка',mb_iconHand +

mb_ok);

exit;

end;

end;

for i:=1 to n do

begin

maxabs:=abs(a[i,j]); //Поиск номера К уравнения

k:=i; //с наибольшим по абсолютной

for l:=i+1 to n do //величине коэффициентом при [i]

if abs(a[l,i])> maxabs

then

begin

maxabs:=abs(a[l,i]);

k:=l;

end;

if k<>i // перемена местами К-го и i-го уравнений

then

for j:=i to n+1 do

begin

v:=a[i,j];

a[i,j]:=a[k,j];

a[k,j]:=v

end;

v:=a[i,i];

for j:=i to n+1 do

try //Начало защищённого блока 3

a[i,j]:=a[i,j]/v;

except

APPLICATION.MessageBox('Нет решений','Warning',mb_iconExclamation +

mb_ok);

exit;

end; // Конец защищённого блока 3

for l:=i+1 to n do

begin

v:=a[l,i];

for j:=i+1 to n+1 do

a[l,j]:=a[l,j]-a[i,j]*v

end;

end;

x[n]:=a[n,n+1];

for i:=n-1 downto 1 do

begin

x[i]:=a[i,n+1];

for j:=i+1 to n do

x[i]:=x[i]-a[i,j]*x[j]

end;

j:=0;

if combobox1.ItemIndex+1<>m then

for i:=combobox1.ItemIndex+1-m to combobox1.ItemIndex+1 do //Вывод корней

begin

j:=j+1;

if abs(x[j]) > 1.0E-10 then

s2.Cells[i,1]:=floattostr(x[j])

else

s2.Cells[i,1]:='0';

end

else

for i:=1 to n do //Вывод корней

begin

if abs(x[i]) > 1.0E-10 then

s2.Cells[i-1,1]:=floattostr(x[i])

else

s2.Cells[i-1,1]:='0';

end;

end;

procedure TForm2.FormCreate(Sender: TObject);

Var i:integer;

begin

for i:=1 to 350 do

begin

ComboBox1.Items.Add(inttostr(i)); //наполнение списков

ComboBox2.Items.Add(inttostr(i));

end;

S1.Visible:=FALSE; //не отображать таблицы

S2.Visible:=FALSE;

end;

procedure TForm2.SpeedButton5Click(Sender: TObject);

begin

form4.show; //окно выбора цвета

end;

procedure TForm2.N8Click(Sender: TObject);

begin

winhelp(Form2.Handle,'help.hlp',HELP_CONTEXT,1);

end;

procedure TForm2.N10Click(Sender: TObject);

Var //сохранение в файл с неизвестными

fo:textfile;

i,j,n,m:integer;

begin

n:=combobox1.ItemIndex+1; //Получение количества неизвестных

m:=combobox2.ItemIndex+1; //Получение количества уравнений

savedialog1.Title:='Сохранение коэффициентов в текстовый файл';

if not SaveDialog1.Execute then //Пользователь отказался выбрать файл

exit;

AssignFile(fo,SaveDialog1.FileName);

try

rewrite(fo);

except

APPLICATION.MessageBox('Невозможно открыть файл','Ошибка',mb_iconhand +

mb_ok);

exit;

end;

try

Writeln(fo,'Система:');

Writeln(fo);

for i:=1 to m do

for j:=1 to n+1 do

begin

if j<> 1 then

if j<> n+1 then

if strtofloat(s1.Cells[j,i])>=0 then

Write(fo,' +'+s1.Cells[j,i]+'X'+inttostr(j))

Else

Write(fo,' '+s1.Cells[j,i]+'X'+inttostr(j))

Else

Writeln(fo,' ='+s1.Cells[j,i])

else

if strtofloat(s1.Cells[j,i])>=0 then

Write(fo,' '+s1.Cells[j,i]+'X'+inttostr(j))

else Write(fo,s1.Cells[j,i]+'X'+inttostr(j));

end;

Writeln(fo);

Writeln(fo,'Корни:');

for i:=1 to n do

Write(fo,' X'+inttostr(i)+'='+s2.Cells[i-1,1]+' ');

except

APPLICATION.MessageBox('Ошибка записи в файл','Ошибка',mb_iconhand +

mb_ok);

exit;

end;

CloseFile(fo);

end;

procedure TForm2.BitBtn1MouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

BitBtn1.Font.Color:=clBlue;

end;

procedure TForm2.Image2MouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

begin

BitBtn1.Font.Color:=clWindowText

end;

BitBtn2.Font.Color:=clWindowText

end;

procedure TForm2.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

begin

BitBtn1.Font.Color:=clWindowText

end;

BitBtn2.Font.Color:=clWindowText

end;

procedure TForm2.BitBtn2MouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

BitBtn2.Font.Color:=clBlue;

end;

procedure TForm2.ComboBox2Select(Sender: TObject);

Var m,j,i:integer;

begin

m:=combobox2.ItemIndex+1;

s1.RowCount:=m+1;

j:=0;

for i:=1 to m do

s1.cells[j,i]:=inttostr(i)+' уравнение';

s1.Visible:=true;

end;

procedure TForm2.AutoZapExecute(Sender: TObject);

Var //Процедура автозаполнения таблицы

i,j,st,sb:integer;

begin

st:=ComboBox1.ItemIndex+1;

sb:=ComboBox2.ItemIndex+1;

randomize;

for i:=1 to sb do

for j:=1 to st+1 do

begin

s1.Cells[j,i]:=inttostr(random(9)-2);

end;

end;

procedure TForm2.PrintExecute(Sender: TObject);

begin

form5.Show;

end;

procedure TForm2.s2KeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState); //процедура перемещения по малой таблице

Var n:integer;

Begin

n:=combobox1.ItemIndex+1;

if s2.Col<n-1

then

if key=13 then s2.Col:=s2.Col+1;

end;

procedure TForm2.N12Click(Sender: TObject);

Var i,n,m:integer;

begin

n:=combobox1.ItemIndex+1;

m:=combobox2.ItemIndex+1;

for i:=0 to n-m-1 do

s2.Cells[i,1]:=floattostr(random(7));

end;

procedure TForm2.SpeedButton6Click(Sender: TObject);

begin

winhelp(Form2.Handle,'help.hlp',HELP_CONTEXT,1);

end;

procedure TForm2.SpeedButton7Click(Sender: TObject);

Var

flag:boolean;

sum:real;

k,n,i,st,z:integer;

m:array[1..350]of real;

begin

flag:=true;

n:=combobox1.ItemIndex+1; //получение количества неизвестных

z:=combobox2.ItemIndex+1; //получение количества уравнений

if (n=0) or (z=0) then

begin

APPLICATION.MessageBox('Не введена система уравнений',

'Ошибка',mb_iconHand +

mb_ok);

exit;

end;

for st:=1 to z do //Для строки от 1-ой до последней...

begin

sum:=0;

i:=0;

for k:=1 to n do //Для столбца от 1-го до последнего

begin

i:=i+1;

try

m[k]:=strtofloat(s1.Cells[i,st])*strtofloat(s2.Cells[i-1,1]);

except

APPLICATION.MessageBox('Не все поля заолнены',

'Ошибка',mb_iconHand +

mb_ok);

exit;

end;

sum:=sum+m[k];

end;

if abs(sum) < 1.0E-10 then

sum:=0;

if ((strtofloat(s1.Cells[n+1,st])-sum)>0.1) or

((strtofloat(s1.Cells[n+1,st])-sum)<-0.1) then

flag:=false;

end;

if flag=true then

APPLICATION.MessageBox('Правильно',

'Система решена',mb_iconAsterisk +mb_ok) else

APPLICATION.MessageBox('НЕправильно,

'Система решена',mb_iconExclamation +

mb_ok)

end;

end.

{----------------------------------------------------------------------------------------------------------------------}

//окно "О программе"

unit Unit3;

interface

uses

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

Dialogs, StdCtrls, Buttons, ExtCtrls, jpeg;

Type

TForm3 = class(TForm)

Image1: TImage;

StaticText1: TStaticText;

BitBtn1: TBitBtn;

Bevel1: TBevel;

procedure BitBtn1Click(Sender: TObject);

private

{ Private declarations }

Public

{ Public declarations }

end;

var

Form3: TForm3;

implementation

{$R *.dfm}

procedure TForm3.BitBtn1Click(Sender: TObject);

begin

form3.Close;

end;

end.

{----------------------------------------------------------------------------------------------------------------------}

//окно выбора цвета

unit Unit4;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls, Buttons, jpeg;

Type

TForm4 = class(TForm)

CheckBox1: TCheckBox;

BitBtn1: TBitBtn;

ColorDialog1: TColorDialog;

BitBtn2: TBitBtn;

Image1: TImage;

procedure BitBtn1Click(Sender: TObject);

procedure BitBtn2Click(Sender: TObject);

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

Y: Integer);

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

Y: Integer);

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

Y: Integer);

Private

{ Private declarations }

Public

{ Public declarations }

end;

var

Form4: TForm4;

Implementation

uses Unit2;

{$R *.dfm}

procedure TForm4.BitBtn1Click(Sender: TObject);

begin

if checkbox1.Checked then

begin

form2.Image2.Visible:=true;

form2.Image3.Visible:=true;

form2.s1.FixedColor:=clSkyBlue;

form2.s2.FixedColor:=clSkyBlue;

end

else

begin

form2.Image2.Visible:=false;

form2.Image3.Visible:=false;

form2.Panel1.Color:=ColorDialog1.Color;

form2.Panel2.Color:=ColorDialog1.Color;

form2.S1.FixedColor:=ColorDialog1.Color;

form2.S2.FixedColor:=ColorDialog1.Color;

end;

form4.Close;

end;

procedure TForm4.BitBtn2Click(Sender: TObject);

begin

if not ColorDialog1.Execute then

exit;

form2.Image2.Visible:=false;

form2.Image3.Visible:=false;

checkbox1.Checked:=false;

form2.Panel1.Color:=ColorDialog1.Color;

form2.Panel2.Color:=ColorDialog1.Color;

form2.S1.FixedColor:=ColorDialog1.Color;

form2.S2.FixedColor:=ColorDialog1.Color;

end;

procedure TForm4.BitBtn1MouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

BitBtn1.Font.Color:=clBlue;

end;

procedure TForm4.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

begin

BitBtn1.Font.Color:=clWindowText;

end;

BitBtn2.Font.Color:=clWindowText;

end;

procedure TForm4.BitBtn2MouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

BitBtn2.Font.Color:=clBlue;

end;

end.

{----------------------------------------------------------------------------------------------------------------------}

//окно печати

unit Unit5;

interface

uses

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

Dialogs, StdCtrls, Buttons, ComCtrls,Printers, jpeg, ExtCtrls, Menus;

Type

TForm5 = class(TForm)

RichEdit1: TRichEdit;

BitBtn1: TBitBtn;

BitBtn2: TBitBtn;

OpenDialog1: TOpenDialog;

PrintDialog1: TPrintDialog;

Image1: TImage;

PopupMenu1: TPopupMenu;

N1: TMenuItem;

procedure BitBtn1Click(Sender: TObject);

procedure BitBtn2Click(Sender: TObject);

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

Y: Integer);

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

Y: Integer);

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

Y: Integer);

procedure N1Click(Sender: TObject);

private

{ Private declarations }

Public

{ Public declarations }

end;

var

Form5: TForm5;

Implementation

{$R *.dfm}

procedure TForm5.BitBtn1Click(Sender: TObject);

begin //Открытие файла в RichEdit

if OpenDialog1.Execute then

try

RichEdit1.Lines.LoadFromFile(Opendialog1.FileName);

except

MessageDlg('Ошибка открытия файла',mtWarning,

[mbOK],1);

exit;

end;

end;

procedure TForm5.BitBtn2Click(Sender: TObject);

Var fo:textfile;

i:integer;

begin

if RichEdit1.Lines.Count=0 then

exit;

try

if not printDialog1.Execute then

exit;

except

APPLICATION.MessageBox('Не подключен принтер!',

'Warning',mb_iconExclamation +

mb_ok);

exit;

end;

begin

Assignprn(fo);

rewrite(fo);

Printer.Canvas.Font:=RichEdit1.Font;

for i:=0 to RichEdit1.Lines.Count-1 do

writeln (fo,RichEdit1.lines[i]);

closefile(fo);

end;

end;

procedure TForm5.BitBtn1MouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

BitBtn1.Font.Color:=clBlue;

end;

procedure TForm5.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

begin

BitBtn1.Font.Color:=clWindowText;

end;

BitBtn2.Font.Color:=clWindowText;

end;

procedure TForm5.BitBtn2MouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

BitBtn2.Font.Color:=clBlue;

end;

procedure TForm5.N1Click(Sender: TObject);

begin

RichEdit1.Clear;

end;

end.

Соседние файлы в предмете [НЕСОРТИРОВАННОЕ]