Vraag & Antwoord

Programmeren

Delphi 6, actie tijdens WaitForSingleObject

2 antwoorden
  • Met onderstaande procedure laat ik het programma wachten op het verwerken van externe opdrachten. Als het wachten lang gaat duren wil ik toch een voortgangsbalkje op het scherm weergeven, als er maar iets beweegt zodat de gebruiker niet denkt dat het programma hangt. Hoe kan ik met deze procedure zoiets doen of is hiervoor een andere oplossing? [code:1:4aa43f2d8b] procedure ExecAndWait (Filename : TFilename; Params : String; Const wait : Boolean); var ExecInfo : TshellExecuteinfo; Begin {variabelen toekennen} FillChar(ExecInfo, SizeOf(ExecInfo), #0); ExecInfo.cbSize := SizeOf (TshellexecuteInfo); ExecInfo.fMask := SEE_MASK_NOCLOSEPROCESS; ExecInfo.Wnd := HWnd_Desktop; ExecInfo.lpFile := Pchar (filename); ExecInfo.lpDirectory := Pchar (filename); ExecInfo.lpParameters := Pchar (Params); ExecInfo.nShow := SW_SHOWNORMAL; {openen van het document of start programma} if ShellExecuteEx(@ExecInfo) then begin if wait then begin WaitForSingleObject (ExecInfo.hProcess, INFINITE); CloseHandle (ExecInfo.hProcess); end; end; end; [/code:1:4aa43f2d8b]
  • [quote:8f43164a07="Niek Breur"]Met onderstaande procedure laat ik het programma wachten op het verwerken van externe opdrachten. Als het wachten lang gaat duren wil ik toch een voortgangsbalkje op het scherm weergeven, als er maar iets beweegt zodat de gebruiker niet denkt dat het programma hangt. Hoe kan ik met deze procedure zoiets doen of is hiervoor een andere oplossing?[/quote:8f43164a07] [code:1:8f43164a07] {-- WinExecAndWait32V2 ------------------------------------------------} {: Executes a program and waits for it to terminate @Param FileName contains executable + any parameters @Param Visibility is one of the ShowWindow options, e.g. SW_SHOWNORMAL @Returns -1 in case of error, otherwise the programs exit code @Desc In case of error SysErrorMessage( GetlastError ) will return an error message. The routine will process paint messages and messages send from other threads while it waits. }{ Created 27.10.2000 by P. Below -----------------------------------------------------------------------} Function WinExecAndWait32V2( FileName: String; Visibility: integer ): DWORD; Procedure WaitFor( processHandle: THandle ); Var msg: TMsg; ret: DWORD; Begin Repeat ret := MsgWaitForMultipleObjects( 1, { 1 handle to wait on } processHandle, { the handle } False, { wake on any event } INFINITE, { wait without timeout } QS_PAINT or { wake on paint messages } QS_SENDMESSAGE { or messages from other threads } ); If ret = WAIT_FAILED Then Exit; { can do little here } If ret = (WAIT_OBJECT_0 + 1) Then Begin { Woke on a message, process paint messages only. Calling PeekMessage gets messages send from other threads processed. } While PeekMessage( msg, 0, WM_PAINT, WM_PAINT, PM_REMOVE ) Do DispatchMessage( msg ); End; Until ret = WAIT_OBJECT_0; End; { Waitfor } Var { V1 by Pat Ritchey, V2 by P.Below } zAppName:array[0..512] of char; StartupInfo:TStartupInfo; ProcessInfo:TProcessInformation; Begin { WinExecAndWait32V2 } StrPCopy(zAppName,FileName); FillChar(StartupInfo,Sizeof(StartupInfo),#0); StartupInfo.cb := Sizeof(StartupInfo); StartupInfo.dwFlags := STARTF_USESHOWWINDOW; StartupInfo.wShowWindow := Visibility; If not CreateProcess(nil, zAppName, { pointer to command line string } nil, { pointer to process security attributes } nil, { pointer to thread security attributes } false, { handle inheritance flag } CREATE_NEW_CONSOLE or { creation flags } NORMAL_PRIORITY_CLASS, nil, { pointer to new environment block } nil, { pointer to current directory name } StartupInfo, { pointer to STARTUPINFO } ProcessInfo) { pointer to PROCESS_INF } Then Result := DWORD(-1) { failed, GetLastError has error code } Else Begin Waitfor(ProcessInfo.hProcess); GetExitCodeProcess(ProcessInfo.hProcess, Result); CloseHandle( ProcessInfo.hProcess ); CloseHandle( ProcessInfo.hThread ); End; { Else } End; { WinExecAndWait32V2 } [/code:1:8f43164a07] [url=http://forum.computertotaal.nl/phpBB2/viewtopic.php?p=658519]Re: externe processen in Delphi NA elkaar laten plaatsvinden[/url] Hier kom je al een stap verder mee...

Beantwoord deze vraag

Weet jij het antwoord op deze vraag? Registreer of meld je aan met je account

Dit is een gearchiveerde pagina. Antwoorden is niet meer mogelijk.