////////// // Class Name: Debug Windows // Author : RedFox (singlecat@163.com) // Date : 2006-07-11 // Version : 0.9beta // 使用方法: // 把这个单元引入工程. 要输出调试信息就用 debug.write 就可以了 // 需引进的地方: // 类的 ReadAnyKey(); 我想做成 '按任意链继续...'没做完,希望谁能帮我完成 //////////
interface
uses Windows;
type TDbgWnd = class private m_hConsole:THandle; public constructor Create; destructor Destroy;override; procedure write(str:string); procedure read(var str:string); procedure ReadAnyKey(); end;
var debug :TDbgWnd;
implementation
{ TDbgWnd }
constructor TDbgWnd.Create; begin AllocConsole; m_hConsole := CreateConsoleScreenBuffer(GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, CONSOLE_TEXTMODE_BUFFER, 0); SetConsoleActiveScreenBuffer(m_hConsole); SetConsoleMode(m_hConsole,ENABLE_LINE_INPUT or ENABLE_ECHO_INPUT); SetConsoleTitle('debug window') ; end;
destructor TDbgWnd.Destroy; begin FreeConsole; inherited; end;
procedure TDbgWnd.read(var str: string); var n:DWORD; buf:array[0..256] of char; begin n := 0; ReadConsole(m_hConsole,@buf[0],256,n,nil); SetString(str,PChar(@buf[0]),Integer(n)); end;
procedure TDbgWnd.ReadAnyKey; var s:string; begin self.write('Press Any Key to continue....'); Self.read(s); end;
procedure TDbgWnd.Write(str: string); var n:DWORD; begin WriteConsole(m_hConsole, PChar(str+#13#10), Length(str)+2, n, nil); end;
