-
Notifications
You must be signed in to change notification settings - Fork 0
/
fmFilterUnit.pas
123 lines (103 loc) · 3.55 KB
/
fmFilterUnit.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
unit fmFilterUnit;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
dmDataUnit,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, DBGridEhGrouping, ToolCtrlsEh,
DBGridEhToolCtrls, DynVarsEh, FireDAC.Stan.Intf, FireDAC.Stan.Option,
FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf,
FireDAC.DApt.Intf, FireDAC.Stan.Async, FireDAC.DApt, Data.DB,
FireDAC.Comp.DataSet, FireDAC.Comp.Client, Vcl.Menus, Vcl.StdCtrls,
Vcl.ExtCtrls, EhLibVCL, GridsEh, DBAxisGridsEh, DBGridEh;
type
TfmFilter = class(TForm)
dbgAuthors: TDBGridEh;
pnTop: TPanel;
btShare: TButton;
pmFilter: TPopupMenu;
mnAdd: TMenuItem;
mdDel: TMenuItem;
mnEdit: TMenuItem;
fdqFilter: TFDQuery;
fdqFilterid: TFDAutoIncField;
fdqFiltername: TWideMemoField;
fdqFilterarea_type: TIntegerField;
fdqFilteruse_type: TIntegerField;
fdqFilterdate_time_create: TDateTimeField;
fdqFilteris_active: TIntegerField;
dsFilter: TDataSource;
sdAttach: TSaveDialog;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure dbgAuthorsDblClick(Sender: TObject);
procedure btShareClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
fmFilter: TfmFilter;
implementation
{$R *.dfm}
uses fmFilterEditUnit, extend_dialog, extend_diskutil;
procedure TfmFilter.btShareClick(Sender: TObject);
var
filename:string;
sqls_:string;
f: tStringList;
List: TStringList;
fdq_:TFdquery;
i:integer;
begin
if dm.to_filter then begin
if msgquestion('Создать новую базу данных на основании уже открытой с учетом указанных фильтров?') then begin
sdAttach.FileName:='share.db';
sdAttach.DefaultExt:='db';
if sdAttach.Execute then begin
//msgok(savedialog.FileName)
filename:=sdAttach.FileName;
if fileexists(filename) then begin
if msgquestion(format('Файл %s уже существует. Перезаписать?',[filename])) then begin
DeleteFile(filename);
end
else
abort
end;
copyfile(PWideChar(DM.sqlc.Params.Database),PWideChar(filename),true);
dm.sqlcshare.Params.Database:=filename;
dm.sqlcshare.connected:=true;
sqls_:= GetStrFromAppResource('cut_db_filter_source_project'); dm.sqlcshare.ExecSQL(sqls_);
sqls_:= GetStrFromAppResource('clear_tmp_filter'); dm.sqlcshare.ExecSQL(sqls_);
sqls_:= GetStrFromAppResource('clear_service_info'); dm.sqlcshare.ExecSQL(sqls_);
dm.sqlcshare.Commit;
dm.sqlcshare.ExecSQL('VACUUM;');
dm.sqlcshare.connected:=false;
Application.ProcessMessages;
msgok(format('Файл [%s] успешно сохранен в каталоге [%s]!',
[ExtractFileName(filename),ExtractFilePath(filename)]));
end;
end;
end;
end;
procedure TfmFilter.dbgAuthorsDblClick(Sender: TObject);
var
str_:string;
begin
if fmFilterEdit<>nil then begin
fmFilterEdit.Close;
Application.ProcessMessages
end;
fmFilterEdit:=TfmFilterEdit.Create(self);
fmFilterEdit.Show;
end;
procedure TfmFilter.FormClose(Sender: TObject; var Action: TCloseAction);
begin
action:=cafree;
fmFilter:=nil;
end;
procedure TfmFilter.FormCreate(Sender: TObject);
begin
fdqFilter.Open();
end;
end.