我写了一个 Debug 窗口类 ,大家看看(20分)

QSmile · 2006-07-11

我最早是用 VB 的,后来才用的 Delphi .相比而言我很喜欢用 Delphi .

但 VB 下有个功能.我却恋恋不忘.那就是它内置的 debug 类.如果程序想输出什么调试信息,直接用 debug.print 就可以了. Delphi 没这个功能.不过有更强大的 CodeSite 之类的.问题也不是很大.

但现在我要用 Delphi 做纯 API 的开发.所以我就写了这样一个类

unit DbgWnd;

//////////////////////////////////////
// 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

WORD;
buf:array[0..256] of char;
begin
n := 0;
ReadConsole(m_hConsole,@buf[0],256,n,nil);
SetString(str,PChar(@buf[0]),Integer

);
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

WORD;
begin

WriteConsole(m_hConsole,
PChar(str+#13#10),
Length(str)+2,
n,
nil);
end;

initialization
debug := TDbgWnd.Create;

finalization
debug.Free;

end.

// 使用方法:
// 把这个单元引入工程. 要输出调试信息就用 debug.write 就可以了
// 需引进的地方:
// 类的 ReadAnyKey(); 我想做成 '按任意链继续...'没做完,希望谁能帮我完成

duhai_lee · 2006-07-11

支持原创。哈哈：）

有空了试试。

52free · 2006-07-11

'按任意链继续...'

这个是个什么功能？？有什么用？

ff_ff · 2006-07-11

看看

QSmile · 2006-07-11

因为程序运行完了后这个 Console 窗口会被关闭..那些输出的调试信息就看不到了.

我想加一个 ReadAnyKey();
在程序最后,让程序停在这里,看了调试信息后,按一下键盘,程序才结束.

zhongs · 2006-07-11

不错的方法。有些调试不能在IDE时，我以前用的方法是OutputDebugString()，然后用工具
Dbgview.exe查看。

现在提供另外更直观的高度方法，我加强一下：

procedure write(const Format: string; const Args: array of const); overload;
procedure write(const str: string); overload;

procedure TDbgWnd.Write(const Format: string; const Args: array of const);
var
S: string;
begin
S:= SysUtils.Format(Format, Args);
write(S);
end;

QSmile · 2006-07-12

多谢楼上的.我昨天也正好找到你说的那个功能了.

现在贴个新版上来.!!!!程序做了点小修改,把 write 做成内部函数,用 print 代替
可以用 PrintWarning , PrintError, PrintNotice ,PrintEmphasis 显示不同颜色的
信息

unit DbgWnd;

//////////////////////////////////////
// Class Name: Debug Windows
// Author : RedFox (singlecat@163.com)
// Date : 2006-07-11
// Version : 0.9beta
// 使用方法:
// 把这个单元引入工程. 要输出调试信息就用 debug.print 就可以了
// 可以用 PrintWarning , PrintError, PrintNotice ,PrintEmphasis 显示不同颜色的
// 需引进的地方:
// 类的 ReadAnyKey(); 我想做成 '按任意链继续...'没做完,希望谁能帮我完成
//////////////////////////////////////

interface

uses
Windows;

type
TDbgWnd = class
private
m_hConsole:THandle;
procedure DisableClose();
procedure write(str:string);
public
constructor Create;
destructor Destroy;override;

procedure read(var str:string);
procedure ReadAnyKey();
procedure Print(str:string);
procedure PrintWarning(str:string);
procedure PrintError(str:string);
procedure PrintNotic(str:string);
procedure PrintEmphasis(str:string);
end;

var
debug :TDbgWnd;

implementation

{ TDbgWnd }

constructor TDbgWnd.Create;
begin
AllocConsole;

m_hConsole := CreateFile('CONOUT$',
GENERIC_WRITE or GENERIC_READ,
FILE_SHARE_WRITE,
nil,
OPEN_EXISTING, 0, 0);

SetConsoleActiveScreenBuffer(m_hConsole);
SetConsoleMode(m_hConsole, ENABLE_PROCESSED_OUTPUT or ENABLE_WRAP_AT_EOL_OUTPUT );
SetConsoleTitle('debug window') ;
DisableClose();
end;

destructor TDbgWnd.Destroy;
begin
FreeConsole;
inherited;
end;

procedure TDbgWnd.DisableClose;
var
h_wnd:HWND;
lpszWndTitle

Char;
h_Menu:HMENU;
begin
if m_hConsole = 0 then exit;

GetMem(lpszWndTitle,256);
GetConsoleTitle(lpszWndTitle,256);
h_wnd := FindWindow('ConsoleWindowClass',lpszWndTitle);
if(h_Wnd <> 0) then
begin
h_Menu := GetSystemMenu(h_Wnd,false);
if(h_Menu <> 0) then
begin
DeleteMenu(h_Menu, SC_CLOSE, MF_BYCOMMAND);
DrawMenuBar(h_Wnd);
end;
end;
FreeMem(lpszWndTitle);
end;

procedure TDbgWnd.Print(str: string);
begin
SetConsoleTextAttribute(m_hConsole, FOREGROUND_RED or FOREGROUND_GREEN or FOREGROUND_BLUE);
Self.write(str);
end;

procedure TDbgWnd.PrintEmphasis(str: string);
begin
SetConsoleTextAttribute(m_hConsole,
FOREGROUND_RED or
FOREGROUND_GREEN or
FOREGROUND_BLUE or
FOREGROUND_INTENSITY
);
write(str);
end;

procedure TDbgWnd.PrintError(str: string);
begin
SetConsoleTextAttribute(m_hConsole,
FOREGROUND_RED or
FOREGROUND_INTENSITY
);
write(str);
end;

procedure TDbgWnd.PrintNotic(str: string);
begin
SetConsoleTextAttribute(m_hConsole,
FOREGROUND_GREEN or
FOREGROUND_INTENSITY
);
write(str);
end;

procedure TDbgWnd.PrintWarning(str: string);
begin
SetConsoleTextAttribute(m_hConsole,
FOREGROUND_RED or
FOREGROUND_GREEN or
FOREGROUND_INTENSITY
);
write(str);
end;

procedure TDbgWnd.read(var str: string);
var
n

WORD;
buf:array[0..256] of char;
begin
n := 0;
ReadConsole(m_hConsole,@buf[0],256,n,nil);
SetString(str,PChar(@buf[0]),Integer

);
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

WORD;
begin

WriteConsole(m_hConsole,
PChar(str+#13#10),
Length(str)+2,
n,
nil);
end;

initialization
debug := TDbgWnd.Create;

finalization
debug.Free;

end.

QSmile · 2006-07-12

to zhongs,
你的方法我也会加进去的.

QSmile · 2006-07-12

unit DbgWnd;

//////////////////////////////////////
// Class Name: Debug Windows
// Author : RedFox (singlecat@163.com)
// Date : 2006-07-11
// Version : 0.9beta
// 使用方法:
// 把这个单元引入工程. 要输出调试信息就用 debug.print 就可以了
// 可以用 PrintWarning , PrintError, PrintNotice ,PrintEmphasis 显示不同颜色的
// 需引进的地方:
// 类的 ReadAnyKey(); 我想做成 '按任意链继续...'没做完,希望谁能帮我完成
//////////////////////////////////////

interface

uses
Windows, SysUtils;

type
TDbgWnd = class
private
m_hConsole:THandle;
procedure DisableClose();
procedure write(str:string);overload;
procedure write(const fmt: string; const Args: array of const); overload;
public
constructor Create;
destructor Destroy;override;

procedure read(var str:string);
procedure ReadAnyKey();

procedure Print(str:string);overload;
procedure Print(const fmt:string; const Args:array of const);overload;

procedure PrintWarning(str:string);overload;
procedure PrintWarning(const fmt:string; const Args:array of const);overload;

procedure PrintError(str:string);overload;
procedure PrintError(const fmt:string; const Args:array of const);overload;

procedure PrintNotic(str:string);overload;
procedure PrintNotic(const fmt:string; const Args:array of const);overload;

procedure PrintEmphasis(str:string);overload;
procedure PrintEmphasis(const fmt:string; const Args:array of const);overload;
end;

var
debug :TDbgWnd;

implementation

{ TDbgWnd }

constructor TDbgWnd.Create;
begin
AllocConsole;

m_hConsole := CreateFile('CONOUT$',
GENERIC_WRITE or GENERIC_READ,
FILE_SHARE_WRITE,
nil,
OPEN_EXISTING, 0, 0);

SetConsoleActiveScreenBuffer(m_hConsole);
SetConsoleMode(m_hConsole, ENABLE_PROCESSED_OUTPUT or ENABLE_WRAP_AT_EOL_OUTPUT );
SetConsoleTitle('debug window') ;
DisableClose();
end;

destructor TDbgWnd.Destroy;
begin
FreeConsole;
inherited;
end;

procedure TDbgWnd.DisableClose;
var
h_wnd:HWND;
lpszWndTitle

Char;
h_Menu:HMENU;
begin
if m_hConsole = 0 then exit;

GetMem(lpszWndTitle,256);
GetConsoleTitle(lpszWndTitle,256);
h_wnd := FindWindow('ConsoleWindowClass',lpszWndTitle);
if(h_Wnd <> 0) then
begin
h_Menu := GetSystemMenu(h_Wnd,false);
if(h_Menu <> 0) then
begin
DeleteMenu(h_Menu, SC_CLOSE, MF_BYCOMMAND);
DrawMenuBar(h_Wnd);
end;
end;
FreeMem(lpszWndTitle);
end;

procedure TDbgWnd.Print(str: string);
begin
SetConsoleTextAttribute(m_hConsole, FOREGROUND_RED or FOREGROUND_GREEN or FOREGROUND_BLUE);
Self.write(str);
end;

procedure TDbgWnd.Print(const fmt: string; const Args: array of const);
begin
SetConsoleTextAttribute(m_hConsole, FOREGROUND_RED or FOREGROUND_GREEN or FOREGROUND_BLUE);
Self.write(fmt,Args);
end;

procedure TDbgWnd.PrintEmphasis(str: string);
begin
SetConsoleTextAttribute(m_hConsole,
FOREGROUND_RED or
FOREGROUND_GREEN or
FOREGROUND_BLUE or
FOREGROUND_INTENSITY
);
write(str);
end;

procedure TDbgWnd.PrintError(str: string);
begin
SetConsoleTextAttribute(m_hConsole,
FOREGROUND_RED or
FOREGROUND_INTENSITY
);
write(str);
end;

procedure TDbgWnd.PrintNotic(str: string);
begin
SetConsoleTextAttribute(m_hConsole,
FOREGROUND_GREEN or
FOREGROUND_INTENSITY
);
write(str);
end;

procedure TDbgWnd.PrintWarning(str: string);
begin
SetConsoleTextAttribute(m_hConsole,
FOREGROUND_RED or
FOREGROUND_GREEN or
FOREGROUND_INTENSITY
);
write(str);
end;

procedure TDbgWnd.PrintNotic(const fmt: string;
const Args: array of const);
begin
SetConsoleTextAttribute(m_hConsole,
FOREGROUND_GREEN or
FOREGROUND_INTENSITY
);
write(fmt,args);
end;

procedure TDbgWnd.PrintWarning(const fmt: string;
const Args: array of const);
begin
SetConsoleTextAttribute(m_hConsole,
FOREGROUND_RED or
FOREGROUND_GREEN or
FOREGROUND_INTENSITY
);
write(fmt,Args);
end;

procedure TDbgWnd.read(var str: string);
var
n

WORD;
buf:array[0..256] of char;
begin
n := 0;
ReadConsole(m_hConsole,@buf[0],256,n,nil);
SetString(str,PChar(@buf[0]),Integer

);
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

WORD;
begin

WriteConsole(m_hConsole,
PChar(str+#13#10),
Length(str)+2,
n,
nil);
end;

procedure TDbgWnd.write(const fmt: string; const Args: array of const);
begin
write(Format(fmt, Args));
end;

procedure TDbgWnd.PrintEmphasis(const fmt: string;
const Args: array of const);
begin
SetConsoleTextAttribute(m_hConsole,
FOREGROUND_RED or
FOREGROUND_GREEN or
FOREGROUND_BLUE or
FOREGROUND_INTENSITY
);
write(fmt,args);
end;

procedure TDbgWnd.PrintError(const fmt: string;
const Args: array of const);
begin
SetConsoleTextAttribute(m_hConsole,
FOREGROUND_RED or
FOREGROUND_INTENSITY
);
write(fmt,args);
end;

initialization
debug := TDbgWnd.Create;

finalization
debug.Free;

end.

rhcgrys · 2006-07-12

不错,我收了!

wr960204 · 2006-07-12

不用如此麻烦吧?
你不使用API开发吗.有一个API就是向调试器输出调试信息的.
OutPutDebugString
调用了以后在集成环境下Delphi的EventLog窗口就会打印出调试信息.
用了这个API即使不是集成调试而是运行状态也可以通过DegbugView这个第三方工具看到调试信息.当然也可以是SoftIce,WinDbg等任何调试器.

QSmile · 2006-07-12

Event Log 一大堆东西,眼都看花了.

dsl520 · 2006-07-12

顶,骗分.

zqw0117 · 2006-07-12

是个不错的想法,呵呵,收藏,帮顶.

0415xxx · 2006-07-12

QSmile · 2006-08-04

多人接受答案了。

我写了一个 Debug 窗口类 ,大家看看(20分)

QSmile

Unregistered / Unconfirmed

duhai_lee

Unregistered / Unconfirmed

52free

Unregistered / Unconfirmed

ff_ff

Unregistered / Unconfirmed

QSmile

Unregistered / Unconfirmed

zhongs

Unregistered / Unconfirmed

QSmile

Unregistered / Unconfirmed

QSmile

Unregistered / Unconfirmed

QSmile

Unregistered / Unconfirmed

rhcgrys

Unregistered / Unconfirmed

wr960204

Unregistered / Unconfirmed

QSmile

Unregistered / Unconfirmed

dsl520

Unregistered / Unconfirmed

zqw0117

Unregistered / Unconfirmed

0415xxx

Unregistered / Unconfirmed

QSmile

Unregistered / Unconfirmed

Similar threads