VPF::Сделать на форме окно для консольного приложения?

Nicholas

Дата 30.11.2008, 13:03 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 436
Регистрация: 30.9.2004

Репутация: нет
Всего: 0

В общем у меня в цикле много раз запускается консольное приложение (конвертор), но не много окон, а прога ждет пока оно завершится потом продолжает цыкл, мне надо чтоб его окно запускалось внутри моей формы!
Иначе по рабочему столу начинают прыгать окшки консольного приложения, то там то тут smile

))

Нашел пример здесь. Исходник примера здесь.

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    GroupBox1: TGroupBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  ProcessInfo:TProcessInformation;
  CMD:Cardinal;
  OldParent:HWND; //если захочет вернуть :)

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var StartUpInfo:TStartupInfo;
    PrConsole:String;
    pID:Cardinal;
begin
 FillChar(StartUpInfo,SizeOf(TStartUpInfo),0);
 StartUpInfo.cb:=SizeOf(TStartUpInfo);
 StartUpInfo.dwFlags:=STARTF_USESHOWWINDOW;
 StartUpInfo.wShowWindow:=SW_SHOW;
 PrConsole:=ExtractFilePath(ParamStr(0))+'Console\PrConsole.exe';
 if CreateProcess(nil,{'cmd.exe'}PChar(PrConsole),nil,nil,false,NORMAL_PRIORITY_CLASS,nil,nil,StartUpInfo,ProcessInfo) then
  begin
   repeat
    CMD:=findwindow('ConsoleWindowClass', nil);
    pID:=0;
    if CMD<>0 then
     begin
      GetWindowThreadProcessId(CMD,@pID);
      if pID<>ProcessInfo.dwProcessId then CMD:=0; //Ждем пока именно наша консоль не окажется на самом верху
     end;
   until (CMD<>0);
   OldParent:=Windows.SetParent(CMD,GroupBox1.Handle);
   SetWindowPos(CMD,0,5,20,GroupBox1.ClientWidth-15,GroupBox1.ClientHeight-20,0);
  end else
  begin
   ShowMessage({'cmd.exe - не найден!'}'PrConsole.exe - не найден!');
   Application.Terminate;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 TerminateProcess(ProcessInfo.hProcess,0);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 Close;
end;

end.

Что я пока не понял в примере, это то как окно появляется на форме и как оно таскается мышью... :(
Вообще мне нажна процедура которая будет в своих параметрах иметь еще и GroupBox в котором будет работать окно консольного приложения.

Сейчас я пользуюсь функцией которая запускает и ждет выполнения приложения:

Код



function SwitchToProg(const Path: string): Boolean;
var
  SI: TStartupInfo;
  PI: TProcessInformation;
  ExitCode: Cardinal;
begin
  FillChar(SI, SizeOf(SI), 0);
  SI.cb := SizeOf(SI);

  Result := CreateProcess(nil, PChar(Path), nil, nil, False, 0, nil, nil,
    SI, PI);

  if Result then
  begin
    Application.MainForm.Hide;
    while GetExitCodeProcess(PI.hProcess, ExitCode) and
      (ExitCode = STILL_ACTIVE) do
      ; // ждем завершения, пустой цикл
    Application.MainForm.Show;
  end;
end;

Подскажите как ее переделать что было примерно так

Код


function SwitchToProg(const Path: string,GroupBox1:TGroupBox): Boolean;

Может ктонибудь предложит вариант проще???

Это сообщение отредактировал(а) Nicholas - 30.11.2008, 13:12

Letov

Дата 30.11.2008, 15:11 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 321
Регистрация: 22.2.2007
Где: Санкт-Петербург

Репутация: нет
Всего: 4

Интересная задача. Я, например, тяжело представляю себе как запускать приложение внутри своей формы (как я понял - консоль должна появляться в GroupBox1).
Есть другой интересный метод.
Например, запускать скрытый консольный процесс, и, если надо, перехватывать вывод консоль, например, с помощью пайпов (Pipe) и выводить ее в Memo.
В общем случает - смотри drkb. Там это есть.

Код


function SwitchToProg(const Path: string): Boolean;
var
  SI: TStartupInfo;
  PI: TProcessInformation;
  ExitCode: Cardinal;
begin
  FillChar(SI, SizeOf(SI), 0);
  SI.cb := SizeOf(SI);

  Result := CreateProcess(nil, PChar(Path), nil, nil, False, 0, nil, nil,
    SI, PI);

  if Result then
  begin
    Application.MainForm.Hide;
    while GetExitCodeProcess(PI.hProcess, ExitCode) and
      (ExitCode = STILL_ACTIVE) do
         Application.ProcessMessages
      ; // ждем завершения
    Application.MainForm.Show;
  end;
end;

Так лучше^^.

Это сообщение отредактировал(а) Letov - 30.11.2008, 15:12

--------------------

Не бывает плохих языков программирования. Бывают плохие программисты...

bems

Дата 30.11.2008, 18:23 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 3400
Регистрация: 5.1.2006

Репутация: 31
Всего: 88

Думаю, лучше так: сначала вызываешь AllocConsole. Новый процесс создаешь не указывая флажки DETACHED_PROCESS, CREATE_NEW_CONSOLE, CREATE_NEW_PROCESS_GROUP. Новый процесс унаследует твою консоль, и вместо привязки каждой новой консоли к твоему окну, достаточно это сделать один раз для своей консоли. Для этого сначала получаешь хэндл консольного окна (это GetConsoleWindow в новых виндах и куча сомнительных трюков в старых - ищи по форуму), а потоми делаешь SetParent этому окну

--------------------

Обижено школьников: 8

Nicholas

Дата 3.12.2008, 15:29 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 436
Регистрация: 30.9.2004

Репутация: нет
Всего: 0

Цитата(bems @ 30.11.2008, 18:23)

Я без собранного во едино кода нифига не пойму :(

bems

Дата 3.12.2008, 20:25 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 3400
Регистрация: 5.1.2006

Репутация: 31
Всего: 88

ну вот тебе пример:

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetConsoleWindow:HWND;external 'kernel32.dll';

procedure TForm1.Button1Click(Sender: TObject);
var wnd:HWND;
    pi:TProcessInformation;
    si:TStartupInfo;
begin
AllocConsole;
wnd:=GetConsoleWindow;
Windows.SetParent(wnd,Panel1.Handle);
SetWindowPos(wnd,0,0,0,Panel1.Width,Panel1.Height,0); 
ZeroMemory(@si,SizeOf(si));
si.cb:=SizeOf(si);
if CreateProcess(nil,'cmd.exe',nil,nil,False,0,nil,nil,si,pi)
   then begin
        CloseHandle(pi.hProcess);
        CloseHandle(pi.hThread)
        end;
end;

end.

--------------------

Обижено школьников: 8

Nicholas

Дата 4.12.2008, 04:56 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 436
Регистрация: 30.9.2004

Репутация: нет
Всего: 0

Нее, я все забыл... :(

п.с. Спасибо за пример.

Nicholas

Дата 4.6.2011, 19:08 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 436
Регистрация: 30.9.2004

Репутация: нет
Всего: 0

Подскажите, как сделать, что бы консольное окно никак не реагировало ни на мышь, ни на клавиатуру? Т.е. надо, что оно просто выводило результаты работы, а главное никто эту работу не мог прервать.

п.с.
Убрал заголовок и запретил изменение размеров так:

Код


// скрываем заголовок окна
SetWindowLong(wnd, GWL_STYLE, GetWindowLong(wnd, GWL_STYLE) xor WS_BORDER);
// запрещаем изменение размера окна
SetWindowLong(wnd, GWL_STYLE, GetWindowLong(wnd, GWL_STYLE) And Not WS_THICKFRAME);

Nicholas

Дата 20.6.2011, 07:26 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 436
Регистрация: 30.9.2004

Репутация: нет
Всего: 0

Модераторы, можете тему перенести в ветку "Delphi: WinAPI и системное программирование" ?
а то здесь она заглохнет судя по всему...

Это сообщение отредактировал(а) Nicholas - 20.6.2011, 07:27

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »