qStoreGoods. SQL. Add ('order by gID');

updStoreGoods. RefreshSQL. LoadFromFile (AppFolder + '\Res\StoreGoods. Refresh. sql');

end;

procedure TDM. DBMainAfterConnect (Sender: TObject);

begin

trnReadMain. StartTransaction;

end;

procedure TDM. DBMainBeforeDisconnect (Sender: TObject);

begin

if trnReadMain. InTransaction then trnReadMain.commit;

if trnWriteMain. InTransaction then trnWriteMain. Rollback;

end;

procedure TDM. DataModuleCreate (Sender: TObject);

begin

smgControls. IniFileName: = ExtractFilePath (Application. ExeName) + iniControls;

LoadINIDB (ExtractFilePath (Application. ExeName) + iniDB);

LoadINISQL;

end;

procedure TDM. DataModuleDestroy (Sender: TObject);

begin

SaveINIDB (ExtractFilePath (Application. ExeName) + iniDB);

end;

procedure TDM. DBParkAfterConnect (Sender: TObject);

begin

trnReadPark. StartTransaction;

end;

procedure TDM. dbParkBeforeDisconnect (Sender: TObject);

begin

if trnReadPark. InTransaction then trnReadPark.commit;

if trnWritePark. InTransaction then trnWritePark. Rollback;

end;

procedure TDM. qCarDriverAfterOpen (DataSet: TDataSet);

begin

qCarDriver. FetchAll;

end;

procedure TDM. DBStoreAfterConnect (Sender: TObject);

begin

trnReadStore. StartTransaction;

end;

procedure TDM. DBStoreBeforeDisconnect (Sender: TObject);

begin

if trnReadStore. InTransaction then trnReadStore.commit;

if trnWriteStore. InTransaction then trnWriteStore. Rollback;

end;

end.

unit uFrmPark;

interface

uses

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

Dialogs, uFrmPattern, ImgList, ActnList, ComCtrls, DB, IBCustomDataSet,

IBUpdateSQL, IBUpdateSQLW, IBQuery, Grids, DBGridEh, ToolWin,

PropFilerEh, PropStorageEh, ExtCtrls, uFrmDrivers, StdCtrls, DBCtrls;

type

TfrmPark = class (TfrmPattern)

actNewCar: TAction;

PageControl1: TPageControl;

TabSheet1: TTabSheet;

ToolBar1: TToolBar;

ToolButton1: TToolButton;

gridCar: TDBGridEh;

ToolButton2: TToolButton;

actEditCar: TAction;

actDelCar: TAction;

ToolButton3: TToolButton;

ptnDriver: TPanel;

actAssignDriver: TAction;

actRemoveDriver: TAction;

tabDrivers: TTabSheet;

gridCarDriver: TDBGridEh;

Splitter1: TSplitter;

ToolBar2: TToolBar;

ToolButton4: TToolButton;

ToolButton5: TToolButton;

Panel2: TPanel;

pnlExtendCarData: TPanel;

Splitter2: TSplitter;

actUpdateReqState: TAction;

Panel1: TPanel;

Panel3: TPanel;

GroupBox1: TGroupBox;

txReqCompleted: TLabel;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

txRID: TLabel;

txReqClientName: TLabel;

txReqType: TLabel;

Label5: TLabel;

txCID: TLabel;

btnUpdateReqState: TButton;

procedure actNewCarExecute (Sender: TObject);

procedure actEditCarExecute (Sender: TObject);

procedure actDelCarExecute (Sender: TObject);

procedure actRemoveDriverExecute (Sender: TObject);

procedure actAssignDriverExecute (Sender: TObject);

procedure tabDriversShow (Sender: TObject);

procedure actUpdateReqStateExecute (Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

constructor Create (AOwner: TComponent); override;

function Initialize: boolean; override;

function Finalize: boolean; override;

end;

var

frmPark: TfrmPark;

frmDrivers: TfrmDrivers;

implementation

uses uDM, uConnect, uEditCar, uAssignDriver;

{$R *. dfm}

constructor TfrmPark. Create (AOwner: TComponent);

begin

inherited;

ModuleName: = 'Автопарк';

end;

procedure CarAfterScroll;

begin

with frmPark do begin

txCID. Caption: = dm. qCar. fieldByName ('cID'). AsString;

txRID. Caption: = '';

txReqClientName. Caption: = '';

txReqType. Caption: = '';

txReqCompleted. Caption: = '';

end;

end;

function TfrmPark. Initialize: boolean;

begin

if dm. DBPark. TestConnected

then result: = true

else result: = IsPositiveResult (ConnectTo (dm. dbPark, 'БД Автопарк'));

if result then begin

@dm. qCar. AfterScroll: = @CarAfterScroll;

frmDrivers: = TfrmDrivers. Create (nil);

frmDrivers. Parent: = tabDrivers;

frmDrivers. Visible: = true;

result: = frmDrivers. Initialize;

if result then begin

sControls. LoadProperties;

with DM do begin

qCar. Open;

qCar. FetchAll;

qCarDriver. Open;

qCarDriver. FetchAll;

end;

end;

end;

end;

function TfrmPark. Finalize: boolean;

begin

sControls. SaveProperties;

with DM do begin

if trnWritePark. InTransaction then

trnWritePark. Rollback;

if qCar. Active then qCar. Close;

if qCarDriver. Active then qCarDriver. Close;

if qDriver. Active then qDriver. Close;

end;

if Assigned (frmDrivers) then begin

frmDrivers. Finalize;

frmDrivers. Free;

frmDrivers: = nil;

end;

end;

procedure TfrmPark. actNewCarExecute (Sender: TObject);

begin

with TfrEditCar. Create (self) do try

Caption: = 'Добавить автомашину';

with DM do begin

updCar. UpdateTransaction. StartTransaction;

with qCar do begin

Insert;

edtCargo. Text: = '0';

edtTrailer_cnt. Text: = '0';

if isPositiveResult (Showmodal) then begin

Post;

updCar. UpdateTransaction.commit;

end else begin

CancelUpdates;

updCar. UpdateTransaction. Rollback;

end;

end;

end;

finally Free

end;

end;

procedure TfrmPark. actEditCarExecute (Sender: TObject);

begin

if not dm. qCar. IsEmpty then

with TfrEditCar. Create (self) do try

Caption: = 'Изменить автомашину';

with DM do begin

updCar. UpdateTransaction. StartTransaction;

with qCar do begin

Edit;

if isPositiveResult (Showmodal) then begin

Post;

updCar. UpdateTransaction.commit;

end else begin

CancelUpdates;

updCar. UpdateTransaction. Rollback;

end;

end;

end;

finally Free

end;

end;

procedure TfrmPark. actRemoveDriverExecute (Sender: TObject);

begin

with DM do if not qCarDriver. IsEmpty then begin

qWritepark. Transaction. StartTransaction;

with qWritepark do begin

SQL. Text: = 'update driver set driver. CAR = NULL where dID =: dID';

ParamByName ('dID'). AsInteger: = qCarDriver. FieldByName ('dID'). AsInteger;

ExecSQL;

end;

qWritepark. Transaction.commit;

qCarDriver. Close;

qCarDriver. Open;

end;

end;

procedure TfrmPark. actAssignDriverExecute (Sender: TObject);

begin

with TfrAssignDriver. Create (self) do try

with DM do begin

with qCar do begin

if isPositiveResult (Showmodal) and (dID <> 0) then begin

qWritePark. Transaction. StartTransaction;

with qWritePark do begin

SQL. Text: = 'update driver set driver. CAR =: CAR where DID =: DID';

ParamByName ('dID'). AsInteger: = dID;

ParamByName ('CAR'). AsInteger: = qCar. FieldByName ('cID'). AsInteger;

ExecSQL;

end;

qWritePark. Transaction.commit;

qCarDriver. Close;

qCarDriver. Open;

end;

end;

end;

finally Free

end;

end;

procedure TfrmPark. actDelCarExecute (Sender: TObject);

begin

with DM do if not qCar. IsEmpty then begin

updCar. UpdateTransaction. StartTransaction;

qCar. Delete;

updCar. UpdateTransaction.commit;

end;

end;

procedure TfrmPark. tabDriversShow (Sender: TObject);

begin

with DM do begin

qDriver. Close;

qDriver. Open;

end;

end;

procedure TfrmPark. actUpdateReqStateExecute (Sender: TObject);

begin

if dm. DBMain. TestConnected or IsPositiveResult (ConnectTo (dm. dbMain, 'Главная БД'))

then

with DM. qRead do begin

SQL. LoadFromFile (ExtractFilePath (Application. ExeName) + '\Res\Car. Request. sql');

ParamByName ('RID'). AsInteger: = dm. qCar. FieldByName ('request'). AsInteger;

Open;

txCID. Caption: = dm. qCar. FieldByName ('CID'). AsString;

txRID. Caption: = FieldByName ('rID'). AsString;

txReqClientName. Caption: = FieldByName ('client_name'). AsString;

txReqType. Caption: = FieldByName ('request_type_name'). AsString;

if not FieldByName ('completed'). IsNull then

if FieldByName ('completed'). AsInteger = 0

then txReqCompleted. Caption: = 'Не выполнена'

else txReqCompleted. Caption: = 'Выполнена';

Close;

end

else MessageDlg ('Отсутствует соединение с БД, необходимой '#13'для работы модуля', mtError, [mbOK], 0);

end;

end.

unit uFrmUsers;

interface

uses

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

Dialogs, uFrmPattern, ImgList, ActnList, ComCtrls, StdCtrls, ExtCtrls,

Grids, DBGridEh, ToolWin, PropFilerEh, PropStorageEh, DB, DBGrids;

type

TFrmUsers = class (TfrmPattern)

gridUsers: TDBGridEh;

pnlRules: TPanel;

Label1: TLabel;

Label2: TLabel;

ToolBar1: TToolBar;

btnAddUser: TToolButton;

btnEditUser: TToolButton;

btnDelUser: TToolButton;

actNewUser: TAction;

actEditUser: TAction;

actDelUser: TAction;

actSaveUser: TAction;

actCancelUser: TAction;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

Panel2: TPanel;

DataSource1: TDataSource;

procedure actNewUserExecute (Sender: TObject);

procedure actEditUserExecute (Sender: TObject);

procedure actDelUserExecute (Sender: TObject);

procedure actSaveUserExecute (Sender: TObject);

procedure actCancelUserExecute (Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

{ModuleName: string;

ModuleID: integer; }

constructor Create (AOwner: TComponent); override;

function Initialize: boolean; override;

function Finalize: boolean; override;

end;

var

FrmUsers: TFrmUsers;

implementation

uses uDM, uSettings, uConstants, uConnect, uEditUsers;

{$R *. dfm}

constructor TFrmUsers. Create (AOwner: TComponent);

begin

inherited;

ModuleName: = 'Пользователи';

end;

function TFrmUsers. Initialize: boolean;

begin

if dm. DBMain. TestConnected

then result: = true

else result: = IsPositiveResult (ConnectTo (dm. DBMain, 'Главная БД'));

if result then begin

sControls. LoadProperties;

with DM do begin

qUsers. Open;

qUsers. FetchAll;

end;

end;

end;

function TFrmUsers. Finalize: boolean;

begin

sControls. SaveProperties;

with DM do begin

if trnWriteMain. InTransaction then

trnWriteMain. Rollback;

if qUsers. Active then qUsers. Close;

end;

end;

procedure TFrmUsers. actNewUserExecute (Sender: TObject);

var uID: integer;

begin

with DM do

with TfrEditUsers. Create (self) do try

Caption: = 'Добавить пользователя';

if isPositiveResult (Showmodal) then begin

trnWriteMain. StartTransaction;

with qWrite do begin

SQL. Text: = 'select * from users_insert (: pass,: rules,: name,: login) ';

ParamByName ('name'). AsString: = edtName. Text;

ParamByName ('rules'). AsString: = edtRules. Text;

ParamByName ('pass'). AsString: = edtPass. Text;

ParamByName ('login'). AsString: = edtLogin. Text;

Open;

uID: = FieldByName ('uID'). AsInteger;

Close;

end;

trnWriteMain.commit;

with qUsers do begin

DisableControls;

Close;

Open;

Locate ('uID',uID, []);

EnableControls;

end;

end;

finally Free

end;

end;

procedure TFrmUsers. actEditUserExecute (Sender: TObject);

var uID: integer;

begin

with DM do

with TfrEditUsers. Create (self) do try

Caption: = 'Изменить пользователя';

with qUsers do begin

edtName. Text: = FieldByName ('name'). AsString;

edtRules. Text: = FieldByName ('rules'). AsString;

edtPass. Text: = FieldByName ('pass'). AsString;

edtLogin. Text: = FieldByName ('login'). AsString;

if AnsiUpperCase (FieldByName ('login'). AsString) = 'ADMIN'

then begin

edtRules. Enabled: = false;

edtLogin. Enabled: = false;

end;

end;

if isPositiveResult (Showmodal) then begin

trnWriteMain. StartTransaction;

with qWrite do begin

SQL. Text: = 'execute procedure users_update (: rules,: pass,: name,: uid,: login) ';

ParamByName ('uid'). AsInteger: = qUsers. FieldByName ('uID'). AsInteger;

ParamByName ('name'). AsString: = edtName. Text;

ParamByName ('rules'). AsString: = edtRules. Text;

ParamByName ('pass'). AsString: = edtPass. Text;

ParamByName ('login'). AsString: = edtLogin. Text;

ExecSQL;

end;

trnWriteMain.commit;

with qUsers do begin

uID: = FieldByName ('uID'). AsInteger;

DisableControls;

Close;

Open;

Locate ('uID',uID, []);

EnableControls;

end;

end;

finally Free

end;

end;

procedure TFrmUsers. actDelUserExecute (Sender: TObject);

var uID: integer;

begin

with DM do if not qUsers. IsEmpty then begin

if AnsiUpperCase (qUsers. FieldByName ('login'). AsString) <> 'ADMIN' then begin

trnWriteMain. StartTransaction;

with qWrite do begin

SQL. Text: = 'execute procedure users_delete (: uid) ';

ParamByName ('uid'). AsInteger: = qUsers. FieldByName ('uID'). AsInteger;

ExecSQL;

end;

trnWriteMain.commit;

with qUsers do begin

uID: = FieldByName ('uID'). AsInteger;

DisableControls;

Close;

Open;

Locate ('uID',uID, []);

EnableControls;

end;

end else MessageDlg ('Невозможно удалить запись администратора! ', mtError, [mbOK], 0);

end;

end;

procedure TFrmUsers. actSaveUserExecute (Sender: TObject);

var fID: integer;

begin

with DM do

with qUsers do

if trnWriteMain. InTransaction then begin

if Modified then qUsers. Post;

fID: = FieldByName ('uID'). AsInteger;

trnWriteMain.commit;

DisableControls;

Close;

Open;

Locate ('uID',fID, []);

EnableControls;

end;

end;

procedure TFrmUsers. actCancelUserExecute (Sender: TObject);

var fID: integer;

begin

with DM do

with qUsers do

if trnWriteMain. InTransaction then begin

if Modified then CancelUpdates;

fID: = FieldByName ('uID'). AsInteger;

trnWriteMain. Rollback;

DisableControls;

Close;

Open;

Locate ('uID',fID, []);

EnableControls;

end;

end;

end.

unit uSettings;

interface

uses

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

Dialogs, StdCtrls, PropFilerEh, PropStorageEh, ExtCtrls, iniFiles;

type

TfrSettings = class (TForm)

grDb: TGroupBox;

cmdConnection: TComboBox;

Label2: TLabel;

labelIP: TLabel;

edtIP: TEdit;

labelPort: TLabel;

edtPort: TEdit;

edtDB: TEdit;

Label5: TLabel;

pnlBtn: TPanel;

btnCancel: TButton;

btnOK: TButton;

btnLocateDb: TButton;

dlgLocateDb: TOpenDialog;

procedure FormShow (Sender: TObject);

procedure cmdConnectionChange (Sender: TObject);

procedure btnLocateDbClick (Sender: TObject);

procedure FormCloseQuery (Sender: TObject; var CanClose: Boolean);

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

private

{ Private declarations }

ConnectionStringLast: string;

public

{ Public declarations }

ConnectionString: string;

iniFilename, iniSection: string;

procedure SaveINI (filename, section: string);

procedure LoadINI (filename, section: string);

end;

var

frSettings: TfrSettings;

implementation

uses uDM;

{$R *. dfm}

function isInt (str: string): boolean;

begin

result: = true;

try

StrToInt (str);

except

on E: EConvertError do result: = false;

end;

end;

procedure TfrSettings. SaveINI (filename, section: string);

begin

with TIniFile. Create (filename) do try

WriteInteger (section, 'cmdConnectionIndex', cmdConnection. ItemIndex);

WriteBool (section, 'labelIPVisible', labelIP. Visible);

WriteBool (section, 'labelPortVisible', labelPort. Visible);

WriteBool (section, 'edtIPVisible', edtIP. Visible);

WriteBool (section, 'edtPortVisible', edtPort. Visible);

WriteString (section, 'edtIP', edtIP. Text);

WriteString (section, 'edtPort', edtPort. Text);

WriteString (section, 'edtDB', edtDB. Text);

UpdateFile;

Free;

except

on e: Exception do MessageDlg ('Ошибка ini-файла: ' + e. Message, mtError, [mbOK], 0)

end;

end;

procedure TfrSettings. LoadINI (filename, section: string);

begin

with TIniFile. Create (filename) do try

cmdConnection. ItemIndex: = ReadInteger (section, 'cmdConnectionIndex', 0);

labelIP. Visible: = ReadBool (section, 'edtIPVisible', true);

labelPort. Visible: = ReadBool (section, 'edtPortVisible', true);

edtIP. Visible: = ReadBool (section, 'edtIPVisible', true);

edtPort. Visible: = ReadBool (section, 'edtPortVisible', true);

edtIP. Text: = ReadString (section, 'edtIP', '');

edtPort. Text: = ReadString (section, 'edtPort', '');

edtDB. Text: = ReadString (section, 'edtDB', '');

Free;

except

on e: Exception do MessageDlg ('Ошибка ini-файла: ' + e. Message, mtError, [mbOK], 0)

end;

end;

procedure TfrSettings. FormShow (Sender: TObject);

begin

// к этому моменту должны быть заданы iniFilename, iniSection

LoadINI (iniFilename, iniSection);

if cmdConnection. ItemIndex = 0

then ConnectionString: = edtDB. Text // Локальное подключение

else ConnectionString: = edtIP. Text + '/ ' + edtPort. Text + ': ' + edtDB. Text; // Удаленное

ConnectionStringLast: = ConnectionString;

end;

procedure TfrSettings. cmdConnectionChange (Sender: TObject);

begin

if (sender as TComboBox). ItemIndex = 0 then begin

labelIP. Visible: = false;

edtIP. Visible: = false;

labelPort. Visible: = false;

edtPort. Visible: = false;

ConnectionString: = edtDB. Text;

btnLocateDb. Visible: = true;

end

else begin

labelIP. Visible: = true;

edtIP. Visible: = true;

labelPort. Visible: = true;

edtPort. Visible: = true;

btnLocateDb. Visible: = false;

ConnectionString: = edtIP. Text + '/ ' + edtPort. Text + ': ' + edtDB. Text;

end;

end;

procedure TfrSettings. btnLocateDbClick (Sender: TObject);

begin

if dlgLocateDb. Execute and (dlgLocateDb. FileName <> '') then

edtDB. Text: = dlgLocateDb. FileName;

end;

procedure TfrSettings. FormCloseQuery (Sender: TObject;

var CanClose: Boolean);

begin

if ModalResult = mrOK then begin

CanClose: = false;

if (cmdConnection. ItemIndex = 1) and (length (edtIP. Text) = 0)

then MessageDlg ('Ошибка ввода'#13'Поле "IP-адрес сервера" не может быть пустым', mtError, [mbOK], 0)

else

if (cmdConnection. ItemIndex = 1) and (length (edtPort. Text) = 0)

then MessageDlg ('Ошибка ввода'#13'Поле "Порт" не может быть пустым', mtError, [mbOK], 0)

else

if length (edtDB. Text) = 0

then MessageDlg ('Ошибка ввода'#13'Поле "Путь к файлу БД" не может быть пустым', mtError, [mbOK], 0)

else begin

dlgLocateDb. InitialDir: = ExtractFilePath (dlgLocateDb. FileName);

SaveINI (iniFilename, iniSection);

if cmdConnection. ItemIndex = 0

then ConnectionString: = edtDB. Text

else ConnectionString: = edtIP. Text + '/ ' + edtPort. Text + ': ' + edtDB. Text;

CanClose: = true;

end;

end;

end;

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

begin

if ConnectionString = ConnectionStringLast

then ModalResult: = mrCancel;

end;

end.

unit uDBState;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls, IBDAtabase;

type

TfrDBState = class (TForm)

pnlBtn: TPanel;

btnClose: TButton;

GroupBox1: TGroupBox;

t1: TLabel;

btnDBMain: TButton;

btnConnectDBMain: TButton;

btnDct1: TButton;

Label1: TLabel;

GroupBox2: TGroupBox;

Label2: TLabel;

t2: TLabel;

btnDct2: TButton;

btnConnectDBPark: TButton;

btnDBPark: TButton;

GroupBox3: TGroupBox;

t3: TLabel;

btnDBStore: TButton;

btnConnectDBStore: TButton;

btnDct3: TButton;

Label3: TLabel;

procedure btnDBMainClick (Sender: TObject);

procedure FormShow (Sender: TObject);

procedure btnDBParkClick (Sender: TObject);

procedure btnDBStoreClick (Sender: TObject);

procedure btnConnectDBMainClick (Sender: TObject);

procedure btnConnectDBParkClick (Sender: TObject);

procedure btnConnectDBStoreClick (Sender: TObject);

procedure btnDct1Click (Sender: TObject);

procedure btnDct2Click (Sender: TObject);

procedure btnDct3Click (Sender: TObject);

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

private

{ Private declarations }

modified: boolean;

procedure TestConnected;

procedure TryConnect (DB: TIBDatabase; FormCaption: string);

public

{ Public declarations }

end;

var

frDBState: TfrDBState;

implementation

uses uDM, uSettings, uConstants, UConnect;

{$R *. dfm}

procedure TfrDBState. TryConnect (DB: TIBDatabase; FormCaption: string);

begin

ConnectTo (DB, FormCaption);

TestConnected;

modified: = true;

end;

procedure TfrDBState. TestConnected;

begin

with DM do begin

if DBMain. TestConnected then begin

t1. Font. Color: = clGreen;

t1. Caption: = 'Активно';

end else begin

t1. Font. Color: = clRed;

t1. Caption: = 'Неактивно';

end;

if DBPark. TestConnected then begin

t2. Font. Color: = clGreen;

t2. Caption: = 'Активно';

end else begin

t2. Font. Color: = clRed;

t2. Caption: = 'Неактивно';

end;

if DBStore. TestConnected then begin

t3. Font. Color: = clGreen;

t3. Caption: = 'Активно';

end else begin

t3. Font. Color: = clRed;

t3. Caption: = 'Неактивно';

end;

end;

end;

procedure TfrDBState. FormShow (Sender: TObject);

begin

TestConnected;

modified: = false;

end;

procedure TfrDBState. btnDBMainClick (Sender: TObject);

var cs: string;

begin

with (TfrSettings. Create (nil)) do try

iniFilename: = ExtractFilePath (Application. ExeName) + iniDB;

iniSection: = iniDBMainSection;

if isPositiveResult (ShowModal) then begin

if dm. DBMain. TestConnected then begin

dm. DBMain. Close;

TestConnected;

end;

dm. DBMain. DatabaseName: = ConnectionString;

end;

Finally Free;

end;

end;

procedure TfrDBState. btnDBParkClick (Sender: TObject);

begin

with (TfrSettings. Create (nil)) do try

iniFilename: = ExtractFilePath (Application. ExeName) + iniDB;

iniSection: = iniDBParkSection;

if isPositiveResult (ShowModal) then begin

if dm. DBPark. TestConnected then begin

dm. DBPark. Close;

TestConnected;

end;

dm. DBPark. DatabaseName: = ConnectionString;

end;

Finally Free;

end;

end;

procedure TfrDBState. btnDBStoreClick (Sender: TObject);

begin

with (TfrSettings. Create (nil)) do try

iniFilename: = ExtractFilePath (Application. ExeName) + iniDB;

iniSection: = iniDBStoreSection;

if isPositiveResult (ShowModal) then begin

if dm. DBStore. TestConnected then begin

dm. DBStore. Close;

TestConnected;

end;

dm. DBStore. DatabaseName: = ConnectionString;

end;

Finally Free;

end;

end;

procedure TfrDBState. btnConnectDBMainClick (Sender: TObject);

begin

TryConnect (dm. DBMain, 'Главная БД');

end;

procedure TfrDBState. btnConnectDBParkClick (Sender: TObject);

begin

TryConnect (dm. DBPark, 'БД Автопарк');

end;

procedure TfrDBState. btnConnectDBStoreClick (Sender: TObject);

begin

TryConnect (dm. DBStore, 'БД Склад');

end;

procedure TfrDBState. btnDct1Click (Sender: TObject);

begin

if dm. DBMain. TestConnected then begin

dm. DBMain. Connected: = false;

TestConnected;

modified: = true;

end;

end;

procedure TfrDBState. btnDct2Click (Sender: TObject);

begin

if dm. DBPark. TestConnected then begin

dm. DBPark. Connected: = false;

TestConnected;

modified: = true;

end;

end;

procedure TfrDBState. btnDct3Click (Sender: TObject);

begin

if dm. DBStore. TestConnected then begin

dm. DBStore. Connected: = false;

TestConnected;

modified: = true;

end;

end;

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

begin

if modified then ModalResult: = mrCancel else ModalResult: = mrOk;

end;

end.

unit uFrmStore;

interface

uses

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

Dialogs, uFrmPattern, PropFilerEh, PropStorageEh, ImgList, ActnList,

ComCtrls, Grids, DBGridEh, ExtCtrls, ToolWin;

type

TfrmStore = class (TfrmPattern)

gridGoods: TDBGridEh;

ToolBar1: TToolBar;

ToolButton1: TToolButton;

actNewGoods: TAction;

actEditGoods: TAction;

actDelGoods: TAction;

Panel3: TPanel;

ToolButton2: TToolButton;

ToolButton3: TToolButton;

actFilterGoods: TAction;

ToolButton4: TToolButton;

procedure actNewGoodsExecute (Sender: TObject);

procedure actDelGoodsExecute (Sender: TObject);

procedure actEditGoodsExecute (Sender: TObject);

procedure actFilterGoodsExecute (Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

constructor Create (AOwner: TComponent); override;

function Initialize: boolean; override;

function Finalize: boolean; override;

end;

var

frmStore: TfrmStore;

implementation

uses uDM, uConnect, uEditStoreGoods, uFilterStoreGoods;

{$R *. dfm}

constructor TfrmStore. Create (AOwner: TComponent);

begin

inherited;

ModuleName: = 'Склад';

end;

function TfrmStore. Initialize: boolean;

begin

if dm. DBStore. TestConnected

then result: = true

else result: = IsPositiveResult (ConnectTo (dm. DBStore, 'БД Склад'));

if result then begin

sControls. LoadProperties;

with DM do begin

qStoreGoods. Open;

qStoreGoods. FetchAll;

end;

end;

end;

function TfrmStore. Finalize: boolean;

begin

sControls. SaveProperties;

with DM do begin

if trnWriteStore. InTransaction then

trnWriteStore. Rollback;

if qStoreGoods. Active then qStoreGoods. Close;

end;

end;

procedure TfrmStore. actNewGoodsExecute (Sender: TObject);

begin

with TfrEditStoreGoods. Create (self) do try

Caption: = 'Добавить товар';

with DM do begin

updStoreGoods. UpdateTransaction. StartTransaction;

with qStoreGoods do begin

Insert;

FieldByName ('IS_OLD'). AsInteger: = 0;

FieldByName ('CNT'). AsInteger: = 1;

if isPositiveResult (Showmodal) then begin

if clientID <> - 1 then FieldByName ('CLIENT'). AsInteger: = clientID;

Post;

updStoreGoods. UpdateTransaction.commit;

end else begin

CancelUpdates;

updStoreGoods. UpdateTransaction. Rollback;

end;

Refresh;

end;

end;

finally Free

end;

end;

procedure TfrmStore. actEditGoodsExecute (Sender: TObject);

begin

if not dm. qStoreGoods. IsEmpty then

with TfrEditStoreGoods. Create (self) do try

Caption: = 'Добавить товар';

with DM do begin

updStoreGoods. UpdateTransaction. StartTransaction;

with qStoreGoods do begin

Edit;

edtClient. Text: = FieldByName ('CLIENT_NAME'). AsString;

if not FieldByName ('CLIENT'). IsNull then

clientID: = FieldByName ('CLIENT'). AsInteger;

if isPositiveResult (Showmodal) then begin

if clientID <> - 1 then FieldByName ('CLIENT'). AsInteger: = clientID;

Post;

updStoreGoods. UpdateTransaction.commit;

end else begin

CancelUpdates;

updStoreGoods. UpdateTransaction. Rollback;

end;

Refresh;

end;

end;

finally Free

end;

end;

procedure TfrmStore. actFilterGoodsExecute (Sender: TObject);

begin

with DM do

with ftFilterStoreGoods do begin

if isPositiveResult (Showmodal) then begin

qStoreGoods. Close;

qStoreGoods. SQL. LoadFromFile (ExtractFilePath (Application. ExeName) + '\Res\StoreGoods. Select. sql');

qStoreGoods. SQL. Add (FilterSQL);

qStoreGoods. SQL. Add (' order by gID ');

qStoreGoods. Open;

qStoreGoods. FetchAll;

end else begin

end;

end;

end;

procedure TfrmStore. actDelGoodsExecute (Sender: TObject);

begin

with DM do if not qStoreGoods. IsEmpty then begin

updStoreGoods. UpdateTransaction. StartTransaction;

qStoreGoods. Delete;

updStoreGoods. UpdateTransaction.commit;

end;

end;

end.

unit uFrmClient;

interface

uses

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

Dialogs, uFrmPattern, PropFilerEh, PropStorageEh, ImgList, ActnList,

ComCtrls, IBCustomDataSet, IBUpdateSQL, IBUpdateSQLW, DB, IBQuery, Grids,

DBGridEh, IBDatabase, ActnMan, ActnColorMaps, ToolWin, ExtCtrls;

type

TfrmClient = class (TfrmPattern)

gridClient: TDBGridEh;

dsClient: TDataSource;

qClient: TIBQuery;

updClient: TIBUpdateSQLW;

qClientNAME: TIBStringField;

qClientDETAIL: TIBStringField;

ToolBar1: TToolBar;

ToolButton1: TToolButton;

trnWriteClient: TIBTransaction;

actNewClient: TAction;

ectEditClient: TAction;

actDelClient: TAction;

qClientCID: TIntegerField;

ToolButton2: TToolButton;

ToolButton3: TToolButton;

Panel2: TPanel;

procedure actNewClientExecute (Sender: TObject);

procedure ectEditClientExecute (Sender: TObject);

procedure actDelClientExecute (Sender: TObject);

private

{ Private declarations }

public

DB: TIBDatabase;

constructor Create (AOwner: TComponent); override;

function Initialize: boolean; override;

function Finalize: boolean; override;

end;

implementation

uses uDM, uConnect, uEditClient;

{$R *. dfm}

constructor TfrmClient. Create (AOwner: TComponent);

begin

inherited;

ModuleName: = 'Склад';

end;

function TfrmClient. Initialize: boolean;

begin

// К этому моменту свойство DB должно быть задано

if DB. TestConnected

then result: = true

else result: = IsPositiveResult (ConnectTo (DB, 'База данных'));

if result then begin

sControls. LoadProperties;

with DM do begin

trnWriteClient. DefaultDatabase: = DB; // Пишущая транзакция

qClient. Transaction: = DB. DefaultTransaction; // Читающая транзакция

qClient. Database: = DB;

qClient. Open;

qClient. FetchAll;

end;

end;

end;

function TfrmClient. Finalize: boolean;

begin

sControls. SaveProperties;

with DM do begin

if trnWriteClient. InTransaction then

trnWriteClient. Rollback;

if qClient. Active then qClient. Close;

end;

end;

procedure TfrmClient. actNewClientExecute (Sender: TObject);

begin

with TfrEditClient. Create (self) do try

Caption: = 'Добавить клиента';

updClient. UpdateTransaction. StartTransaction;

with qClient do begin

Insert;

edtName. Text: = '';

edtDetail. Text: = '';

if isPositiveResult (Showmodal) then begin

FieldByName ('NAME'). AsString: = edtName. Text;

FieldByName ('DETAIL'). AsString: = edtDetail. Text;

Post;

updClient. UpdateTransaction.commit;

end else begin

CancelUpdates;

updClient. UpdateTransaction. Rollback;

end;

end;

finally Free

end;

end;

procedure TfrmClient. ectEditClientExecute (Sender: TObject);

begin

if not qClient. IsEmpty then

with TfrEditClient. Create (self) do try

Caption: = 'Изменить клиента';

updClient. UpdateTransaction. StartTransaction;

with qClient do begin

Edit;

edtName. Text: = FieldByName ('NAME'). AsString;

edtDetail. Text: = FieldByName ('DETAIL'). AsString;

if isPositiveResult (Showmodal) then begin

FieldByName ('NAME'). AsString: = edtName. Text;

FieldByName ('DETAIL'). AsString: = edtDetail. Text;

Post;

updClient. UpdateTransaction.commit;

end else begin

CancelUpdates;

updClient. UpdateTransaction. Rollback;

end;

end;

finally Free

end;

end;

procedure TfrmClient. actDelClientExecute (Sender: TObject);

begin

if not qClient. IsEmpty then begin

updClient. UpdateTransaction. StartTransaction;

qClient. Delete;

updClient. UpdateTransaction.commit;

end;

end;

end.

unit uFrmDrivers;

interface

uses

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

Dialogs, uFrmPattern, PropFilerEh, PropStorageEh, ImgList, ActnList,

ComCtrls, Grids, DBGridEh, ToolWin, ExtCtrls;

type

TfrmDrivers = class (TfrmPattern)

ToolBar1: TToolBar;

ToolButton1: TToolButton;

ToolButton2: TToolButton;

ToolButton3: TToolButton;

gridCar: TDBGridEh;

actNewDriver: TAction;

actEditDriver: TAction;

actDelDriver: TAction;

Panel2: TPanel;

procedure actNewDriverExecute (Sender: TObject);

procedure actEditDriverExecute (Sender: TObject);

procedure actDelDriverExecute (Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

constructor Create (AOwner: TComponent); override;

function Initialize: boolean; override;

function Finalize: boolean; override;

end;

implementation

uses uDM, uEditDriver;

{$R *. dfm}

constructor TfrmDrivers. Create (AOwner: TComponent);

begin

inherited;

ModuleName: = 'Водители';

end;

function TfrmDrivers. Initialize: boolean;

begin

if dm. DBPark. TestConnected then begin

sControls. LoadProperties;

with DM do begin

if qDriver. Active then qDriver. Close;

qDriver. Open;

qDriver. FetchAll;

end;

result: = true

end

else result: = false;

end;

function TfrmDrivers. Finalize: boolean;

begin

sControls. SaveProperties;

end;

procedure TfrmDrivers. actNewDriverExecute (Sender: TObject);

begin

with TfrEditDriver. Create (self) do try

Caption: = 'Добавить водителя';

with DM do begin

updDriver. UpdateTransaction. StartTransaction;

with qDriver do begin

Insert;

if isPositiveResult (Showmodal) then begin

Post;

updDriver. UpdateTransaction.commit;

end else begin

CancelUpdates;

updDriver. UpdateTransaction. Rollback;

end;

end;

end;

finally Free

end;

end;

procedure TfrmDrivers. actEditDriverExecute (Sender: TObject);

begin

if not dm. qDriver. IsEmpty then

with TfrEditDriver. Create (self) do try

Caption: = 'Изменить водителя';

with DM do begin

updDriver. UpdateTransaction. StartTransaction;

with qDriver do begin

Edit;

if isPositiveResult (Showmodal) then begin

Post;

updDriver. UpdateTransaction.commit;

end else begin

CancelUpdates;

updDriver. UpdateTransaction. Rollback;

end;

end;

end;

finally Free

end;

end;

procedure TfrmDrivers. actDelDriverExecute (Sender: TObject);

begin

with DM do if not qDriver. IsEmpty then begin

updDriver. UpdateTransaction. StartTransaction;

qDriver. Delete;

updDriver. UpdateTransaction.commit;

end;

end;

end.

unit uConnect;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls, IBDatabase;

const

WaitConnect = 10;

WaitClose = 3;

type

TfrConnect = class (TForm)

btnCancel: TButton;

t1: TLabel;

Timer: TTimer;

t2: TLabel;

procedure TimerTimer (Sender: TObject);

procedure FormShow (Sender: TObject);

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

private

{ Private declarations }

fConnectionString: string;

fDB: TIBDatabase;

function TryConnect: boolean;

public

{ Public declarations }

end;

var

frConnect: TfrConnect;

i: integer;

Closing: boolean;

function ConnectTo (DB: TIBDatabase; FormCaption: string): integer;

implementation

{$R *. dfm}

uses uDM;

function ConnectTo (DB: TIBDatabase; FormCaption: string): integer;

begin

with (TfrConnect. Create (nil)) do try

fDB: = db;

Caption: = FormCaption;

result: = ShowModal;

Finally Free;

end;

end;

function TfrConnect. TryConnect;

var t: integer;

begin

result: = false;

try

if fDB. Connected then begin

fDB. CloseDataSets;

fDB. Connected: = false;

end;

fDB. Connected: = true;

if fDB. TestConnected then

result: = true;

except

on E: Exception do begin

t1. Caption: = 'Ошибка подключения'; // + e. Message;

result: = false;

end;

end;

end;

procedure TfrConnect. TimerTimer (Sender: TObject);

begin

t2. Caption: = '';

dec (i);

if (i = 0) then begin

if Closing

then ModalResult: = mrOK

else begin

t1. Caption: = 'Подключение. ';

Update;

if TryConnect then begin

// Подключение успешно, отсчет до закрытия окна

t1. Caption: = 'Подключение установлено';

Update;

btnCancel. ModalResult: = mrOK;

btnCancel. Caption: = 'Закрыть [' + inttostr (WaitClose) +'] ';

i: = WaitClose;

closing: = true;

end

else begin

t1. Caption: = 'Ошибка подключения';

Update;

i: = WaitConnect; // Ошибка подключения, сброс таймера

end;

end;

end

else // i <> 0, отсчет

if Closing

then btnCancel. Caption: = 'Закрыть [' + inttostr (i) + '] '

else t2. Caption: = 'Повтор через ' + inttostr (i) + ' секунд';

end;

procedure TfrConnect. FormShow (Sender: TObject);

begin

i: = 1;

btnCancel. ModalResult: = mrCancel;

btnCancel. Caption: = 'Отмена';

t1. Caption: = 'Подключение. ';

t2. Caption: = '';

Closing: = false;

Timer. Enabled: = true;

end;

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

begin

Timer. Enabled: = false;

end;

end.

unit uFilterRequest;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls, DBCtrls;

type

TfrFilterRequest = class (TForm)

pnlBtns: TPanel;

btnCancel: TButton;

btnOK: TButton;

Label1: TLabel;

edtName: TEdit;

Label2: TLabel;

cbCompleted: TCheckBox;

cbRequestType: TComboBox;

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

procedure FormShow (Sender: TObject);

private

{ Private declarations }

function MakeFilter: boolean;

public

{ Public declarations }

FilterSQL: string;

end;

var

frFilterRequest: TfrFilterRequest;

implementation

uses uDM;

{$R *. dfm}

function TfrFilterRequest. MakeFilter: boolean;

begin

result: = false;

FilterSQL: = '';

if length (edtName. Text) > 0 then

FilterSQL: = FilterSQL + ' (UPPER (c. name) LIKE ''%' + AnsiUpperCase (edtName. Text) + '%'') and ';

if Integer (cbRequestType. Items. Objects [cbRequestType. ItemIndex]) <> 0 then

FilterSQL: = FilterSQL + ' (r. request_type = ' + inttostr (Integer (cbRequestType. Items. Objects [cbRequestType. ItemIndex])) + ') and ';

if not (cbCompleted. State = cbGrayed) then

if cbCompleted. Checked

then FilterSQL: = FilterSQL + ' (r.completed = 1) and '

else FilterSQL: = FilterSQL + ' (r.completed = 0) and ';

if length (FilterSQL) > 0 then begin

FilterSQL: = ' where ' + FilterSQL;

setlength (FilterSQL, length (FilterSQL) - 4);

end;

end;

procedure TfrFilterRequest. FormClose (Sender: TObject;

var Action: TCloseAction);

begin

MakeFilter;

end;

procedure TfrFilterRequest. FormShow (Sender: TObject);

begin

edtName. SetFocus;

if cbRequestType. Items. Count = 0 then begin

cbRequestType. Clear;

cbRequestType. AddItem ('Нет', nil);

cbRequestType. ItemIndex: = 0;

if dm. DBMain. TestConnected then

with DM. qRead do begin

SQL. Text: = 'select tID,NAME from request_type';

Open;

FetchAll;

First;

while not EOF do begin

cbRequestType. AddItem (FieldByName ('NAME'). AsString, pointer (FieldByName ('tID'). AsInteger));

Next;

end;

Close;

end

else MessageDlg ('Отсутствует соединение с БД, необходимой '#13'для работы модуля', mtError, [mbOK], 0);

end;

end;

end.

unit uEditStoreGoods;

interface

uses

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

Dialogs, StdCtrls, Mask, DBCtrlsEh, ExtCtrls, DBCtrls;

type

TfrEditStoreGoods = class (TForm)

pnlBtns: TPanel;

btnCancel: TButton;

btnOK: TButton;

GroupBox1: TGroupBox;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

edtName: TDBEditEh;

edtKey: TDBEditEh;

edtCnt: TDBEditEh;

edtSize: TDBEditEh;

edtWeight: TDBEditEh;

GroupBox3: TGroupBox;

edtClient: TEdit;

btnAssignClient: TButton;

cbIS_OLD: TDBCheckBox;

Label6: TLabel;

edtRequest: TDBEditEh;

GroupBox2: TGroupBox;

Label7: TLabel;

edtStand: TDBEditEh;

Label8: TLabel;

edtShelf: TDBEditEh;

procedure btnAssignClientClick (Sender: TObject);

procedure FormCreate (Sender: TObject);

procedure FormCloseQuery (Sender: TObject; var CanClose: Boolean);

private

{ Private declarations }

public

{ Public declarations }

clientID: integer;

end;

var

frEditStoreGoods: TfrEditStoreGoods;

implementation

uses uDM, uAssignClient, uConstants;

{$R *. dfm}

procedure TfrEditStoreGoods. btnAssignClientClick (Sender: TObject);

begin

with TfrAssignClient. Create (self) do try

DB: = dm. DBStore;

if isPositiveResult (Showmodal) then begin

clientID: = cID;

edtClient. Text: = cNAME;

end;

finally Free

end;

end;

procedure TfrEditStoreGoods. FormCreate (Sender: TObject);

begin

clientID: = - 1;

end;

procedure TfrEditStoreGoods. FormCloseQuery (Sender: TObject;

var CanClose: Boolean);

begin

CanClose: = true;

if (ModalResult = mrOK) then begin

if (length (edtName. Text) = 0) then begin

MessageDlg ('Поле "Наименование" не может быть пустым! ', mtError, [mbOK], 0);

CanClose: = false;

end else

if (not IsInt (edtCnt. Text)) then begin

MessageDlg ('Поле "Количество" должно содержать целое числовое значение', mtError, [mbOK], 0);

CanClose: = false;

end;

end;

end;

end.

unit uFilterStoreGoods;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls;

type

TftFilterStoreGoods = class (TForm)

pnlBtns: TPanel;

btnCancel: TButton;

btnOK: TButton;

Label1: TLabel;

edtName: TEdit;

Label2: TLabel;

cbIS_OLD: TCheckBox;

edtRequest: TEdit;

Label3: TLabel;

edtClient: TEdit;

procedure FormShow (Sender: TObject);

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

private

{ Private declarations }

function MakeFilter: boolean;

public

{ Public declarations }

FilterSQL: string;

end;

var

ftFilterStoreGoods: TftFilterStoreGoods;

implementation

{$R *. dfm}

function TftFilterStoreGoods. MakeFilter: boolean;

begin

result: = false;

FilterSQL: = '';

if length (edtName. Text) > 0 then

FilterSQL: = FilterSQL + ' (UPPER (g. name) LIKE ''%' + AnsiUpperCase (edtName. Text) + '%'') and ';

if length (edtRequest. Text) > 0 then

FilterSQL: = FilterSQL + ' (g. request = ' + AnsiUpperCase (edtRequest. Text) + ') and ';

if length (edtClient. Text) > 0 then

FilterSQL: = FilterSQL + ' (UPPER (c. name) LIKE ''%' + AnsiUpperCase (edtClient. Text) + '%'') and ';

if not (cbIS_OLD. State = cbGrayed) then

if cbIS_OLD. Checked

then FilterSQL: = FilterSQL + ' (g. is_old = 1) and '

else FilterSQL: = FilterSQL + ' (g. is_old = 0) and ';

if length (FilterSQL) > 0 then begin

FilterSQL: = ' where ' + FilterSQL;

setlength (FilterSQL, length (FilterSQL) - 4);

end;

end;

procedure TftFilterStoreGoods. FormShow (Sender: TObject);

begin

edtName. SetFocus;

end;

procedure TftFilterStoreGoods. FormClose (Sender: TObject;

var Action: TCloseAction);

begin

MakeFilter;

end;

end.

unit uAssignClient;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls, IBDatabase;

type

TfrAssignClient = class (TForm)

Panel1: TPanel;

btnCancel: TButton;

btnOK: TButton;

procedure FormShow (Sender: TObject);

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

private

{ Private declarations }

public

{ Public declarations }

DB: TIBDatabase;

cID: integer;

cNAME: string;

end;

var

frAssignClient: TfrAssignClient;

implementation

{$R *. dfm}

uses ufrmClient, DB;

var frmClient: TfrmClient;

procedure TfrAssignClient. FormShow (Sender: TObject);

begin

// свойство DB должно быть уже задано

cID: = 0;

frmClient: = TfrmClient. Create (nil);

frmClient. Parent: = self;

frmClient. DB: = DB;

if frmClient. Initialize

then begin

frmClient. Visible: = true;

frmClient. gridClient. SetFocus;

end

else begin

MessageDlg ('Отсутствует соединение с БД, необходимой '#13'для работы модуля', mtError, [mbOK], 0);

Close;

end;

end;

procedure TfrAssignClient. FormClose (Sender: TObject;

var Action: TCloseAction);

begin

with frmClient do if qClient. Active then begin

cID: = qClient. FieldByName ('cID'). AsInteger;

cNAME: = qClient. FieldByName ('NAME'). AsString;

if updClient. UpdateTransaction. InTransaction then

updClient. UpdateTransaction. Rollback;

qClient. Close;

end;

if Assigned (frmClient) then begin

frmClient. Finalize;

frmClient. Free;

frmClient: = nil;

end;

end;

end.

unit uEditRoute;

interface

uses

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

Dialogs, DBCtrlsEh, StdCtrls, ExtCtrls, Mask, DBCtrls, dateutils;

type

TfrEditRoute = class (TForm)

Label1: TLabel;

edtName: TDBEditEh;

pnlBtns: TPanel;

btnCancel: TButton;

btnOK: TButton;

GroupBox1: TGroupBox;

edtDate_pass: TDBDateTimeEditEh;

Label2: TLabel;

cbPassed: TCheckBox;

procedure FormCloseQuery (Sender: TObject; var CanClose: Boolean);

procedure FormShow (Sender: TObject);

procedure cbPassedClick (Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

frEditRoute: TfrEditRoute;

implementation

{$R *. dfm}

uses uDM, Math;

procedure TfrEditRoute. FormCloseQuery (Sender: TObject;

var CanClose: Boolean);

begin

CanClose: = true;

if (ModalResult = mrOK) then begin

if (length (edtName. Text) = 0) then begin

MessageDlg ('Поле "Наименование" не может быть пустым! ', mtError, [mbOK], 0);

CanClose: = false;

end;

end;

end;

procedure TfrEditRoute. FormShow (Sender: TObject);

begin

edtDate_pass. Enabled: = cbPassed. Checked;

end;

procedure TfrEditRoute. cbPassedClick (Sender: TObject);

begin

if cbPassed. Checked then begin

edtDate_pass. Enabled: = true;

if VarType (edtDate_pass. Value) = varNull

then edtDate_pass. Value: = now;

end

else edtDate_pass. Enabled: = false;

edtDate_pass. Enabled: = cbPassed. Checked;

end;

end.

unit uEditCar;

interface

uses

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

Dialogs, StdCtrls, Mask, DBCtrlsEh, ExtCtrls;

type

TfrEditCar = class (TForm)

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

edtName: TDBEditEh;

edtCargo: TDBEditEh;

edtTrailer_cnt: TDBEditEh;

pnlBtns: TPanel;

btnCancel: TButton;

btnOK: TButton;

Label4: TLabel;

edtRequest: TDBEditEh;

procedure FormCloseQuery (Sender: TObject; var CanClose: Boolean);

private

{ Private declarations }

public

{ Public declarations }

end;

var

frEditCar: TfrEditCar;

implementation

uses uConstants, uDM;

{$R *. dfm}

procedure TfrEditCar. FormCloseQuery (Sender: TObject;

var CanClose: Boolean);

begin

CanClose: = true;

if (ModalResult = mrOK) then begin

if (length (edtName. Text) = 0) then begin

MessageDlg ('Поле "Наименование" не может быть пустым! ', mtError, [mbOK], 0);

CanClose: = false;

end else

if (not IsInt (edtCargo. Text)) or (not IsInt (edtTrailer_cnt. Text)) then begin

MessageDlg ('Поля "Вместимость", "Число прицепов"'#13'должны содержать целое числовое значение', mtError, [mbOK], 0);

CanClose: = false;

end;

end;

end;

end.

unit uLogin;

interface

uses

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

Dialogs, Mask, StdCtrls, DB, Grids, DBGrids, PropFilerEh, PropStorageEh,

ExtCtrls;

type

TfrLogin = class (TForm)

Label1: TLabel;

Label2: TLabel;

edtLogin: TEdit;

edtPass: TMaskEdit;

sControls: TPropStorageEh;

Panel1: TPanel;

btnOK: TButton;

btnClose: TButton;

btnSettings: TButton;

procedure FormShow (Sender: TObject);

procedure btnSettingsClick (Sender: TObject);

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

private

{ Private declarations }

public

{ Public declarations }

end;

var

frLogin: TfrLogin;

ConnectionString: string;

implementation

{$R *. dfm}

uses uDM, uConnect, uSettings, uConstants, uDBState;

procedure TfrLogin. FormShow (Sender: TObject);

begin

edtPass. SetFocus;

sControls. LoadProperties;

end;

procedure TfrLogin. btnSettingsClick (Sender: TObject);

begin

with (TfrDBState. Create (nil)) do try

ShowModal;

Finally Free;

end;

end;

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

begin

sControls. SaveProperties;

end;

end.

unit uEditRequest;

interface

uses

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

DB, Dialogs, StdCtrls, ExtCtrls, Mask, DBCtrlsEh, DBCtrls;

type

TfrEditRequest = class (TForm)

Label1: TLabel;

pnlBtns: TPanel;

btnCancel: TButton;

btnOK: TButton;

cbRequestType: TDBLookupComboBox;

Label2: TLabel;

cbCompleted: TDBCheckBox;

btnAssignClient: TButton;

edtName: TEdit;

procedure btnAssignClientClick (Sender: TObject);

procedure FormCreate (Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

clientID: integer;

end;

var

frEditRequest: TfrEditRequest;

implementation

uses uDM, uAssignClient;

{$R *. dfm}

procedure TfrEditRequest. btnAssignClientClick (Sender: TObject);

begin

with TfrAssignClient. Create (self) do try

DB: = dm. DBMain;

if isPositiveResult (Showmodal) then begin

clientID: = cID;

edtName. Text: = cNAME;

end;

finally Free

end;

end;

procedure TfrEditRequest. FormCreate (Sender: TObject);

begin

clientID: = - 1;

end;

end.

unit uEditClient;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls, Mask, DBCtrlsEh;

type

TfrEditClient = class (TForm)

Label1: TLabel;

Label2: TLabel;

pnlBtns: TPanel;

btnCancel: TButton;

btnOK: TButton;

edtName: TEdit;

edtDetail: TEdit;

procedure FormCloseQuery (Sender: TObject; var CanClose: Boolean);

private

{ Private declarations }

public

{ Public declarations }

end;

var

frEditClient: TfrEditClient;

implementation

{$R *. dfm}

procedure TfrEditClient. FormCloseQuery (Sender: TObject;

var CanClose: Boolean);

begin

CanClose: = true;

if (ModalResult = mrOK) then begin

if (length (edtName. Text) = 0) then begin

MessageDlg ('Поле "Наименование" не может быть пустым! ', mtError, [mbOK], 0);

CanClose: = false;

end;

end;

end;

end.

unit uSelectFrame;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls;

type

TfrSelectFrame = class (TForm)

Panel1: TPanel;

btnOK: TButton;

btnCancel: TButton;

listFrames: TListBox;

procedure listFramesDblClick (Sender: TObject);

procedure FormShow (Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

frSelectFrame: TfrSelectFrame;

implementation

{$R *. dfm}

procedure TfrSelectFrame. listFramesDblClick (Sender: TObject);

begin

//

{showmessage (inttostr ( (Sender as TListBox). ItemAtPos (mouse. CursorPos, false)));

if (Sender as TListBox). ItemAtPos (mouse. CursorPos, true) <> - 1

then} ModalResult: = mrOK;

end;

procedure TfrSelectFrame. FormShow (Sender: TObject);

begin

listFrames. SetFocus;

end;

end.

unit uFrmPattern;

interface

uses

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

Dialogs, ComCtrls, ImgList, ActnList, PropFilerEh, PropStorageEh;

type

TfrmPattern = class (TFrame)

aclFrame: TActionList;

imlFrame: TImageList;

sbFrame: TStatusBar;

sControls: TPropStorageEh;

private

{ Private declarations }

public

{ Public declarations }

ModuleName: string;

ModuleID: integer;

// Абстрактный метод инициализации модуля, переопределяется в потомках

// Должен возвращать true, если открыта необходимая БД или false, если закрыта

function Initialize: boolean; virtual; abstract;

// Абстрактный метод завершения работы модуля, переопределяется в потомках

function Finalize: boolean; virtual; abstract;

end;

var

frmPattern: TfrmPattern;

implementation

{$R *. dfm}

end.

unit uEditUsers;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls;

type

TfrEditUsers = class (TForm)

pnlBtns: TPanel;

btnCancel: TButton;

btnOK: TButton;

Label1: TLabel;

edtName: TEdit;

Label2: TLabel;

edtLogin: TEdit;

Label3: TLabel;

edtPass: TEdit;

Label4: TLabel;

edtRules: TEdit;

Label5: TLabel;

Label6: TLabel;

Label7: TLabel;

Label8: TLabel;

Label9: TLabel;

procedure FormShow (Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

frEditUsers: TfrEditUsers;

implementation

{$R *. dfm}

procedure TfrEditUsers. FormShow (Sender: TObject);

begin

// edtName. SetFocus;

end;

end.

unit uEditReqGoods;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls, Mask, DBCtrlsEh;

type

TfrEditReqGoods = class (TForm)

Label1: TLabel;

edtName: TDBEditEh;

pnlBtns: TPanel;

btnCancel: TButton;

btnOK: TButton;

Label2: TLabel;

edtKey: TDBEditEh;

Label3: TLabel;

edtCnt: TDBEditEh;

Label4: TLabel;

edtSize: TDBEditEh;

Label5: TLabel;

edtWeight: TDBEditEh;

private

{ Private declarations }

public

{ Public declarations }

end;

var

frReqEditGoods: TfrEditReqGoods;

implementation

uses uDM;

{$R *. dfm}

end.

unit uEditGoods;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls, Mask, DBCtrlsEh;

type

TfrEditGoods = class (TForm)

Label1: TLabel;

edtName: TDBEditEh;

pnlBtns: TPanel;

btnCancel: TButton;

btnOK: TButton;

Label2: TLabel;

edtKey: TDBEditEh;

Label3: TLabel;

edtCnt: TDBEditEh;

Label4: TLabel;

edtSize: TDBEditEh;

Label5: TLabel;

edtWeight: TDBEditEh;

private

{ Private declarations }

public

{ Public declarations }

end;

var

frEditGoods: TfrEditGoods;

implementation

uses uDM;

{$R *. dfm}

end.

unit uFrmRoute;

interface

uses

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

Dialogs, uFrmPattern, PropFilerEh, PropStorageEh, ImgList, ActnList,

ComCtrls, ExtCtrls, ToolWin, Grids, DBGridEh;

type

TfrmRoute = class (TfrmPattern)

gridCar: TDBGridEh;

ToolBar1: TToolBar;

Panel2: TPanel;

actNewCP: TAction;

actEditCP: TAction;

actDelCP: TAction;

private

{ Private declarations }

public

{ Public declarations }

end;

var

frmRoute: TfrmRoute;

implementation

{$R *. dfm}

end.

unit uEditDriver;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls, Mask, DBCtrlsEh;

type

TfrEditDriver = class (TForm)

Label1: TLabel;

edtName: TDBEditEh;

pnlBtns: TPanel;

btnCancel: TButton;

btnOK: TButton;

Label2: TLabel;

edtPassport: TDBEditEh;

private

{ Private declarations }

public

{ Public declarations }

end;

var

frEditDriver: TfrEditDriver;

implementation

{$R *. dfm}

uses uDM;

end.

unit uConstants;

interface

uses SysUtils;

const

ProductName = 'Автотранспорт';

iniDB = 'DB. ini';

iniSQL = 'SQL. ini';

iniDBMainSection = 'DBMain';

iniDBParkSection = 'DBPark';

iniDBStoreSection = 'DBStore';

iniControls = 'Controls. ini'; // гриды и тд

function isInt (str: string): boolean;

implementation

function isInt (str: string): boolean;

begin

result: = true;

try

StrToInt (str);

except

on E: EConvertError do result: = false;

end;

end;

end.

unit uAbout;

interface

uses

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

Dialogs, StdCtrls;

type

TfrAbout = class (TForm)

Label1: TLabel;

private

{ Private declarations }

public

{ Public declarations }

end;

var

frAbout: TfrAbout;

implementation

{$R *. dfm}

end.

Размещено на Allbest.ru