:: MVP ::
|
|
:: RSS ::
|
|
|
Как вывести результат работы консоли в 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
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.
|
При использовании материала - ссылка на сайт обязательна
|
|