Приложение а
Листинг программы
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.