anoniem Geplaatst: 15 februari 2004 Delen Geplaatst: 15 februari 2004 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 Link naar reactie
anoniem Geplaatst: 15 februari 2004 Auteur Delen Geplaatst: 15 februari 2004 [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... Quote Link naar reactie
anoniem Geplaatst: 16 februari 2004 Auteur Delen Geplaatst: 16 februari 2004 Ik heb de code geimplementeerd en het werkt goed maar mijn programma staat nog steeds stil tijdens het uitvoeren van een extern proces. Ik heb al even in de code gekeken maar zie geen mogelijkheid om een application.ProcessMessages o.i.d. tussen te voegen. Is het de bedoeling dat ik iets tussen de code zet? Quote Link naar reactie
Aanbevolen berichten
Om een reactie te plaatsen, moet je eerst inloggen