unit AOSU;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
//
DBGridEhGrouping, ToolCtrlsEh, DBGridEhToolCtrls, DynVarsEh, GridsEh,
DBAxisGridsEh, DBGridEh, DBVertGridsEh, EhLibADO, DBGridEhImpExp,
//
ShellApi, Vcl.ExtCtrls, sPanel, Vcl.Menus, Vcl.Buttons, sSkinProvider,
sSkinManager, sSpeedButton, sLabel, Vcl.StdCtrls, sDBText, cxGraphics,
cxControls, cxLookAndFeels, cxLookAndFeelPainters, cxContainer, cxEdit,
Vcl.DBCtrls, sDBMemo, acTitleBar, acSlider;
type
TAOS = class(TForm)
Menu: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
P1: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
Skin: TsSkinManager;
NewEdit: TsSpeedButton;
Delete: TsSpeedButton;
Edit: TsSpeedButton;
sSpeedButton1: TsSpeedButton;
GRID: TDBGridEh;
Find: TsSpeedButton;
sSpeedButton3: TsSpeedButton;
sPanel1: TsPanel;
VGrid: TDBVertGridEh;
N9: TMenuItem;
N10: TMenuItem;
H1: TMenuItem;
sSpeedButton2: TsSpeedButton;
PrintQR: TsSpeedButton;
spdbtn2: TsSpeedButton;
Y1: TMenuItem;
procedure NewEditClick(Sender: TObject);
procedure EditClick(Sender: TObject);
procedure DeleteClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure sSpeedButton1Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure P1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure H1Click(Sender: TObject);
procedure FindClick(Sender: TObject);
procedure sSpeedButton3Click(Sender: TObject);
procedure spdbtn2Click(Sender: TObject);
procedure GRIDSelectionChanged(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure PrintQRClick(Sender: TObject);
procedure Y1Click(Sender: TObject);
private
mS: TMemoryStream;
{ Private declarations }
public
{ Public declarations }
end;
var
AOS: TAOS;
NewBit: Boolean; // бит нового документа
BDString: string;
implementation
{$R *.dfm}
uses DMU, NEditU, SEditU, SedU, About, QuricolCode, QuricolAPI;
// Подсчет выделенных элементов и страниц...
procedure select;
var
sumselrow, Page: Integer;
begin
sumselrow := AOS.GRID.SelectedRows.Count;
AOS.GRID.Columns[1].Footer.Value := ('Выделено:' + IntToStr(sumselrow));
Page := (sumselrow + 23) div 24;
AOS.GRID.Columns[2].Footer.Value := 'Страниц на печать:' + IntToStr(Page);
end;
procedure TAOS.FormActivate(Sender: TObject);
begin
select
end;
procedure TAOS.GRIDSelectionChanged(Sender: TObject);
begin
select
end;
// Визуализация/Скрытие колонок
procedure ColVisible(a: Boolean);
begin
if a = True then
AOS.GRID.StartLoadingStatus('Пожалуйста подождите...', -1)
else
AOS.GRID.FinishLoadingStatus;
AOS.GRID.Columns[0].Visible := a;
AOS.GRID.Columns[8].Visible := a;
AOS.GRID.Columns[9].Visible := a;
end;
procedure TAOS.spdbtn2Click(Sender: TObject);
begin
ColVisible(True);
DM.PGrid.Preview;
ColVisible(False)
end;
// Удаление элементов БД
procedure TAOS.DeleteClick(Sender: TObject);
begin
if GRID.SelectedRows.CurrentRowSelected = False then
MessageBox(Handle, PChar('Не выбранно ни одной строки'),
PChar('Информация'), MB_ICONINFORMATION + MB_OK)
else if Application.MessageBox
(PChar('Вы действительно хотите удалить выделенные строки ?'),
'Внимание!!!', MB_OKCANCEL + MB_ICONWARNING) = id_OK then
GRID.SelectedRows.Delete;
end;
// Выбор действий при закрытии программы
procedure TAOS.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if DM.AOST.HasCachedChanges then
case Application.MessageBox('Сохранить изменения перед выходом ?',
'Предупреждение', MB_YESNOCANCEL + MB_ICONWARNING) of
IDYes:
begin
DM.AOST.ApplyUpdates(0);
CanClose := True;
end;
IDNo:
CanClose := True;
IDCancel:
CanClose := False;
end;
end;
procedure TAOS.N2Click(Sender: TObject);
begin
Close;
end;
// ---- Перходы на форму редактирования списков
procedure TAOS.N4Click(Sender: TObject);
begin
Vkl := 2;
SEd.ShowModal;
end;
procedure TAOS.N5Click(Sender: TObject);
begin
Vkl := 1;
SEd.ShowModal;
end;
procedure TAOS.N6Click(Sender: TObject);
begin
Vkl := 0;
SEd.ShowModal;
end;
procedure TAOS.N7Click(Sender: TObject);
begin
Vkl := 3;
SEd.ShowModal;
end;
procedure TAOS.sSpeedButton1Click(Sender: TObject);
begin
Vkl := 0;
SEd.ShowModal;
end;
// ---- Перходы на форму About
procedure TAOS.N8Click(Sender: TObject);
begin
About.ShowAboutForm;
end;
// ---- Новая запись и редактирование
procedure TAOS.NewEditClick(Sender: TObject);
begin
NEdit.Caption := 'Новая Запись';
NewBit := True;
DM.AOST.Insert;
NEdit.ShowModal;
end;
procedure TAOS.EditClick(Sender: TObject);
begin
NEdit.Caption := 'Редактирование записи';
NewBit := False;
DM.AOST.Edit;
NEdit.ShowModal;
end;
// ---- Открытие БД
procedure TAOS.P1Click(Sender: TObject);
begin
GRID.StartLoadingStatus('Загрузка БД...', -1);
if DM.OpenDB.Execute then
With DM.CON do
begin
Close;
ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;' + 'Data Source=' +
DM.OpenDB.FileName + ';Persist Security Info=false';
Open;
end;
DM.AOST.Active := True;
DM.ITT.Active := True;
DM.CabT.Active := True;
DM.OST.Active := True;
DM.SotrT.Active := True;
DM.DevT.Active := True;
DM.DSD.KeyFields := 'Код';
DM.AOST.Refresh;
GRID.FinishLoadingStatus;
end;
// Сохранение элементов БД...
procedure TAOS.sSpeedButton3Click(Sender: TObject);
begin
DM.AOST.ApplyUpdates(0)
end;
// Организация функции поиска и фильрации элементов
procedure TAOS.FindClick(Sender: TObject);
begin
if GRID.STFilter.Visible = False then
begin
GRID.STFilter.Visible := True;
Find.ImageIndex := 3;
end
else
begin
GRID.STFilter.Visible := False;
Find.ImageIndex := 4;
end;
end;
end.
unit DMU;
interface
uses
System.SysUtils, System.Classes, EhLibMTE, MemTableDataEh, Data.DB,
MemTableEh, DataDriverEh, Data.Win.ADODB, MemDS, VirtualTable, Vcl.ImgList,
Vcl.Controls, acAlphaImageList, Vcl.Menus, Vcl.Dialogs, sDialogs,
ToolCtrlsEh, DBGridEhToolCtrls, ADODataDriverEh, DynVarsEh, sSkinManager,
PrnDbgeh, frxClass, frxDBSet, frxExportPDF, ADODB2010, comobj, ADOX_TLB;
type
TDM = class(TDataModule)
VPT: TVirtualTable;
VPS: TDataSource;
AOSS: TDataSource;
CabS: TDataSource;
OSS: TDataSource;
SotrS: TDataSource;
DevS: TDataSource;
CON: TADOConnection;
ITT: TADOTable;
CabT: TADOTable;
OST: TADOTable;
SotrT: TADOTable;
DevT: TADOTable;
DSD: TDataSetDriverEh;
AOST: TMemTableEh;
AOSTКод: TAutoIncField;
AOSTCOD: TIntegerField;
AOSTИНВ: TIntegerField;
AOSTУстройство: TIntegerField;
AOSTКабинет: TIntegerField;
AOSTОС: TIntegerField;
AOSTСотрудник: TIntegerField;
AOSTДатаучета: TDateTimeField;
AOSTUpgrade: TDateTimeField;
AOSTSN: TWideStringField;
AOSTКонфигурация: TWideMemoField;
AOSTDev: TStringField;
AOSTCab: TStringField;
AOSTOS: TStringField;
AOSTSotr: TStringField;
VPTКод: TAutoIncField;
VPTKabinet: TWideStringField;
VPTINB: TWideStringField;
VPTName: TWideStringField;
VPTQRCOD: TBlobField;
MImage: TsAlphaImageList;
ITTКод: TAutoIncField;
ITTCOD: TIntegerField;
ITTИНВ: TIntegerField;
ITTУстройство: TIntegerField;
ITTКабинет: TIntegerField;
ITTОС: TIntegerField;
ITTСотрудник: TIntegerField;
ITTДатаучета: TDateTimeField;
ITTUpgrade: TDateTimeField;
ITTSN: TWideStringField;
ITTКонфигурация: TWideMemoField;
CabTКод: TAutoIncField;
CabTКабинет: TWideStringField;
OSTКод: TAutoIncField;
OSTОС: TWideStringField;
SotrTКод: TAutoIncField;
SotrTСотрудник: TWideStringField;
DevTКод: TAutoIncField;
DevTУстройство: TWideStringField;
OpenDB: TsOpenDialog;
sSkinManager1: TsSkinManager;
SFile: TsSaveDialog;
AImage: TsAlphaImageList;
PGrid: TPrintDBGridEh;
QRDS: TfrxDBDataset;
QRPrint: TfrxReport;
frxPDFExport1: TfrxPDFExport;
SQL: TADODataDriverEh;
Query: TADOQuery;
procedure DataModuleCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
DM: TDM;
procedure NewDB(FileName : String);
procedure Connect;
implementation
uses AOSU;
{ %CLASSGROUP 'Vcl.Controls.TControl' }
{$R *.dfm}
procedure NewDB(FileName : String);
begin
//
end;
procedure Connect;
var
FilePath: String;
begin
AOS.GRID.StartLoadingStatus('Загрузка БД...', -1);
if FileExists(ExtractFilePath(ParamStr(0))+ GetCurrentDir + '\db.mdb') then
FilePath := ExtractFilePath(ParamStr(0))+ GetCurrentDir + '\db.mdb'
else if FileExists(ExtractFilePath(ParamStr(0)) + GetCurrentDir + '\DB\db.mdb') then
FilePath := ExtractFilePath(ParamStr(0))+ GetCurrentDir + '\DB\db.mdb'
else if FileExists(ExtractFilePath(ParamStr(0))+ '..\..\DB\db.mdb') then
FilePath := ExtractFilePath(ParamStr(0)) + '..\..\DB\db.mdb'
else if FileExists(ExtractFilePath(ParamStr(0)) + '..\..\..\DB\db.mdb') then
FilePath := ExtractFilePath(ParamStr(0)) + '..\..\..\DB\db.mdb'
else if DM.OpenDB.Execute then
FilePath := DM.OpenDB.FileName else exit;
DM.CON.ConnectionString := ('Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;'
+ 'Data Source=' + FilePath + ';' +
'Mode=Share Deny None;Jet OLEDB:System database="";');
AOS.Caption := 'Инвентаризация оборудования';
DM.AOST.Active := True;
DM.ITT.Active := True;
DM.CabT.Active := True;
DM.OST.Active := True;
DM.SotrT.Active := True;
DM.DevT.Active := True;
DM.DSD.KeyFields:='Код';
DM.AOST.Refresh;
AOS.GRID.FinishLoadingStatus;
AOS.Show;
end;
procedure TDM.DataModuleCreate(Sender: TObject);
begin
CON.Connected:=False;
Connect;
CON.Connected:=True;
end;
end.
unit NEditU;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, cxGraphics, cxControls, cxLookAndFeels,
cxLookAndFeelPainters, cxContainer, cxEdit, cxDBLookupEdit,
cxDBLookupComboBox, cxDBEdit, cxTextEdit, cxMaskEdit,
Vcl.StdCtrls, Vcl.Mask, Vcl.DBCtrls, sDBEdit, sDBLookupComboBox, sMaskEdit,
sCustomComboEdit, sToolEdit, sDBDateEdit, sDBMemo, Vcl.Buttons, sSpeedButton;
type
TNEdit = class(TForm)
CodEdit: TsDBEdit;
InvEdit: TsDBEdit;
SNEdit: TsDBEdit;
sDBMemo1: TsDBMemo;
DevLookup: TsDBLookupComboBox;
CabLookup: TsDBLookupComboBox;
SotrLookup: TsDBLookupComboBox;
OSLookup: TsDBLookupComboBox;
DateEdit: TsDBDateEdit;
sDBDateEdit1: TsDBDateEdit;
Edit: TsSpeedButton;
procedure EditClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;
var
NEdit: TNEdit;
procedure colorR;
implementation
{$R *.dfm}
uses DMU, AOSU;
procedure colorR;
begin
NEdit.SotrLookup.BoundLabel.Font.Color := $004D352B;
NEdit.InvEdit.BoundLabel.Font.Color := $004D352B;
NEdit.DateEdit.BoundLabel.Font.Color := $004D352B;
NEdit.CabLookup.BoundLabel.Font.Color := $004D352B;
NEdit.DevLookup.BoundLabel.Font.Color := $004D352B;
end;
procedure TNEdit.EditClick(Sender: TObject);
begin
colorR;
if InvEdit.Text = '' then
InvEdit.BoundLabel.Font.Color := clRed
else if VarIsNull(DevLookup.KeyValue) = true then
DevLookup.BoundLabel.Font.Color := clRed
else if VarIsNull(SotrLookup.KeyValue) = true then
SotrLookup.BoundLabel.Font.Color := clRed
else if VarIsNull(CabLookup.KeyValue) = true then
CabLookup.BoundLabel.Font.Color := clRed
else if DateEdit.Date = 0 then
DateEdit.BoundLabel.Font.Color := clRed
else
begin
DM.AOST.Post;
NewBit := False;
Close;
end;
end;
procedure TNEdit.FormClose(Sender: TObject; var Action: TCloseAction);
begin
colorR;
if NewBit = true then
DM.AOST.Delete;
end;
end.
unit SedU;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, DBGridEhGrouping, ToolCtrlsEh,
DBGridEhToolCtrls, DynVarsEh, Vcl.Buttons, sSpeedButton, GridsEh,
DBAxisGridsEh, DBGridEh, Vcl.StdCtrls, sBitBtn;
type
TSEd = class(TForm)
BtSotr: TsBitBtn;
BtCab: TsBitBtn;
BtDev: TsBitBtn;
BtOS: TsBitBtn;
SGrid: TDBGridEh;
SIns: TsSpeedButton;
Sdel: TsSpeedButton;
SOk: TsSpeedButton;
procedure FormActivate(Sender: TObject);
procedure BtSotrClick(Sender: TObject);
procedure BtCabClick(Sender: TObject);
procedure BtDevClick(Sender: TObject);
procedure BtOSClick(Sender: TObject);
procedure SInsClick(Sender: TObject);
procedure SOkClick(Sender: TObject);
procedure SdelClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
SEd: TSEd;
Vkl: integer;
procedure Activ;
implementation
{$R *.dfm}
uses DMU, AOSU;
procedure Activ;
begin
case Vkl of
0:
begin
DM.SotrT.Cancel;
SEd.SGrid.DataSource := DM.SotrS;
SEd.Caption := 'Сотрудник';
SEd.BtSotr.SetFocus;
end;
1:
begin
DM.CabT.Cancel;
SEd.SGrid.DataSource := DM.CabS;
SEd.Caption := 'Кабинет';
SEd.BtCab.SetFocus;
end;
2:
begin
DM.DevT.Cancel;
SEd.SGrid.DataSource := DM.DevS;
SEd.Caption := 'Устройство';
SEd.BtDev.SetFocus;
end;
3:
begin
DM.OST.Cancel;
SEd.SGrid.DataSource := DM.OSS;
SEd.Caption := 'ОС';
SEd.BtOS.SetFocus;
end;
end;
end;
procedure TSEd.BtCabClick(Sender: TObject);
begin
Vkl := 1;
Activ;
end;
procedure TSEd.BtDevClick(Sender: TObject);
begin
Vkl := 2;
Activ;
end;
procedure TSEd.BtOSClick(Sender: TObject);
begin
Vkl := 3;
Activ;
end;
procedure TSEd.BtSotrClick(Sender: TObject);
begin
Vkl := 0;
Activ;
end;
procedure TSEd.FormActivate(Sender: TObject);
begin
Activ;
end;
procedure TSEd.SdelClick(Sender: TObject);
begin
case Vkl of
0:
if Application.MessageBox(PChar('Вы действительно хотите удалить: ' +
DM.SotrTСотрудник.AsString + '?' + #13 + #10 +
'Изменения будут необратимы!'), 'Внимание!!!',
MB_OKCANCEL + MB_ICONWARNING) = id_OK then
DM.SotrT.Delete;
1:
if Application.MessageBox(PChar('Вы действительно хотите удалить: ' +
DM.CabTКабинет.AsString + '?' + #13 + #10 +
'Изменения будут необратимы!'), 'Внимание!!!',
MB_OKCANCEL + MB_ICONWARNING) = id_OK then
DM.CabT.Delete;
2:
if Application.MessageBox(PChar('Вы действительно хотите удалить: ' +
DM.DevTУстройство.AsString + '?' + #13 + #10 +
'Изменения будут необратимы!'), 'Внимание!!!',
MB_OKCANCEL + MB_ICONWARNING) = id_OK then
DM.DevT.Delete;
3:
if Application.MessageBox(PChar('Вы действительно хотите удалить: ' +
DM.OSTОС.AsString + '?' + #13 + #10 + 'Изменения будут необратимы!'),
'Внимание!!!', MB_OKCANCEL + MB_ICONWARNING) = id_OK then
DM.OST.Delete;
end;
end;
procedure TSEd.SInsClick(Sender: TObject);
begin
case Vkl of
0:
DM.SotrT.Insert;
1:
DM.CabT.Insert;
2:
DM.DevT.Insert;
3:
DM.OST.Insert;
end;
end;
procedure TSEd.SOkClick(Sender: TObject);
begin
case Vkl of
0:
if DM.SotrT.Modified then
DM.SotrT.Post;
1:
if DM.CabT.Modified then
DM.CabT.Post;
2:
if DM.DevT.Modified then
DM.DevT.Post;
3:
if DM.OST.Modified then
DM.OST.Post;
end;
end;
end.