Ga naar inhoud

Delphi 6, actie tijdens WaitForSingleObject


anoniem

Aanbevolen berichten

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]
Link naar reactie
[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...
Link naar reactie

Om een reactie te plaatsen, moet je eerst inloggen

Gast
Reageer op dit topic

×   Geplakt als verrijkte tekst.   Herstel opmaak

  Er zijn maximaal 75 emoji toegestaan.

×   Je link werd automatisch ingevoegd.   Tonen als normale link

×   Je vorige inhoud werd hersteld.   Leeg de tekstverwerker

×   Je kunt afbeeldingen niet direct plakken. Upload of voeg afbeeldingen vanaf een URL in

  • Populaire leden

    Er is nog niemand die deze week reputatie heeft ontvangen.

  • Leden

    Geen leden om te tonen

×
×
  • Nieuwe aanmaken...