Приложение а

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

Form1: Главное окно программы.

unit Unit1;

interface

uses

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

Dialogs, DB, ADODB, Grids, DBGrids, Menus, ToolWin, ComCtrls, StdCtrls,

ExtCtrls, DBCtrls,ComObj, OleServer, ExcelXP, shellapi, ActiveX, Buttons;

type

TForm1 = class(TForm)

DataSource1: TDataSource;

ADOConnection1: TADOConnection;

ADOQuery1: TADOQuery;

ExcelApp: TExcelApplication;

ADOQuery2: TADOQuery;

DataSource2: TDataSource;

ADOConnection2: TADOConnection;

Button1: TButton;

StringGrid1: TStringGrid;

DBGrid2: TDBGrid;

DBGrid1: TDBGrid;

Label3: TLabel;

Button7: TButton;

ListBox1: TListBox;

Label4: TLabel;

Edit2: TEdit;

Button6: TButton;

Label2: TLabel;

ComboBox2: TComboBox;

Button4: TButton;

Label1: TLabel;

ComboBox1: TComboBox;

Edit1: TEdit;

Button2: TButton;

Button3: TButton;

Button5: TButton;

Button8: TButton;

Button9: TButton;

Button10: TButton;

Label5: TLabel;

procedure Button1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

procedure Button5Click(Sender: TObject);

procedure ListBox1Click(Sender: TObject);

procedure Button7Click(Sender: TObject);

procedure Button6Click(Sender: TObject);

procedure Edit2Change(Sender: TObject);

procedure Edit1Click(Sender: TObject);

procedure Button8Click(Sender: TObject);

procedure Button9Click(Sender: TObject);

procedure Button10Click(Sender: TObject);

procedure ADOQuery1AfterEdit(DataSet: TDataSet);

private

{ Private declarations }

public

check:boolean; // лошическая переменная для определения. выполнены ли уловия программы

publicTableName:string; // переменная для передачи выбранной таблицы

{ Public declarations }

end;

var

Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

begin // кнопка 'Exit'

close; // закрыть программу

end;

procedure TForm1.FormCreate(Sender: TObject);

var name:array of array of string;

Col, Row, i, j: integer;

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

Edit2.Clear; // очистить поле ввода нового названия группы

Edit1.text:='Введите критерий поиска...';

Label3.Caption:= 'Группа товаров: не выбрана';

Row:=ADOQuery2.RecordCount; // записать количество записей в Row

Col:=ADOQuery2.FieldCount; // запичать количество полей в Col

setLength(name, Row, Col); // задать размер массива name

for i:=0 to Row-1 do // i - строка, j - столбец

Begin

for j:=0 to Col-1 do

begin

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

name[i, j]:=ADOQuery2.Fields.Fields[j].Value;

end;

ADOQuery2.next; // перейти к следующей записи

end;

ListBox1.Sorted := True; // сортировать ListBox

for i:=0 to Row-1 do

Begin // заполнение списка имен групп товаров

ListBox1.Items.Add(name[i,1]); //Добавление строк в конец списка

end;

end;

procedure TForm1.Button2Click(Sender: TObject);

var st:string;

k:integer;

begin // кнопка "Поиск"

check:=true;

case ComboBox1.ItemIndex of // сохранить выбранное поле поиска в переменную st

0 : st:='№';

1 : st:='Название_товара';

2 : st:='Количество';

3 : st:='Описание';

else

Begin // если поле не выбрано, то вывести сообщение

MessageDlg('Поле для поиска не выбрано!',mtInformation,[mbok],0);

check:=false;

end;

end;

if check = true then // если поле выбрано

if Edit1.Text = '' then // и если поле критерия не заполнено, то

begin

check:=false; // вывести сообшение

MessageDlg('Критерий для поиска не выбран!',mtInformation,[mbok],0);

end;

if check = true then // если поле поиска выбрано и критерий заполнен, то

if (ComboBox1.ItemIndex = 0) or (ComboBox1.ItemIndex = 2) then

if not TryStrToInt(edit1.text,k) then // если идёт поиск по числовым значениям, то проверить введено ли число

begin // если введено не число, то вывести сообщение

MessageDlg('Для данного поля допустимы только числовые значения!',mtInformation,[mbok],0);

check:=false;

end

else

Begin // если выбрано числовое поле и введен числовой критерий, то

ADOQuery1.Close; // запросить все записи по выбранному полю и критерию

ADOQuery1.SQL.Clear;

ADOQuery1.SQL.Add('Select * from ' + publicTableName + ' where '+st+' = '+Edit1.Text);

ADOQuery1.Open;

end

else

Begin // иначе искать по текстовым полям если выбрано поле и критерий

ADOQuery1.Close;

ADOQuery1.SQL.Clear;

ADOQuery1.SQL.Add('Select * from ' + publicTableName + ' where '+st+' LIKE'+#39+'%'+Edit1.Text+'%'+#39);

ADOQuery1.Open;

end;

end;

procedure TForm1.Button3Click(Sender: TObject);

begin // кнопка "Показать все записи"

ADOQuery1.Close; // запросить все записи текущей группы товаров

ADOQuery1.SQL.Clear;

ADOQuery1.SQL.Add('Select * from ' + publicTableName);

ADOQuery1.Open;

end;

procedure TForm1.Button4Click(Sender: TObject);

var str:string;

begin // кнопка "Отсортировать"

check:=true;

case ComboBox2.ItemIndex of // сохранить выбранное поле в переменную str

0 : str:='№';

1 : str:='Название_товара';

2 : str:='Количество';

3 : str:='Описание';

else

Begin // если поле сортировки не выбрано, то вывести сообшение

MessageDlg('Поле для сортировки не выбрано!',mtInformation,[mbok],0);

check:=false;

end;

end;

if check = true then

begin // если поле сортировки выбрано, то

ADOQuery1.Close; // сортировать по выбранному полю в текущей таблице

ADOQuery1.SQL.Clear;

ADOQuery1.SQL.Add('Select * from ' + publicTableName + ' ORDER BY '+str);

ADOQuery1.Open;

end;

end;

procedure TForm1.Button5Click(Sender: TObject);

var str: array of array of string;

sCol, sRow, sColC, sRowC, i: integer;

Excel, Sheet, Colum: variant;

Col, Row: Word;

begin // кнопка сохранить в Excel

sRowC:=ADOQuery1.RecordCount; // сохранить количество записей текущей таблицы в sRowC

sColC:=ADOQuery1.FieldCount; // сохранить количество полей текущей таблицы в sColC

StringGrid1.ColCount:= sColC; // установить количество полей в StringGrid

StringGrid1.RowCount:= sRowC+1; // установить количество записей в StringGrid

// установить заголовки для полей документа

StringGrid1.Cells[0,0]:='Группа товаров: ' + publicTablename;

StringGrid1.cells[0,1]:='№';

StringGrid1.cells[1,1]:='Название товара';

StringGrid1.cells[2,1]:='Количество';

StringGrid1.cells[3,1]:='Описание';

setLength(str, sColC,sRowC); // установить размер массива str

ADOQuery1.Open; // открыть таблицу

ADOQuery1.First; // встать на первую запись

for sRow:=0 to sRowC-1 do

Begin

for sCol:=0 to sColC-1 do

begin

// Переписать содержимое таблицы в массив str

str[sCol, sRow]:=ADOQuery1.Fields.Fields[sCol].Value;

end;

ADOQuery1.next; // переход к следующей записи

end;

for sRow:=0 to sRowC-1 do

for sCol:=0 to sColC-1 do

begin

// отобразить содержимое массива str в StringGrid

StringGrid1.cells[sCol, sRow+2]:=str[sCol, sRow];

end;

Excel := CreateOleObject('Excel.Application'); // создаем экземпляр Excel

Excel.Visible := false; // скрыть окно Excel

Excel.Workbooks.Add(-4167);// добавляем новую книгу

Excel.Workbooks[1].WorkSheets[1].Name:='Учет товаров на складе';

Colum:=Excel.Workbooks[1].WorkSheets['Учет товаров на складе'].Columns;

// Установить длины полей

Colum.Columns[1].ColumnWidth:=5;

Colum.Columns[2].ColumnWidth:=40;

Colum.Columns[3].ColumnWidth:=15;

Colum.Columns[4].ColumnWidth:=140;

Colum.Columns[3].HorizontalAlignment := 2; // выравнивание количества по левому краю

Colum:=Excel.Workbooks[1].WorkSheets['Учет товаров на складе'].Rows;

// Установить жирный шрифт, разер 14, цвет черный для заголовка

Colum.Rows[1].Font.Bold:=true;

Colum.Rows[1].Font.Color:=clBlack;

Colum.Rows[1].Font.Size:=14;

for i:=2 to sRowC+2 do

begin // установить размер и цвет для всего остального документа

Colum.Rows[i].Font.Color:=clBlack;

Colum.Rows[i].Font.Size:=14;

end;

// переписать содержимое StringGrid в документ Excel

Sheet := Excel.ActiveWorkbook.Worksheets[1];

try

for Col := 0 to StringGrid1.ColCount - 1 do

for Row := 0 to StringGrid1.RowCount do

begin

Sheet.Cells[Row + 1, Col + 1] := StringGrid1.Cells[Col, Row]; //перенос

end;

finally

if not VarIsEmpty(Excel) then // если запущен процесс Excell

begin

Excel.Quit; // завершить процесс Excell

end;

end;

end;

procedure TForm1.ListBox1Click(Sender: TObject);

var str:string;

begin // клик по списку групп товаров

str:= ListBox1.Items[ListBox1.ItemIndex]; // запомнить выбранную группу в str

Label3.Caption:= 'Группа товаров: ' + str; // вывести str в метку

Label5.Caption:= str;

DBGrid1.SetFocus; // установить фокус на таблицу

publicTableName := str; // запомнить имя выбранной таблицы в глобальной переменной

//num:=ListBox1.ItemIndex; // взять номер выделенной строки

//ShowMessage(IntToStr(num)); // вывести номер выделенной строки

// активизаровать элементы управления если группа выбрана

Button7.Enabled:= true;

Button2.Enabled:= true;

Button3.Enabled:= true;

Button4.Enabled:= true;

Button5.Enabled:= true;

Button8.Enabled:= true;

Button9.Enabled:= true;

ComboBox1.Enabled:=true;

ComboBox2.Enabled:=true;

Edit1.Enabled:=true;

ADOQuery1.Close; // запросить все имена из таблицы inf

ADOQuery1.SQL.Clear;

ADOQuery1.SQL.Add('Select * from inf');

ADOQuery1.Open;

ADOQuery1.Close;

ADOQuery1.SQL.Clear; // вызвать пустую таблицу

ADOQuery1.SQL.Add('Select * from clear');

ADOQuery1.Open;

// Открыть таблицу с именем выделенной строки

ADOQuery1.Close;

ADOQuery1.SQL.Clear;

ADOQuery1.SQL.Add('Select * from '+ str);

ADOQuery1.Open;

end;

procedure TForm1.Button7Click(Sender: TObject);

var dropName:string;

buttonSelected:integer;

begin // кнопка "Удалить выделенную группу товаров"

buttonSelected:=MessageDlg('Вы действительно хотите ' +

'удалить группу товаров " ' + publicTableName +

' "? Восстановить данные будет невозможно!', mtWarning, [mbYes, mbNo], 0); // диалоговое окно

if buttonSelected = mrYes then // если нажали Yes, то

Begin

dropName:= ListBox1.Items[ListBox1.ItemIndex]; // запомнить название удаляемой группы в dropName

ADOQuery2.Close();

ADOQuery2.SQL.Clear(); // удалить таблицу удаляемой группы

ADOQuery2.SQL.Add('DROP TABLE ' + dropName);

ADOQuery2.ExecSQL();

ADOQuery2.Close();

ADOQuery2.SQL.Clear(); // удалить название группы из таблицы групп

ADOQuery2.SQL.Add('DELETE FROM inf WHERE title = '+ #39 + dropName + #39);

ADOQuery2.ExecSQL();

ListBox1.Items.Delete(ListBox1.ItemIndex); // удалить название группы из списка групп

Button7.Enabled := false; // дезактивировать кнопку "Удалить выбранную группу"

ADOQuery2.Close;

ADOQuery2.SQL.Clear; // вызвать все имена из таблицы имен групп

ADOQuery2.SQL.Add('Select * from inf');

ADOQuery2.Open;

ADOQuery1.Close;

ADOQuery1.SQL.Clear; // вызвать пустую таблицу

ADOQuery1.SQL.Add('Select * from clear');

ADOQuery1.Open;

Label3.Caption:= 'Группа товаров: не выбрана'; // вывести сообщение в метку

// ДеЗактивировать все элементы управления

Button7.Enabled:= false;

Button2.Enabled:= false;

Button3.Enabled:= false;

Button4.Enabled:= false;

Button5.Enabled:= false;

Button8.Enabled:= false;

Button9.Enabled:= false;

ComboBox1.Enabled:=false;

ComboBox2.Enabled:=false;

Edit1.Enabled:=false;

end;

end;

procedure TForm1.Button6Click(Sender: TObject);

var tableName:string;

name:array of array of string;

name_two:array of string;

Col, Row, i, j: integer;

begin // кнопка добавить группу товаров

tableName:=Edit2.Text; // сохранить введеное имя в переменную tableName

ADOQuery2.Close; // проверить, есть ли имя новой таблицы в таблице имен

ADOQuery2.SQL.Clear;

ADOQuery2.SQL.Add('SELECT * FROM inf WHERE title = ' +#39+ tableName + #39);

ADOQuery2.Open;

if ADOQuery2.RecordCount = 0 then // если нет, то добавляем

Begin

ADOQuery2.Close();

ADOQuery2.SQL.Clear(); // создать таблицу с именем tableName

ADOQuery2.SQL.Add('CREATE TABLE '+tableName+' (№ AUTOINCREMENT NOT NULL PRIMARY KEY, Название_товара varchar(50), Количество int, Описание varchar(250));');

ADOQuery2.ExecSQL();

ADOQuery2.Close();

ADOQuery2.SQL.Clear(); // добавить имя таблицы в таблицу имен

ADOQuery2.SQL.Add('INSERT INTO inf (title) VALUES(:titl);');

ADOQuery2.Parameters.ParamByName('titl').Value := Edit2.text;

ADOQuery2.ExecSQL();

ADOQuery2.Close;

ADOQuery2.SQL.Clear; // запросить все записи из таблицы имен

ADOQuery2.SQL.Add('Select * from inf');

ADOQuery2.Open;

Row:=ADOQuery2.RecordCount; // количество записей

Col:=ADOQuery2.FieldCount; // количество полей

setLength(name, Row, Col); // установить размер массива name

setLength(name_two, Row); // установить размер массива name_two

for i:=0 to Row-1 do // i - строка, j - столбец

Begin

for j:=0 to Col-1 do

begin

// заполнить массив name_two номерами названий групп

name_two[i]:= ADOQuery2.Fields.Fields[j].Value;

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

name[i, j]:=ADOQuery2.Fields.Fields[j].Value;

end;

ADOQuery2.next; // перейти на следующую запись

end;

Button6.Caption:='Wait...';

sleep(2200); // ждать 2.2 сек, т.к. таблица добавляется не моментально

Button6.Caption:='Добавлено!';

// вывести сообщение об успешном добавлении группы

MessageDlg('Группа товаров " '+ tableName +' " добавлена.',mtInformation,[mbok],0);

ListBox1.Items.Add(tableName); // добавить нове название таблицы в ListBox

Button6.Caption:='Добавить группу товаров';

end

else // если имя группы уже есть в таблице имен, то вывести сообщение

MessageDlg('Группа товаров с именем " '+ tableName +' " уже существует!',mtInformation,[mbok],0);

end;

procedure TForm1.Edit2Change(Sender: TObject);

begin // реакция на ввод в поле ввода новой группы

if Edit2.Text <> '' then // если в поле введено, то

Button6.Enabled := true // активировать кнопку "Добавить группу товаров"

else

Button6.Enabled := false; // иначе если ничего нет, то дезактивировать.

end;

procedure TForm1.Edit1Click(Sender: TObject);

begin // реакция на клик в поле критерий поиска

Edit1.Clear; // очистить поле критерий поиска

end;

procedure TForm1.Button8Click(Sender: TObject);

begin // кнопка "Добавить товар"

Form2.show; // открыть форму добавления нового товара

end;

procedure TForm1.Button9Click(Sender: TObject);

var buttonSelected:integer;

begin // кнопка "Удалить товар"

buttonSelected:=MessageDlg('Вы действительно хотите удалить запись?',

mtWarning, [mbYes, mbNo], 0); // вывод диалогового окна

if buttonSelected = mrYes then // если нажали "Yes", то

ADOQuery1.Delete; // удалить выделенную запись

end;

procedure TForm1.Button10Click(Sender: TObject);

begin // кнопка "Сохранить изменения"

ADOQuery1.Post; // сохранить изменения

Button10.Enabled:=false; // дезактивировать кнопку "Сохранить изменения"

end;

procedure TForm1.ADOQuery1AfterEdit(DataSet: TDataSet);

begin // если данные таблицы были изменены, то

Button10.Enabled:=true; // активировать кнопку "Сохранить изменения"

end;

end.

Form2: Форма добавления нового товара

unit Unit2;

interface

uses

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

Dialogs, StdCtrls;

type

TForm2 = class(TForm)

Button1: TButton;

Button2: TButton;

Button3: TButton;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Edit1: TEdit;

Edit2: TEdit;

Edit3: TEdit;

procedure FormCreate(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Edit2KeyPress(Sender: TObject; var Key: Char);

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form2: TForm2;

implementation

uses Unit1;

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);

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

Edit1.Clear; // --//--

Edit2.Clear; // Очистить поля ввода

Edit3.Clear; // --//--

end;

procedure TForm2.Button2Click(Sender: TObject);

begin // кнопка "Отменить"

Edit1.Clear; // --//--

Edit2.Clear; // Очистить поля ввода

Edit3.Clear; // --//--

end;

procedure TForm2.Button3Click(Sender: TObject);

begin // кнопка "Закрыть"

close; // закрыть форму добавления товара

end;

procedure TForm2.Edit2KeyPress(Sender: TObject; var Key: Char);

begin // реакция на ввод в поле "Количество"

// возможен ввод только цифр

if not (key in['0'..'9',decimalseparator,#8]) then key:=#0;

end;

procedure TForm2.Button1Click(Sender: TObject);

var check:boolean;

begin // кнопка "Добавить"

check:= true;

if(Edit1.Text = '') then

begin // Если поле Название не заполнено, то вывести сообщение

MessageDlg('Заполните поле Название!',mtInformation,[mbok],0);

check:=false;

end;

if(Edit2.Text = '') then

begin // Если поле Количество не заполнено, то вывести сообщение

MessageDlg('Заполните поле Количество!',mtInformation,[mbok],0);

check:=false;

end;

if(Edit3.Text = '') then

begin // Если поле Описание не заполнено, то вывести сообщение

MessageDlg('Заполните поле Описание!',mtInformation,[mbok],0);

check:=false;

end;

if (check = true) then // если все поля заполнены, то

begin // занести данные в таблицу

Form1.ADOQuery1.Close();

Form1.ADOQuery1.SQL.Clear();

Form1.ADOQuery1.SQL.Add('INSERT INTO '+Form1.Label5.Caption+' (Название_товара, Количество, Описание) VALUES(:name, :kol, :description)');

Form1.ADOQuery1.Parameters.ParamByName('name').Value := Edit1.text;

Form1.ADOQuery1.Parameters.ParamByName('kol').Value := Edit2.text;

Form1.ADOQuery1.Parameters.ParamByName('description').Value := Edit3.text;

Form1.ADOQuery1.ExecSQL();

Form1.ADOQuery1.Close;

Form1.ADOQuery1.SQL.Clear; // Обновить таблицу выбранной группы товаров

Form1.ADOQuery1.SQL.Add('Select * from ' + Form1.Label5.Caption);

Form1.ADOQuery1.Open;

end;

end;

end.