trunk/testsuite/Test19.pas

unit Test19;

{$mode objfpc}{$H+}

{Test 19: Master/Detail Queries}

{ Description
  Two IBQueries are opened in a master detail relationship. The master is scrolled
  and the secondary shown to follow suite.
}

interface

uses
  Classes, SysUtils,   TestApplication, IBXTestBase, DB, IB, IBQuery,
  fpTimer, IBInternals;

const
  aTestID    = '19';
  aTestTitle = 'TIBDataset Master/Detail Queries';

type

{ TTest19 }

  TTest19 = class(TIBXTestBase)
  private
    FDetailQuery: TIBQuery;
    FMasterSource: TDataSource;
    procedure InitDetailQuery(Application: TTestApplication);
  protected
    procedure CreateObjects(Application: TTestApplication); override;
    function GetTestID: AnsiString; override;
    function GetTestTitle: AnsiString; override;
    procedure InitTest; override;
  public
    procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
  end;

  { TNonGUITimer }

  TNonGUITimer = class(TInterfacedObject,IIBTimerInf)
  private
    FTimer: TFPTimer;
  public
    constructor Create;
    destructor Destroy; override;
  public
    function GetEnabled: boolean;
    procedure SetEnabled(Value: Boolean);
    function GetInterval: Cardinal;
    procedure SetInterval(Value: Cardinal);
    function GetOnTimer: TNotifyEvent;
    procedure SetOnTimer(Value: TNotifyEvent);
    function GetOnStartTimer: TNotifyEvent;
    procedure SetOnStartTimer(Value: TNotifyEvent);
    function GetOnStopTimer: TNotifyEvent;
    procedure SetOnStopTimer(Value: TNotifyEvent);
    property Enabled: Boolean read GetEnabled write SetEnabled;
    property Interval: Cardinal read GetInterval write SetInterval;
    property OnTimer: TNotifyEvent read GetOnTimer write SetOnTimer;
    property OnStartTimer: TNotifyEvent read GetOnStartTimer write SetOnStartTimer;
    property OnStopTimer: TNotifyEvent read GetOnStopTimer write SetOnStopTimer;
  end;

  { TDummyGUIInterface }

  TDummyGUIInterface = class(TInterfacedObject,IIBGUIInterface)
  public
    function ServerLoginDialog(var AServerName: string;
                               var AUserName, APassword: string): Boolean;
    function LoginDialogEx(var ADatabaseName: string;
                               var AUserName, APassword: string;
                               NameReadOnly: Boolean): Boolean;
    procedure SetCursor;
    procedure RestoreCursor;
    function CreateTimer: IIBTimerInf;
  end;


implementation

{ TDummyGUIInterface }

function TDummyGUIInterface.ServerLoginDialog(var AServerName: string;
  var AUserName, APassword: string): Boolean;
begin
  Result := false;
end;

function TDummyGUIInterface.LoginDialogEx(var ADatabaseName: string;
  var AUserName, APassword: string; NameReadOnly: Boolean): Boolean;
begin
  Result := false;
end;

procedure TDummyGUIInterface.SetCursor;
begin

end;

procedure TDummyGUIInterface.RestoreCursor;
begin

end;

function TDummyGUIInterface.CreateTimer: IIBTimerInf;
begin
  Result := TNonGUITimer.Create;
end;

{ TNonGUITimer }

constructor TNonGUITimer.Create;
begin
  inherited Create;
  FTimer := TFPTimer.Create(nil);
end;

destructor TNonGUITimer.Destroy;
begin
  if FTimer <> nil then FTimer.Free;
  inherited Destroy;
end;

function TNonGUITimer.GetEnabled: boolean;
begin
  Result := FTimer.Enabled;
end;

procedure TNonGUITimer.SetEnabled(Value: Boolean);
begin
  FTimer.Enabled := Value;
end;

function TNonGUITimer.GetInterval: Cardinal;
begin
  Result := FTimer.Interval;
end;

procedure TNonGUITimer.SetInterval(Value: Cardinal);
begin
  FTimer.Interval := Value;
end;

function TNonGUITimer.GetOnTimer: TNotifyEvent;
begin
  Result := FTimer.OnTimer;
end;

procedure TNonGUITimer.SetOnTimer(Value: TNotifyEvent);
begin
  FTimer.OnTimer := Value;
end;

function TNonGUITimer.GetOnStartTimer: TNotifyEvent;
begin
  Result := FTimer.OnStartTimer;
end;

procedure TNonGUITimer.SetOnStartTimer(Value: TNotifyEvent);
begin
  FTimer.OnStartTimer := Value;
end;

function TNonGUITimer.GetOnStopTimer: TNotifyEvent;
begin
  Result := FTimer.OnStopTimer;
end;

procedure TNonGUITimer.SetOnStopTimer(Value: TNotifyEvent);
begin
  FTimer.OnStopTimer := Value;
end;

{ TTest19 }

procedure TTest19.InitDetailQuery(Application: TTestApplication);
begin
  FDetailQuery := TIBQuery.Create(Application);
  FDetailQuery.Database := IBDatabase;
  FDetailQuery.Transaction := IBTransaction;
  FDetailQuery.SQL.Text := 'Select * From EMPLOYEE Where DEPT_NO = :DEPT_NO';
  FDetailQuery.DataSource := FMasterSource;
end;

procedure TTest19.CreateObjects(Application: TTestApplication);
begin
  inherited CreateObjects(Application);
  IBQuery.SQL.Text := 'Select * From DEPARTMENT';
  FMasterSource := TDataSource.Create(Application);
  FMasterSource.DataSet := IBQuery;
  InitDetailQuery(Application);
end;

function TTest19.GetTestID: AnsiString;
begin
  Result := aTestID;
end;

function TTest19.GetTestTitle: AnsiString;
begin
  Result := aTestTitle;
end;

procedure TTest19.InitTest;
begin
  IBDatabase.DatabaseName := Owner.GetEmployeeDatabaseName;
  ReadOnlyTransaction;
end;

procedure TTest19.RunTest(CharSet: AnsiString; SQLDialect: integer);
begin
  IBDatabase.Connected := true;
  try
    IBTransaction.Active := true;
    IBQuery.Active := true;
    FDetailQuery.Active := true;
    writeln(Outfile,'Department Record:');
    PrintDataSetRow(IBQuery);
    writeln(Outfile);
    writeln(Outfile,'Employee Records:');
    PrintDataSet(FDetailQuery);
    writeln(Outfile);
    writeln(OutFile,'Advance to next department');
    IBQuery.Next;
    writeln(Outfile,'Department Record:');
    PrintDataSetRow(IBQuery);
    writeln(Outfile);
    writeln(Outfile,'Employee Records:');
    PrintDataSet(FDetailQuery);
    FDetailQuery.Active := false;
    IBQuery.Active := false;

    FreeAndNil(FDetailQuery);
    IBGUIInterface := TDummyGUIInterface.Create;
    try
      InitDetailQuery(Owner);
      FDetailQuery.MasterDetailDelay := 500;
      writeln(Outfile,'Repeat test with an active master/detail timer');
      IBQuery.Active := true;
      FDetailQuery.Active := true;
      writeln(Outfile,'Department Record:');
      PrintDataSetRow(IBQuery);
      writeln(Outfile);
      writeln(Outfile,'Employee Records:');
      PrintDataSet(FDetailQuery);
      writeln(Outfile);
      writeln(OutFile,'Advance to next department');
      IBQuery.Next;
      writeln(Outfile,'Department Record:');
      PrintDataSetRow(IBQuery);
      writeln(Outfile);
      writeln(Outfile,'Employee Records:');
      writeln(Outfile,'Result - before checksynchronise');
      PrintDataSet(FDetailQuery);
      CheckSynchronize(5000);
      writeln(Outfile,'Result - after checksynchronise');
      PrintDataSet(FDetailQuery);
    finally
      IBGUIInterface := nil;
    end;
  finally
    IBDatabase.Connected := false;
  end;
end;

initialization
  RegisterTest(TTest19);

end.

Revision:	315
Committed:	Thu Feb 25 11:56:36 2021 UTC (3 years, 8 months ago) by tony
Content type:	text/x-pascal
File size:	6812 byte(s)
Log Message:	Updated for IBX 4 release
#	User	Rev	Content
1	tony	315	unit Test19;
2
3			{$mode objfpc}{$H+}
4
5			{Test 19: Master/Detail Queries}
6
7			{ Description
8			Two IBQueries are opened in a master detail relationship. The master is scrolled
9			and the secondary shown to follow suite.
10			}
11
12			interface
13
14			uses
15			Classes, SysUtils, TestApplication, IBXTestBase, DB, IB, IBQuery,
16			fpTimer, IBInternals;
17
18			const
19			aTestID = '19';
20			aTestTitle = 'TIBDataset Master/Detail Queries';
21
22			type
23
24			{ TTest19 }
25
26			TTest19 = class(TIBXTestBase)
27			private
28			FDetailQuery: TIBQuery;
29			FMasterSource: TDataSource;
30			procedure InitDetailQuery(Application: TTestApplication);
31			protected
32			procedure CreateObjects(Application: TTestApplication); override;
33			function GetTestID: AnsiString; override;
34			function GetTestTitle: AnsiString; override;
35			procedure InitTest; override;
36			public
37			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
38			end;
39
40			{ TNonGUITimer }
41
42			TNonGUITimer = class(TInterfacedObject,IIBTimerInf)
43			private
44			FTimer: TFPTimer;
45			public
46			constructor Create;
47			destructor Destroy; override;
48			public
49			function GetEnabled: boolean;
50			procedure SetEnabled(Value: Boolean);
51			function GetInterval: Cardinal;
52			procedure SetInterval(Value: Cardinal);
53			function GetOnTimer: TNotifyEvent;
54			procedure SetOnTimer(Value: TNotifyEvent);
55			function GetOnStartTimer: TNotifyEvent;
56			procedure SetOnStartTimer(Value: TNotifyEvent);
57			function GetOnStopTimer: TNotifyEvent;
58			procedure SetOnStopTimer(Value: TNotifyEvent);
59			property Enabled: Boolean read GetEnabled write SetEnabled;
60			property Interval: Cardinal read GetInterval write SetInterval;
61			property OnTimer: TNotifyEvent read GetOnTimer write SetOnTimer;
62			property OnStartTimer: TNotifyEvent read GetOnStartTimer write SetOnStartTimer;
63			property OnStopTimer: TNotifyEvent read GetOnStopTimer write SetOnStopTimer;
64			end;
65
66			{ TDummyGUIInterface }
67
68			TDummyGUIInterface = class(TInterfacedObject,IIBGUIInterface)
69			public
70			function ServerLoginDialog(var AServerName: string;
71			var AUserName, APassword: string): Boolean;
72			function LoginDialogEx(var ADatabaseName: string;
73			var AUserName, APassword: string;
74			NameReadOnly: Boolean): Boolean;
75			procedure SetCursor;
76			procedure RestoreCursor;
77			function CreateTimer: IIBTimerInf;
78			end;
79
80
81			implementation
82
83			{ TDummyGUIInterface }
84
85			function TDummyGUIInterface.ServerLoginDialog(var AServerName: string;
86			var AUserName, APassword: string): Boolean;
87			begin
88			Result := false;
89			end;
90
91			function TDummyGUIInterface.LoginDialogEx(var ADatabaseName: string;
92			var AUserName, APassword: string; NameReadOnly: Boolean): Boolean;
93			begin
94			Result := false;
95			end;
96
97			procedure TDummyGUIInterface.SetCursor;
98			begin
99
100			end;
101
102			procedure TDummyGUIInterface.RestoreCursor;
103			begin
104
105			end;
106
107			function TDummyGUIInterface.CreateTimer: IIBTimerInf;
108			begin
109			Result := TNonGUITimer.Create;
110			end;
111
112			{ TNonGUITimer }
113
114			constructor TNonGUITimer.Create;
115			begin
116			inherited Create;
117			FTimer := TFPTimer.Create(nil);
118			end;
119
120			destructor TNonGUITimer.Destroy;
121			begin
122			if FTimer <> nil then FTimer.Free;
123			inherited Destroy;
124			end;
125
126			function TNonGUITimer.GetEnabled: boolean;
127			begin
128			Result := FTimer.Enabled;
129			end;
130
131			procedure TNonGUITimer.SetEnabled(Value: Boolean);
132			begin
133			FTimer.Enabled := Value;
134			end;
135
136			function TNonGUITimer.GetInterval: Cardinal;
137			begin
138			Result := FTimer.Interval;
139			end;
140
141			procedure TNonGUITimer.SetInterval(Value: Cardinal);
142			begin
143			FTimer.Interval := Value;
144			end;
145
146			function TNonGUITimer.GetOnTimer: TNotifyEvent;
147			begin
148			Result := FTimer.OnTimer;
149			end;
150
151			procedure TNonGUITimer.SetOnTimer(Value: TNotifyEvent);
152			begin
153			FTimer.OnTimer := Value;
154			end;
155
156			function TNonGUITimer.GetOnStartTimer: TNotifyEvent;
157			begin
158			Result := FTimer.OnStartTimer;
159			end;
160
161			procedure TNonGUITimer.SetOnStartTimer(Value: TNotifyEvent);
162			begin
163			FTimer.OnStartTimer := Value;
164			end;
165
166			function TNonGUITimer.GetOnStopTimer: TNotifyEvent;
167			begin
168			Result := FTimer.OnStopTimer;
169			end;
170
171			procedure TNonGUITimer.SetOnStopTimer(Value: TNotifyEvent);
172			begin
173			FTimer.OnStopTimer := Value;
174			end;
175
176			{ TTest19 }
177
178			procedure TTest19.InitDetailQuery(Application: TTestApplication);
179			begin
180			FDetailQuery := TIBQuery.Create(Application);
181			FDetailQuery.Database := IBDatabase;
182			FDetailQuery.Transaction := IBTransaction;
183			FDetailQuery.SQL.Text := 'Select * From EMPLOYEE Where DEPT_NO = :DEPT_NO';
184			FDetailQuery.DataSource := FMasterSource;
185			end;
186
187			procedure TTest19.CreateObjects(Application: TTestApplication);
188			begin
189			inherited CreateObjects(Application);
190			IBQuery.SQL.Text := 'Select * From DEPARTMENT';
191			FMasterSource := TDataSource.Create(Application);
192			FMasterSource.DataSet := IBQuery;
193			InitDetailQuery(Application);
194			end;
195
196			function TTest19.GetTestID: AnsiString;
197			begin
198			Result := aTestID;
199			end;
200
201			function TTest19.GetTestTitle: AnsiString;
202			begin
203			Result := aTestTitle;
204			end;
205
206			procedure TTest19.InitTest;
207			begin
208			IBDatabase.DatabaseName := Owner.GetEmployeeDatabaseName;
209			ReadOnlyTransaction;
210			end;
211
212			procedure TTest19.RunTest(CharSet: AnsiString; SQLDialect: integer);
213			begin
214			IBDatabase.Connected := true;
215			try
216			IBTransaction.Active := true;
217			IBQuery.Active := true;
218			FDetailQuery.Active := true;
219			writeln(Outfile,'Department Record:');
220			PrintDataSetRow(IBQuery);
221			writeln(Outfile);
222			writeln(Outfile,'Employee Records:');
223			PrintDataSet(FDetailQuery);
224			writeln(Outfile);
225			writeln(OutFile,'Advance to next department');
226			IBQuery.Next;
227			writeln(Outfile,'Department Record:');
228			PrintDataSetRow(IBQuery);
229			writeln(Outfile);
230			writeln(Outfile,'Employee Records:');
231			PrintDataSet(FDetailQuery);
232			FDetailQuery.Active := false;
233			IBQuery.Active := false;
234
235			FreeAndNil(FDetailQuery);
236			IBGUIInterface := TDummyGUIInterface.Create;
237			try
238			InitDetailQuery(Owner);
239			FDetailQuery.MasterDetailDelay := 500;
240			writeln(Outfile,'Repeat test with an active master/detail timer');
241			IBQuery.Active := true;
242			FDetailQuery.Active := true;
243			writeln(Outfile,'Department Record:');
244			PrintDataSetRow(IBQuery);
245			writeln(Outfile);
246			writeln(Outfile,'Employee Records:');
247			PrintDataSet(FDetailQuery);
248			writeln(Outfile);
249			writeln(OutFile,'Advance to next department');
250			IBQuery.Next;
251			writeln(Outfile,'Department Record:');
252			PrintDataSetRow(IBQuery);
253			writeln(Outfile);
254			writeln(Outfile,'Employee Records:');
255			writeln(Outfile,'Result - before checksynchronise');
256			PrintDataSet(FDetailQuery);
257			CheckSynchronize(5000);
258			writeln(Outfile,'Result - after checksynchronise');
259			PrintDataSet(FDetailQuery);
260			finally
261			IBGUIInterface := nil;
262			end;
263			finally
264			IBDatabase.Connected := false;
265			end;
266			end;
267
268			initialization
269			RegisterTest(TTest19);
270
271			end.
272