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