![]() |
Threaded SplashScreen
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:
Nun die Unit TSplashThread
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; ...
Delphi-Quellcode:
Wenn ich nun aber versuche nach dem letzten Terminate den Screen wieder zu öffnen,
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. 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) |
AW: Threaded SplashScreen
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. :stupid: Zitat:
Alle verwendeten APIs haben Rückgabewerte, welche du dringend mal auswerten solltest. :warn: Und mit Auswerten meinte ich nicht sowas wie diese paar EXIT. (du woltest ja was sehn :roll:) Nja, und du könntest zumindestens mal ein UnregisterClass an das Ende deine Threads machen. |
AW: Threaded SplashScreen
Zitat:
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:
|
AW: Threaded SplashScreen
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. |
Alle Zeitangaben in WEZ +1. Es ist jetzt 01:59 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz