if OpenDialogFile.Execute then begin
Screen.Cursor:=crHourGlass;
try
sDestFile:=PathDataBase;
sFilename:=OpenDialogFile.FileName;
UnCompressFile(sFilename,sDestFile);
ShowMessage(^aan успешно извлечен!');
finally
Screen.Cursor := crDefault;
end;
end;
IBDB .Connected:=True;
end;
end;
procedure TFSaveLoad.FormActivate(Sender: TObject);
begin
Left:=Round((GetSystemMetrics(SM_CXSCREEN)-Width)/2);
Top:=Round((GetSystemMetrics(SM_CYSCREEN)-Height)/2);
end;
end.
unit Select;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, jpeg, ExtCtrls;
type
TFSelect = class(TForm)
PanelMain: TPanel;
SBMain: TStatusBar;
ButtonSaveLoad: TButton;
ButtonEmployers: TButton;
ButtonJobTitle: TButton;
ButtonClear: TButton;
ButtonEnterPrises: TButton;
procedure ButtonJobTitleClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure ButtonSaveLoadClick(Sender: TObject);
procedure ButtonEmployersClick(Sender: TObject);
procedure ButtonClearClick(Sender: TObject);
procedure ButtonEnterPrisesClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FSelect: TFSelect;
implementation
uses DataModule, JobTitles, SaveLoad, Main, Employers, EditEnterPrises;
{$R *.dfm}
procedure TFSelect.ButtonJobTitleClick(Sender: TObject);
begin
with DM do begin
IBQJobTitles.SQL.Clear;
IBQJobTitles.SQL.Append('select * from JobTitles');
IBQJobTitles.SQL.Append('Order By JobTitle');
IBQJobTitles.Open;
FSelect.Enabled:=False;
JobTitles.SelectJobTitle:=1;
FJobTitles.Show;
end;
end;
procedure TFSelect.FormActivate(Sender: TObject);
begin
Left:=Round((GetSystemMetrics(SM_CXSCREEN)-Width)/2);
Top:=Round((GetSystemMetrics(SM_CYSCREEN)-Height)/2);
end;
procedure TFSelect.FormClose(Sender: TObject; var Action: TCloseAction);
begin
with DM do
IBDB Connected:=False;
MainForm.Enabled:=True;
end;
procedure TFSelect.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=27 then FSelect.Close;
end;
procedure TFSelect.ButtonSaveLoadClick(Sender: TObject);
begin
if DirectoryExists(PathArhive) then begin
FSelect.Enabled:=False;
FSaveLoad.Show;
end else Application.MessageBox('Войдите в пункт меню "Настройка" и выберите путь
к папке архива БД','Неправильный путь к каталогу архива базы данных',MB_OK);
end;
procedure TFSelect.ButtonEmployersClick(Sender: TObject);
begin
with DM do begin
IB QEmpl oyers.SQL .Clear;
IBQEmployers.SQL.Append('select * from Employers');
IBQEmployers.SQL.Append('Order by Family,Name,Fathers');
IBQEmployers.Open;
IBQMilitary.SQL.Clear;
IBQMilitary.SQL.Append('select * from Military');
IBQMilitary.Open;
IBQJobTitles.SQL.Clear;
IBQJobTitles.SQL.Append('select * from JobTitles');
IBQJobTitles.SQL.Append('Order By JobTitle');
IBQJobTitles.Open;
FSelect.Enabled:=False;
FEmpl oyers.Show;
end;
end;
procedure TFSelect.ButtonClearClick(Sender: TObject);
begin
with DM do begin
IBDB.Connected:=True;
IBQExecSQL.SQL.Clear;
IBQExecSQL.SQL.Append('Delete from Looks');
IBQExecSQL.ExecSQL;
IBDB Connected:=False;
Application.MessageBox('Bce блокировки базы данных
сброшены...','Message',MB_OK);
end;
end;
procedure TFSelect.ButtonEnterPrisesClick(Sender: TObject);
begin
with DM do begin
FSelect.Enabled:=True;
IBQEnterprises.Open;
FEditEnterPrises.Show;
end;
end;
end.
unit SelectPhoto;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ExtCtrls, StdCtrls;
type
TFSelectPhoto = class(TForm)
PanelSelectPhoto: TPanel;
SBSelectPhoto: TStatusBar;
ButtonSelect: TButton;
ButtonClear: TButton;
OpenDialogLoad: TOpenDialog;
procedure ButtonSelectClick(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ButtonClearClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FSelectPhoto: TFSelectPhoto;
implementation
uses EditEmployers;
{$R *.dfm}
procedure TFSelectPhoto.ButtonSelectClick(Sender: TObject);
begin
OpenDialogLoad.Filter:='Фотография|*.bmp';
if OpenDialogLoad.Execute then
FEditEmployers.ImagePhoto.Picture.Bitmap.LoadFromFile(OpenDialogLoad.FileName);
FEditEmployers.Enabled:=True;
FSelectPhoto.Close;
end;
procedure TFSelectPhoto.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=27 then FSelectPhoto.Close;
end;
procedure TFSelectPhoto.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
FEditEmployers.Enabled:=True;
end;
procedure TFSelectPhoto.ButtonClearClick(Sender: TObject);
begin
FEditEmployers.ImagePhoto.Picture.Bitmap:=FEditEmployers.ImageBuffer.Picture.Bitmap;
FEditEmployers.Enabled:=True;
FSelectPhoto.Close;
end;
procedure TFSelectPhoto.FormActivate(Sender: TObject);
begin
Left:=Round((GetSystemMetrics(SM_CXSCREEN)-Width)/2);
Top:=Round((GetSystemMetrics(SM_CYSCREEN)-Height)/2);
end;
end.
unit FoundJobTitle;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, Grids, DBGrids, StdCtrls, ExtCtrls, DB;
type
TFFoundJobTitles = class(TForm)
PanelFoundJobTitle: TPanel;
LabelString: TLabel;
EditString: TEdit;
DBGrFoundJobTitle: TDBGrid;
LabelFoundJobTitle: TLabel;
SBFoundJobTitles: TStatusBar;
procedure FormActivate(Sender: TObject);
procedure EditStringChange(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FFoundJobTitles: TFFoundJobTitles;
RecSave: LongInt;
implementation
uses DataModule, JobTitles;
{$R *.dfm}
procedure InitJobTitles;
begin
with DM do begin
IBQJobTitles.Close;
IBQJobTitles.SQL.Clear;
IBQJobTitles.SQL.Append('select * from JobTitles');
if Trim(FFoundJobTitles.EditString.Text)<>'' then IBQJobTitles.SQL.Append('where
JobTitle Like '+chr(39)+Trim(FFoundJobTitles.EditString.Text)+'%'+chr(39));
IBQJobTitles.SQL.Append('Order By JobTitle');
IBQJobTitles.Open;
end;
end;
procedure TFFoundJobTitles.FormActivate(Sender: TObject);
begin
Left:=Round((GetSystemMetrics(SM_CXSCREEN)-Width)/2);
Top:=Round((GetSystemMetrics(SM_CYSCREEN)-Height)/2);
with DM do begin
EditString .Text:='';
InitJobTitles;
EditString.SetFocus;
end;
end;
procedure TFFoundJobTitles.EditStringChange(Sender: TObject);
var Stroka:String;
begin
with DM do begin
IBQJobTitles.First;
if not IBQJobTitles.Locate('JobTitle',Trim(EditString.Text),[loPartialKey]) then begin
Stroka:=EditString.Text;
Stroka :=Copy(Stroka, 1,Length(Stroka)-1);
EditString .Text:=Stroka;
EditString.SelStart:=Length(Stroka);
end;
InitJobTitles;
end;
end;
procedure TFFoundJobTitles.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
FJobTitles.Enabled:=True;
end;
procedure TFFoundJobTitles.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
with DM do
case key of
13: begin
RecSave:=IB QJobTitlesID.AsInteger;
EditString .Text:-';
InitJobTitles;
IBQJobTitles.Locate('ID',RecSave,[loCaseInsensitive]);
FFoundJobTitles.Close;
end;
27: begin
EditString .Text:-';
InitJobTitles;
IBQJobTitles.Locate('ID',RecSave,[loCaseInsensitive]);
FFoundJobTitles.Close;
end;
end;
end;
end.
unit FoundEmployers;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, Grids, DBGrids, StdCtrls, ExtCtrls, DB;
type
TFFoundEmployers - class(TForm)
PanelFoundEmployers: TPanel;
LabelString: TLabel;
EditString: TEdit;
LabelFoundEmployers: TLabel;
DBGrFoundEmployers: TDBGrid;
SBFoundEmployers: TStatusBar;
procedure FormActivate(Sender: TObject);
procedure EditStringChange(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FFoundEmployers: TFFoundEmployers;
RecSave: LongInt;
implementation
uses DataModule, Employers;
{$R
procedure InitEmployers;
begin
with DM do begin
IBQEmployers.Close;
IB QEmpl oyers.SQL .Clear;
IBQEmployers.SQL.Append('select * from Employers');
if FFoundEmployers.EditString.Text<>'' then IBQEmployers.SQL.Append('where Family
Like '+chr(39)+Trim(FFoundEmployers.EditString.Text)+'%'+chr(39));
IBQEmployers.SQL.Append('Order By Family');
IBQEmployers.Open;
end;
end;
procedure TFFoundEmployers.FormActivate(Sender: TObject);
begin
Left:=Round((GetSystemMetrics(SM_CXSCREEN)-Width)/2);
Top:=Round((GetSystemMetrics(SM_CYSCREEN)-Height)/2);
with DM do begin
EditString .Text:='';
InitEmployers;
EditString.SetFocus;
end;
end;
procedure TFFoundEmployers.EditStringChange(Sender: TObject);
var Stroka:String;
begin
with DM do begin
IB QEmpl oyers.First;
if not IBQEmployers.Locate('Family',Trim(EditString.Text),[loPartialKey]) then begin
Stroka:=EditString.Text;
Stroka :=Copy(Stroka, 1,Length(Stroka)-1);
EditString .Text:=Stroka;
EditString.SelStart:=Length(Stroka);
end;
InitEmployers;
end;
end;
procedure TFFoundEmployers.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
with DM do
case key of
13: begin
RecSave:=IB QEmpl oyersID.AsInteger;
EditString .Text:-';
InitEmployers;
IBQEmployers.Locate('ID',RecSave,[loCaseInsensitive]);
FFoundEmployers.Close;
end;
27: begin
EditString .Text:-';
InitEmployers;
IBQEmployers.Locate(TD',RecSave,[loCaseInsensitive]);
FFoundEmployers.Close;
end;
end;
end;
procedure TFFoundEmployers.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
FEmployers.Enabled:=True;
end;
end.
unit Employers;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ExtCtrls, Grids, DBGrids, DB;
type
TFEmployers = class(TForm)
PanelEmployers: TPanel;
SBEmployers: TStatusBar;
DBGrEmployers: TDBGrid;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FEmployers: TFEmployers;
implementation
uses DataModule, Main, EditEmployers, FoundEmployers, Select;
{$R *.dfm}
procedure InitSQL;
begin
with DM do begin
IBQFamily.SQL.Clear;
IBQFamily.SQL.Append('select * from Family');
IBQFamily.SQL.Append('where
Empl oyers='+IntToStr(IB QEmpl oyersID.AsInteger));
IBQFamily.SQL.Append('Order By DateBirth');
IBQFamily.Open;
IBQMotionEmployers. SQL.Clear;
IBQMotionEmployers.SQL.Append('select * from MotionEmployers');
IB QMoti onEmpl oyers.S QL .App end('where
Empl oyers='+IntToStr(IB QEmpl oyersID.AsInteger));
IBQMotionEmployers.SQL.Append('Order By DateFrom');
IB QMoti onEmpl oyers.Open;
IBQChangeFIO.SQL.Clear;
IBQChangeFIO.SQL.Append('select * from ChangeFIO');
IBQChangeFIO.SQL.Append('where
Empl oyers='+IntToStr(IB QEmpl oyersID.AsInteger));
IBQChangeFIO.SQL.Append('Order By DateChange');
IBQChangeFIO.Open;
{Application.MessageBox(PChar(IBQEmployersFamily.AsString),PChar(IntToStr(IB
QEmployersID.AsInteger)),MB_OK);}
IBQFormations.SQL.Clear;
IBQFormations.SQL.Append('select * from Formations');
IBQFormations.SQL.Append('where
Empl oyers='+IntToStr(IB QEmpl oyersID.AsInteger));
IBQFormations.SQL.Append('Order By YearEnd');
IBQFormations.Open;
IBQQualifications.SQL.Clear;
IBQQualifications.SQL.Append('select * from Qualifications');
IBQQualifications.SQL.Append('where
Empl oyers='+IntToStr(IB QEmpl oyersID.AsInteger));
IBQQualifications.SQL.Append('Order By Dates');
IBQQualifications.Open;
IBQIncQualifics.SQL.Clear;
IBQIncQualifics.SQL.Append('select * from IncQualifics');
IBQIncQualifics.SQL.Append('where
Empl oyers='+IntToStr(IB QEmpl oyersID.AsInteger));
IBQIncQualifics.SQL.Append('Order By DateOrder');
IBQIncQualifics.Open;
IBQBookWorks.SQL.Clear;
IBQBookWorks.SQL.Append('select * from BookWorks');
IBQBookWorks.SQL.Append('where
Empl oyers='+IntToStr(IB QEmpl oyersID.AsInteger));
IBQBookWorks.SQL.Append('Order By DateOrder');
IBQBookWorks.Open;