Добавил:

Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.

Вуз:

Белорусский государственный педагогический университет им. М. Танка

Предмет:

[НЕСОРТИРОВАННОЕ]

Файл:

Колобок.doc

Скачиваний:

Добавлен:

02.09.2019

Размер:

1.32 Mб

Скачать

☆

<<< < Предыдущая 12 / 22

5. Проверка и методика испытания

5.1. Область применения:

Данный программный продукт может быть применён на предприятиях, в которых необходимы экономические вычисления:

Элементы расчёта заработной платы, ведомость удержания, естественную убыль, процент выполнения плана, расчёт калорийности продукции, расчёт платёжной ведомости, счёт фактура.

5.2. Цель испытаний:

Проверить правильность вычислений, убедиться в том, что программа защищена от некорректного ввода данных, что в ней учтены все исключительные ситуации.

З аключение

Данный программный продукт был разработан в среде Delphi7, так как эта среда более понятна и проста из известных мне языков программирования.

Эта программа предназначена для вычисления арифметических выражений экономической информации.

Цель и задача были выполнены по возможности.

На данной стадии программный продукт завершён, но он может быть доработан и изменён по желанию пользователя.

Интерфейс в первой части программы представлен в виде списка, из которого пользователь выбирает определённый тип обрабатываемой таблицы. Интерфейс второй части программы представлен в виде самой таблицы, в которую вводятся данные и в которой сохраняются результаты вычислений, при этом вычисления производятся при переходе на следующую строчку или при нажатии на соответствующую кнопку «Вычислить».

Возникшие сложности были устранены.

Список литературы

Руководство Delphi для программиста. Архангельский

Учебный курс Delphi7. Фаронов В.В.

Прикладная информатика. Койпыш С.К.

Прикладная информатика. Практикум. Сочнёва С.В.

Бобровский В.А. Delphi 5. Начальный курс. - СПб., 1998

Рейсдорф Кент. Delphi 4. Освой самостоятельно. - М.:Бином, 1999

СОДЕРЖАНИЕ

Введение……………………………………………………………………...……3

1. Системное проектирование…………………..………………………..……..4

1.1. Постановка задачи…………………………………………………….……4

1.2. Структура программы…………………………………………………..….4

1.3.Информационная база задачи…………………………………………........4

1.4. Требования к аппаратному обеспечению……………………………...….4

1.5. Выбор программного средства………………………………………….…5

2. Постоянная информация………..………………………………..………...….6

3. Руководство пользователя…………………………………………….………7

4. Описание программы………………………………………….………...…...14

5. Проверка и методика испытания…………………………………..…....…..33

5.1. Область применения……………………………………………………...33

5.2. Цель испытаний……………………………………………………..…….33

Заключение…………………………………………………………….………...33

Список литературы……………………………………………………………...35

Приложение А…………………………………………………….……………. 36

Приложение Б

3.Описание программы

Описание процедур и функций, которые используются в программе:

function isEnteredFieldCorrect(st:string):boolean;

var i:byte;

begin

Result:=FALSE;

if length(st)<1 then exit;

for i:=1 to length(st) do

if not (st[i] in [#$30..#$39]) then exit;

Result:=TRUE;

end;

Данная функция проверяет, является ли введённое поле правильным.

procedure Tform2.calc_(y: word);

begin

case Tabletype of

0: begin

if (isEnteredFieldCorrect(StringGrid1.Cells[1,y]))

and (isEnteredFieldCorrect(StringGrid1.Cells[2,y]))

and (isEnteredFieldCorrect(StringGrid1.Cells[3,y]))

then begin

StringGrid1.Cells[4,y]:=

FloatToStr(StrToInt(StringGrid1.Cells[2,y])*

StrToInt(StringGrid1.Cells[3,y])/100);

StringGrid1.Cells[5,y]:=

FloatToStr(StrToInt(StringGrid1.Cells[2,y])*

StrToFloat(StringGrid1.Cells[4,y]))

end else begin

StringGrid1.Cells[4,y]:='введите значения';

StringGrid1.Cells[5,y]:= 'введите значения';

end;

1: begin

if (isEnteredFieldCorrect(StringGrid1.Cells[1,y]))

and (isEnteredFieldCorrect(StringGrid1.Cells[2,y]))

and (isEnteredFieldCorrect(StringGrid1.Cells[3,y]))

then begin

StringGrid1.Cells[4,y]:=

FloatToStr(StrToFloat(StringGrid1.Cells[1,y])+

StrToFloat(StringGrid1.Cells[2,y])+

StrToFloat(StringGrid1.Cells[3,y]));

end else begin

StringGrid1.Cells[4,y]:= 'введите значения';

end;

2: begin

if (isEnteredFieldCorrect(StringGrid1.Cells[2,y]))

and (isEnteredFieldCorrect(StringGrid1.Cells[3,y]))

then begin

StringGrid1.Cells[4,y]:=

FloatToStr(StrToFloat(StringGrid1.Cells[2,y])*

StrToFloat(StringGrid1.Cells[3,y])/100);

end else begin

StringGrid1.Cells[4,y]:= 'введите значения';

end;

3: begin

if (isEnteredFieldCorrect(StringGrid1.Cells[4,y]))

and (isEnteredFieldCorrect(StringGrid1.Cells[3,y]))

then begin

StringGrid1.Cells[5,y]:=

FloatToStr(StrToFloat(StringGrid1.Cells[4,y])/

StrToFloat(StringGrid1.Cells[3,y])*100);

end else begin

StringGrid1.Cells[5,y]:= 'введите значения';

end;

4: begin

if (isEnteredFieldCorrect(StringGrid1.Cells[2,y]))

and (isEnteredFieldCorrect(StringGrid1.Cells[3,y]))

then begin

StringGrid1.Cells[4,y]:=

FloatToStr(StrToFloat(StringGrid1.Cells[2,y])*

StrToFloat(StringGrid1.Cells[3,y]));

end else begin

StringGrid1.Cells[4,y]:= 'введите значения';

end;

5: begin

if (isEnteredFieldCorrect(StringGrid1.Cells[1,y]))

and (isEnteredFieldCorrect(StringGrid1.Cells[2,y]))

and (isEnteredFieldCorrect(StringGrid1.Cells[3,y]))

then begin

StringGrid1.Cells[4,y]:=

FloatToStr(StrToFloat(StringGrid1.Cells[1,y])+

StrToFloat(StringGrid1.Cells[2,y])+

StrToFloat(StringGrid1.Cells[3,y]));

if (isEnteredFieldCorrect(StringGrid1.Cells[5,y])) then begin

StringGrid1.Cells[6,y]:=

FloatToStr(StrToFloat(StringGrid1.Cells[4,y])-

StrToFloat(StringGrid1.Cells[5,y]));

end else StringGrid1.Cells[6,y]:= 'введите значения';

end else begin

StringGrid1.Cells[4,y]:= 'введите значения';

end;

В этой процедуре производится расчёт каждой таблицы.

procedure TForm2.WMNCHitTest(var M: TWMNCHitTest);

begin

if (M.YPos<(Form2.Top+55)) and(M.Result = htClient) then

M.Result := htCaption;

End;

Процедура взята из учебника «Mn3moLand(c)» inherited.

procedure TForm2.FormShow(Sender: TObject);

begin

capt_.Caption:=Form2.Caption;

case tableType of

0: begin

StringGrid1.RowCount:=2;

StringGrid1.ColCount:=6;

StringGrid1.Cells[0,0]:='табельный номер;roCols[0]:=FALSE;

StringGrid1.ColWidths[0]:=107;

StringGrid1.Cells[1,0]:='разряд';roCols[1]:=FALSE;

StringGrid1.ColWidths[1]:=46;

StringGrid1.Cells[2,0]:='зарплата руб.';roCols[2]:=FALSE;

StringGrid1.ColWidths[2]:=95;

StringGrid1.Cells[3,0]:='премия %';roCols[3]:=FALSE;

StringGrid1.ColWidths[3]:=70;

StringGrid1.Cells[4,0]:='премия в руб.';roCols[4]:=TRUE;

StringGrid1.ColWidths[4]:=95;

StringGrid1.Cells[5,0]:=’начисленная сумма';roCols[5]:=TRUE;

StringGrid1.ColWidths[5]:=120;

Width:=670;

end;

1: begin

StringGrid1.RowCount:=2; StringGrid1.ColCount:=5;

StringGrid1.Cells[0,0]:='табельный номер'; roCols[0]:=FALSE;

StringGrid1.ColWidths[0]:=107;

StringGrid1.Cells[1,0]:='аванс';roCols[1]:=FALSE;

StringGrid1.ColWidths[1]:=46;

StringGrid1.Cells[2,0]:='налог';roCols[2]:=FALSE;

StringGrid1.ColWidths[2]:=55;

StringGrid1.Cells[3,0]:='% удержания';roCols[3]:=FALSE;

StringGrid1.ColWidths[3]:=90;

StringGrid1.Cells[4,0]:='всего удержано';roCols[4]:=TRUE;

StringGrid1.ColWidths[4]:=115;

Width:=670;

end;

2: begin

StringGrid1.RowCount:=2; StringGrid1.ColCount:=5;

StringGrid1.Cells[0,0]:='номер п/п'; roCols[0]:=FALSE;

StringGrid1.ColWidths[0]:=100;

StringGrid1.Cells[1,0]:='наименование';roCols[1]:=FALSE;

StringGrid1.ColWidths[1]:=100;

StringGrid1.Cells[2,0]:='кол-во кг ';roCols[2]:=FALSE;

StringGrid1.ColWidths[2]:=95;

StringGrid1.Cells[3,0]:='норма убыли';roCols[3]:=FALSE;

StringGrid1.ColWidths[3]:=95;

StringGrid1.Cells[4,0]:='убыль';roCols[4]:=TRUE;

StringGrid1.ColWidths[4]:=95;

Width:=670;

end;

3: begin

StringGrid1.RowCount:=2; StringGrid1.ColCount:=6;

StringGrid1.Cells[0,0]:='месяц'; roCols[0]:=FALSE;

StringGrid1.ColWidths[0]:=100;

StringGrid1.Cells[1,0]:='ср.сут.т..';roCols[1]:=FALSE;

StringGrid1.ColWidths[1]:=100;

StringGrid1.Cells[2,0]:='выход за месяц';roCols[2]:=FALSE;

StringGrid1.ColWidths[2]:=110;

StringGrid1.Cells[3,0]:='по плану';roCols[3]:=FALSE;

StringGrid1.ColWidths[3]:=95;

StringGrid1.Cells[4,0]:='фактически';roCols[4]:=TRUE;

StringGrid1.ColWidths[4]:=95;

StringGrid1.Cells[5,0]:='% выполнения';roCols[5]:=TRUE;

StringGrid1.ColWidths[5]:=95;

Width:=670;

end;

4: begin

StringGrid1.RowCount:=2; StringGrid1.ColCount:=4;

StringGrid1.Cells[0,0]:='состав'; roCols[0]:=FALSE;

StringGrid1.ColWidths[0]:=80;

StringGrid1.Cells[1,0]:='% содержания';roCols[1]:=FALSE;

StringGrid1.ColWidths[1]:=100;

StringGrid1.Cells[2,0]:='калорийность';roCols[2]:=FALSE;

StringGrid1.ColWidths[2]:=150;

StringGrid1.Cells[3,0]:='калорийность 100 г';roCols[3]:=TRUE;

StringGrid1.ColWidths[3]:=200;

Width:=670;

end;

5: begin

StringGrid1.RowCount:=2; StringGrid1.ColCount:=7;

StringGrid1.Cells[0,0]:='табельный номер'; roCols[0]:=FALSE;

StringGrid1.ColWidths[0]:=100;

StringGrid1.Cells[1,0]:='поврем';roCols[1]:=FALSE;

StringGrid1.ColWidths[1]:=60;

StringGrid1.Cells[2,0]:='сдельно.';roCols[2]:=FALSE;

StringGrid1.ColWidths[2]:=65;

StringGrid1.Cells[3,0]:='свернур';roCols[3]:=FALSE;

StringGrid1.ColWidths[3]:=65;

StringGrid1.Cells[4,0]:='итого';roCols[4]:=TRUE;

StringGrid1.ColWidths[4]:=65;

StringGrid1.Cells[5,0]:='удержано';roCols[5]:=FALSE;

StringGrid1.ColWidths[5]:=95;

StringGrid1.Cells[6,0]:='к выдаче';roCols[6]:=TRUE;

StringGrid1.ColWidths[6]:=95;

Width:=750;

end;

Благодаря этой процедуре происходит расчерчивание таблицы и занисение названий колонок.

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

Shift: TShiftState);

begin

case tableType of

0: begin

if StringGrid1.Col<=3 then

if Key=13 then stringGrid1.Col:=stringGrid1.Col+1;

if StringGrid1.Col>3 then begin

if Key=13 then begin

calc_(StringGrid1.RowCount-1);

stringGrid1.RowCount:=stringGrid1.RowCount+1;

stringGrid1.Col:=0;

stringGrid1.Row:=stringGrid1.RowCount-1;

end;end;

end;

1: begin

if StringGrid1.Col<=3 then

if Key=13 then stringGrid1.Col:=stringGrid1.Col+1;

if StringGrid1.Col>3 then begin

if Key=13 then begin

calc_(StringGrid1.RowCount-1);

stringGrid1.RowCount:=stringGrid1.RowCount+1;

stringGrid1.Col:=0;

stringGrid1.Row:=stringGrid1.RowCount-1;

end;end;

end;

2: begin

if StringGrid1.Col<=3 then

if Key=13 then stringGrid1.Col:=stringGrid1.Col+1;

if StringGrid1.Col>3 then begin

if Key=13 then begin

calc_(StringGrid1.RowCount-1);

stringGrid1.RowCount:=stringGrid1.RowCount+1;

stringGrid1.Col:=0;

stringGrid1.Row:=stringGrid1.RowCount-1;

end;end;

end;

3: begin

if StringGrid1.Col<=4 then

if Key=13 then stringGrid1.Col:=stringGrid1.Col+1;

if StringGrid1.Col>4 then begin

if Key=13 then begin

calc_(StringGrid1.RowCount-1);

stringGrid1.RowCount:=stringGrid1.RowCount+1;

stringGrid1.Col:=0;

stringGrid1.Row:=stringGrid1.RowCount-1;

end;end;

end;

4: begin

if StringGrid1.Col<=2 then

if Key=13 then stringGrid1.Col:=stringGrid1.Col+1;

if StringGrid1.Col>2 then begin

if Key=13 then begin

calc_(StringGrid1.RowCount-1);

stringGrid1.RowCount:=stringGrid1.RowCount+1;

stringGrid1.Col:=0;

stringGrid1.Row:=stringGrid1.RowCount-1;

end;end;

end;

5: begin

if StringGrid1.Col>=5 then begin

if Key=13 then begin

calc_(StringGrid1.RowCount-1);

stringGrid1.RowCount:=stringGrid1.RowCount+1;

stringGrid1.Col:=0;

stringGrid1.Row:=stringGrid1.RowCount-1; exit;

end;end;

if StringGrid1.Col=3 then if Key=13 then stringGrid1.Col:=5;

if StringGrid1.Col<=3 then if Key=13 then stringGrid1.Col:=stringGrid1.Col+1;

end;

Cnt.Caption:=IntToStr(StringGrid1.RowCount-1);

end;

Данная процедура производит перемещение вправо/влево по нажатой клавише ENTER, а если колонка последняя, то перемещение на новую строку и расчёт введённых параметров.

procedure TForm2.BitBtn5Click(Sender: TObject);

begin

Close;

end;

Благодаря этой процедуре происходит выход из данной таблицы.

procedure TForm2.BT_Clear(Sender: TObject);

var i,j: integer;

begin

for i:=0 to stringgrid1.ColCount do

for j:=1 to stringgrid1.RowCount do

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

end;

procedure TForm2.BTCalcClick(Sender: TObject);

var i: integer;

begin

for i:=1 to StringGrid1.RowCount do calc_(i);

Cnt.Caption:=IntToStr(StringGrid1.RowCount-1);

end;

Кнопка «расчет».

procedure TForm2.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

begin

if roCols[aCol] then

with Sender as TStringGrid do begin

Canvas.Brush.Color := $00886633{Color};

Canvas.Font.Color := clwhite{Font.Color};

Canvas.TextRect(Rect, Rect.Left+2, Rect.Top+2, Cells[ACol, ARow]);

END;

end;

procedure TForm2.BTSaveTBLClick(Sender: TObject);

type Trow1=string[30];

var f: file of Trow1;

i,j: integer;

row1:Trow1;

begin

savedialog1.Filter:='Таблица "TBL"|*.TBL';

savedialog1.FileName:='табличные данные 1.TBL';

savedialog1.DefaultExt:='TBL';

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

if savedialog1.Execute then begin

if ExtractFileExt(savedialog1.FileName)<>'.TBL' then

savedialog1.FileName:=savedialog1.FileName+'.TBL';

if FileExists(savedialog1.Filename) then begin

if MessageDlg('Файл уже существует.'+#13+'Перезаписать ?',mtConfirmation,

[mbYes]+[mbNo], 1)= mrNo then Exit;

end;

AssignFile(f,savedialog1.Filename);

rewrite(f);

for i:=1 to StringGrid1.RowCount do begin

for j:=0 to StringGrid1.ColCount do begin

row1:=StringGrid1.Cells[j,i];

if not roCols[j] then

write(f,row1);

end;

closeFile(f);

end;

В этой процедуре происходят такие действия, как: отображение диалога сохранения таблицы в текстовый файл, выдача сообщения, перезапись и открытие файла для записи, а так же повторный расчёт таблиц.

procedure TForm2.BT_SAVE_TXTClick(Sender: TObject);

var

f: textFile;

i,j,k: integer;

off1: array [0..99] of byte;

begin

savedialog1.Filter:='*.TXT|*.TXT';

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

If savedialog1.Execute then begin

if ExtractFileExt(savedialog1.FileName)<>'.TXT' then

savedialog1.FileName:=savedialog1.FileName+'.TXT';

If FileExists(savedialog1.Filename) then begin

if MessageDlg('Файл уже существует.'+#13+'Перезаписать ?',mtConfirmation,

[mbYes]+[mbNo], 1)= mrNo then Exit;

end;

for j:=0 to StringGrid1.ColCount do off1[j]:=0;

for i:=0 to StringGrid1.RowCount do

for j:=0 to StringGrid1.ColCount do begin

if off1[j]<Length(StringGrid1.Cells[j,i]) then

off1[j]:=Length(StringGrid1.Cells[j,i]);

end;

AssignFile(f,savedialog1.Filename);

rewrite(f);

writeln(f,' таблица:"'+capt_.caption+'"');

write(f,' ');

for j:=0 to StringGrid1.ColCount do

for i:=0 to off1[j]+1 do write(f,'-');

writeln(f);

for i:= 0 to StringGrid1.RowCount do begin

for j:=0 to StringGrid1.ColCount do begin

write(f,'|'+StringGrid1.Cells[j,i]);

for k:=0 to off1[j]-Length(StringGrid1.Cells[j,i]) do begin

write(f,' ');

end;

writeln(f);

end;

write(f,' ');

for j:=0 to StringGrid1.ColCount do

for i:=0 to off1[j]+1 do write(f,'-');

writeln(f);

CloseFile(f);

end;

Процедура сохранения таблицы в текстовый файл, отображение диалога сохранения файла таблицы, перезапись, расчёт максимальной длинны колонок, обнуление массивов «отступов» для каждой из колонок, запись в файл заглавия таблицы.

procedure TForm2.DelRowClick(Sender: TObject);

var

i,j: integer;

begin

if StringGrid1.RowCount < 3 then exit;

for i:= StringGrid1.Row to StringGrid1.RowCount do

for j:=0 to StringGrid1.ColCount do begin

StringGrid1.Cells[j,i]:=StringGrid1.Cells[j,i+1];

end;

StringGrid1.RowCount:=StringGrid1.RowCount-1;

if StringGrid1.Row>1 then StringGrid1.Row:=StringGrid1.Row-1;

end;

Кнопка «удалить строку».

procedure TForm2.BTOpenTBLClick(Sender: TObject);

type Trow1=string[30];

var f: file of Trow1;

i,j: integer;

Row1:Trow1;

begin

OpenDialog1.Filter:='Таблица "TBL"|*.TBL';

OpenDialog1.FileName:='табличные данные 1.TBL';

OpenDialog1.DefaultExt:='TBL';

OpenDialog1.Title:='Открыть данные для таблицы из файла "TBL"...';

if OpenDialog1.Execute then begin

If Not( FileExists(OpenDialog1.Filename)) then begin

MessageDlg('Ошибка при открытии файла',mtError,[mbCancel], 1);

Exit;

end;

BT_Clear(Sender);

AssignFile(f,OpenDialog1.Filename);

reset(f);

j:=1;

i:=0;

row1:='';

repeat

read(f,row1);

StringGrid1.Cells[i,j]:=row1;

repeat

if i< stringGrid1.ColCount then

i:=i+1 else begin j:=j+1; i:=0; end;

until not roCols[i];

until eof(f);

stringGrid1.RowCount:=j+1;

closeFile(f);

end;

Открытие данных для таблицы из файла “TBL” файлы, закрытие файла.

procedure TForm2.BTOpenTXTClick(Sender: TObject);

var f: TextFile;

i,j,k: integer;

st,temp: string[255];

begin

OpenDialog1.Filter:='Таблица "TXT"|*.TXT';

OpenDialog1.FileName:='табличные данные 1.TXT';

OpenDialog1.DefaultExt:='TXT';

OpenDialog1.Title:='Открыть данные для таблицы из файла "TXT"...';

if OpenDialog1.Execute then begin

If Not( FileExists(OpenDialog1.Filename)) then begin

MessageDlg('Ошибка при открытии файла',mtError,[mbCancel], 1);

Exit;

end;

BT_Clear(Sender);

AssignFile(f,OpenDialog1.Filename);

reset(f);

j:=1;

i:=0;

st:='';

readln(f,st);

repeat

readln(f,st);

temp:='';

for k:=1 to length(st) do begin

if st[k] in ['0'..'9',','] then begin

temp:=temp+st[k];

end else begin

if temp>'' then begin

stringGrid1.RowCount:=j+2;

StringGrid1.Cells[i,j]:=temp;

if i< stringGrid1.ColCount then

i:=i+1 else begin break; end;

temp:='';

end;

j:=j+1; i:=0;

until eof(f);

stringGrid1.RowCount:=j+1;

closeFile(f);

end;

Процедура для отображения “TBL” файлов.

procedure TForm2.BTCloseClick(Sender: TObject);

begin

Close;

end;

Закрытие.

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

begin

case MessageDlg('Хотите сохранить таблицу ?',mtConfirmation,

[mbYes]+[mbNo]+[mbCancel], 1) of

mrNo: ;

mrYes: BTSaveTBLClick(Sender);

mrCancel: exit;

end;

BT_Clear(Sender);

end;

Процедура, которая обеспечивает выход из таблицы, выдача сообщения, очистка таблицы.

procedure TForm2.N8Click(Sender: TObject);

begin

Panel1.Visible:=N8.Checked;

end;

procedure TForm2.N7Click(Sender: TObject);

begin

Panel2.Visible:=N7.Checked;

end;

procedure TForm2.x1Click(Sender: TObject);

begin

BT_Clear(Sender);

StringGrid1.RowCount:=2;

end;

procedure TForm2.N10Click(Sender: TObject);

begin

showMessage('Таблица рассчитывается по формуле колонок:'+#13+

Formula_kolonok[tableType]);

end;

end.

Листинг

// КУРСОВОЙ ПРОЕКТ //

// //

// Козловской Т.Л. (группа 213) 2006 год //

//______________________________________________________________//

program kurs;

uses Forms,

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

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

PreUnit in 'PreUnit.pas',

// предварительное окно выбора стиля интерфейса.

MainUnit in 'MainUnit.pas',

// главное окно "выбора таблиц"

Tables in 'Tables.pas',

// окно с самой таблицей

About in 'About.pas';

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

{$R kurs.res}

// подключение ресурсов (в данном случае - одной иконки)

begin

Application.Initialize;

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

Application.Title := 'Курсовой проект';

// изменения названия окна

Application.CreateForm(TPreForm, PreForm);

// создание "предварительного" окна (окна выбора стиля интерфейса)

Application.Run;

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

end.

// предварительное окно выбора стиля интерфейса. //

unit PreUnit;

interface

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

Dialogs, ExtCtrls, StdCtrls, Buttons, MainUnit, Tables, About;

type TPreForm = class(TForm)

Image1: TImage;

STYLE0: TRadioButton;

STYLE1: TRadioButton;

Label1: TLabel;

CBAlpha: TCheckBox;

Bevel1: TBevel;

Bevel2: TBevel;

Shape1: TShape;

BT01: TPanel;

Image2: TImage;

CBBSClear: TCheckBox;

procedure STYLE1Click(Sender: TObject);

procedure STYLE0Click(Sender: TObject);

procedure BT01Click(Sender: TObject);

procedure BT01MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

end;

var

PreForm: TPreForm;

implementation

{$R *.dfm}

procedure TPreForm.STYLE1Click(Sender: TObject);

begin Style0.Checked:= not Style1.Checked;

CBAlpha.Enabled:= not Style0.Checked;

end;

procedure TPreForm.STYLE0Click(Sender: TObject);

begin Style1.Checked:= not Style0.Checked;

CBAlpha.Enabled:= not Style0.Checked;

end;

procedure TPreForm.BT01Click(Sender: TObject);

begin

Application.CreateForm(TMainForm, MainForm);

Application.CreateForm(TForm2, Form2);

Application.CreateForm(TForm3, Form3);

PreForm.Hide;

if style1.Checked then begin

MainForm.Image1.Visible:=TRUE;

MainForm.Image2.Visible:=TRUE;

MainForm.ST0BACK.Visible:=FALSE;

MainForm.ST0NEXT.Visible:=FALSE;

MainForm.BorderStyle:=bsNone;

MainForm.Height:=262;

MainForm.Width:=616;

if CBBsClear.Checked then MainForm.Brush.Style:=bsClear;

MainForm.TransparentColor:=TRUE;

if CBAlpha.Checked then begin

MainForm.AlphaBlend:=TRUE;

MainForm.AlphaBlendValue:=240;

end;

MainForm.Show;

end else begin

if CBBsClear.Checked then MainForm.Brush.Style:=bsClear;

MainForm.Image1.Visible:=FALSE;

MainForm.Image2.Visible:=FALSE;

MainForm.ST0BACK.Visible:=TRUE;

MainForm.ST0NEXT.Visible:=TRUE;

MainForm.BorderStyle:=bsSingle;

MainForm.Width:=616;

MainForm.Height:=262;

MainForm.Color:=$00FF8080;

MainForm.Show;

if CBAlpha.Checked then begin

MainForm.AlphaBlend:=TRUE;

MainForm.AlphaBlendValue:=240;

end;

procedure TPreForm.BT01MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

BT01.BevelInner:=bvLowered;

end;

end.

// главное окно "выбора таблиц" //

// //

unit MainUnit;

interface

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

Dialogs, ExtCtrls, StdCtrls, Buttons, Tables, About;

type

TMainForm = class(TForm)

Label1: TLabel;

Image1: TImage;

image2: TImage;

logo_second: TImage;

ListBox1: TListBox;

Bevel1: TBevel;

show__: TTimer;

hide__: TTimer;

show2_: TTimer;

hide2_: TTimer;

BitBtn4: TLabel; // надпись "о программе" в виде кнопки

ST1NEXT: TImage;

ST1BACK: TImage;

ST0BACK: TBitBtn;

ST0NEXT: TBitBtn;

procedure FormShow(Sender: TObject);

procedure BitBtn21Click(Sender: TObject);

procedure BitBtn3Click(Sender: TObject);

procedure show__Timer(Sender: TObject);

procedure BitBtn11Click(Sender: TObject);

procedure hide__Timer(Sender: TObject);

procedure BitBtn41Click(Sender: TObject);

procedure ST1NEXTMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure ST1NEXTMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure ST1BACKMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure ST1BACKMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure image2MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure proc_page_move(p:integer);

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

procedure show2_Timer(Sender: TObject);

procedure hide2_Timer(Sender: TObject);

end;

const

// массив описаний таблиц (6 таблиц)

hlptit: array[0..5] of string[200]=

// 0Ведомость начисления заработной платы

('преднозначена для расчёта ' +#13+

'начисления заработной платы ' +#13+

'по разряду и проценту преммии' ,

// 1Ведомость удержания

'преднозначена для расчёта ' +#13+

'удержания по размеру аванса ' +#13+

'проценту удержания и налогу. ' ,

// 2Естественная убыль

'преднозначена для расчёта ' +#13+

'естественной убыли предприятия.',

// 3Процент выполнения плана

'преднозначена для расчёта ' +#13+

'процета выполнения плана по ' +#13+

'факт. и плановому соотношению.' ,

// 4Расчёт калорийности продукции

'преднозначена для расчёта ' +#13+

'каллорийности продукции по про-' +#13+

'центу соотношения веществ. ' ,

// 5Расчёт платёжной ведомости

'преднозначена для расчёта ' +#13+

'платёжной ведомости по стандарту' +#13+

'предприятия для выдачи зарплат.');

// Для создания эффекта "выползания" букв с обоих краёв окна, необходимо

// создать каждую букву в отдельный объект TLabel и постепенно менять свойства

// "visible" (с обоих краёв) на TRUE.

type TcLet=record

// тип записи которорый содержит букву(или буквы) и её позицию на экране

lab: Tlabel; // "метка"

end;

// тип записи которорый содержит динамический массив "записей" букв

// или просто тип данных: "строчка выплываемого по букве текста".

type cLet=record//cLet - это значит "Collecton Letters" тоесть множество меток

t:array of TcLet;

visible: shortint;

end;

type TTEXT=array [1..2] of cLet;

var

MainForm: TMainForm; // главное окно (!)

logo1: Timage; // фоновый рисунок

Text1: TText; // 1 строчка текста состоящего из дин. букв

page: byte=1; // текущая "закладка"

tit1,tit2: string[200];

implementation

{$R *.dfm}

procedure init_cLabels(var cL:cLet;st:string;x,y:word);

var t: word;

begin

setLength(cL.t,length(st)+1);

for t:=1 to length(st) do begin

cL.t[t].lab:=Tlabel.Create(MainForm);

cL.t[t].lab.Parent:=MainForm;

cL.t[t].lab.Font.Name:='Lucida Console';

cL.t[t].lab.Font.Color:=$00FFEEEE;

cL.t[t].lab.Font.size:=11;

cL.t[t].lab.Transparent:=TRUE;

cL.t[t].lab.Font.Style:= [fsBold];

cL.t[t].lab.visible:=FALSE;

cL.t[t].lab.Left:=x+t*9;

cL.t[t].lab.top:=y;

cL.t[t].lab.Caption:=copy(st,t,1);

end;

cL.visible:=0; // устанавливаем текущий видимый символ

end;

procedure kill_cLabels(var cL:cLet;st:string);

var t:byte;

begin //уничтожение букв без проверки( так как мы знаем что они есть )

for t:=1 to length(st) do

cL.t[t].lab.Free;

SetLength(cl.t,0);

cl.visible:=-1;// этим мы говорим что переменная запись уничтожена.

end;

procedure TMainForm.FormShow(Sender: TObject);

begin

Listbox1.ItemIndex:=0;

{ MainForm.Brush.Style:=bsClear;

MainForm.TransparentColor:=TRUE;}

{form1.Color:=0;}

{ form1.TransparentColorValue:=0;}

{form1.GetFormImage.LoadFromFile('logo_.bmp');}

{ Form1.Show; }

{ init_cLabels(cLetters, tit1,8,24);{logo_.bmp}

init_cLabels(Text1[1], tit1,48,24);

init_cLabels(Text1[2], tit2,48,24);

MainForm.show__.enabled:=TRUE;

proc_page_move(page);

{shiftColors.Enabled:=TRUE;}

end;

procedure TMainForm.proc_page_move(p:integer);

// процедура в теле которой предусмотренно перемещение по закладкам таблицы

// которые реализованы по принципу проверки "видимости" тех элементов, что

// должны присутствовать. переменная PAGE - это идентефикатор текущей страницы.

begin

case p of

1: begin

ST1BACK.Visible:=FALSE; // кнопка "назад" невидимая

listBox1.Visible:=FALSE;// список таблиц невидимый

label1.visible:=False; // описание таблицы невидимое

bevel1.visible:=False; // ...

end;

2: begin

listBox1.Visible:=TRUE;

logo_second.Visible:=FALSE;

ST1BACK.Enabled:=TRUE;

ST1BACK.Visible:=TRUE;

label1.visible:=False;

bevel1.visible:=False;

hide__.enabled:=TRUE;

show2_.enabled:=TRUE;

end;

3: begin

ST1BACK.Enabled:=TRUE;

listBox1.Visible:=FALSE;

label1.visible:=True;

bevel1.visible:=True;

label1.Caption:=listbox1.Items.Strings[listbox1.ItemIndex];

label1.Caption:=label1.Caption+#13+

hlptit[listbox1.ItemIndex];

logo_second.Visible:=TRUE;

end;

4..10: begin // отображение самой таблицы .

tableType:=listbox1.ItemIndex;// обязательная связка с юнимтом таблицы (!)

Form2.Caption:=listbox1.Items.Strings[listbox1.ItemIndex];

Form2.Position:=poScreenCenter;

Form2.show;

p:=3;

end;

procedure TMainForm.BitBtn21Click(Sender: TObject);

begin

inc(page);

proc_page_move(page);

end;

procedure TMainForm.BitBtn3Click(Sender: TObject);

begin

Application.Terminate;

end;

procedure TMainForm.show__Timer(Sender: TObject);

var curr, end_t: integer;

begin

inc(Text1[1].visible); curr:=Text1[1].visible;

end_t:=round((HIGH (Text1[1].t))/2);

if Text1[1].visible <= end_t then begin

Text1[1].t[Text1[1].visible ].lab.visible:=TRUE;

Text1[1].t[end_t*2-Text1[1].visible+1].lab.visible:=TRUE;

end else show__.Enabled:=FALSE;

end;

procedure TMainForm.show2_Timer(Sender: TObject);

var curr, end_t: byte;

begin

inc(Text1[2].visible); curr:=Text1[2].visible;

end_t:=round((HIGH (Text1[2].t))/2);

if Text1[2].visible <= end_t then begin

Text1[2].t[Text1[2].visible ].lab.visible:=TRUE;

Text1[2].t[end_t*2-Text1[2].visible+1].lab.visible:=TRUE;

end else show2_.Enabled:=FALSE;

end;

procedure TMainForm.BitBtn11Click(Sender: TObject);

begin

if page>1 then dec (page);

proc_page_move(page);

end;

procedure TMainForm.hide__Timer(Sender: TObject);

var curr, end_t: byte;

begin

show__.Enabled:=FALSE;

dec(Text1[1].visible);

curr:=Text1[1].visible;

end_t:=round((HIGH (Text1[1].t))/2);

if Text1[1].visible >=1 then begin

Text1[1].t[Text1[1].visible].lab.visible:=FALSE;

Text1[1].t[end_t*2-Text1[1].visible+1].lab.visible:=FALSE;

end else

{ kill_cLabels(cLetters,tit1);}

hide__.Enabled:=FALSE;

end;

procedure TMainForm.hide2_Timer(Sender: TObject);

var curr, end_t: byte;

begin

show2_.Enabled:=FALSE;

dec(Text1[2].visible);

curr:=Text1[2].visible;

end_t:=round((HIGH (Text1[1].t))/2);

if Text1[2].visible >=1 then begin

Text1[2].t[Text1[2].visible].lab.visible:=FALSE;

Text1[2].t[end_t*2-Text1[2].visible+1].lab.visible:=FALSE;

end else

{ kill_cLabels(cLetters,tit1); }

hide__.Enabled:=FALSE;

end;

procedure TMainForm.BitBtn41Click(Sender: TObject);

begin // при нажатии на кнопку "О программе"

Form3.showModal; // отображение модального окна с сообщением

end;

procedure TMainForm.ST1NEXTMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

ST1NEXT.Left:= 393;

end;

procedure TMainForm.ST1NEXTMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

ST1NEXT.Left:= 390;

end;

procedure TMainForm.ST1BACKMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

ST1BACK.Left:= 310;

end;

procedure TMainForm.ST1BACKMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

ST1BACK.Left:= 307;

end;

procedure TMainForm.image2MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

Image2.Left:=455;

end;

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

begin

Application.Terminate;

end;

initialization

tit1:='Добро пожаловать в генератор таблиц ведомостей';

tit2:=' Выберете тип отображаемой таблицы: ';

{ CLetters_cur_show:=0;}

//Добро пожаловать в генер|атор таблиц ведомостей'

page:=1;

end.

// окно с самой таблицей //

// //

Unit Tables;

interface

uses

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

Dialogs, StdCtrls, Buttons, ToolWin, ComCtrls, Grids, ExtCtrls, Menus;

type TForm2 = class(TForm)

StringGrid1: TStringGrid;

BTOpenTBL: TBitBtn;

BTSaveTBL: TBitBtn;

BTClose: TBitBtn;

Image1: TImage;

capt_: TLabel;

Bevel1: TBevel;

Label1: TLabel;

Cnt: TLabel;

SaveDialog1: TSaveDialog;

OpenDialog1: TOpenDialog;

Panel1: TPanel;

Image2: TImage;

Panel2: TPanel;

ClearAll: TBitBtn;

DelRow: TBitBtn;

BTOpenTXT: TBitBtn;

MainMenu1: TMainMenu;

z1: TMenuItem;

x1: TMenuItem;

c1: TMenuItem;

v1: TMenuItem;

N1: TMenuItem;

BL1: TMenuItem;

N2: TMenuItem;

BL2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

N5: TMenuItem;

N6: TMenuItem;

N7: TMenuItem;

N8: TMenuItem;

N9: TMenuItem;

N10: TMenuItem;

BTSaveTXT: TBitBtn;

BT_calc: TBitBtn;

N11: TMenuItem;

procedure FormShow(Sender: TObject);

procedure StringGrid1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

procedure BitBtn5Click(Sender: TObject);

procedure BT_Clear(Sender: TObject);

procedure BTCalcClick(Sender: TObject);

procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;Rect: TRect; State: TGridDrawState);

procedure BTSaveTBLClick(Sender: TObject);

procedure BT_SAVE_TXTClick(Sender: TObject);

procedure DelRowClick(Sender: TObject);

procedure BTOpenTBLClick(Sender: TObject);

procedure BTCloseClick(Sender: TObject);

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

procedure N8Click(Sender: TObject);

procedure N7Click(Sender: TObject);

procedure x1Click(Sender: TObject);

procedure BTOpenTXTClick(Sender: TObject);

procedure N10Click(Sender: TObject);

private

// процедура взятая из справочника для обработки сообщений

// о нажатой клавише мыши на картинке с надписью и возможность

// "перетаскивать" за эту картинку всё окно.

procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;

public

procedure calc_(y: word);

end;

const

formula_kolonok: array[0..5] of string[40]=

(' 4 = 2 * 3 / 100', // 0

' 4 = 1 + 2 + 3 ',

' 4 = 2 * 3 / 100',

' 5 = 4 / 3 * 100',

' 4 = 2 * 3 ',

' 4 = 1 + 2 + 3 '+#13+

' 6 = 4 - 5');

var

Form2: TForm2;

tableType: byte;

roCOLs: array [0..99] of boolean;

implementation

{$R *.dfm}

function isEnteredFieldCorrect(st:string):boolean;

var i:byte;

begin

Result:=FALSE;

if length(st)<1 then exit;

for i:=1 to length(st) do

if not (st[i] in [#$30..#$39]) then exit;

Result:=TRUE;

end;

procedure Tform2.calc_(y: word);

begin

case Tabletype of

0: begin

if (isEnteredFieldCorrect(StringGrid1.Cells[1,y]))

and (isEnteredFieldCorrect(StringGrid1.Cells[2,y]))

and (isEnteredFieldCorrect(StringGrid1.Cells[3,y]))

then begin

StringGrid1.Cells[4,y]:=

FloatToStr(StrToInt(StringGrid1.Cells[2,y])*

StrToInt(StringGrid1.Cells[3,y])/100);

StringGrid1.Cells[5,y]:=

FloatToStr(StrToInt(StringGrid1.Cells[2,y])*

StrToFloat(StringGrid1.Cells[4,y]))

end else begin

StringGrid1.Cells[4,y]:='введите значения';

StringGrid1.Cells[5,y]:='введите значения';

end;

1: begin

if (isEnteredFieldCorrect(StringGrid1.Cells[1,y]))

and (isEnteredFieldCorrect(StringGrid1.Cells[2,y]))

and (isEnteredFieldCorrect(StringGrid1.Cells[3,y]))

then begin

StringGrid1.Cells[4,y]:=

FloatToStr(StrToFloat(StringGrid1.Cells[1,y])+

StrToFloat(StringGrid1.Cells[2,y])+

StrToFloat(StringGrid1.Cells[3,y]));

end else begin

StringGrid1.Cells[4,y]:='введите значения';

end;

2: begin

if (isEnteredFieldCorrect(StringGrid1.Cells[2,y]))

and (isEnteredFieldCorrect(StringGrid1.Cells[3,y]))

then begin

StringGrid1.Cells[4,y]:=

FloatToStr(StrToFloat(StringGrid1.Cells[2,y])*

StrToFloat(StringGrid1.Cells[3,y])/100);

end else begin

StringGrid1.Cells[4,y]:='введите значения';

end;

3: begin

if (isEnteredFieldCorrect(StringGrid1.Cells[4,y]))

and (isEnteredFieldCorrect(StringGrid1.Cells[3,y]))

then begin

StringGrid1.Cells[5,y]:=

FloatToStr(StrToFloat(StringGrid1.Cells[4,y])/

StrToFloat(StringGrid1.Cells[3,y])*100);

end else begin

StringGrid1.Cells[5,y]:='введите значения';

end;

4: begin

if (isEnteredFieldCorrect(StringGrid1.Cells[2,y]))

and (isEnteredFieldCorrect(StringGrid1.Cells[3,y]))

then begin

StringGrid1.Cells[4,y]:=

FloatToStr(StrToFloat(StringGrid1.Cells[2,y])*

StrToFloat(StringGrid1.Cells[3,y]));

end else begin

StringGrid1.Cells[4,y]:='введите значения';

end;

5: begin

if (isEnteredFieldCorrect(StringGrid1.Cells[1,y]))

and (isEnteredFieldCorrect(StringGrid1.Cells[2,y]))

and (isEnteredFieldCorrect(StringGrid1.Cells[3,y]))

then begin

StringGrid1.Cells[4,y]:=

FloatToStr(StrToFloat(StringGrid1.Cells[1,y])+

StrToFloat(StringGrid1.Cells[2,y])+

StrToFloat(StringGrid1.Cells[3,y]));

if (isEnteredFieldCorrect(StringGrid1.Cells[5,y])) then begin

StringGrid1.Cells[6,y]:=

FloatToStr(StrToFloat(StringGrid1.Cells[4,y])-

StrToFloat(StringGrid1.Cells[5,y]));

end else StringGrid1.Cells[6,y]:='введите значения';

end else begin

StringGrid1.Cells[4,y]:='введите значения';

end;

{ (' 4 = 2 * 3 / 100', 0

' 4 = 1 + 2 + 3 ', 1

' 4 = 2 * 3 / 100', 2

' 5 = 4 / 3 * 100', 3

' 4 = 2 * 3 ', 4

' 4 = 1 + 2 + 3 '+#13+ 5

' 6 = 4 - 5'); }

end;

procedure TForm2.WMNCHitTest(var M: TWMNCHitTest);

begin // процедура взята из учебника "Mn3m0Land(c)"//

inherited; //

if (M.YPos<(Form2.Top+55)) and(M.Result = htClient) then

M.Result := htCaption; //

end; // //

procedure TForm2.FormShow(Sender: TObject);

begin

capt_.Caption:=Form2.Caption;

case tableType of

0: begin // ведомость начисления зароботной платы

StringGrid1.RowCount:=2;

StringGrid1.ColCount:=6;

StringGrid1.Cells[0,0]:='табельный номер';roCols[0]:=FALSE;

StringGrid1.ColWidths[0]:=107;

StringGrid1.Cells[1,0]:='разряд';roCols[1]:=FALSE;

StringGrid1.ColWidths[1]:=46;

StringGrid1.Cells[2,0]:='зарплата в руб.';roCols[2]:=FALSE;

StringGrid1.ColWidths[2]:=95;

StringGrid1.Cells[3,0]:='премия в %';roCols[3]:=FALSE;

StringGrid1.ColWidths[3]:=70;

StringGrid1.Cells[4,0]:='премия в руб.';roCols[4]:=TRUE;

StringGrid1.ColWidths[4]:=95;

StringGrid1.Cells[5,0]:='Начисленная сумма';roCols[5]:=TRUE;

StringGrid1.ColWidths[5]:=120;

Width:=670;

end;

1: begin // ведомость удержания

StringGrid1.RowCount:=2; StringGrid1.ColCount:=5;

StringGrid1.Cells[0,0]:='табельный номер'; roCols[0]:=FALSE;

StringGrid1.ColWidths[0]:=107;

StringGrid1.Cells[1,0]:='аванс';roCols[1]:=FALSE;

StringGrid1.ColWidths[1]:=46;

StringGrid1.Cells[2,0]:='налог';roCols[2]:=FALSE;

StringGrid1.ColWidths[2]:=55;

StringGrid1.Cells[3,0]:='% удержания';roCols[3]:=FALSE;

StringGrid1.ColWidths[3]:=90;

StringGrid1.Cells[4,0]:='Всего удержано';roCols[4]:=TRUE;

StringGrid1.ColWidths[4]:=115;

Width:=670;

end;

2: begin

StringGrid1.RowCount:=2; StringGrid1.ColCount:=5;

StringGrid1.Cells[0,0]:='номер п/п'; roCols[0]:=FALSE;

StringGrid1.ColWidths[0]:=100;

StringGrid1.Cells[1,0]:='наименование';roCols[1]:=FALSE;

StringGrid1.ColWidths[1]:=100;

StringGrid1.Cells[2,0]:='кол-во кг';roCols[2]:=FALSE;

StringGrid1.ColWidths[2]:=95;

StringGrid1.Cells[3,0]:='норма убыли';roCols[3]:=FALSE;

StringGrid1.ColWidths[3]:=95;

StringGrid1.Cells[4,0]:='убыль';roCols[4]:=TRUE;

StringGrid1.ColWidths[4]:=95;

Width:=670;

end;

3: begin

StringGrid1.RowCount:=2; StringGrid1.ColCount:=6;

StringGrid1.Cells[0,0]:='месяц'; roCols[0]:=FALSE;

StringGrid1.ColWidths[0]:=100;

StringGrid1.Cells[1,0]:='ср.сут.т.';roCols[1]:=FALSE;

StringGrid1.ColWidths[1]:=100;

StringGrid1.Cells[2,0]:='выход за мес';roCols[2]:=FALSE;

StringGrid1.ColWidths[2]:=110;

StringGrid1.Cells[3,0]:='по плану';roCols[3]:=FALSE;

StringGrid1.ColWidths[3]:=95;

StringGrid1.Cells[4,0]:='фактически';roCols[4]:=TRUE;

StringGrid1.ColWidths[4]:=95;

StringGrid1.Cells[5,0]:='% выполнения';roCols[5]:=TRUE;

StringGrid1.ColWidths[5]:=95;

Width:=670;

end;

4: begin

StringGrid1.RowCount:=2; StringGrid1.ColCount:=4;

StringGrid1.Cells[0,0]:='состав'; roCols[0]:=FALSE;

StringGrid1.ColWidths[0]:=80;

StringGrid1.Cells[1,0]:='% сожержания';roCols[1]:=FALSE;

StringGrid1.ColWidths[1]:=100;

StringGrid1.Cells[2,0]:='калорийность 1г';roCols[2]:=FALSE;

StringGrid1.ColWidths[2]:=150;

StringGrid1.Cells[3,0]:='калорийность 100г';roCols[3]:=TRUE;

StringGrid1.ColWidths[3]:=200;

Width:=670;

end;

5: begin

StringGrid1.RowCount:=2; StringGrid1.ColCount:=7;

StringGrid1.Cells[0,0]:='табелный номер'; roCols[0]:=FALSE;

StringGrid1.ColWidths[0]:=100;

StringGrid1.Cells[1,0]:='поврем.';roCols[1]:=FALSE;

StringGrid1.ColWidths[1]:=60;

StringGrid1.Cells[2,0]:='сдельно.';roCols[2]:=FALSE;

StringGrid1.ColWidths[2]:=65;

StringGrid1.Cells[3,0]:='сверур';roCols[3]:=FALSE;

StringGrid1.ColWidths[3]:=65;

StringGrid1.Cells[4,0]:='итого';roCols[4]:=TRUE;

StringGrid1.ColWidths[4]:=65;

StringGrid1.Cells[5,0]:='удержанно';roCols[5]:=FALSE;

StringGrid1.ColWidths[5]:=95;

StringGrid1.Cells[6,0]:='к выдаче';roCols[6]:=TRUE;

StringGrid1.ColWidths[6]:=95;

Width:=750;

end;

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

Shift: TShiftState);

begin

case tableType of

0: begin

if StringGrid1.Col<=3 then

if Key=13 then stringGrid1.Col:=stringGrid1.Col+1;

// перемещение курсора ВПРАВО по нажотой клавише ENTER

if StringGrid1.Col>3 then begin

// А если колонка последняя, то перемещение на новую строчку и

// расчёт введённый параметров.

if Key=13 then begin

calc_(StringGrid1.RowCount-1);

stringGrid1.RowCount:=stringGrid1.RowCount+1;

stringGrid1.Col:=0;

stringGrid1.Row:=stringGrid1.RowCount-1;

end;end;

end;

1: begin

if StringGrid1.Col<=3 then

if Key=13 then stringGrid1.Col:=stringGrid1.Col+1;

// перемещение курсора ВПРАВО по нажотой клавише ENTER

if StringGrid1.Col>3 then begin

// А если колонка последняя, то перемещение на новую строчку и

// расчёт введённый параметров.

if Key=13 then begin

calc_(StringGrid1.RowCount-1);

stringGrid1.RowCount:=stringGrid1.RowCount+1;

stringGrid1.Col:=0;

stringGrid1.Row:=stringGrid1.RowCount-1;

end;end;

end;

2: begin

if StringGrid1.Col<=3 then

if Key=13 then stringGrid1.Col:=stringGrid1.Col+1;

// перемещение курсора ВПРАВО по нажотой клавише ENTER

if StringGrid1.Col>3 then begin

// А если колонка последняя, то перемещение на новую строчку и

// расчёт введённый параметров.

if Key=13 then begin

calc_(StringGrid1.RowCount-1);

stringGrid1.RowCount:=stringGrid1.RowCount+1;

stringGrid1.Col:=0;

stringGrid1.Row:=stringGrid1.RowCount-1;

end;end;

end;

3: begin

if StringGrid1.Col<=4 then

if Key=13 then stringGrid1.Col:=stringGrid1.Col+1;

// перемещение курсора ВПРАВО по нажотой клавише ENTER

if StringGrid1.Col>4 then begin

// А если колонка последняя, то перемещение на новую строчку и

// расчёт введённый параметров.

if Key=13 then begin

calc_(StringGrid1.RowCount-1);

stringGrid1.RowCount:=stringGrid1.RowCount+1;

stringGrid1.Col:=0;

stringGrid1.Row:=stringGrid1.RowCount-1;

end;end;

end;

4: begin

if StringGrid1.Col<=2 then

if Key=13 then stringGrid1.Col:=stringGrid1.Col+1;

// перемещение курсора ВПРАВО по нажотой клавише ENTER

if StringGrid1.Col>2 then begin

// А если колонка последняя, то перемещение на новую строчку и

// расчёт введённый параметров.

if Key=13 then begin

calc_(StringGrid1.RowCount-1);

stringGrid1.RowCount:=stringGrid1.RowCount+1;

stringGrid1.Col:=0;

stringGrid1.Row:=stringGrid1.RowCount-1;

end;end;

end;

5: begin

// перемещение курсора ВПРАВО по нажотой клавише ENTER

if StringGrid1.Col>=5 then begin

// А если колонка последняя, то перемещение на новую строчку и

// расчёт введённый параметров.

if Key=13 then begin

calc_(StringGrid1.RowCount-1);

stringGrid1.RowCount:=stringGrid1.RowCount+1;

stringGrid1.Col:=0;

stringGrid1.Row:=stringGrid1.RowCount-1; exit;

end;end;

if StringGrid1.Col=3 then if Key=13 then stringGrid1.Col:=5;

if StringGrid1.Col<=3 then if Key=13 then stringGrid1.Col:=stringGrid1.Col+1;

end;

Cnt.Caption:=IntToStr(StringGrid1.RowCount-1);

end;

procedure TForm2.BitBtn5Click(Sender: TObject);

begin

Close;

end;

procedure TForm2.BT_Clear(Sender: TObject);

var i,j: integer;

begin

for i:=0 to stringgrid1.ColCount do

for j:=1 to stringgrid1.RowCount do

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

end;

procedure TForm2.BTCalcClick(Sender: TObject);

// кнопка "Расчёт" .

var i: integer;

begin

for i:=1 to StringGrid1.RowCount do calc_(i);

Cnt.Caption:=IntToStr(StringGrid1.RowCount-1);

end;

procedure TForm2.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

begin

{if ARow>=1 then calc_( ARow);}

if roCols[aCol] then

{IF Sender = ActiveControl THEN Exit;

IF NOT (gdSelected IN State) THEN Exit;}

with Sender as TStringGrid do begin

Canvas.Brush.Color := $00886633{Color};

Canvas.Font.Color := clwhite{Font.Color};

Canvas.TextRect(Rect, Rect.Left+2, Rect.Top+2, Cells[ACol, ARow]);

END;

end;

procedure TForm2.BTSaveTBLClick(Sender: TObject);

type Trow1=string[30];// тип: "одна строка".

var f: file of Trow1; // типизированный файл

i,j: integer;

row1:Trow1;

begin

savedialog1.Filter:='Таблица "TBL"|*.TBL';

// фильтр "диалога". Будут отображены только "TBL" файлы.

savedialog1.FileName:='табличные данные 1.TBL';

savedialog1.DefaultExt:='TBL';

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

if savedialog1.Execute then begin

if ExtractFileExt(savedialog1.FileName)<>'.TBL' then

savedialog1.FileName:=savedialog1.FileName+'.TBL';

// отобразим Диалог Сохранения файла таблицы.

If FileExists(savedialog1.Filename) then begin

if MessageDlg('Файл уже существует.'+#13+'Перезаписать ?',mtConfirmation,

[mbYes]+[mbNo], 1)= mrNo then Exit;

end;

AssignFile(f,savedialog1.Filename);

// связываем файл с файловой переменной

rewrite(f);

// перезаписываем и открываем файл для записи

for i:=1 to StringGrid1.RowCount do begin

for j:=0 to StringGrid1.ColCount do begin

row1:=StringGrid1.Cells[j,i];

if not roCols[j] then

write(f,row1);

// и сохранять мы будем только те значения которые мы

// ввели с клавиатуры, для того что бы можно было без

// труда подставить в любую другую таблицу, и произвести

// повторный расчёт.

end;

closeFile(f);

//закрываем файл.

end;

procedure TForm2.BT_SAVE_TXTClick(Sender: TObject);

var

f: textFile; // сохранять будем в текстовый файл.

i,j,k: integer;

off1: array [0..99] of byte;

// off1 - массив для хранения в нём ширины каждой колонки таблицы

// (для того что бы осуществить "форматированное" сохранение в файл)

begin

savedialog1.Filter:='*.TXT|*.TXT';

// фильтр "диалога". Будут отображены только "TXT" файлы.

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

// заглавие диалога

If savedialog1.Execute then begin

// отобразим Диалог Сохранения файла таблицы.

if ExtractFileExt(savedialog1.FileName)<>'.TXT' then

savedialog1.FileName:=savedialog1.FileName+'.TXT';

If FileExists(savedialog1.Filename) then begin

if MessageDlg('Файл уже существует.'+#13+'Перезаписать ?',mtConfirmation,

[mbYes]+[mbNo], 1)= mrNo then Exit;

end;

// произведём расчёт максимальной ширины колонок. --------------

for j:=0 to StringGrid1.ColCount do off1[j]:=0;

// обнуляем массив "отступов" для каждой из колонок

for i:=0 to StringGrid1.RowCount do

for j:=0 to StringGrid1.ColCount do begin

if off1[j]<Length(StringGrid1.Cells[j,i]) then

off1[j]:=Length(StringGrid1.Cells[j,i]);

// "проходим" по всем строчкам и колонкам и определяем

// максимальную ширину каждой из колонок

end;

AssignFile(f,savedialog1.Filename);

// связываем файл с файловой переменной

rewrite(f);

// перезаписываем и открываем файл для записи

writeln(f,' таблица:"'+capt_.caption+'"');

// записываем в файл заглавие таблицы

write(f,' ');

for j:=0 to StringGrid1.ColCount do

for i:=0 to off1[j]+1 do write(f,'-');

writeln(f);

for i:= 0 to StringGrid1.RowCount do begin

for j:=0 to StringGrid1.ColCount do begin

write(f,'|'+StringGrid1.Cells[j,i]);

for k:=0 to off1[j]-Length(StringGrid1.Cells[j,i]) do begin

write(f,' ');

// заполняем пробелами для выравнивания колонок в таблице

end;

writeln(f);

end;

write(f,' ');

for j:=0 to StringGrid1.ColCount do

for i:=0 to off1[j]+1 do write(f,'-');

writeln(f);

CloseFile(f);

end;

procedure TForm2.DelRowClick(Sender: TObject);

// кнопка "удалить строку"

var

i,j: integer;

begin

if StringGrid1.RowCount < 3 then exit;

for i:= StringGrid1.Row to StringGrid1.RowCount do

for j:=0 to StringGrid1.ColCount do begin

StringGrid1.Cells[j,i]:=StringGrid1.Cells[j,i+1];

end;

StringGrid1.RowCount:=StringGrid1.RowCount-1;

if StringGrid1.Row>1 then StringGrid1.Row:=StringGrid1.Row-1;

end;

procedure TForm2.BTOpenTBLClick(Sender: TObject);

type Trow1=string[30];// тип: "одна строка".

var f: file of Trow1; // типизированный файл

i,j: integer;

Row1:Trow1;

begin

OpenDialog1.Filter:='Таблица "TBL"|*.TBL';

// фильтр "диалога". Будут отображены только "TBL" файлы.

OpenDialog1.FileName:='табличные данные 1.TBL';

OpenDialog1.DefaultExt:='TBL';

OpenDialog1.Title:='Открыть данные для таблицы из файла "TBL"...';

if OpenDialog1.Execute then begin

If Not( FileExists(OpenDialog1.Filename)) then begin

MessageDlg('Ошибка при открытии файла',mtError,[mbCancel], 1);

Exit;

end;

BT_Clear(Sender); // очищаем текщую таблицу

AssignFile(f,OpenDialog1.Filename);

// связываем файл с файловой переменной

reset(f);

// открываем файл для чтения

j:=1;

i:=0;

row1:='';

repeat

read(f,row1);

StringGrid1.Cells[i,j]:=row1;

repeat

if i< stringGrid1.ColCount then

i:=i+1 else begin j:=j+1; i:=0; end;

until not roCols[i];

until eof(f);

stringGrid1.RowCount:=j+1;

closeFile(f);

//закрываем файл.

end;

procedure TForm2.BTOpenTXTClick(Sender: TObject);

var f: TextFile; // типизированный файл

i,j,k: integer;

st,temp: string[255];

begin

OpenDialog1.Filter:='Таблица "TXT"|*.TXT';

// фильтр "диалога". Будут отображены только "TBL" файлы.

OpenDialog1.FileName:='табличные данные 1.TXT';

OpenDialog1.DefaultExt:='TXT';

OpenDialog1.Title:='Открыть данные для таблицы из файла "TXT"...';

if OpenDialog1.Execute then begin

If Not( FileExists(OpenDialog1.Filename)) then begin

MessageDlg('Ошибка при открытии файла',mtError,[mbCancel], 1);

Exit;

end;

BT_Clear(Sender); // очищаем текщую таблицу

AssignFile(f,OpenDialog1.Filename);

// связываем файл с файловой переменной

reset(f);

// открываем файл для чтения

j:=1;

i:=0;

st:='';

readln(f,st);

repeat

readln(f,st);

temp:='';

//showmessage(st+intToStr(i));

for k:=1 to length(st) do begin

if st[k] in ['0'..'9',','] then begin

temp:=temp+st[k];

end else begin

if temp>'' then begin

stringGrid1.RowCount:=j+2;

StringGrid1.Cells[i,j]:=temp;

if i< stringGrid1.ColCount then

i:=i+1 else begin break; end;

temp:='';

end;

j:=j+1; i:=0;

until eof(f);

stringGrid1.RowCount:=j+1;

closeFile(f);

//закрываем файл.

end;

procedure TForm2.BTCloseClick(Sender: TObject);

begin

Close;

end;

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

begin

case MessageDlg('Хотите сохранить таблицу ?',mtConfirmation,

[mbYes]+[mbNo]+[mbCancel], 1) of

mrNo: ;

mrYes: BTSaveTBLClick(Sender);

mrCancel: exit;

end;

BT_Clear(Sender); // очищаем текщую таблицу

end;

procedure TForm2.N8Click(Sender: TObject);

begin

Panel1.Visible:=N8.Checked;

end;

procedure TForm2.N7Click(Sender: TObject);

begin

Panel2.Visible:=N7.Checked;

end;

procedure TForm2.x1Click(Sender: TObject);

begin

BT_Clear(Sender);

StringGrid1.RowCount:=2;

end;

procedure TForm2.N10Click(Sender: TObject);

begin

showMessage('Таблица расчитывается по формуле колонок:'+#13+

Formula_kolonok[tableType]);

end;

end.

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

// //

Unit About;

interface

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

Dialogs, StdCtrls, Buttons, Grids, ExtCtrls;

type TForm3 = class(TForm)

Label1: TLabel;

Label2: TLabel;

BitBtn1: TBitBtn;

Bevel1: TBevel;

procedure BitBtn1Click(Sender: TObject);

end;

var Form3: TForm3;

implementation

{$R *.dfm}

procedure TForm3.BitBtn1Click(Sender: TObject);

begin

Close;

end;

end.

<<< < Предыдущая 12 / 22

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

#
18.03.2015228.46 Кб47Кодекс Рб о браке и семье.docx
#
18.03.201586.02 Кб11Кодекс экзаменатора.doc
#
18.03.201531.29 Кб9Кодифицированное законодательство.docx
#
18.11.201978.74 Кб8КОИН.docx
#
20.09.2019104.35 Кб4Коллективные+творческие+дела.docx
#
02.09.20191.32 Mб4Колобок.doc
#
18.03.20152.26 Mб477комплексная диагностика дошкольника.doc
#
30.09.2019133.66 Кб3Комплексная УО практика2 курс СППП последняя 20...docx
#
18.03.201580.38 Кб131Комплексное исследование ребенка 1,5-3 лет.doc
#
06.09.201944.71 Кб11Композиция.docx
#
04.09.20197.84 Mб3Компьютерная обработка видео информации(Зарембо...docx