138
FamilyForm.DBEdit30.Clear;
FamilyForm.DBEdit31.Clear;
FamilyForm.DBEdit32.Clear;
FamilyForm.DBEdit33.Clear;
FamilyForm.DateTimePicker1.DateTime:=Now;
FamilyForm.CanClose:=False;
FamilyForm.ShowModal;
end;
procedure TCardMenuForm.BitBtn6Click(Sender: TObject);
begin
VBiletForm.Tag:=0;
DataModule1.VBiletList.Insert;
VBiletForm.DBEdit35.Clear;
VBiletForm.DBEdit36.Clear;
VBiletForm.DBEdit37.Clear;
VBiletForm.DBEdit38.Clear;
VBiletForm.DBEdit39.Clear;
VBiletForm.DBEdit40.Clear;
VBiletForm.DBEdit41.Clear;
VBiletForm.DBEdit42.Clear;
VBiletForm.DBEdit43.Clear;
VBiletForm.CanClose:=False;
VBiletForm.ShowModal;
end;
procedure TCardMenuForm.BitBtn7Click(Sender: TObject);
begin
StaqWorkForm.Tag:=0;
DataModule1.StaqWorkList.Insert;
StaqWorkForm.DBEdit44.Clear;
StaqWorkForm.DBEdit45.Clear;
StaqWorkForm.DBEdit46.Clear;
StaqWorkForm.DBEdit47.Clear;
StaqWorkForm.DBEdit48.Clear;
StaqWorkForm.DBEdit49.Clear;
StaqWorkForm.DBEdit50.Clear;
StaqWorkForm.DBEdit51.Clear;
StaqWorkForm.DBEdit52.Clear;
StaqWorkForm.CanClose:=False;
StaqWorkForm.ShowModal;
end;
139
end.
SearchUnit.pas
unit SearchUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TSearchForm = class(TForm)
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
Label1: TLabel;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
CanClose:Boolean;
{ Public declarations }
end;
var
SearchForm: TSearchForm;
implementation
uses DMUnit, MainUnit;
{$R *.dfm}
procedure TSearchForm.Button2Click(Sender: TObject);
begin
CanClose:=True;
Close;
end;
140
procedure TSearchForm.Button1Click(Sender: TObject);
VAR
V:Variant;
begin
try
V:=Edit1.Text;
DataModule1.CardList.Locate(MainForm.DBGrid1.SelectedField.FieldName,v,[]);
CanClose:=True;
Close;
except
ShowMessage('Не удается найти запись.');
end;
end;
procedure TSearchForm.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
Case key of
'А'..'Я','а'..'я',#1..#32:exit
else key:=#0;
end;
end;
procedure TSearchForm.FormShow(Sender: TObject);
begin
CanClose:=False;
end;
end.
FiltrUnit.pas
unit FiltrUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, StdCtrls;
type
TFiltrForm = class(TForm)
ComboBox1: TComboBox;
ComboBox2: TComboBox;
141
ComboBox3: TComboBox;
ComboBox4: TComboBox;
ListBox1: TListBox;
Button1: TButton;
Button2: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure ComboBox2Change(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FiltrForm: TFiltrForm;
implementation
uses MainUnit, DMUnit;
{$R *.dfm}
procedure TFiltrForm.Button2Click(Sender: TObject);
{VAR
S:String;}
begin
{S:='select * from CardListQuery where (kodorg=:kodorg) and (Archive=False)';
DataModule1.CardListQuery.Close;
DataModule1.CardListQuery.SQL.Clear;
DataModule1.CardListQuery.SQL.Add(S);
DataModule1.CardListQuery.Open;
//CanClose:=True;
//ToolBar1.Enabled:=True;
142
//MainMenu1.Items.Enabled:=True;
//DBGrid1.Enabled:=True;
DataModule1.CardListQuery.EnableControls;
//GroupBox1.Hide;}
Close;
end;
procedure TFiltrForm.Button1Click(Sender: TObject);
{VAR
I:Integer;
S:String;}
begin
{S:='select * from CardListQuery where (kodorg=:kodorg) and (Archive=False)';
Case ListBox1.Items.Count of
1:S:=S+' and';
2..1000:S:=S+' and ('
end;
For I:=0 to ListBox1.Items.Count-1 do
S:=S+ListBox1.Items[i];
If ListBox1.Items.Count>1 then S:=S+')';
DataModule1.CardListQuery.Close;
DataModule1.CardListQuery.SQL.Clear;
DataModule1.CardListQuery.SQL.Add(S);
DataModule1.CardListQuery.Open;
//CanClose:=True;
//MainMenu1.Items.Enabled:=True;
//DBGrid1.Enabled:=True;
DataModule1.CardListQuery.EnableControls;
//GroupBox1.Hide;}
end;
procedure TFiltrForm.ComboBox2Change(Sender: TObject);
begin
{DataModule1.CardListQuery.First;
ComboBox4.Clear;
While not DataModule1.CardListQuery.Eof do
begin
Case DataModule1.CardListQuery.FieldList.Fields[Combobox2.ItemIndex+1].DataType of
ftAuto-
inc,ftInteger,ftBoolean:ComboBox4.Items.Add(DataModule1.CardListQuery.FieldList.Fields[Combobox2.ItemI
ndex+1].AsString);
143
ftWid-
eString,ftString,ftDatetime:ComboBox4.Items.Add(''''+DataModule1.CardListQuery.FieldList.Fields[Combobox
2.ItemIndex+1].AsString+'''');
end;
DataModule1.CardListQuery.Next;}
end;
procedure TFiltrForm.SpeedButton1Click(Sender: TObject);
{VAR
S:String;}
begin
{If ListBox1.ItemIndex>=0 then
begin
ListBox1.Items.Delete(ListBox1.ItemIndex);
if ListBox1.Items.count>0 then
begin
S:=ListBox1.Items[0];
delete(S,1,4);
ListBox1.Items[0]:=S;
end;
end;}
end;
end.
ArchiveUnit.pas
unit ArchiveUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, DBGrids, ToolWin, ComCtrls, ExtCtrls, DBCtrls;
type
TArchiveForm = class(TForm)
ToolBar1: TToolBar;
DBGrid1: TDBGrid;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
DBNavigator1: TDBNavigator;
144
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
CanClose:Boolean;
{ Public declarations }
end;
var
ArchiveForm: TArchiveForm;
implementation
uses ArchiveSearchUnit, DMUnit, MainUnit;
{$R *.dfm}
procedure TArchiveForm.ToolButton1Click(Sender: TObject);
begin
If DataModule1.ArchiveListQuery.RecordCount>0 then
begin
ArchiveSearchForm.CanClose:=False;
ArchiveSearchForm.Caption:='Поиск';
ArchiveSearchForm.Edit1.Clear;
ArchiveSearchForm.ShowModal;
end;
end;
procedure TArchiveForm.ToolButton2Click(Sender: TObject);
145
begin
If DataModule1.ArchiveListQuery.RecordCount>0 then
try
DataModule1.ArchiveListQuery.Sort:=DBGrid1.SelectedField.FieldName+' ASC';
except
ShowMessage('Не удается отсортировать список.');
DataModule1.ArchiveListQuery.Sort:='';
end;
end;
procedure TArchiveForm.ToolButton3Click(Sender: TObject);
begin
If DataModule1.ArchiveListQuery.RecordCount>0 then
try
DataModule1.ArchiveListQuery.Sort:=DBGrid1.SelectedField.FieldName+' DESC';
except
ShowMessage('Не удается отсортировать список.');
DataModule1.ArchiveListQuery.Sort:='';
end;
end;
procedure TArchiveForm.ToolButton4Click(Sender: TObject);
begin
If MessageDlg('Вы действительно хотите удалить
запись?',mtConfirmation,[mbYes,mbNo],0)=mrYes then
begin
DataModule1.ArchiveListQuery.Delete;
ArchiveForm.Label3.Caption:=inttostr(DataModule1.ArchiveListQuery.RecordCount);
end;
end;
procedure TArchiveForm.FormShow(Sender: TObject);
begin
CanClose:=True;
DataModule1.ArchiveListQuery.Close;
DataModule1.ArchiveListQuery.Open;
ArchiveForm.Label3.Caption:=inttostr(DataModule1.ArchiveListQuery.RecordCount);
end;
procedure TArchiveForm.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
146
CanClose:=ArchiveForm.CanClose;
end;
procedure TArchiveForm.Button1Click(Sender: TObject);
begin
If DataModule1.ArchiveListQuery.RecordCount>0 then
begin
ArchiveSearchForm.CanClose:=False;
ArchiveSearchForm.Caption:='Поиск';
ArchiveSearchForm.Edit1.Clear;
ArchiveSearchForm.ShowModal;
end;
end;
procedure TArchiveForm.Button2Click(Sender: TObject);
begin
If DataModule1.ArchiveListQuery.RecordCount>0 then
try
DataModule1.ArchiveListQuery.Sort:=DBGrid1.SelectedField.FieldName+' ASC';
except
ShowMessage('Не удается отсортировать список.');
DataModule1.ArchiveListQuery.Sort:='';
end;
end;
procedure TArchiveForm.Button3Click(Sender: TObject);
begin
If DataModule1.ArchiveListQuery.RecordCount>0 then
try
DataModule1.ArchiveListQuery.Sort:=DBGrid1.SelectedField.FieldName+' DESC';
except
ShowMessage('Не удается отсортировать список.');
DataModule1.ArchiveListQuery.Sort:='';
end;
end;
procedure TArchiveForm.Button4Click(Sender: TObject);
begin
If MessageDlg('Вы действительно хотите удалить
запись?',mtConfirmation,[mbYes,mbNo],0)=mrYes then
begin
DataModule1.ArchiveListQuery.Delete;
147
ArchiveForm.Label3.Caption:=inttostr(DataModule1.ArchiveListQuery.RecordCount);
end;
end;
end.
BlockUnit.pas
unit BlockUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, Mask, DBCtrls;
type
TBlockForm = class(TForm)
Label1: TLabel;
BitBtn1: TBitBtn;
Edit1: TEdit;
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
BlockForm: TBlockForm;
implementation
uses MainUnit, DMUnit;
{$R *.dfm}
procedure TBlockForm.BitBtn1Click(Sender: TObject);
Var
V:Variant;
begin
V:=MainForm.CurUser;
DataModule1.UsersList.Locate('NameUser',V,[]);
If Edit1.Text=DataModule1.UsersListPassword.Value then