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 :

zusammenfalten · markieren

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

zusammenfalten · markieren

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)

Eine richtige Lösung hab ich erstmal noch nicht, aber kann es sein, daß du irgendwie falschrum rangehst?

Laß Fensterzeugs im Hauptthread und lagere deine Dateisuche in einen Thread aus.
Im Prinzip macht das jeder Andere so und hatte damit noch keine Probleme.

Zitat:

keine Fehlermeldung, nix!

Ist auch vollkommen klar, denn du hast sämtliche Fehlerprüfungen vergessen einzubauen.
Alle verwendeten APIs haben Rückgabewerte, welche du dringend mal auswerten solltest.
Und mit Auswerten meinte ich nicht sowas wie diese paar EXIT. (du woltest ja was sehn )

Nja, und du könntest zumindestens mal ein UnregisterClass an das Ende deine Threads machen.

Zitat von Jood:

Moin,
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.

In unserem Projekt haben wir es auch so. Also der Splash wird in einem Thread aktiviert, während im Hintergrund die Anwendung lädt.
Dazu haben wir einen Befehl "SetSplashHint", der jeweils die Caption des Splash aktualisiert und ihn auch gleich anzeigt.
Übergibt man einen Leerstring, wird das Splash-Fenster versteckt. Terminiert wird nur, wenn der ganze Thread nicht mehr gebraucht wird, dh entweder wenn die Anwendung komplett geladen wurde oder aus irgendwelchen Gründen auch immer der Programmstart abgebrochen wird (ungültige Lizenz, nicht automatisch behebbare Datenbankprobleme, usw.).

Zitat von himitsu:

Im Prinzip macht das jeder Andere so und hatte damit noch keine Probleme.

Wer ist denn jeder andere?

Ich gehöre hier auch nicht zu "jeder andere". Vorteil des threaded splash screens: Egal welcher andere Thread etwas darin anzeigen will: Et geht. Macht sich vor allem nett, wenn man diverse Lade- und Init-Routinen in Threads machen lässt. Und ein animiertes "Etwas" im Splash macht sich auch immer nett, was hierdurch recht einfach wird - selbst wenn da ein blocking socket in einer Init-Methode dabei ist.
Mein Splash hat hier allerdings ein kleines "Memo", welches durch ein (threadsicheres) "AddStatus(s: String)" von ladenden Methoden befüllt wird, und sich entweder nach 3 Sek. selbst ausblendet, auf Anfrage N Sekunden wartet, oder auf dirketen Wunsch unsichtbar wird. Wirklich beendet wird der Thread zwar erst mit Ende des Prozesses, aber eine Sleep(10)-Loop wenn nichts ansteht kostet halt auch nix.