Question

Using: Delphi XE2, DBExpress, Firebird

I can't access any VCL control outside the main thread safely, that includes forms, panels, edits, etc and the Timage and Timage descendants. I'm need to open ClientDataSet (Master/Detail) in separate Thread(different of main thread).

I'm need to create animated splash screen while accessing database

Can someone show me a simple example of how to do this?

Was it helpful?

Solution

I'm assuming that the database access in a thread is of no problem for you.

For a complete example of a threaded access to a dbExpress database (including feedback to the main thread), see the examples made by Marco Cantù here: dbexpress_firebird_examples.

It involves putting all the database connection setup in a TDataModule and creating an instance of this datamodule for each threaded access.

Anyway, to make the GUI informed about the background thread process with an animated Gif, here is an example:

enter image description here

unit TestAnimatedScreen;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Imaging.GIFImg,
  Vcl.ExtCtrls;

type
  TMyEndNotify = procedure (value: Boolean) of object;

type
  TMyThread = class(TThread)
  private
    fEndNotification : TMyEndNotify;
    procedure NotifyEndOfThread;
  protected
    procedure Execute; override;
  public
    Constructor Create(endNotification : TMyEndNotify);
  end;

type
  TMainForm = class(TForm)
    Image1: TImage;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    FShowAnimation : Boolean;
    procedure SetShowAnimation(value : Boolean);
  public
    { Public declarations }
    property ShowAnimation : Boolean read FShowAnimation write SetShowAnimation;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMyThread.NotifyEndOfThread;
begin
  if Assigned(fEndNotification) then
    fEndNotification(False);
end;

constructor TMyThread.Create(endNotification: TMyEndNotify);
begin
  Inherited Create(false);
  fEndNotification := endNotification;
  Self.FreeOnTerminate := True; // Free automatically
end;

procedure TMyThread.Execute;
begin
  try
    {Add your database access code here}
    Sleep(5000); // Simulate lengthy process
  finally
    Synchronize(NotifyEndOfThread);
  end;
end;

{ TMainForm }

procedure TMainForm.Button1Click(Sender: TObject);
begin
  ShowAnimation := True;
  TMyThread.Create(Self.SetShowAnimation);
end;

procedure TMainForm.SetShowAnimation(value: Boolean);
begin
  FShowAnimation := Value;
  if FShowAnimation then
  begin
    {Add animation code here}
    Button1.Enabled := false;
    Button1.Caption := 'Processing, please wait ...';
    (Image1.Picture.Graphic as TGIFImage).AnimateLoop := glEnabled;
    (Image1.Picture.Graphic as TGIFImage).Animate := true;
  end
  else
  begin
    {Stop animation}
    (Image1.Picture.Graphic as TGIFImage).Animate := false;
    Button1.Caption := 'Start lengthy process';
    Button1.Enabled := True;
  end;
end;

end.

object MainForm: TMainForm
  Left = 0
  Top = 0
  Caption = 'MainForm'
  ClientHeight = 265
  ClientWidth = 236
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Image1: TImage
    Left = 8
    Top = 8
    Width = 200
    Height = 200
    AutoSize = True
    IncrementalDisplay = True
  end
  object Button1: TButton
    Left = 8
    Top = 224
    Width = 200
    Height = 25
    Caption = 'Start lengthy process'
    TabOrder = 0
    OnClick = Button1Click
  end
end

Should you have an older Delphi version than Delphi 2007, see How to use Animated Gif in a delphi form for more information about how to implement an animated GIF.

The animated GIF I used can be found here.

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top