FAQ VCL
Консоль

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как использовать консоль в не-консольном приложении?

procedure TForm1.Button1Click(Sender: TObject);
var
  s: string;
begin
  AllocConsole;
  try
    Write('Type here your words and press ENTER: ');
    Readln(s);
    Writeln(s);
    Sleep(2000);
  finally
    FreeConsole;
  end;
end;


Как изменить заголовок консольного окна?

procedure TForm1.Button1Click(Sender: TObject);
begin
  AllocConsole;
  try
    SetConsoleTitle(PChar('Console Title'));
    Sleep(2000);
  finally
    FreeConsole;
  end;
end;


Как вывести результат работы консоли в Memo?

procedure RunDosInMemo(AppName, CmdLine: string; AMemo: TMemo);
const
  ReadBuffer = 2400;
var
  Security: TSecurityAttributes;
  ReadPipe, WritePipe: THandle;
  Start: TStartUpInfo;
  ProcessInfo: TProcessInformation;
  Buffer: PAnsiChar;
  BytesRead: DWord;
  Apprunning: DWord;
begin
  Screen.Cursor := CrHourGlass;

  with Security do
  begin
    nlength := SizeOf(TSecurityAttributes);
    binherithandle := True;
    lpsecuritydescriptor := nil;
  end;

  if Createpipe(ReadPipe, WritePipe, @Security, 0) then
  begin
    Buffer := AllocMem(ReadBuffer+1);
    FillChar(Start, Sizeof(Start), #0);
    Start.cb := SizeOf(Start);
    Start.hStdOutput := WritePipe;
    Start.hStdInput := ReadPipe;
    Start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
    Start.wShowWindow := SW_HIDE;
    if CreateProcess(PWideChar(AppName), PWideChar(AppName + ' ' + CmdLine),
                     @Security, @Security, True, NORMAL_PRIORITY_CLASS, nil, nil,
                     Start, ProcessInfo) then
    begin
      repeat
        Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 100);
        ReadFile(ReadPipe, Buffer[0], ReadBuffer, BytesRead, nil);
        Buffer[BytesRead] := #0;
        OemToAnsi(Buffer, Buffer);
        AMemo.Text := AMemo.Text + string(Buffer);
        Application.ProcessMessages;
      until Apprunning <> WAIT_TIMEOUT;
      // until BytesRead < ReadBuffer;
    end;
    FreeMem(Buffer);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ReadPipe);
    CloseHandle(WritePipe);
  end;
  Screen.Cursor := CrDefault;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Clear;
  Button1.Enabled := False;
  RunDosInMemo('c:\Windows\System32\ping.exe', '127.0.0.1', Memo1);
  Button1.Enabled := True;
end;


Как изменить цвет текста в консольном приложении?

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils, Windows;

begin
  // Возможные варианты цветов:
  // FOREGROUND_BLUE, FOREGROUND_GREEN,
  // FOREGROUND_RED, FOREGROUND_INTENSITY
  SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),
                          FOREGROUND_BLUE or FOREGROUND_INTENSITY);
  Readln;
end.


Как изменить цвет фона текста в консольном приложении?

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils, Windows;

begin
  // Возможные варианты цветов:
  // BACKGROUND_BLUE, BACKGROUND_GREEN,
  // BACKGROUND_RED, BACKGROUND_INTENSITY
  SetConsoleTextAttribute(GetStdHandle( STD_OUTPUT_HANDLE),
                          BACKGROUND_BLUE or BACKGROUND_INTENSITY);
  Readln;
end.


Как в консольном приложении установить курсор в нужную позицию?

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils, Windows;

var
  Coord: TCoord;

begin
  Coord.X := 2;
  Coord.Y := 2;
  SetConsoleCursorPosition(GetStdHandle(STD_OUTPUT_HANDLE), Coord);
  Readln;
end.


Как очистить экран в консольном приложении?

// Способ первый
program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils, Windows;

var
  ConHandle: THandle;
  Coord: TCoord;
  NOCW: Cardinal;
  MaxX, MaxY: SmallInt;

procedure GotoXY(x, y: Word);
begin
  Coord.X := x;
  Coord.Y := y;
  SetConsoleCursorPosition(ConHandle, Coord);
end;

begin
  // Получаем Hendle консоли
  ConHandle := GetStdHandle(STD_OUTPUT_HANDLE);
  // Получаем максимально возможные размеры консоли
  Coord := GetLargestConsoleWindowSize(ConHandle);
  MaxX := Coord.X;
  MaxY := Coord.Y;
  Writeln('Height -', Coord.X:5);
  Writeln('Width  -', Coord.Y:5);
  Readln;
  // Очищаем консоль
  Coord.X := 0;
  Coord.Y := 0;
  FillConsoleOutputCharacter(ConHandle, ' ', MaxX * MaxY, Coord, NOCW);
  // Устанавливаем курсор в начальное положение
  GotoXY(0, 0);
  Readln;
end.

// Способ второй
program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils, Windows;

var
  sbi: TConsoleScreenBufferInfo;
  i: Integer;

begin
  Writeln('A Console Applicaiton');
  Writeln('Press Enter To Clear The Screen');
  GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), sbi);
  Readln;
  GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), sbi);
  for i := 0 to sbi.dwSize.y do
    Writeln;
  Writeln('Press Enter To End');
  Readln;
end.


Как в консольном приложении вывести строку с нужным цветом текста и фона в указанных координатах?

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils, Windows;

// Задаем цвет фона и текста
const
  LineColor = BACKGROUND_RED or BACKGROUND_INTENSITY or
              FOREGROUND_RED or FOREGROUND_GREEN or
              FOREGROUND_BLUE or FOREGROUND_INTENSITY;

var
  NOCW: Cardinal;
  Coord: TCoord;
  ConHandle: THandle;

procedure StatusLine(x, y: Byte; Str: string);
begin
  Coord.X := x;
  Coord.Y := y;
  WriteConsoleOutputCharacter(ConHandle, PChar(Str), Length(Str)+1, Coord, NOCW);
  FillConsoleOutputAttribute(ConHandle, LineColor, Length(Str), Coord, NOCW);
end;

begin
  ConHandle := GetStdHandle(STD_OUTPUT_HANDLE);
  StatusLine(0, 0, 'Test string');
  Readln;
end.


Как поменять иконку в заголовке консольного окна?

procedure TForm1.Button1Click(Sender: TObject);
var
  Wnd: HWND;
  AIcon: TIcon;
begin
  Wnd := THandle(AllocConsole);
  AIcon := TIcon.Create;
  ImageList1.GetIcon(0, AIcon);
  PostMessage(Wnd, WM_SETICON, 0, AIcon.Handle);
  Readln;
  AIcon.Free;
  FreeConsole;
end;


Как скрыть курсор в консольном приложении?

// Способ первый
program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils, Windows;

procedure ShowCursor(Show: Bool);
var
  CCI: TConsoleCursorInfo;
begin
  CCI.dwSize := SizeOf(TConsoleCursorInfo);
  CCI.bVisible := Show;
  SetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), CCI);
end;

begin
  try
    ShowCursor(False);
    Readln;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

// Способ второй
program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils, Windows;

var
  CCI: TConsoleCursorInfo;

begin
  GetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), CCI);
  CCI.bVisible := False;
  SetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), CCI);

  Readln;
end.

При использовании материала - ссылка на сайт обязательна