RSS订阅 | 匿名投稿
您的位置:网站首页 > 程序 > 正文

delphi ShowDebugInfo 窗口

作者:admin 来源: 日期:2018/3/13 21:18:34 人气: 标签:

//调用 ShowDebugInfo('登录成功了','登录成功了');


unit uDebug;

interface

uses
  windows, Forms, StdCtrls, Controls, SysUtils;

type

  TOnDispDebugMsg = procedure(AMsg: string) of object;

procedure ShowDebugInfo(Title: string; Info: string);
procedure OutDbgMsg(AMsg: string; Value: integer); overload;
procedure OutDbgMsg(AMsg: string; Value: Cardinal); overload;
procedure OutDbgMsg(AMsg: string; Value: boolean); overload;
procedure OutDbgMsg(AMsg: string; Value: string); overload;

procedure SetOnDispDebugMsg(AOnDispDebugMsg: TOnDispDebugMsg);
procedure DispDebugMsg(AMsg: string);

implementation

var
  OnDispDebugMsg: TOnDispDebugMsg;

procedure ShowDebugInfo(Title: string; Info: string);
var
  Frm: TForm;
  Memo: TMemo;
begin

  Frm := TForm.Create(nil);
  Memo := TMemo.Create(Frm);

  with Frm do
  begin
    Left := 100;
    Top := 100;
    Caption := Title;
  end;

  with Memo do
  begin
    Parent := Frm;
    Align := alClient;
    Font.Size := 11;
    Font.Charset := GB2312_CHARSET;
    Font.Name := '宋体';
    Text := Info;
    ScrollBars := ssBoth;
  end;

  try
    Frm.ShowModal();
  finally
    Frm.Free();
  end;
end;

procedure OutDbgMsg(AMsg: string; Value: integer);
var
  sTemp: string;
begin
  AMsg := AMsg + ':';
  sTemp := inttostr(Value);
  OutputDebugString(pchar(AMsg + sTemp));
end;

procedure OutDbgMsg(AMsg: string; Value: Cardinal);
var
  sTemp: string;
begin
  AMsg := AMsg + ':';
  sTemp := inttostr(Value);
  OutputDebugString(pchar(AMsg + sTemp));
end;

procedure OutDbgMsg(AMsg: string; Value: boolean); overload;
var
  sTemp: string;
begin
  AMsg := AMsg + ':';

  if Value then
    sTemp := 'True'
  else
    sTemp := 'False';
  OutputDebugString(pchar(AMsg + sTemp));

end;

procedure OutDbgMsg(AMsg: string; Value: string);

begin
  AMsg := AMsg + ':';
  OutputDebugString(pchar(AMsg + Value));
end;

procedure SetOnDispDebugMsg(AOnDispDebugMsg: TOnDispDebugMsg);
begin
  OnDispDebugMsg := AOnDispDebugMsg;
end;

procedure DispDebugMsg(AMsg: string);
begin
  if Assigned(OnDispDebugMsg) then
    OnDispDebugMsg(AMsg);
end;

end.

读完这篇文章后,您心情如何?
0
0
0
0
0
0
0
0
本文网址:
下一篇:没有资料