Konsolenprogramme wie in TP

[jbg]

Zitat von Christian Seehase:

... aber auch das mit den Farben könnte sich über spezielle ASCII Codes (Wert < 32) einleiten lassen.

Das ist mir neu. Das ging schon unter DOS nicht. Warum sollte es dann unter Windows funktionieren?

Windows bietet für die Consolenprogrammierung genug API Funktionen.
Hier ist mal ein kleines Beispielprogramm:

Delphi-Quellcode:

program Project1;
{$APPTYPE CONSOLE}
uses
  Windows,
  SysUtils;


type
  TConsole = class(TObject)
  private
    FNewConsole: Boolean;
    FhOut, FhIn: THandle;
    procedure SetTitle(const Value: string);
    function GetTitle: string;
  public
    constructor Create(const Title: string = ''; NewConsole: Boolean = True);
    destructor Destroy; override;

    procedure ClrScr;
    procedure GotoXY(x, y: Integer);
    procedure SetTextAttr(Attr: Word);
    procedure WriteEx(const Text: string; Attr: Word);

    property Title: string read GetTitle write SetTitle;
    property hOut: THandle read FhOut;
    property hIn: THandle read FhIn;
  end;

constructor TConsole.Create(const Title: string = ''; NewConsole: Boolean = True);
begin
  inherited Create;
  FNewConsole := NewConsole;
  if FNewConsole then AllocConsole;
  FhOut := GetStdHandle(STD_OUTPUT_HANDLE);
  FhIn := GetStdHandle(STD_INPUT_HANDLE);
  SetTitle(Title);
end;

destructor TConsole.Destroy;
begin
  if FNewConsole then FreeConsole;
  inherited Destroy;
end;

procedure TConsole.SetTitle(const Value: string);
begin
  SetConsoleTitle(PChar(Value));
end;

function TConsole.GetTitle: string;
var Buf: Array[0..1024] of Char;
begin
  SetString(Result, Buf, GetConsoleTitle(Buf, 1024));
end;

procedure TConsole.ClrScr;
var
  NumWritten: Cardinal;
  c: TCoord;
  Info: TConsoleScreenBufferInfo;
begin
  c.X := 0;
  c.Y := 0;
  GetConsoleScreenBufferInfo(hOut, Info);
  FillConsoleOutputAttribute(hOut, Info.wAttributes, 80 * 25, c, NumWritten);
  FillConsoleOutputCharacter(hOut, ' ', 80 * 25, c, NumWritten)
end;

procedure TConsole.GotoXY(x, y: Integer);
var c: TCoord;
begin
  c.X := x;
  c.Y := y;
  SetConsoleCursorPosition(hOut, c);
end;

procedure TConsole.SetTextAttr(Attr: Word);
begin
  SetConsoleTextAttribute(hOut, Attr);
end;

procedure TConsole.WriteEx(const Text: string; Attr: Word);
var NumWritten: Cardinal;
begin
  SetConsoleTextAttribute(hOut, Attr);
  WriteConsole(hOut, PChar(Text), Length(Text), NumWritten, nil);
end;

var Con: TConsole;
begin
  Con := TConsole.Create('Meine Konsole');
  try
    Con.SetTextAttr(FOREGROUND_GREEN or FOREGROUND_RED or FOREGROUND_INTENSITY
                    or
                    BACKGROUND_BLUE);
    Con.ClrScr;
    Con.GotoXY(10, 10);
    Write('Hallo');
    ReadLn;
    Con.ClrScr;
    ReadLn;
  finally
    Con.Free;
  end;
end.