121
begin
ModalResult:=-1;
Exit
end;
ModalResult:=0;
end;
procedure TPasswordDlg.btnYesClick(Sender: TObject);
begin
if lcbUserName.Text='' then
begin
MessageDlg('Выберите пользователя',mtWarning,[mbOk],0);
ModalResult:=mrNone;
end
else
begin
UserId:=DataInfo.qListUsers.FieldByName('Id').asInteger;
UserName:=DataInfo.qListUsers.FieldByName('UserName').asString;
UserLevel:=DataInfo.qListUsers.FieldByName('TypeUser').asString;
UserPassword:=Password.Text;
ModalResult:=1
end
end;
end.
unit TypeWare;
122
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
Forms,
Dialogs, dxSkinsCore, dxSkinsDefaultPainters, cxStyles, cxGraphics,
cxEdit, cxDBLookupComboBox, cxCheckBox, Menus,
cxLookAndFeelPainters,
StdCtrls, cxButtons, cxVGrid, cxDBVGrid, cxControls,
cxInplaceContainer,
cxDropDownEdit, cxLookAndFeels;
type
TfrmTypes = class(TForm)
vgTypes: TcxDBVerticalGrid;
btnYes: TcxButton;
btnNo: TcxButton;
vgTypesTypeName: TcxDBEditorRow;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure btnNoClick(Sender: TObject);
procedure btnYesClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
123
var
frmTypes: TfrmTypes;
implementation
uses DataBase;
{$R *.dfm}
procedure TfrmTypes.FormClose(Sender: TObject; var Action:
TCloseAction);
begin
DataInfo.qTypes.Close;
end;
procedure TfrmTypes.FormShow(Sender: TObject);
begin
if frmTypes.Tag=1 then
begin
frmTypes.Caption:='Новый тип';
DataInfo.qTypes.Close;
DataInfo.qTypes.Parameters.ParamValues['TypeId']:=0;
DataInfo.qTypes.Open;
DataInfo.qTypes.Insert;
end
else
begin
124
frmTypes.Caption:=DataInfo.qListTypes.FieldByName('TypeName').asString;
DataInfo.qTypes.Close;
DataInfo.qTypes.Parameters.ParamValues['TypeId']:=DataInfo.qListTypes.FieldB
yName('Id').asInteger;
DataInfo.qTypes.Open;
DataInfo.qTypes.Edit;
end;
end;
procedure TfrmTypes.btnNoClick(Sender: TObject);
begin
DataInfo.qTypes.Cancel;
frmTypes.Close;
end;
procedure TfrmTypes.btnYesClick(Sender: TObject);
begin
if DataInfo.qTypes.FieldByName('TypeName').isNull then
begin
MessageDlg('Укажите название типа изделия!',mtError,[mbOk],0);
Exit
end;
DataInfo.qTypes.Post;
try
Pos:=DataInfo.qListTypes.GetBookmark;
DataInfo.qListTypes.Close;
125
DataInfo.qListTypes.Open;
DataInfo.qListTypes.GotoBookmark(Pos);
finally
DataInfo.qListTypes.FreeBookmark(Pos);
end;
frmTypes.Close;
end;
end.
unit Ware;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
Forms,
Dialogs, cxGraphics, cxLookAndFeels, cxLookAndFeelPainters, Menus,
dxSkinsCore, dxSkinsDefaultPainters, StdCtrls, cxButtons, cxControls,
cxStyles, cxEdit, cxDBLookupComboBox, cxVGrid, cxDBVGrid,
cxInplaceContainer;
type
TfrmWares = class(TForm)
btnYes: TcxButton;
btnNo: TcxButton;
vgWares: TcxDBVerticalGrid;
vgWaresCategoryId: TcxDBEditorRow;
vgWaresDateInput: TcxDBEditorRow;
126
vgWaresWareName: TcxDBEditorRow;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure btnNoClick(Sender: TObject);
procedure btnYesClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmWares: TfrmWares;
implementation
uses DataBase;
{$R *.dfm}
procedure TfrmWares.FormClose(Sender: TObject; var Action:
TCloseAction);
begin
DataInfo.qListUsers.Close;
DataInfo.qListCategories.Close;
DataInfo.qWares.Close;
end;
127
procedure TfrmWares.FormShow(Sender: TObject);
begin
DataInfo.qListUsers.Open;
DataInfo.qListCategories.Open;
if frmWares.Tag=1 then
begin
frmWares.Caption:='Новое изделие';
DataInfo.qWares.Close;
DataInfo.qWares.Parameters.ParamValues['WareId']:=0;
DataInfo.qWares.Open;
DataInfo.qWares.Insert;
end
else
begin
frmWares.Caption:=DataInfo.qListWares.FieldByName('WareName').asString;
DataInfo.qWares.Close;
DataInfo.qWares.Parameters.ParamValues['WareId']:=DataInfo.qListWares.FieldB
yName('Id').asInteger;
DataInfo.qWares.Open;
DataInfo.qWares.Edit;
end;
end;
procedure TfrmWares.btnNoClick(Sender: TObject);
begin
DataInfo.qWares.Cancel;
128
frmWares.Close;
end;
procedure TfrmWares.btnYesClick(Sender: TObject);
begin
if DataInfo.qWares.FieldByName('CategoryId').isNull then
begin
MessageDlg('Выберите категорию изделия!',mtError,[mbOk],0);
Exit
end;
if DataInfo.qWares.FieldByName('DateInput').isNull then
begin
MessageDlg('Укажите дату поступления!',mtError,[mbOk],0);
Exit
end;
if DataInfo.qWares.FieldByName('WareName').isNull then
begin
MessageDlg('Укажите название изделия!',mtError,[mbOk],0);
Exit
end;
DataInfo.qWares.FieldByName('UserId').asInteger:=UserId;
DataInfo.qWares.Post;
try
Pos:=DataInfo.qListWares.GetBookmark;
DataInfo.qListWares.Close;
DataInfo.qListWares.Open;
DataInfo.qListWares.GotoBookmark(Pos);
finally
129
DataInfo.qListWares.FreeBookmark(Pos);
end;
frmWares.Close;
end;
end.
unit TypeWare;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
Forms,
Dialogs, dxSkinsCore, dxSkinsDefaultPainters, cxStyles, cxGraphics,
cxEdit, cxDBLookupComboBox, cxCheckBox, Menus,
cxLookAndFeelPainters,
StdCtrls, cxButtons, cxVGrid, cxDBVGrid, cxControls,
cxInplaceContainer,
cxDropDownEdit, cxLookAndFeels;
type
TfrmTypes = class(TForm)
vgTypes: TcxDBVerticalGrid;
btnYes: TcxButton;
btnNo: TcxButton;
vgTypesTypeName: TcxDBEditorRow;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
130
procedure btnNoClick(Sender: TObject);
procedure btnYesClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmTypes: TfrmTypes;
implementation
uses DataBase;
{$R *.dfm}
procedure TfrmTypes.FormClose(Sender: TObject; var Action:
TCloseAction);
begin
DataInfo.qTypes.Close;
end;
procedure TfrmTypes.FormShow(Sender: TObject);
begin
if frmTypes.Tag=1 then
begin
frmTypes.Caption:='Новый тип';