cls in console app

[value is NULL]

Hi

möchte in meiner console app einen cls befehl einbauen, habe dazu folgendes aus dem netz gefunden:

Delphi-Quellcode:

uses
  Windows;

{$R *.RES}

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.

das sieht jedoch mörder schw*** aus bis er alles mit leerzeichen befüllt hat.

mein projekt ist eine kleine shell zu basteln dh der aufbau des fensters sieht wie ein dos fenster aus...

hat jemand ne idee wie ich das umsetzen kann?

danke im voraus

LG

[DeddyH]

Geht es mit der DelphiCrt schneller?

[rollstuhlfahrer]

warum eine Kommandozeile selbst basteln? Windows hat doch eine an Bord. Einfach in die Projektdatei ein "{$APPTYPE CONSOLE}" hinzuschreiben und du hast dein Konsolenprogramm. Einfacher gehts über Datei->Neu->weiteres...->...->Konsolenprogramm

Bernhard

[DeddyH]

Da gibt es aber keine Möglichkeiten, Schriftfarben zu setzen oder den Bildschirm zu leeren wie mit TP unter DOS.

[Luckie]

Natürlich gibt es die Möglichkeit die Frabe zu setzen. Dazu gibt es die Funktion setconsoletextattribute.

[DeddyH]

Meinetwegen, aber was ist mit clrscr, gotoxy usw.? Willst Du das jedesmal neu implementieren?

[value is NULL]

nun ja es ist ja eine console app....

brauche praktisch nur eine function mit der ich das cls imitieren kann...

[DeddyH]

In der angesprochenen DelphiCRT wird dazu FillConsoleOutputCharacter und FillConsoleOutputAttribute benutzt. Nach einem flüchtigen Blick glaube ich allerdings nicht, dass man die ClrScr-Routine einfach so per C&P übernehmen kann. Spricht denn etwas dagegen, die Unit einzubinden?

[Luckie]

Zitat:

Zitat von DeddyH (Beitrag 1055558)

Meinetwegen, aber was ist mit clrscr, gotoxy usw.? Willst Du das jedesmal neu implementieren?

Nö, warum? Ich nehem da einfach die unit von Oliver: http://www.michael-puff.de/Programmi...d/ConTools.inc

[DeddyH]

Dann kann man aber auch die von mir verlinkte Unit nehmen. Ich hatte ja nicht behauptet, dass es grundsätzlich unmöglich ist, sondern dass es eine Menge Arbeit ist, die Funktionalität zu implementieren. Von daher würde ich auf eine fertige Unit zurückgreifen, welche, sei mal dahingestellt.

[value is NULL]

hm blöde frage vielleicht, wie verwende ich die unit? bzw. was brauche ich dazu hab versucht mir diese CRT32 zu erstellen aber irgendwie will das nicht...

[DeddyH]

Pack sie entweder in den Suchpfad von Delphi oder ins Projektverzeichnis und binde sie in Deine uses-Klausel ein.

[value is NULL]

so jetzts hats geklappt

Delphi-Quellcode:

{$APPTYPE CONSOLE}
unit crt32;
{# freeware}
{# version 1.0.0127}
{# Date 18.01.1997}
{# Author Frank Zimmer}
{# description
 Copyright © 1997, Frank Zimmer, [e-mail]
 Version: 1.0.0119
 Date:    18.01.1997

 an Implementation of Turbo Pascal CRT-Unit for Win32 Console Subsystem
 testet with Windows NT 4.0
 At Startup you get the Focus to the Console!!!!

 ( with * are not in the original Crt-Unit):
 Procedure and Function:
   ClrScr
   ClrEol
   WhereX
   WhereY
   GotoXY
   InsLine
   DelLine
   HighVideo
   LowVideo
   NormVideo
   TextBackground
   TextColor
   Delay             // use no processtime
   KeyPressed
   ReadKey           // use no processtime
   Sound             // with Windows NT your could use the Variables SoundFrequenz, SoundDuration
   NoSound
   *TextAttribut     // Set TextBackground and TextColor at the same time, usefull for Lastmode
   *FlushInputBuffer // Flush the Keyboard and all other Events
   *ConsoleEnd       // output of 'Press any key' and wait for key input when not pipe
   *Pipe             // True when the output is redirected to a pipe or a file

 Variables:
   WindMin           // the min. WindowRect
   WindMax           // the max. WindowRect
   *ViewMax          // the max. ConsoleBuffer start at (1,1);
   TextAttr          // Actual Attributes only by changing with this Routines
   LastMode          // Last Attributes only by changing with this Routines
   *SoundFrequenz    // with Windows NT your could use these Variables
   *SoundDuration    // how long bells the speaker  -1 until ??, default = -1
   *HConsoleInput    // the Input-handle;
   *HConsoleOutput   // the Output-handle;
   *HConsoleError    // the Error-handle;


 This Source is freeware, have fun :-)

 History
   18.01.97   the first implementation
   23.01.97   Sound, delay, Codepage inserted and setfocus to the console
   24.01.97   Redirected status
}

interface
uses windows,messages;
{$ifdef win32}
const
  Black           = 0;
  Blue            = 1;
  Green           = 2;
  Cyan            = 3;
  Red             = 4;
  Magenta         = 5;
  Brown           = 6;
  LightGray       = 7;
  DarkGray        = 8;
  LightBlue       = 9;
  LightGreen      = 10;
  LightCyan       = 11;
  LightRed        = 12;
  LightMagenta    = 13;
  Yellow          = 14;
  White           = 15;

  Function WhereX: integer;
  Function WhereY: integer;
  procedure ClrEol;
  procedure ClrScr;
  procedure InsLine;
  Procedure DelLine;
  Procedure GotoXY(const x,y:integer);
  procedure HighVideo;
  procedure LowVideo;
  procedure NormVideo;
  procedure TextBackground(const Color:word);
  procedure TextColor(const Color:word);
  procedure TextAttribut(const Color,Background:word);
  procedure Delay(const ms:integer);
  function KeyPressed:boolean;
  function ReadKey:Char;
  Procedure Sound;
  Procedure NoSound;
  procedure ConsoleEnd;
  procedure FlushInputBuffer;
  Function Pipe:boolean;

var
  HConsoleInput:tHandle;
  HConsoleOutput:thandle;
  HConsoleError:Thandle;
  WindMin:tcoord;
  WindMax:tcoord;
  ViewMax:tcoord;
  TextAttr : Word;
  LastMode : Word;
  SoundFrequenz :Integer;
  SoundDuration : Integer;

{$endif win32}

implementation
{$ifdef win32}
uses sysutils;
var
  StartAttr:word;
  OldCP:integer;
  CrtPipe : Boolean;
  German : boolean;

procedure ClrEol;
var tC :tCoord;
  Len,Nw: DWord;
  Cbi : TConsoleScreenBufferInfo;
begin
  GetConsoleScreenBufferInfo(HConsoleOutput,cbi);
  len := cbi.dwsize.x-cbi.dwcursorposition.x;
  tc.x := cbi.dwcursorposition.x;
  tc.y := cbi.dwcursorposition.y;
  FillConsoleOutputAttribute(HConsoleOutput,textattr,len,tc,nw);
  FillConsoleOutputCharacter(HConsoleOutput,#32,len,tc,nw);
end;

procedure ClrScr;
var tc :tcoord;
  nw: DWord;
  cbi : TConsoleScreenBufferInfo;
begin
  getConsoleScreenBufferInfo(HConsoleOutput,cbi);
  tc.x := 0;
  tc.y := 0;
  FillConsoleOutputAttribute(HConsoleOutput,textattr,cbi.dwsize.x*cbi.dwsize.y,tc,nw);
  FillConsoleOutputCharacter(HConsoleOutput,#32,cbi.dwsize.x*cbi.dwsize.y,tc,nw);
  setConsoleCursorPosition(hconsoleoutput,tc);
end;

Function WhereX: integer;
var cbi : TConsoleScreenBufferInfo;
begin
  getConsoleScreenBufferInfo(HConsoleOutput,cbi);
  result := tcoord(cbi.dwCursorPosition).x+1
end;

Function WhereY: integer;
var cbi : TConsoleScreenBufferInfo;
begin
  getConsoleScreenBufferInfo(HConsoleOutput,cbi);
  result := tcoord(cbi.dwCursorPosition).y+1
end;

Procedure GotoXY(const x,y:integer);
var coord :tcoord;
begin
  coord.x := x-1;
  coord.y := y-1;
  setConsoleCursorPosition(hconsoleoutput,coord);
end;

procedure InsLine;
var
 cbi : TConsoleScreenBufferInfo;
 ssr:tsmallrect;
 coord :tcoord;
 ci :tcharinfo;
 nw:DWord;
begin
  getConsoleScreenBufferInfo(HConsoleOutput,cbi);
  coord := cbi.dwCursorPosition;
  ssr.left := 0;
  ssr.top := coord.y;
  ssr.right := cbi.srwindow.right;
  ssr.bottom := cbi.srwindow.bottom;
  ci.asciichar := #32;
  ci.attributes := cbi.wattributes;
  coord.x := 0;
  coord.y := coord.y+1;
  ScrollConsoleScreenBuffer(HconsoleOutput,ssr,nil,coord,ci);
  coord.y := coord.y-1;
  FillConsoleOutputAttribute(HConsoleOutput,textattr,cbi.dwsize.x*cbi.dwsize.y,coord,nw);
end;

procedure DelLine;
var
 cbi : TConsoleScreenBufferInfo;
 ssr:tsmallrect;
 coord :tcoord;
 ci :tcharinfo;
 nw:DWord;
begin
  getConsoleScreenBufferInfo(HConsoleOutput,cbi);
  coord := cbi.dwCursorPosition;
  ssr.left := 0;
  ssr.top := coord.y+1;
  ssr.right := cbi.srwindow.right;
  ssr.bottom := cbi.srwindow.bottom;
  ci.asciichar := #32;
  ci.attributes := cbi.wattributes;
  coord.x := 0;
  coord.y := coord.y;
  ScrollConsoleScreenBuffer(HconsoleOutput,ssr,nil,coord,ci);
  FillConsoleOutputAttribute(HConsoleOutput,textattr,cbi.dwsize.x*cbi.dwsize.y,coord,nw);
end;

procedure TextBackground(const Color:word);
begin
  LastMode := TextAttr;
  textattr := (color shl 4) or (textattr and $f);
  SetConsoleTextAttribute(hconsoleoutput,textattr);
end;

procedure TextColor(const Color:word);
begin
  LastMode := TextAttr;
  textattr := (color and $f) or (textattr and $f0);
  SetConsoleTextAttribute(hconsoleoutput,textattr);
end;

procedure TextAttribut(const Color,Background:word);
begin
  LastMode := TextAttr;
  textattr := (color and $f) or (Background shl 4);
  SetConsoleTextAttribute(hconsoleoutput,textattr);
end;

procedure HighVideo;
begin
  LastMode := TextAttr;
  textattr := textattr or $8;
  SetConsoleTextAttribute(hconsoleoutput,textattr);
end;

procedure LowVideo;
begin
  LastMode := TextAttr;
  textattr := textattr and $f7;
  SetConsoleTextAttribute(hconsoleoutput,textattr);
end;

procedure NormVideo;
begin
  LastMode := TextAttr;
  textattr := startAttr;
  SetConsoleTextAttribute(hconsoleoutput,textattr);
end;

procedure FlushInputBuffer;
begin
  FlushConsoleInputBuffer(hconsoleinput)
end;

function keypressed:boolean;
var NumberOfEvents:dWord;
begin
  GetNumberOfConsoleInputEvents(hconsoleinput,NumberOfEvents);
  result := NumberOfEvents > 0;
end;

function ReadKey: Char;
var
  NumRead:       dWord;
  InputRec:      TInputRecord;
begin
  while not ReadConsoleInput(HConsoleInput,
                             InputRec,
                             1,
                             NumRead) or
           (InputRec.EventType <> KEY_EVENT) do;
  Result := InputRec.Event.KeyEvent.AsciiChar
end;

procedure delay(const ms:integer);
begin
  sleep(ms);
end;

Procedure Sound;
begin
  windows.beep(SoundFrequenz,soundduration);
end;

Procedure NoSound;
begin
  windows.beep(soundfrequenz,0);
end;

procedure ConsoleEnd;
begin
  if isconsole and not crtpipe then
  begin
    if wherex > 1 then writeln;
    textcolor(green);
    setfocus(GetCurrentProcess);
    if german then write('Bitte eine Taste drücken!')
              else write('Press any key!');
    normvideo;
    FlushInputBuffer;
    ReadKey;
    FlushInputBuffer;
  end;
end;

function Pipe:boolean;
begin
  result := crtpipe;
end;

procedure init;
var
  cbi : TConsoleScreenBufferInfo;
  tc : tcoord;
begin
 SetActiveWindow(0);
 HConsoleInput := GetStdHandle(STD_InPUT_HANDLE);
 HConsoleOutput := GetStdHandle(STD_OUTPUT_HANDLE);
 HConsoleError := GetStdHandle(STD_Error_HANDLE);
 if getConsoleScreenBufferInfo(HConsoleOutput,cbi) then
 begin
   TextAttr := cbi.wAttributes;
   StartAttr := cbi.wAttributes;
   lastmode  := cbi.wAttributes;
   tc.x := cbi.srwindow.left+1;
   tc.y := cbi.srwindow.top+1;
   windmin := tc;
   ViewMax := cbi.dwsize;
   tc.x := cbi.srwindow.right+1;
   tc.y := cbi.srwindow.bottom+1;
   windmax := tc;
   crtpipe := false;
 end else crtpipe := true;
 SoundFrequenz := 1000;
 SoundDuration := -1;
 oldCp := GetConsoleoutputCP;
 SetConsoleoutputCP(1252);
 german := $07 = (LoWord(GetUserDefaultLangID) and $3ff);
end;

initialization
  init;
finalization
 SetConsoleoutputCP(oldcp);
{$endif win32}
end.

und dann im prog nur noch:

Delphi-Quellcode:

ClrScr;

ferdisch :) danke!