Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Объектно-ориентированное программирование на access. Создание базы данных.docx
Скачиваний:
1
Добавлен:
01.07.2025
Размер:
1 Мб
Скачать
☆
  1. Текст программы {DataBaseByTolanuch}

Текст модуля {Cover}

unit Cover;

interface

uses

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

Dialogs, StdCtrls, jpeg, ExtCtrls, ComCtrls;

type

TForm3 = class(TForm)

Image1: TImage;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

ProgressBar1: TProgressBar;

Timer1: TTimer;

procedure Timer1Timer(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form3: TForm3;

implementation

uses Work;

{$R *.dfm}

procedure TForm3.Timer1Timer(Sender: TObject);

begin

ProgressBar1.min:=ProgressBar1.min+25;

if ProgressBar1.min=ProgressBar1.Max then

begin

Form1.Visible:=true;

Form3.Visible:=false;

timer1.Enabled:=false;

end;

end;

end.

Текст модуля {QuaryName}

unit QuaryName;

interface

uses

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

Dialogs, StdCtrls, ComObj;

type

TForm2 = class(TForm)

Button1: TButton;

Edit1: TEdit;

CheckBox1: TCheckBox;

procedure FormShow(Sender: TObject);

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form2: TForm2;

implementation

uses Work, MyClass;

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);

Var w:Variant;

i:integer;

begin

Form1.Query.Active:=False;

Form1.Query.SQL.Clear;

Form1.Query.SQL.Add('SELECT * FROM Table1 WHERE Name_product="'+Edit1.Text+'"');

Form1.Query.Active:=True;

if Form1.Query.Fields[0].AsString='' then

begin

showmessage('Sorry,not found your query...');

exit

end;

Form1.Source.DataSet:=Form1.Query;

Form2.Visible:=False;

if checkbox1.Checked then

begin

w:=createoleobject('word.application');

w.visible:=true;

w.Documents.Add;

Form1.Table.first;

while not Form1.Query.Eof do

begin

for i:=Form1.Query.FieldCount downto 1 do

begin

w.activedocument.range.insertbefore(Form1.Query.Fields[i-1].AsString+' | ');

if i=1 then w.activedocument.range.insertbefore(#13#10);

end;

Form1.Query.Next

end;

w.activedocument.range.insertbefore('Name_product | Costs | Clear_profit | Sales_volume | Cost_price | Name_company | Type_activity');

w.displayalerts:=false;

w.activedocument.saveas(extractfilepath(application.exename)+'Report.docx');

w.quit;

w:=unassigned;

end;

end;

procedure TForm2.FormShow(Sender: TObject);

begin

Edit1.SetFocus;

end;

end.

Текст модуля {MyClass}

unit MyClass;

interface

type TDataBase=class(TObject)

FF1,FF6,FF7:String;

FF2,FF3,FF5:Real;

FF4:Integer;

Constructor Create(a,f,g:String;b,c,e:Real;d:Integer);

procedure CreateRecord;

Procedure EditRecord;

end;

var x:TDataBase;

implementation

uses Work,QuaryName,SysUtils, Dialogs;

Constructor TDataBase.Create(a,f,g:String;b,c,e:Real;d:Integer) ;

begin

inherited create;

FF1:=a;

FF6:=f;

FF7:=g;

FF2:=b;

FF3:=c;

FF4:=d;

FF5:=e;

end;

procedure TDataBase.CreateRecord;

begin

Form1.Table.Append;

Form1.Table.FieldByName('Name_product').AsString:=FF1;

Form1.Table.FieldByName('Costs').AsFloat:=FF2;

Form1.Table.FieldByName('Clear_profit').AsFloat:=FF3;

Form1.Table.FieldByName('Sales_volume').AsInteger:=FF4;

Form1.Table.FieldByName('Cost_price').AsFloat:=FF5;

Form1.Table.FieldByName('Name_company').AsString:=FF6;

Form1.Table.FieldByName('Type_activity').AsString:=FF7;

Form1.Table.Post;

end;

Procedure TDataBase.EditRecord;

begin

Form1.Table.Edit;

Form1.Table.FieldByName('Name_product').AsString:=FF1;

Form1.Table.FieldByName('Costs').AsFloat:=FF2;

Form1.Table.FieldByName('Clear_profit').AsFloat:=FF3;

Form1.Table.FieldByName('Sales_volume').AsInteger:=FF4;

Form1.Table.FieldByName('Cost_price').AsFloat:=FF5;

Form1.Table.FieldByName('Name_company').AsString:=FF6;

Form1.Table.FieldByName('Type_activity').AsString:=FF7;

Form1.Table.Post

end;

end.

Текст модуля {Work}

unit Work;

interface

uses

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

Dialogs, Menus, ExtCtrls, DB, ADODB, XPMan, Grids, DBGrids, StdCtrls,

Mask, DBCtrls, jpeg, ComObj;

type

TForm1 = class(TForm)

XPManifest1: TXPManifest;

Source: TDataSource;

Connection: TADOConnection;

Table: TADOTable;

Query: TADOQuery;

DBGrid1: TDBGrid;

GroupBox1: TGroupBox;

Button1: TButton;

Button2: TButton;

GroupBox2: TGroupBox;

First: TButton;

Previous: TButton;

Next: TButton;

Last: TButton;

GroupBox3: TGroupBox;

NewRecord: TButton;

Delete: TButton;

GroupBox4: TGroupBox;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

Label6: TLabel;

Label7: TLabel;

Button3: TButton;

Edit1: TEdit;

Edit2: TEdit;

Edit3: TEdit;

Edit4: TEdit;

Edit5: TEdit;

Edit6: TEdit;

Edit7: TEdit;

Apply: TButton;

EditRecord: TButton;

Apply_: TButton;

CheckBox1: TCheckBox;

Button4: TButton;

procedure FirstClick(Sender: TObject);

procedure PreviousClick(Sender: TObject);

procedure NextClick(Sender: TObject);

procedure LastClick(Sender: TObject);

procedure DeleteClick(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure EditRecordClick(Sender: TObject);

procedure NewRecordClick(Sender: TObject);

procedure ApplyClick(Sender: TObject);

procedure Apply_Click(Sender: TObject);

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

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

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

procedure Button4Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

uses QuaryName,MyClass;

{$R *.dfm}

procedure TForm1.ApplyClick(Sender: TObject);

begin

GroupBox1.Visible:=True;

GroupBox2.Visible:=True;

GroupBox3.Visible:=True;

GroupBox4.Visible:=False;

Apply.Visible:=False;

x.Free;

x:=TDataBase.create(edit1.Text, edit6.Text, edit7.Text, StrToFloat(Edit2.Text), StrToFloat(Edit3.Text), StrToFloat(Edit5.Text), StrToInt(Edit4.Text));

x.CreateRecord;

end;

procedure TForm1.Apply_Click(Sender: TObject);

begin

GroupBox1.Visible:=True;

GroupBox2.Visible:=True;

GroupBox3.Visible:=True;

GroupBox4.Visible:=False;

Apply_.Visible:=False;

x.Free;

x:=TDataBase.create(edit1.Text, edit6.Text, edit7.Text, StrToFloat(Edit2.Text), StrToFloat(Edit3.Text), StrToFloat(Edit5.Text), StrToInt(Edit4.Text));

x.EditRecord;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Form2.Visible:=True

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

Table.Open;

Source.DataSet:=Table;

Query.SQL.Clear;

Query.Close

end;

procedure TForm1.Button3Click(Sender: TObject);

var e:Variant;

i,j:integer;

begin

Query.Active:=False;

Query.SQL.Clear;

Query.SQL.Add('SELECT * FROM Table1 WHERE Costs>Clear_profit');

Query.Active:=True;

if Form1.Query.Fields[0].AsString='' then

begin

showmessage('Sorry,not found your query...');

exit

end;

Source.DataSet:=Form1.Query;

if CheckBox1.Checked then

begin

e:=createoleobject('excel.application');

e.workbooks.add;

Form1.Table.first;

j:=2;

e.workbooks.item[1].sheets.item[1].cells[1,1]:='Name_product';

e.workbooks.item[1].sheets.item[1].cells[1,2]:='Costs';

e.workbooks.item[1].sheets.item[1].cells[1,3]:='Clear_profit';

e.workbooks.item[1].sheets.item[1].cells[1,4]:='Sales_volume';

e.workbooks.item[1].sheets.item[1].cells[1,5]:='Cost_price';

e.workbooks.item[1].sheets.item[1].cells[1,6]:='Name_company';

e.workbooks.item[1].sheets.item[1].cells[1,7]:='Type_activity';

while not Form1.Query.Eof do

begin

for i := 1 to Form1.Query.FieldCount do

e.workbooks.item[1].sheets.item[1].cells[j,i]:=Form1.Query.Fields[i-1].AsString;

j:=j+1;

Form1.Query.Next;

end;

e.displayalerts:=false;

e.workbooks.item[1].saveas(extractfilepath(application.exename)+'Report.xlsx');

e.quit;

e:=unassigned;

end;

end;

procedure TForm1.Button4Click(Sender: TObject);

begin

GroupBox1.Visible:=True;

GroupBox2.Visible:=True;

GroupBox3.Visible:=True;

GroupBox4.Visible:=False;

Apply_.Visible:=False;

Apply.Visible:=False;

end;

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

begin

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

end;

procedure TForm1.Edit4KeyPress(Sender: TObject; var Key: Char);

begin

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

end;

procedure TForm1.EditRecordClick(Sender: TObject);

begin

Edit1.Text:= Table.FieldByName('Name_product').AsString;

Edit2.Text:=Table.FieldByName('Costs').AsString;

Edit3.Text:=Table.FieldByName('Clear_profit').AsString;

Edit4.Text:=Table.FieldByName('Sales_volume').AsString;

Edit5.Text:=Table.FieldByName('Cost_price').AsString;

Edit6.Text:=Table.FieldByName('Name_company').AsString;

Edit7.Text:=Table.FieldByName('Type_activity').AsString;

GroupBox1.Visible:=False;

GroupBox2.Visible:=False;

GroupBox3.Visible:=False;

GroupBox4.Visible:=True;

Apply_.Visible:=True;

end;

procedure TForm1.DeleteClick(Sender: TObject);

begin

Table.Delete

end;

procedure TForm1.FirstClick(Sender: TObject);

begin

Table.First

end;

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

begin

Application.Terminate;

end;

procedure TForm1.LastClick(Sender: TObject);

begin

Table.Last

end;

procedure TForm1.NewRecordClick(Sender: TObject);

begin

GroupBox1.Visible:=False;

GroupBox2.Visible:=False;

GroupBox3.Visible:=False;

GroupBox4.Visible:=True;

Apply.Visible:=True;

end;

procedure TForm1.NextClick(Sender: TObject);

begin

Table.Next

end;

procedure TForm1.PreviousClick(Sender: TObject);

begin

Table.Prior

end;

end.