Интересует то, как можно dos-приложение засунуть в окно(естественно написанное на Delphi), но не только текст, как через пайпы, а все окно, с возможностью управления над ним.
Пример: Такое окно открывается в Windows, при запуске консольного приложения в режиме "отображать в окне".
Warlock
30.06.2003 13:52
Мне кажется, что никак не получится. Окно дельфиное - это окно. А досовое приложение - это по-любому запуск VDM (виртуальной машины ДОС). И как умять одно в другое - я лично без понятия. Есть предположение, что это можно написать с помощью WinAPI, с регистрацией окна, созданием экземпляра VDM и так дальше...
mj
1.07.2003 12:22
Создаёшь консоль, активизирушь её, запускаешь в ней приложение и упровляешь ей... Всё просто ;)
unit DrvCrt; // Работа с экраном в текстовом режиме // с многоязыковой поддержкой и без VCL.
interface
uses Windows;
const CR = #10; // Перевод на следующюю строку при наличии 0 бита в режиме консоли Ramka_LineH: array[1..2] of Char = (#196, #205); // "-=" Горизонтальная палка Ramka_LineV: array[1..2] of Char = (#179, #186); // Вертикальная палка Ramka_LineHV: array[1..4] of Char = (#197, #186, #215, #216); // Крест Ramka_LineRD: array[1..4] of Char = (#218, #201, #214, #213); // Справа вниз Ramka_LineLD: array[1..4] of Char = (#191, #187, #183, #184); // Слева вниз Ramka_LineRU: array[1..4] of Char = (#192, #200, #211, #212); // Справа вверх Ramka_LineLU: array[1..4] of Char = (#217, #188, #189, #190); // Слева вверх Ramka_LineVL: array[1..4] of Char = (#180, #185, #181, #182); // Вертикальная палка + Лево Ramka_LineVR: array[1..4] of Char = (#195, #204, #198, #199); // Вертикальная палка + Право Ramka_LineHU: array[1..4] of Char = (#193, #202, #208, #207); // Горизонтальная палка + Вверх Ramka_LineHD: array[1..4] of Char = (#194, #203, #210, #209); // Горизонтальная палка + Вниз // 1 - Оба направления одиночная полоска // 2 - Оба направления двойная полоска // 3 - Первое направления одиночная полоска, второе направление двойная полоска // 4 - Первое направления двойная полоска, второе направление одиночная полоска BarChar: array[1..5] of Char = (#219, #220, #221, #222, #223); // символы-квадраты соответственно: весь, снизу, слева, справа, сверху PsetChar: array[1..3] of Char = (#176, #177, #178); // Точеки соответственно: мало, средне, много NumberChar = #252; // Знак "№" (номер) SolnChar = #253; // Знак "Солнышко" SqeChar = #251; // Знак "Корень" CenterPsetChar = #149; // Маленькая точка в центре CenterMiniPsetChar = #150; // Совсем маленькая точка в центре
var STDInputHandle: THandle; STDOutPutHandle: THandle; STDErrorHandle: THandle; ActiveCrt: THandle;
{ Начало работы } procedure InitDrvCrt; { Конец работы } procedure DoneDrvCrt; { Создание экрана } function CreateCrt: THandle; { Удаление экрана } procedure DestroyCrt(Handle: THandle); { Установка режима } procedure SetModeCrt(Handle: THandle; Mode: Cardinal); { Чтение режима } function GetModeCrt(Handle: THandle): Cardinal; { Установка активного экрана } procedure SetActiveCrt(Handle: THandle); { Отключение активных экранов } procedure FreeCrt;
{ Установка названия в панели задач } procedure SetTitleCrt(Title: String); { Чтение названия с панели задач } function GetTitleCrt: String; { Установка позиции курсора } procedure SetCursorPosCrt(X, Y: SmallInt); overload; procedure SetCursorPosCrt(Pos: TCoord); overload; { Чтение позиции курсора } procedure GetCursorPosCrt(var X, Y: SmallInt); overload; procedure GetCursorPosCrt(var Pos: TCoord); overload; { Установка цвета вывода текста } procedure SetTextOutColorCrt(Attr: Word); { Вывод текста} procedure OutTextCrt(Str: Variant; Cod: TCodOut=ccWideChar); overload; procedure OutTextCrt(X, Y: Integer; Str: Variant; Cod: TCodOut=ccWideChar); overload; { Cod - Способ передачи данных } { Чтение событий } function GetEventCrt(Delete: Boolean=True): TEventCrt; { Delete True удаляет событие из очереди после чтения }
{ Изменение кодировки строк из Windows кодировки в кодировку Dos } function WinToDos(Str: String): String; // Работает быстро, но не по стандартам!!!
procedure DoneDrvCrt; begin CloseHandle(STDInputHandle); CloseHandle(STDOutPutHandle); CloseHandle(STDErrorHandle); end;
function CreateCrt: THandle; begin Result := CreateConsoleScreenBuffer( GENERIC_READ or GENERIC_WRITE, 0, nil, CONSOLE_TEXTMODE_BUFFER, nil); end;
procedure DestroyCrt(Handle: THandle); begin if CloseHandle(Handle) then if Handle=ActiveCrt then FreeCrt; end;
procedure SetModeCrt(Handle: THandle; Mode: Cardinal); begin SetConsoleMode(Handle, Mode); end;
function GetModeCrt(Handle: THandle): Cardinal; begin GetConsoleMode(Handle, Result); end;
procedure SetActiveCrt(Handle: THandle); begin if SetConsoleActiveScreenBuffer(Handle) then ActiveCrt := Handle; end;
procedure FreeCrt; begin if FreeConsole then ActiveCrt := 0 end;
{****************************************}
procedure SetTitleCrt(Title: String); begin SetConsoleTitleA(PChar(Title)); end;
function GetTitleCrt: String; begin SetLength(Result, 256); SetLength(Result, GetConsoleTitleA(PChar(Result), 256)); end;
procedure SetCursorPosCrt(X, Y: SmallInt); var Coord: TCoord; begin Coord.X := X; Coord.Y := Y; SetConsoleCursorPosition(ActiveCrt, Coord); end;
procedure SetCursorPosCrt(Pos: TCoord); begin SetConsoleCursorPosition(ActiveCrt, Pos); end;
procedure GetCursorPosCrt(var X, Y: SmallInt); var CSBI: TConsoleScreenBufferInfo; begin GetConsoleScreenBufferInfo(ActiveCrt, CSBI); X := CSBI.dwCursorPosition.X; Y := CSBI.dwCursorPosition.Y; end;
procedure GetCursorPosCrt(var Pos: TCoord); var CSBI: TConsoleScreenBufferInfo; begin GetConsoleScreenBufferInfo(ActiveCrt, CSBI); Pos := CSBI.dwCursorPosition; end;
procedure SetTextOutColorCrt(Attr: Word); begin SetConsoleTextAttribute(ActiveCrt, Attr) end;
procedure OutTextCrt(Str: Variant; Cod: TCodOut=ccWideChar); var tC: Cardinal; WC: WideString; begin if Cod=ccWideChar then begin WC := String(Str); WriteConsoleW(ActiveCrt, PWideChar(WC), Length(String(Str)), tC, nil); end else WriteConsoleA(ActiveCrt, PChar(String(Str)), Length(String(Str)), tC, nil); end;
procedure OutTextCrt(X, Y: Integer; Str: Variant; Cod: TCodOut=ccWideChar); var tC: Cardinal; WC: WideString; begin SetCursorPosCrt(X, Y); if Cod=ccWideChar then begin WC := String(Str); WriteConsoleW(ActiveCrt, PWideChar(WC), Length(String(Str)), tC, nil); end else WriteConsoleA(ActiveCrt, PChar(String(Str)), Length(String(Str)), tC, nil); end;
function GetEventCrt(Delete: Boolean=True): TEventCrt; var tC: Cardinal; begin if Delete then ReadConsoleInputA(STDInputHandle, Result, 1, tC) else PeekConsoleInputA(STDInputHandle, Result, 1, tC); end;
{****************************************}
function WinToDos(Str: String): String; var I: Integer; begin Result := ''; if Str='' then Exit; for I := 1 to Length(Str) do case Str[I] of ' ': Result := Result+' '; 'А'..'п': Result := Result+Char(Byte(Str[I])-64); 'р'..'я': Result := Result+Char(Byte(Str[I])-16); 'Ё': Result := Result+'р'; 'ё': Result := Result+'с'; else Result := Result+Str[I]; end; end;
{****************************************}
initialization
finalization
end.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.