Marco Cantù 1998, Mastering Delphi 4
Project: THREADDBACCESS.DPR
Project Structure
THREADDBACCESS.DPR
program threaddbaccess;
uses
Forms,
formDbthread in 'formDbthread.pas' {Form1},
threadedmodule in 'threadedmodule.pas' {DataModule2: TDataModule},
dbthreadclass in 'dbthreadclass.pas';
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TDataModule2, DataModule2);
Application.Run;
end.
FORMDBTHREAD.PAS
unit formDbThread;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Db, Grids, DBGrids, DBTables, StdCtrls, dbthreadclass;
type
TForm1 = class(TForm)
Table1: TTable;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
Table1Name: TStringField;
Table1Capital: TStringField;
Table1Continent: TStringField;
Table1Area: TFloatField;
Table1Population: TFloatField;
procedure Table1AfterPost(DataSet: TDataSet);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
Th1: TDatabaseThread;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Table1AfterPost(DataSet: TDataSet);
begin
if Th1.Suspended then
Th1.Resume
else
begin
Th1.Free;
Th1 := TDatabaseThread.Create (True);
Th1.Priority := tpLowest;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Th1 := TDatabaseThread.Create (True);
Th1.Priority := tpLowest;
end;
end.
THREADEDMODULE.PAS
unit threadedmodule;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Db, DBTables;
type
TDataModule2 = class(TDataModule)
Session1: TSession;
Table1: TTable;
Database1: TDatabase;
private
{ Private declarations }
public
{ Public declarations }
end;
var
DataModule2: TDataModule2;
implementation
{$R *.DFM}
end.
DBTHREADCLASS.PAS
unit dbthreadclass;
interface
uses
Classes;
type
TDatabaseThread = class(TThread)
private
{ Private declarations }
NewCaption: string;
protected
procedure Execute; override;
procedure UpdateCaption;
end;
implementation
uses
FormDbThread, ThreadedModule, SysUtils;
procedure TDatabaseThread.UpdateCaption;
begin
Form1.Caption := NewCaption;
end;
procedure TDatabaseThread.Execute;
var
Tot: double;
begin
while not Terminated do
begin
Tot := 0;
with DataModule2.Table1 do
begin
Open;
First;
while not EOF do
begin
Tot := Tot + FieldByName('Population').AsFloat;
Next;
end;
Close;
end;
NewCaption := 'Population ' + FloatToStr (Tot);
Synchronize (UpdateCaption);
Suspend;
end; // while
end;
end.
FORMDBTHREAD.DFM
object Form1: TForm1
Left = 198
Top = 180
Width = 592
Height = 250
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = True
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object DBGrid1: TDBGrid
Left = 16
Top = 8
Width = 545
Height = 209
DataSource = DataSource1
TabOrder = 0
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
end
object Table1: TTable
Active = True
AfterPost = Table1AfterPost
DatabaseName = 'DBDEMOS'
TableName = 'country.db'
Left = 24
Top = 56
object Table1Name: TStringField
DisplayWidth = 14
FieldName = 'Name'
Size = 24
end
object Table1Capital: TStringField
DisplayWidth = 18
FieldName = 'Capital'
Size = 24
end
object Table1Continent: TStringField
CustomConstraint = 'X = ''South America'' OR X = ''North America'''
ConstraintErrorMessage = 'Country is not in the American Continent'
DefaultExpression = '''South America'''
DisplayWidth = 19
FieldName = 'Continent'
Size = 24
end
object Table1Area: TFloatField
DisplayWidth = 12
FieldName = 'Area'
end
object Table1Population: TFloatField
DisplayWidth = 12
FieldName = 'Population'
end
end
object DataSource1: TDataSource
DataSet = Table1
Left = 24
Top = 104
end
end
THREADEDMODULE.DFM
object DataModule2: TDataModule2
OldCreateOrder = True
Left = 570
Top = 402
Height = 150
Width = 154
object Session1: TSession
Active = True
AutoSessionName = True
Left = 24
Top = 16
end
object Table1: TTable
DatabaseName = 'mydb'
SessionName = 'Session1_1'
TableName = 'country.db'
Left = 64
Top = 16
end
object Database1: TDatabase
AliasName = 'DBDEMOS'
Connected = True
DatabaseName = 'mydb'
Params.Strings = (
'USER NAME=SYSDBA')
SessionName = 'Session1_1'
Left = 24
Top = 64
end
end
Copyright Marco Cantù 1998