Threaded SplashScreen

[Jood]

Moin,

Nach längerer Pause vom Programmieren wollte ich mal wieder ein bisschen was tun, allerdings fiel meine Wahl diesmal auf Lazarus.
Geschrieben habe ich mir ein kleines Tool für den USB-Stick, diese Tool dient als Ersatz für die Verknüpfungen im Hauptverzeichnis des USB-Sticks.

Im Prinzip wird eine Dateisuche ausgeführt, und dann das gewünschte Programm gestartet. Da diese Dateisuche ein wenig Zeit beanspruchen kann, bin ich auf die Idee gekommen eine Art Splash-Screen zu Coden.
Während einer Dateisuche wird nun dieser Screen in einem eigenen Thread ausgeführt, so das die Dateisuche unabhängig davon läuft.

Das funktioniert soweit auch ganz gut, der Screen wird mit folgendem Code geöffnet bzw. geschlossen :

Delphi-Quellcode:

uses ..., TSplashThread, ...;
...

TMyApp = class(TCustomApplication)
  protected
    procedure DoRun; override;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
  private
    SplashThread: tSplashThread;
    .....
  end;                                            
...

procedure TMyApp.DoRun;
var
...
begin
...
SplashThread := tSplashThread.Create(ExePath, 'Filesearch, please wait...');
HierkommtwasdasLangedauert;
SplashThread.Terminate;
...

Nun die Unit TSplashThread

Delphi-Quellcode:

unit SplashThread;

{$IFDEF FPC}
  {$MODE Delphi}
{$ENDIF}

interface

uses
  Windows, Messages, Classes, SysUtils;

type
  TSplashThread = class(TThread)
  private
    FTitle     : String;
    FWnd       : HWND;
    hStatic    : HWND;
    hFontText  : HWND;
    FWndClass  : WNDCLASS;
    fText      : String;
  protected
    procedure Execute; override;
  public
    constructor Create(const Title, Text:String); reintroduce;
    destructor Destroy; override;
  end;

implementation

constructor TSplashThread.Create(const Title, Text : String);
begin
  inherited Create(False);
  freeOnTerminate := True;
  FTitle := Title;
  fText  := Text;
  with FWndClass do
  begin
    Style := 0;
    lpfnWndProc := @DefWindowProc;
    cbClsExtra := 0;
    cbWndExtra := 0;
    hInstance := HInstance;
    hIcon := 0;
    hCursor := LoadCursor(0, IDC_ARROW);
    hbrBackground := COLOR_WINDOW;
    lpszMenuName := nil;
    lpszClassName := 'TSplashScreen';
  end;
end;

destructor tSplashThread.Destroy;
begin
  if FWnd <> 0 then
  Begin
    DestroyWindow(FWnd);
    DestroyWindow(hStatic);
    DestroyWindow(hFontText);
  end;
  Windows.UnregisterClass(FWndClass.lpszClassName, FWndClass.hInstance);
  inherited;
End;

procedure TSplashThread.Execute;
var
  Msg  : TMsg;
begin
  if Windows.RegisterClass(FWndClass) = 0 then Exit;
  FWnd := CreateWindow(FWndClass.lpszClassName,PChar(fTitle), WS_POPUPWINDOW or WS_VISIBLE, (GetSystemMetrics(SM_CXSCREEN) div 2)-150,
      (GetSystemMetrics(SM_CYSCREEN) div 2)- 20, 300,40,0,0,hInstance,nil);
  //Create the fonts to use
  hFontText := CreateFont(-14,0,0,0,FW_BOLD,0,0,0,DEFAULT_CHARSET,OUT_DEFAULT_PRECIS,CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,VARIABLE_PITCH or FF_SWISS,'Tahoma');
  //create the static
  hStatic:=CreateWindow('Static',PChar(fText),WS_VISIBLE or WS_CHILD or SS_CENTER, 10,10,290,44,FWnd,0,hInstance,nil);
  SendMessage(hStatic,WM_SETFONT,hFontText,0);
  if FWnd = 0 then Exit;
  while not Terminated do
  begin
    while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
    begin
      if Msg.Message <> WM_QUIT then
      begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end;
    end;
  end;
end;

end.

Wenn ich nun aber versuche nach dem letzten Terminate den Screen wieder zu öffnen,
um z.B. eine andere Meldung zu zeigen, dann passiert schlicht nichts. Kein Screen,
keine Fehlermeldung, nix!

Ich nehme an das ich beim Aufräumen irgendwo einen Bock eingebaut habe, vielleicht
findet jemand von euch den Fehler oder hat zumindestens ein kleinen Hinweis für mich.


Danke schonmal
JoOd

PS: Das Ganze ist ein nonVCL (nonLCL) Projekt, abgesehen vom SplashScreen existiert kein weiteres Fenster. (Auch kein Consolen-Fenster)