unit del;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, DBGrids, ExtCtrls, StdCtrls, LMDControl, LMDBaseControl,
LMDBaseGraphicButton,ActiveX,ComObj, ComCtrls, LMDCustomSpeedButton, LMDSpeedButton,DB;
type
TFdel = class(TForm)
Panel1: TPanel;
DBGrid1: TDBGrid;
Panel5: TPanel;
Panel2: TPanel;
Image1: TImage;
LMDSpeedButton1: TLMDSpeedButton;
Edit1: TEdit;
RadioGroup1: TRadioGroup;
Panel3: TPanel;
LMDSpeedButton2: TLMDSpeedButton;
Image2: TImage;
RadioGroup2: TRadioGroup;
Panel4: TPanel;
Image3: TImage;
LMDSpeedButton3: TLMDSpeedButton;
LMDSpeedButton4: TLMDSpeedButton;
procedure LMDSpeedButton1Click(Sender: TObject);
procedure LMDSpeedButton2Click(Sender: TObject);
procedure LMDSpeedButton4Click(Sender: TObject);
procedure LMDSpeedButton3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Fdel: TFdel;
App, Ke, Abc : Variant;
ExelOtch : String;
Result : HResult;
AppProgID : string;
ServerIsRunning :boolean;
Unknown :IUnknown;
i:integer;
implementation
uses dm;
{$R *.dfm}
Продолжение приложения А
procedure TFdel.LMDSpeedButton1Click(Sender: TObject);
begin
if edit1.Text<>'' then begin
if RadioGroup1.ItemIndex=0 then
if dm1.avto_out.Locate('marka_out',edit1.Text,[loCaseInsensitive]) then
else MessageBox(Handle,'Нет автомобиля такой марки...','',MB_OK);
if RadioGroup1.ItemIndex=1 then
if dm1.avto_out.Locate('model_out',edit1.Text,[loCaseInsensitive]) then
else MessageBox(Handle,'Нет автомобиля такой модели...','',MB_OK);
end
else MessageBox(Handle,'Введите значение для поиска!','',MB_OK);
end;
procedure TFdel.LMDSpeedButton2Click(Sender: TObject);
begin
if RadioGroup2.ItemIndex=0 then
dm1.avto_out.IndexName:='marka_out';
if RadioGroup2.ItemIndex=1 then
dm1.avto_out.IndexName:='V_out';
if RadioGroup2.ItemIndex=2 then
dm1.avto_out.IndexName:='tipkuz_out';
end;
procedure TFdel.LMDSpeedButton4Click(Sender: TObject);
begin
close;
end;
procedure TFdel.LMDSpeedButton3Click(Sender: TObject);
begin
AppProgID := 'Excel.Application';
ServerIsRunning := False;
Result:=GetActiveObject(ProgIDToClassID(AppProgID),nil,Unknown);
try
if (Result = MK_E_UNAVAILABLE) then
App := CreateOleObject(AppProgID)
else
begin
App := GetActiveOleObject(AppProgID);
ServerIsRunning := True;
end;
ExelOtch:=ExtractFilePath(Application.EXEName)+'Проданные автомобили на '+DateToStr(Date)+'.xls';
App.WorkBooks.Add;
Ke:=App.WorkBooks[1];
Abc:=Ke.WorkSheets[1];
Abc.Name:='Проданные авто('+DateToStr(Date)+').xls';
except on EinOutError do begin
messageBox(handle,'Не удаётся создать файл!','Ошибка',MB_ICONERROR);
exit;
end;
end;
App.DisplayAlerts:=False;
Abc.Cells[1,3]:='Проданные авто('+DateToStr(Date)+').xls';
Продолжение приложения А
Abc.Cells[1,3].Font.Bold:=True;
Abc.Cells[1,3].Font.Size:=11;
dm1.avto_out.first;
i:=3;
while not dm1.avto_out.eof do begin
i:=i+1;
app.cells[i,1]:=vartostr(dm1.avto_out['Marka_out']);
Abc.Cells[i,1].ColumnWidth:=15;
app.cells[i,2]:=vartostr(dm1.avto_out['Model_out']);
Abc.Cells[i,2].ColumnWidth:=15;
app.cells[i,3]:=vartostr(dm1.avto_out['v_out']);
Abc.Cells[i,3].ColumnWidth:=5;
app.cells[i,4]:=vartostr(dm1.avto_out['cvet_out']);
Abc.Cells[i,4].ColumnWidth:=15;
app.cells[i,5]:=vartostr(dm1.avto_out['tipkuz_out']);
Abc.Cells[i,5].ColumnWidth:=15;
app.cells[i,6]:=vartostr(dm1.avto_out['cena_out']);
Abc.Cells[i,6].ColumnWidth:=10;
app.cells[i,7]:=vartostr(dm1.avto_out['date']);
Abc.Cells[i,7].ColumnWidth:=8;
dm1.avto_out.next;
end;
App.ActiveWorkBook.SaveAs(ExelOtch);
App.Quit;
App:=Unassigned;
AppProgID := 'Excel.Application';
App := CreateOleObject(AppProgID);
App.Visible := True;
ExelOtch:=ExtractFilePath(Application.EXEName)+'Проданные автомобили на '+DateToStr(Date)+'.xls';
App.WorkBooks.Open(ExelOtch);
end;
end.
А.4 Модуль данных
unit dm;
interface
uses
SysUtils, Classes, DB, DBTables;
type
Tdm1 = class(TDataModule)
dsvlad: TDataSource;
dsavto: TDataSource;
dssot: TDataSource;
dskomplect: TDataSource;
dsavto_in: TDataSource;
dsavto_out: TDataSource;
Продолжение приложения А
sot: TTable;
komplect: TTable;
avto_in: TTable;
avto_out: TTable;
sotKOD_SOT: TSmallintField;
sotFAM: TStringField;
sotNAME: TStringField;
sotOTH: TStringField;
avto_inKOD_IN: TFloatField;
avto_inAKT_NOM: TFloatField;
avto_inKOD_AVTO: TFloatField;
avto_inKOD_VLAD: TFloatField;
avto_inKOD_SOT: TFloatField;
avto_inDATA: TDateField;
komplectKOD_AVTO: TFloatField;
komplectKOLESO: TStringField;
komplectZAPASKA: TBooleanField;
komplectINSTRUMENT: TBooleanField;
komplectMUSIC: TBooleanField;
komplectMEDIC: TBooleanField;
komplectELECT_PAK: TBooleanField;
komplectABS: TBooleanField;
komplectGUR: TBooleanField;
komplectKONDIC: TBooleanField;
komplectINFO: TMemoField;
komplectDEFEKT: TMemoField;
komplectKOROBKA: TStringField;
komplectPRIVOD: TStringField;
avto_outKOD_OUT: TFloatField;
avto_outDATE: TDateField;
avto_outMARKA_OUT: TStringField;
avto_outMODEL_OUT: TStringField;
avto_outV_OUT: TStringField;
avto_outCVET_OUT: TStringField;
avto_outTIPKUZ_OUT: TStringField;
avto_outCENA_OUT: TFloatField;
dsmarka: TDataSource;
marka: TTable;
markaID_MARKA: TSmallintField;
markaMARKA: TStringField;
vlad: TTable;
vladKOD_VLAD: TFloatField;
vladFAM: TStringField;
vladNAME: TStringField;
vladOTH: TStringField;
vladADRES: TStringField;
vladMAIL: TStringField;
vladTEL: TFloatField;
vladSOT: TFloatField;
t1: TTable;
t1KOD_AVTO: TFloatField;
t1KOD_VLAD: TFloatField;
t1MARKA: TSmallintField;
t1MODEL: TStringField;
t1GOS_NOM: TStringField;
t1CVET: TStringField;
t1TIP_KUZ: TStringField;
t1FOTO_1: TStringField;
t1FOTO_2: TStringField;
Продолжение приложения А
t1CENA: TFloatField;
t1hoz: TStringField;
t1V: TStringField;
t1MMarka: TStringField;
avto: TTable;
avtoKOD_AVTO: TFloatField;
avtoKOD_VLAD: TFloatField;
avtoMARKA: TSmallintField;
avtoMODEL: TStringField;
avtoGOS_NOM: TStringField;
avtoCVET: TStringField;
avtoTIP_KUZ: TStringField;
avtoFOTO_1: TStringField;
avtoFOTO_2: TStringField;
avtoCENA: TFloatField;
avtoV: TFloatField;
avtohoz: TStringField;
avtoMMarka: TStringField;
procedure DataModuleCreate(Sender: TObject);
procedure avtoAfterScroll(DataSet: TDataSet);
procedure markaBeforeInsert(DataSet: TDataSet);
procedure markaAfterInsert(DataSet: TDataSet);
private
{ Private declarations }
public
{ Public declarations }
end;
var
dm1: Tdm1;
id : integer;
implementation
uses main;
{$R *.dfm}
procedure Tdm1.DataModuleCreate(Sender: TObject);
begin
avto.Close;
avto.Open;
komplect.Close;
komplect.Open;
avto_in.Close;
avto_in.Open;
avto_out.Close;
avto_out.Open;
vlad.Close;
vlad.Open;
sot.Close;
sot.Open;
end;
procedure Tdm1.avtoAfterScroll(DataSet: TDataSet);
begin
try
Fmain.Image3.Picture.LoadFromFile(ExtractFilePath(path)+'FOTO\'+dm1.avto.fieldbyname('FOTO_1').AsString);
Продолжение приложения А
except
Fmain.Image3.picture:=nil;
end;
try
Fmain.Image4.Picture.LoadFromFile(ExtractFilePath(path)+'FOTO\'+dm1.avto.fieldbyname('FOTO_2').AsString);
except
Fmain.Image4.picture:=nil;
end;
end;
procedure Tdm1.markaBeforeInsert(DataSet: TDataSet);
begin
id:=0;
Marka.First;
while not Marka.Eof do begin
if Marka.FieldByName('Id_marka').asinteger > id
then id := Marka.FieldByName('Id_marka').asinteger;
Marka.Next;
end;
id:=id+1;
end;
procedure Tdm1.markaAfterInsert(DataSet: TDataSet);
begin
Marka.FieldByName('id_marka').asinteger:=id;
end;
end.
Дата: 2019-05-28, просмотров: 198.