Displaying splash screen in Delphi when main thread is busy

前端 未结 6 1015
难免孤独
难免孤独 2020-12-16 00:37

I\'d like to display splash screen while the application is loading. However some 3rd party components block main thread during initilization for several seconds, which caus

6条回答
  •  长情又很酷
    2020-12-16 01:10

    Actually WinApi way is quite simple as long as you use dialog resources. Check this (working even on D7 and XP):

    type
      TDlgThread = class(TThread)
      private
        FDlgWnd: HWND;
        FCaption: string;
      protected
        procedure Execute; override;
        procedure ShowSplash;
      public
        constructor Create(const Caption: string);
      end;
    
    { TDlgThread }
    
    // Create thread for splash dialog with custom Caption and show the dialog
    constructor TDlgThread.Create(const Caption: string);
    begin
      FCaption := Caption;
      inherited Create(False);
      FreeOnTerminate := True;
    end;
    
    procedure TDlgThread.Execute;
    var Msg: TMsg;
    begin
      ShowSplash;
      // Process window messages until the thread is finished
      while not Terminated and GetMessage(Msg, 0, 0, 0) do
      begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end;
      EndDialog(FDlgWnd, 0);
    end;
    
    procedure TDlgThread.ShowSplash;
    const
      PBM_SETMARQUEE = WM_USER + 10;
      {$I 'Dlg.inc'}
    begin
      FDlgWnd := CreateDialogParam(HInstance, MakeIntResource(IDD_WAITDLG), 0, nil, 0);
      if FDlgWnd = 0 then Exit;
      SetDlgItemText(FDlgWnd, IDC_LABEL, PChar(FCaption));           // set caption
      SendDlgItemMessage(FDlgWnd, IDC_PGB, PBM_SETMARQUEE, 1, 100);  // start marquee
    end;
    
    procedure TForm1.Button3Click(Sender: TObject);
    var th: TDlgThread;
    begin
      th := TDlgThread.Create('Connecting to DB...');
      Sleep(3000); // blocking wait
      th.Terminate;
    end;
    

    Of course you must prepare dialog resource (Dlg.rc) and add it to your project:

    #define IDD_WAITDLG 1000
    #define IDC_PGB 1002
    #define IDC_LABEL 1003
    
    #define PBS_SMOOTH  0x00000001
    #define PBS_MARQUEE 0x00000008
    
    IDD_WAITDLG DIALOGEX 10,10,162,33
    STYLE WS_POPUP|WS_VISIBLE|WS_DLGFRAME|DS_CENTER
    EXSTYLE WS_EX_TOPMOST
    BEGIN
      CONTROL "",IDC_PGB,"msctls_progress32",WS_CHILDWINDOW|WS_VISIBLE|PBS_SMOOTH|PBS_MARQUEE,9,15,144,15
      CONTROL "",IDC_LABEL,"Static",WS_CHILDWINDOW|WS_VISIBLE,9,3,144,9
    END
    

    Note these PBS_* defines. I had to add them because Delphi 7 knows nothing of these constants. And definition of constants (Dlg.inc)

    const IDD_WAITDLG = 1000;
    const IDC_PGB = 1002;
    const IDC_LABEL = 1003;
    

    (I use RadAsm resource editor which generates include file automatically).

    What we get under XP

    What is better in this way comparing to VCL tricks (ordering of forms creation and so n) is that you can use it multiple times when your app needs some time to think.

提交回复
热议问题