今天在整理以前写过的代码，发现有些函数还是挺实用的，决定将其贴到Blog上，与众多好友一起分享。
...{*******************************************************************************
* 模块名称: 公用函数库
* 编写人员: Chris Mao
* 编写日期: 2004.10.30
******************************************************************************}
unit JrCommon;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ShellAPI, CommDlg, MMSystem, StdCtrls, Registry, JrConsts, Winsock;
//------------------------------------------------------------------------------
//窗体类函数
//------------------------------------------------------------------------------
function FindFormClass(FormClassName: PChar): TFormClass;
function HasInstance(FormClassName: PChar): Boolean;
//------------------------------------------------------------------------------
//公用对话框函数
//------------------------------------------------------------------------------
procedure InfoDlg(const Msg: String; ACaption: String = SInformation);
...{ 信息对话框 }
procedure ErrorDlg(const Msg: String; ACaption: String = SError);
...{ 错误对话框 }
procedure WarningDlg(const Msg: String; ACaption: String = SWarning);
...{ 警告对话框 }
function QueryDlg(const Msg: String; ACaption: String = SQuery): Boolean;
...{ 确认对话框 }
function QueryNoDlg(const Msg: string; ACaption: string = SQuery): Boolean;
...{ 确认对话框，默认按钮为"否" }
function JrInputQuery(const ACaption, APrompt: String; var Value: string): Boolean;
...{ 输入对话框 }
function JrInputBox(const ACaption, APrompt, ADefault: string): String;
...{ 输入对话框 }
//------------------------------------------------------------------------------
//扩展文件目录操作函数
//------------------------------------------------------------------------------
procedure RunFile(const FileName: String; Handle: THandle = 0; Param: string = '');
...{ 运行一个文件 }
function AppPath: string;
...{ 应用程序路径 }
function GetProgramFilesDir: string;
...{ 取Program Files目录 }
function GetWindowsDir: string;
...{ 取Windows目录}
function GetWindowsTempPath: string;
...{ 取临时文件路径 }
function GetSystemDir: string;
...{ 取系统目录 }
//------------------------------------------------------------------------------
//扩展字符串操作函数
//------------------------------------------------------------------------------
function InStr(const sShort: string; const sLong: string): Boolean;
...{ 判断s1是否包含在s2中 }
function IntToStrSp(Value: Integer; SpLen: Integer = 3; Sp: Char = ','): string;
...{ 带分隔符的整数－字符转换 }
function ByteToBin(Value: Byte): string;
...{ 字节转二进制串 }
function StrRight(Str: string; Len: Integer): string;
...{ 返回字符串右边的字符 }
function StrLeft(Str: string; Len: Integer): string;
...{ 返回字符串左边的字符 }
function Spc(Len: Integer): string;
...{ 返回空格串 }
procedure SwapStr(var s1, s2: string);
...{ 交换字串 }
//------------------------------------------------------------------------------
// 扩展日期时间操作函数
//------------------------------------------------------------------------------
function GetYear(Date: TDate): Word;
...{ 取日期年份分量 }
function GetMonth(Date: TDate): Word;
...{ 取日期月份分量 }
function GetDay(Date: TDate): Word;
...{ 取日期天数分量 }
function GetHour(Time: TTime): Word;
...{ 取时间小时分量 }
function GetMinute(Time: TTime): Word;
...{ 取时间分钟分量 }
function GetSecond(Time: TTime): Word;
...{ 取时间秒分量 }
function GetMSecond(Time: TTime): Word;
...{ 取时间毫秒分量 }
//------------------------------------------------------------------------------
// 位操作函数
//------------------------------------------------------------------------------
type
TByteBit = 0..7; // Byte类型位数范围
TWordBit = 0..15; // Word类型位数范围
TDWordBit = 0..31; // DWord类型位数范围
procedure SetBit(var Value: Byte; Bit: TByteBit; IsSet: Boolean); overload;
...{ 设置二进制位 }
procedure SetBit(var Value: WORD; Bit: TWordBit; IsSet: Boolean); overload;
...{ 设置二进制位 }
procedure SetBit(var Value: DWORD; Bit: TDWordBit; IsSet: Boolean); overload;
...{ 设置二进制位 }
function GetBit(Value: Byte; Bit: TByteBit): Boolean; overload;
...{ 取二进制位 }
function GetBit(Value: WORD; Bit: TWordBit): Boolean; overload;
...{ 取二进制位 }
function GetBit(Value: DWORD; Bit: TDWordBit): Boolean; overload;
...{ 取二进制位 }
//------------------------------------------------------------------------------
// 系统功能函数
//------------------------------------------------------------------------------
procedure ChangeFocus(Handle: THandle; Forword: Boolean = False);
...{ 改变焦点 }
procedure MoveMouseIntoControl(AWinControl: TControl);
...{ 移动鼠标到控件 }
procedure AddComboBoxTextToItems(ComboBox: TComboBox; MaxItemsCount: Integer = 10);
...{ 将 ComboBox 的文本内容增加到下拉列表中 }
function DynamicResolution(x, y: WORD): Boolean;
...{ 动态设置分辨率 }
procedure StayOnTop(Handle: HWND; OnTop: Boolean);
...{ 窗口最上方显示 }
procedure SetHidden(Hide: Boolean);
...{ 设置程序是否出现在任务栏 }
procedure SetTaskBarVisible(Visible: Boolean);
...{ 设置任务栏是否可见 }
procedure SetDesktopVisible(Visible: Boolean);
...{ 设置桌面是否可见 }
function GetWorkRect: TRect;
...{ 取桌面区域 }
procedure BeginWait;
...{ 显示等待光标 }
procedure EndWait;
...{ 结束等待光标 }
function CheckWindows9598: Boolean;
...{ 检测是否Win95/98平台 }
function GetOSString: string;
...{ 返回操作系统标识串 }
function GetComputeNameStr : string;
...{ 得到本机名 }
function GetLocalUserName: string;
...{ 得到本机用户名 }
function GetLocalIP: String;
...{ 得到本机IP地址 }
//------------------------------------------------------------------------------
// 其它过程
//------------------------------------------------------------------------------
function TrimInt(Value, Min, Max: Integer): Integer; overload;
...{ 输出限制在Min..Max之间 }
function InBound(Value: Integer; Min, Max: Integer): Boolean;
...{ 判断整数Value是否在Min和Max之间 }
procedure Delay(const uDelay: DWORD);
...{ 延时 }
procedure BeepEx(const Freq: WORD = 1200; const Delay: WORD = 1);
...{ 在Win9X下让喇叭发声 }
function GetHzPy(const AHzStr: string): string;
...{ 取汉字的拼音 }
function UpperCaseMoney(const Money: Double): String;
...{ 转换为大与金额 }
function SoundCardExist: Boolean;
...{ 声卡是否存在 }
implementation
//------------------------------------------------------------------------------
//窗体类函数
//------------------------------------------------------------------------------
function FindFormClass(FormClassName: PChar): TFormClass;
begin
Result := TFormClass(GetClass(FormClassName));
end;
function HasInstance(FormClassName: PChar): Boolean;
var
i: integer;
begin
Result:=False;
for i := Screen.FormCount - 1 downto 0 do begin
Result := SameText(Screen.Forms[i].ClassName, FormClassName);
if Result then begin
TForm(Screen.Forms[i]).BringToFront;
Break;
end;
end;
end;
//------------------------------------------------------------------------------
//公用对话框函数
//------------------------------------------------------------------------------
procedure InfoDlg(const Msg: String; ACaption: String = SInformation);
begin
Application.MessageBox(PChar(Msg), PChar(ACaption), MB_OK + MB_ICONINFORMATION);
end;
procedure ErrorDlg(const Msg: String; ACaption: String = SError);
begin
Application.MessageBox(PChar(Msg), PChar(ACaption), MB_OK + MB_ICONERROR);
end;
procedure WarningDlg(const Msg: String; ACaption: String = SWarning);
begin
Application.MessageBox(PChar(Msg), PChar(ACaption), MB_OK + MB_ICONWARNING);
end;
function QueryDlg(const Msg: String; ACaption: String = SQuery): Boolean;
begin
Result := Application.MessageBox(PChar(Msg), PChar(ACaption),
MB_YESNO + MB_ICONQUESTION) = IDYES;
end;
function QueryNoDlg(const Msg: string; ACaption: string = SQuery): Boolean;
begin
Result := Application.MessageBox(PChar(Msg), PChar(ACaption),
MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) = IDYES;
end;
function GetAveCharSize(Canvas: TCanvas): TPoint;
var
I: Integer;
Buffer: array[0..51] of Char;
begin
for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
Result.X := Result.X div 52;
end;
function JrInputQuery(const ACaption, APrompt: String; var Value: string): Boolean;
var
Form: TForm;
Prompt: TLabel;
Edit: TEdit;
DialogUnits: TPoint;
ButtonTop, ButtonWidth, ButtonHeight: Integer;
begin
Result := False;
Form := TForm.Create(Application);
with Form do
try
Scaled := False;
&nbs