home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Delphi / kompon / d345 / GUI2ConsoleDemo.EXE / demos / D3 / Unit1.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1998-07-25  |  4.4 KB  |  177 lines
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ConsoleIO, Buttons, ExtCtrls, ComCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     ListBox1: TListBox;
  12.     Panel1: TPanel;
  13.     Edit1: TEdit;
  14.     GUI2Console1: TGUI2Console;
  15.     procedure GUI2Console1Line(Sender: TObject; const Line: String);
  16.     procedure GUI2Console1Done(Sender: TObject);
  17.     procedure GUI2Console1Start(Sender: TObject; const Command: String);
  18.     procedure FormCreate(Sender: TObject);
  19.     procedure FormResize(Sender: TObject);
  20.     procedure GUI2Console1PreDone(Sender: TObject);
  21.     procedure GUI2Console1Prompt(Sender: TObject; const Line: String);
  22.     procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  23.     procedure GUI2Console1Error(Sender: TObject; const Error: String);
  24.     procedure Edit1KeyUp(Sender: TObject; var Key: Word;Shift: TShiftState);
  25.     procedure ListBox1Enter(Sender: TObject);
  26.  
  27.   private
  28.     { Private declarations }
  29.   public
  30.     { Public declarations }
  31.     procedure WMEraseBkgnd(var Message : TWMEraseBkgnd); message WM_ERASEBKGnD;
  32.     function AddListBox(const E : String): Integer;
  33.   end;
  34.  
  35.  TPrompt = record
  36.   Index : Integer;
  37.   Str : String;
  38.   end;
  39.  
  40. var
  41.   Form1: TForm1;
  42.   Prompt : TPrompt;
  43.   FKey : Char;
  44.   Delimit : String; //Delimiter for cmd vs. command is different
  45.  
  46. implementation
  47.  
  48. {$R *.DFM}
  49.  
  50. type
  51.  TOSType = (ostUnknown,ostWin95,ostWinNT);
  52.  
  53. function OSType : TOSType;
  54. var
  55.  osv : TOSVersionInfo;
  56. begin
  57.  osv.dwOSVersionInfoSize := sizeof(osv);
  58.  GetVersionEx(osv);
  59.   Case osv.dwPlatformId of
  60.    VER_PLATFORM_WIN32_NT : Result := ostWinNT;
  61.    VER_PLATFORM_WIN32_WINDOWS : Result := ostWin95;
  62.   else Result := ostUnknown;
  63.   end; //Case
  64. end;
  65.  
  66. procedure TForm1.WMEraseBkgnd(var Message : TWMEraseBkgnd);
  67. begin
  68.  Message.Result := 1;
  69. end;
  70.  
  71.  
  72. function TForm1.AddListBox(const E : String): integer;
  73. begin
  74.   ListBox1.Items.BeginUpdate;
  75.   while ListBox1.Items.Count > 150 do
  76.    ListBox1.Items.Delete(0);
  77.    Result := ListBox1.Items.Add(E);
  78.    with ListBox1 do TopIndex := Items.Count-((Height div ItemHeight));
  79.    ListBox1.Items.EndUpdate;
  80. end;
  81.  
  82. procedure TForm1.GUI2Console1Line(Sender: TObject; const Line: String);
  83. begin
  84.  If Line <> Prompt.Str then
  85.   AddListBox(Line);
  86.  Prompt.Str := '';
  87. end;
  88.  
  89. procedure TForm1.GUI2Console1Done(Sender: TObject);
  90. begin
  91.   AddListBox('Done...');
  92. end;
  93.  
  94. procedure TForm1.GUI2Console1Start(Sender: TObject; const Command: String);
  95. begin
  96.   AddListBox('Start...'+Command);
  97. end;
  98.  
  99. procedure TForm1.FormCreate(Sender: TObject);
  100. begin
  101.  Panel1.Height := Edit1.Height + 2;
  102.  if OSType <> ostUnknown then
  103.  begin
  104.   Case OSType of
  105.    ostWinNT : begin
  106.                 GUI2Console1.Application := 'c:\windows\system32\cmd.exe';
  107.                 GUI2Console1.Command := '';
  108.                 Delimit := CRLF;
  109.                end;
  110.    ostWin95 : begin
  111.                GUI2Console1.Application := '';
  112.                GUI2Console1.Command := 'command.com';
  113.                Delimit := LF;
  114.                GUI2Console1.AppType := at16bit;
  115.               end;
  116.   end;
  117.   GUI2Console1.Start;
  118.  end else
  119.  begin
  120.   AddListBox('Unknown OS Type');
  121.  end;
  122. end;
  123.  
  124. procedure TForm1.FormResize(Sender: TObject);
  125. begin
  126.   Edit1.Width := Panel1.Width -2;
  127.   ListBox1.TopIndex := ListBox1.Items.Count-1;
  128. end;
  129.  
  130. procedure TForm1.GUI2Console1PreDone(Sender: TObject);
  131. begin
  132.  GUI2Console1.Write(#4'C');
  133.  GUI2Console1.WriteLn('exit');
  134. end;
  135.  
  136. procedure TForm1.GUI2Console1Prompt(Sender: TObject; const Line: String);
  137. begin
  138.  Prompt.Str := Line;
  139.  Prompt.Index := AddListBox(Line);
  140. end;
  141.  
  142. procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
  143. begin
  144.   FKey := Key;
  145. end;
  146.  
  147. procedure TForm1.GUI2Console1Error(Sender: TObject; const Error: String);
  148. begin
  149.  AddListBox(Error);
  150. end;
  151.  
  152. procedure TForm1.Edit1KeyUp(Sender: TObject; var Key: Word;
  153.   Shift: TShiftState);
  154. begin
  155.   if (FKey = #13)  then
  156.    begin
  157.     GUI2Console1.Write(Edit1.Text+Delimit);
  158.     Prompt.Str := Prompt.Str + Edit1.Text;
  159.     Edit1.Text := '';
  160.     FKey := #0;
  161.    end else if Fkey in [#8,' '..'z']
  162.     then
  163.      begin
  164.       ListBox1.Items.BeginUpdate;
  165.       ListBox1.Items[Prompt.Index]:= Prompt.Str+ Edit1.Text;
  166.       with ListBox1 do TopIndex := Items.Count-((Height div ItemHeight));
  167.       ListBox1.Items.EndUpdate;
  168.      end;
  169. end;
  170.  
  171. procedure TForm1.ListBox1Enter(Sender: TObject);
  172. begin
  173.  Edit1.Setfocus;
  174. end;
  175.  
  176. end.
  177.