Исходный код

unit mainunit;

interface

uses

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

Dialogs, IniFiles, DB, IBDatabase, Grids, DBGrids, IBCustomDataSet,

IBQuery, StdCtrls, ExtCtrls, ComObj;

type

TForm1 = class(TForm)

IBDatabase1: TIBDatabase;

IBQuery1: TIBQuery;

IBTransaction1: TIBTransaction;

DataSource1: TDataSource;

DBGrid1: TDBGrid;

Panel1: TPanel;

Edit1: TEdit;

Edit2: TEdit;

Edit3: TEdit;

Edit4: TEdit;

ButtonExit: TButton;

Button1: TButton;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

ButtonOK: TButton;

IBQuery2: TIBQuery;

IBTransaction2: TIBTransaction;

ButtonEdit: TButton;

Button2: TButton;

ButtonDel: TButton;

RadioGroup1: TRadioGroup;

Edit5: TEdit;

Button3: TButton;

procedure FormCreate(Sender: TObject);

procedure ButtonExitClick(Sender: TObject);

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

procedure Button1Click(Sender: TObject);

procedure ButtonOKClick(Sender: TObject);

procedure ButtonEditClick(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Grid();

procedure ButtonDelClick(Sender: TObject);

procedure RadioGroup1Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

tabl: string; // переменная для хранения имени таблицы БД

insert:boolean;

implementation

{$R *.dfm}

procedure TForm1.Grid(); //Меняем названия у столбцов на русские

Begin

DBGRid1.Columns[0].Visible:= false; // скрываем столбец Номер

DBGRid1.Columns[1].Title.Caption:= 'Название' ;

DBGRid1.Columns[2].Title.Caption:= 'Параметры функции' ;

DBGRid1.Columns[3].Title.Caption:= 'Язык' ;

DBGRid1.Columns[4].Title.Caption:= 'Описание' ;

end;

procedure TForm1.FormCreate(Sender: TObject); // При создании формы подключаемся к БД

var

IniFile:Tinifile;

begin

//общаемся к ини-фалйлу config.ini, который хранится в каталоге с программой

//это нужно, чтобы можно было подключить другую базу, прописав к ней путь в config.ini

try

IniFile:= TIniFile.Create(ExtractFilePath(Application.ExeName)+'config.ini');

// и считываем оттуда (из секции Base параметр Path ) путь к БД в IBDatabase1

IBDatabase1.DatabaseName:=IniFile.ReadString('Base', 'Path', '');

IBDatabase1.Connected:=true; //присоединяем БД

//считываем имя таблицы из ини файла

tabl:=IniFile.ReadString('Base', 'Name', '');

//загружаем данные из БД

with IBQuery1 do

begin

Sql.Text:='select * from ' + tabl;

open;

end;

Panel1.Visible:=false;

grid(); //Меняем названия у столбцов на русские

insert:=false;

IniFile.Free; //освобождаем память

except // Если произошла ошибка

on E: Exception do

begin //выводим об этом сообщение

Application.MessageBox(PChar(E.Message), 'Ошибка', MB_ICONERROR);

Halt; //закрываем программу в случае ошибки

end;

end;

end;

procedure TForm1.ButtonExitClick(Sender: TObject); //Выход из программы

begin

Close;

end;

//При закрытии формы закрываем БД (отключаем с ней связь)

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

begin

IBQuery1.Close;

IBDatabase1.Connected:=false;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Panel1.Visible:=true;

insert:=true;

end;

//При нажатии на кнопку готово, на панели вставки/редактирования записи

procedure TForm1.ButtonOKClick(Sender: TObject);

begin

if Edit1.Text='' then

Begin

ShowMessage('Введите наименование функции');

exit;

End;

if Edit2.Text='' then

Begin

ShowMessage('Введите параметры функции');

exit;

End;

if Edit3.Text='' then

Begin

ShowMessage('Введите язык');

exit;

End;

if Edit4.Text='' then

Begin

ShowMessage('Введите описание функции');

exit;

End;

if insert then //если вставляем запись...

Begin

try

with IBQuery2 do

Begin //QuotedStr - Ставит кавычки

SQl.Text:='insert into '+tabl+ '(NAME, PARAMETR, LANG, DESCRIPTION) values ('

+QuotedStr(Edit1.Text)+','+QuotedStr(Edit2.Text)+

','+QuotedStr(Edit3.Text)+','+QuotedStr(Edit4.Text)+');';

Transaction.StartTransaction;

ExecSQL; //выполняем запрос ExecSQL, для всех типов кроме select

Transaction.Commit; //подтверждаем транзакцию

Transaction.Active:=false;

end;

IBQuery1.Close; //обновляем Query

IBQuery1.Open;

grid();

except //если произошла ошибка

if IBQuery2.Active then

IBQuery2.Transaction.Rollback; //откатываем транзакцию

end;

end

else //Если запись редактируем

Begin

try

with IBQuery2 do

Begin //QuotedStr - Ставит кавычки

SQl.Text:='update '+tabl+' set NAME='+ QuotedStr(Edit1.Text)+', PARAMETR='+

QuotedStr(Edit2.Text)+', LANG='+QuotedStr(Edit3.Text)+

', DESCRIPTION='+ QuotedStr(Edit4.Text)+' where ID='+IBQuery1.FieldByName('ID').AsString;

Transaction.StartTransaction;

ExecSQL; //выполняем запрос ExecSQL, для всех типов кроме select

Transaction.Commit; //подтврждаем транзакцию

Transaction.Active:=false;

end;

IBQuery1.Close; //обновляем Query

IBQuery1.Open;

grid();

except //если произошла ошибка

if IBQuery2.Active then

IBQuery2.Transaction.Rollback; //откатываем транзакцию

end;

end;

Panel1.Visible:=false;

end;

procedure TForm1.ButtonEditClick(Sender: TObject);

begin

insert:=false; //указываем что мы редактируем, а не вставляем запись

Edit1.Text:= IBQuery1.FieldByName('Name').AsString;

Edit2.Text:= IBQuery1.FieldByName('PARAMETR').AsString;

Edit3.Text:= IBQuery1.FieldByName('LANG').AsString;

Edit4.Text:= IBQuery1.FieldByName('DESCRIPTION').AsString;

Panel1.Visible:=true; // показываем панель с полями

end;

//отмена

procedure TForm1.Button2Click(Sender: TObject);

begin

Panel1.Visible:=false;

end;

procedure TForm1.ButtonDelClick(Sender: TObject); // Удалить запись

begin

if MessageDlg('Действительно хотите удалить запись из БД?',mtConfirmation, mbOKCancel, 0)= mrOK

then

Begin

try

with IBQuery2 do

Begin //QuotedStr - Ставит кавычки

SQl.Text:='delete from '+tabl+' where ID='+IBQuery1.FieldByName('ID').AsString;

Transaction.StartTransaction;

ExecSQL; //выполняем запрос ExecSQL, для всех типов кроме select

Transaction.Commit; //подтврждаем транзакцию

Transaction.Active:=false;

end;

IBQuery1.Close; //обновляем Query

IBQuery1.Open;

grid();

ShowMessage('Запись удалена успешно');

except //если произошла ошибка

if IBQuery2.Active then

IBQuery2.Transaction.Rollback; //откатываем транзакцию

end;

end;

end;

procedure TForm1.RadioGroup1Click(Sender: TObject); // При выборе радиокнопок на панели поиска

begin

if RadioGroup1.ItemIndex = 0

then

begin // При выборе "Отбразить все записи"

with IBQuery1 do

begin

Sql.Text:='select * from ' + tabl;

open;

end;

end

else

begin // При выборе "Поиск функции"

with IBQuery1 do

begin

Sql.Text:='select * from ' + tabl + ' where NAME=' + QuotedStr(Edit5.Text);

open;

end;

end ;

grid();

end;

procedure TForm1.Button3Click(Sender: TObject);

var

i,j,index: Integer;

ExcelApp,sheet: Variant;

begin

ExcelApp := CreateOleObject('Excel.Application'); // для использования CreateOleObject необходимо подключить модуль ComObj

ExcelApp.Visible := true;

ExcelApp.WorkBooks.Add(-4167);

ExcelApp.WorkBooks[1].WorkSheets[1].name := 'Otchet';

sheet:=ExcelApp.WorkBooks[1].WorkSheets['Otchet'];

index:=3;

//Вторая строка будет отображаться жирным (заголов таблицы)

ExcelApp.ActiveWorkBook.ActiveSheet.Rows[2].Font.Bold:=true;

//Вывод шапки таблицы

sheet.cells[2,1]:= 'Имя ';

sheet.cells[2,2]:= 'Параметры';

sheet.cells[2,3]:= 'Язык';

sheet.cells[2,4]:= 'Описание';

//вывод данных

//DBGrid1.DataSource.DataSet.First;

for i:=1 to DBGrid1.DataSource.DataSet.RecordCount do

begin

for j:=2 to DBGrid1.FieldCount do

sheet.cells[index,j-1]:=DBGrid1.fields[j-1].asstring;

inc(index);

DBGrid1.DataSource.DataSet.Next; //переход к следующей строке грида

end;

end;

end.

38