ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/ibstoredproc/Unit2.pas
Revision: 158
Committed: Thu Mar 1 11:23:33 2018 UTC (6 years ago) by tony
Content type: text/x-pascal
File size: 2537 byte(s)
Log Message:
Repository resync

File Contents

# Content
1 (*
2 * IBX For Lazarus (Firebird Express)
3 *
4 * The contents of this file are subject to the Initial Developer's
5 * Public License Version 1.0 (the "License"); you may not use this
6 * file except in compliance with the License. You may obtain a copy
7 * of the License here:
8 *
9 * http://www.firebirdsql.org/index.php?op=doc&id=idpl
10 *
11 * Software distributed under the License is distributed on an "AS
12 * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
13 * implied. See the License for the specific language governing rights
14 * and limitations under the License.
15 *
16 * The Initial Developer of the Original Code is Tony Whyman.
17 *
18 * The Original Code is (C) 2015 Tony Whyman, MWA Software
19 * (http://www.mwasoftware.co.uk).
20 *
21 * All Rights Reserved.
22 *
23 * Contributor(s): ______________________________________.
24 *
25 *)
26
27 unit Unit2;
28
29 {$mode objfpc}{$H+}
30
31 interface
32
33 uses
34 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
35 ComCtrls, ibxscript;
36
37 type
38
39 { TDBCreateForm }
40
41 TDBCreateForm = class(TForm)
42 IBXScript1: TIBXScript;
43 Panel1: TPanel;
44 ProgressBar1: TProgressBar;
45 procedure FormShow(Sender: TObject);
46 private
47 procedure DoCreateDatabase(Data: PtrInt);
48 procedure NotifyDBCreated;
49 public
50
51 end;
52
53 var
54 DBCreateForm: TDBCreateForm;
55
56 implementation
57
58 {$R *.lfm}
59
60 type
61
62 { TCreateDBThread }
63
64 TCreateDBThread = class(TThread)
65 private
66 FOwner: TDBCreateForm;
67 procedure NotifyDBCreated;
68 protected
69 procedure Execute; override;
70 public
71 constructor Create(aOwner: TDBCreateForm);
72 end;
73
74 { TCreateDBThread }
75
76 procedure TCreateDBThread.NotifyDBCreated;
77 begin
78 FOwner.NotifyDBCreated;
79 end;
80
81 procedure TCreateDBThread.Execute;
82 begin
83 FOwner.IBXScript1.Transaction.Active := true;
84 FOwner.IBXScript1.RunScript('fbout-header.sql');
85 FOwner.IBXScript1.RunScript('fbout-body.sql');
86 FOwner.IBXScript1.RunScript('fbout-test.sql');
87 FOwner.IBXScript1.Transaction.Commit;
88 Synchronize(@NotifyDBCreated);
89 end;
90
91 constructor TCreateDBThread.Create(aOwner: TDBCreateForm);
92 begin
93 inherited Create(true);
94 FOwner := aOwner;
95 FreeOnTerminate := true;
96 end;
97
98 { TDBCreateForm }
99
100 procedure TDBCreateForm.FormShow(Sender: TObject);
101 begin
102 Application.QueueAsyncCall(@DoCreateDatabase,0);
103 end;
104
105 procedure TDBCreateForm.DoCreateDatabase(Data: PtrInt);
106 var aThread: TCreateDBThread;
107 begin
108 aThread := TCreateDBThread.Create(self);
109 aThread.Resume;
110 end;
111
112 procedure TDBCreateForm.NotifyDBCreated;
113 begin
114 ModalResult := mrOK;
115 end;
116
117 end.
118