📄 msgshowunt.pas
字号:
{*******************************************************}
// 单元: MsgShowUnt.pas
// 作者: 雲飛揚兮 - jlwen@163.com
// 日期: 2008-05-12
// 说明: 自定义的对话框
// 版权所有 (C) 2008
// 公司名 中天軟件工作室
{*******************************************************}
unit MsgShowUnt;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ImgList, ShellAPI, ComputerInfo
// , ztConst
;
const
SB_OK = -2;
SB_OKCANCEL = -3;
SB_YESNO = -5;
SB_OKOPTION = -7;
SB_YESNOCANCEL = -9;
SB_ErrorReport = -11;
SB_About = -13;
SBICON_INFO = 1;
SBICON_WARNING = 2;
SBICON_QUERY = 3;
SBICON_ERROR = 5;
type
TMsgShowFrm = class(TForm)
ImgList: TImageList;
ImgIcon: TImage;
ImgClose: TImage;
LabCap: TLabel;
LabMsg: TLabel;
Timer1: TTimer;
Panel1: TPanel;
Image2: TImage;
Image1: TImage;
Image3: TImage;
FMeoOption: TMemo;
lbHttp: TLabel;
procedure FormShow(Sender: TObject);
procedure Image2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ImgCloseClick(Sender: TObject);
procedure ImgCloseMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ImgCloseMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Timer1Timer(Sender: TObject);
procedure lbHttpMouseEnter(Sender: TObject);
procedure lbHttpMouseLeave(Sender: TObject);
procedure lbHttpClick(Sender: TObject);
private
VaResult: integer;
procedure CreateIcon(Index: Integer);
procedure CreatefrmSize;
procedure GetCreateButton(Mst: Integer; frm1: TMsgShowFrm);
procedure OnClickBtn(Sender: TObject);
procedure TimeClosefrm;
{ Private declarations }
public
SType: Integer;
SIcon: Integer;
STime: Integer;
timeCount: Integer;
oldCaption: string;
defaultButton: Integer;
btnTop: Integer;
btnTopAutoSize: Integer;
{ Public declarations }
procedure setMinWidth(i: integer);
end;
var
MsgShowFrm: TMsgShowFrm;
minWidth: integer;
function ShowMsg(Text: string; ShowType: Integer = SB_OK; ShowTime: Integer =
-1; Caption: string = ''; defButton: integer = -1; ShowIcon: integer = 1;
OptionText: string = '详细的信息'): Integer;
function ShowErrMsg(E: Exception; ShowTime: Integer = -1;
Caption: string = ''): Integer;
procedure ShowAbout(ver: string);
procedure GetSysInfo ;
implementation
{$R *.DFM}
procedure GetSysInfo ;
var
winInfo: TWindowInfo;
MemInfo : TMemoryInfo;
cpuInfo : TCPUInfo;
cpuRec : TCPURec;
i : Integer;
sSysInfo : string;
sLine : string;
begin
with MsgShowFrm.FMeoOption.Lines do
begin
Clear;
sLine := '------------------------------------------------';
winInfo := GetWindowInfo;
Add( '系统信息' + #13#10 + sLine +
#13#10 + '操作系统: ' + winInfo.ProductName + ' ' +
winInfo.Version + '.' + IntToStr(winInfo.BuildNumber)
+ #13#10 + '补丁: ' + winInfo.CSDVersion
+ #13#10 + '序列号: ' + winInfo.ProductID
+ #13#10 + '授权给: '
+ #13#10 + ' 用户名称: ' + winInfo.RegisteredOwner
+ #13#10 + ' 公司名称: ' + winInfo.RegisteredCompany
+ #13#10 + '语言: ' + winInfo.Language
+ #13#10 + '登录名: ' + winInfo.CurrentUserName)
;
MemInfo := GetMemoryInfo;
Add( #13#10 +#13#10 +'内存' + #13#10 + sLine +
#13#10 + '使用率: ' + IntToStr(meminfo.UsePercent) + '%'
+ #13#10 + '物理内存: ' + IntToStr(meminfo.MemoryTotal)
+ #13#10 + '可用内存: ' + IntToStr(meminfo.MemoryUsable)
+ #13#10 + '虚拟内存: ' + IntToStr(meminfo.VirtualTotal)
+ #13#10 + '可用虚存: ' + IntToStr(meminfo.VirtualUsable)
+ #13#10 + '页面文件: ' + IntToStr(meminfo.PageTotal)
);
MsgShowFrm.Update;
cpuInfo := GetCPUInfo ;
Add( #13#10#13#10 + '当前系统中发现['+ IntToStr(cpuInfo.CPUCount) +
']个处理器 ' + #13#10 + sLine );
for i := 0 to cpuInfo.CPUCount - 1 do
begin
cpurec:= CpuInfo.Cpus[i];
Add(
'CPU['+Inttostr(i)+']名称: '+ cpuRec.Name
+ #13#10+ 'CPU['+Inttostr(i)+']主频: '+ IntToStr(cpuRec.MHZ)
+ #13#10+ 'CPU['+Inttostr(i)+']占用: '+ IntToStr(cpuInfo.CPUUsage)
+ #13#10+ 'CPU['+Inttostr(i)+']厂商: '+ cpuRec.Firm
+ #13#10+ 'CPU['+Inttostr(i)+'] ID: '+ cpuRec.ID
// + #13#10+ 'CPU['+Inttostr(i)+']特性: '+ cpuRec.FeatureStr
);
end;
end;
MsgShowFrm.FMeoOption.SelStart := 1;
MsgShowFrm.FMeoOption.SelLength := 1;
// Result := sSysInfo;
end;
procedure ShowAbout(ver: string);
var
sCap, sSysInfo: string;
begin
minWidth := 400;
sCap := ' ' + Application.Title +
#13#10 +
' ' + '版本: ' + ver + #13#10#13#10#13#10#13#10 +
'' + #13#10 +
'QQ:75937515' + #13#10 +
'By Jlwen@163.com ' + #13#10
+ 'http://www.jmsoft8.com'
+ #13#10 +
'中天科技有限公司 版权所有(&C) ';
showmsg(sCap, SB_About, 30, '关于', 1, -1, '');
end;
function ShowErrMsg(E: Exception; ShowTime: Integer = -1;
Caption: string = ''): Integer;
begin
minWidth := 400;
// MsgShowFrm.Constraints.MaxHeight := 10000; //无法覆盖此类系统错误....
Result := ShowMsg('软体异常报告详细信息' + #13#10#13#10
+ '所在窗体: ' + Screen.ActiveForm.Caption+ '[' + Screen.ActiveForm.Name + ']' +#13#10
+ '异常类型: ' + E.ClassName +
#13#10 + '异常描述: ' + E.Message
, SB_ErrorReport, ShowTime, Caption, 2, 5)
end;
procedure TMsgShowFrm.FormShow(Sender: TObject);
begin
CreatefrmSize; //调整窗体大小..
GetCreateButton(SType, self); //创建按钮..
CreateIcon(SIcon); //显示图标...
self.Height := btnTopAutoSize + 113;
Self.Refresh;
end;
procedure TMsgShowFrm.Image2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
ReleaseCapture;
SendMessage(handle, WM_SYSCOMMAND, SC_MOVE or 2, 0);
end
else
inherited;
end;
procedure TMsgShowFrm.CreateIcon(Index: Integer);
begin
if Index <> -1 then
ImgList.GetIcon(Index, ImgIcon.Picture.Icon)
else
ImgIcon.Picture.Icon.Handle := Application.Icon.Handle;
end;
procedure TMsgShowFrm.ImgCloseClick(Sender: TObject);
begin
VaResult := IDCANCEL;
close;
end;
procedure TMsgShowFrm.ImgCloseMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ImgClose.Left := ImgClose.Left + 1;
ImgClose.Top := ImgClose.Top + 1;
end;
procedure TMsgShowFrm.ImgCloseMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ImgClose.Left := ImgClose.Left - 1;
ImgClose.Top := ImgClose.Top - 1;
end;
procedure TMsgShowFrm.CreatefrmSize;
begin
self.Width := self.LabMsg.Width + 80;
// Height := btnTopAutoSize + 249;
Panel1.Height := btnTopAutoSize + 112;
Image1.Height := btnTopAutoSize + 55;
if Width < 300 then
width := 300;
self.lbHttp.Left := Self.Width - 100;
self.ImgClose.Left := Self.Width - 18;
self.FMeoOption.Width := self.Image2.Width;
// Height := Image2.Height;
end;
procedure TMsgShowFrm.GetCreateButton(Mst: Integer; frm1: TMsgShowFrm);
var
Btn: TButton;
nbtnTop: Integer;
begin
nbtnTop := frm1.Height - 189 + btnTopAutoSize;
// ShowMessage(Format('%d - %d-%d', [nbtnTop, frm1.Height, btnTopAutoSize]));
if Mst = SB_OK then
begin
Btn := TButton.Create(self);
Btn.parent := self;
Btn.Width := 75;
Btn.Top := nbtnTop;
Btn.Left := frm1.Width - 100;
Btn.Name := 'SB_OK';
Btn.Caption := '确 定';
Btn.OnClick := OnClickBtn;
Btn.SetFocus;
end;
if Mst = SB_OKCANCEL then
begin
Btn := TButton.Create(self);
Btn.parent := self;
Btn.Width := 70;
Btn.Top := nbtnTop;
Btn.Left := frm1.Width - 180;
Btn.Name := 'SB_OK';
Btn.Caption := '确 定';
Btn.OnClick := OnClickBtn;
Btn.SetFocus;
Btn := TButton.Create(self);
Btn.parent := self;
Btn.Width := 70;
Btn.Top := nbtnTop;
Btn.Left := frm1.Width - 90;
Btn.Name := 'SB_CANCEL';
Btn.Cancel := true;
Btn.Caption := '取 消';
Btn.OnClick := OnClickBtn;
if defaultButton = 2 then
Btn.SetFocus;
end;
if Mst = SB_YESNO then
begin
Btn := TButton.Create(self);
Btn.parent := self;
Btn.Width := 70;
Btn.Top := nbtnTop;
Btn.Left := frm1.Width - 180;
Btn.Name := 'SB_YES';
Btn.Caption := '是';
Btn.OnClick := OnClickBtn;
Btn.SetFocus;
Btn := TButton.Create(self);
Btn.parent := self;
Btn.Width := 70;
Btn.Top := nbtnTop;
Btn.Left := frm1.Width - 90;
Btn.Name := 'SB_NO';
Btn.Caption := '否';
Btn.OnClick := OnClickBtn;
if defaultButton = 2 then
Btn.SetFocus;
end;
if Mst = SB_YESNOCANCEL then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -