jrcommon.pas

常用的功能函数定义

{******************************************************************************* 
* 模块名称: 公用函数库 
* 编写人员: 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 SplitString(Source, Deli: string ): TStringList;
{ 分解字符串，按给定的标记串}

//------------------------------------------------------------------------------ 
// 扩展日期时间操作函数 
//------------------------------------------------------------------------------ 

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; 
Font.Name := SDefaultFontName; 
Font.Size := SDefaultFontSize; 
Font.Charset := SDefaultFontCharset; 
Canvas.Font := Font; 
DialogUnits := GetAveCharSize(Canvas); 
BorderStyle := bsDialog; 
Caption := ACaption; 
ClientWidth := MulDiv(180, DialogUnits.X, 4); 
ClientHeight := MulDiv(63, DialogUnits.Y, 8); 
Position := poScreenCenter; 
Prompt := TLabel.Create(Form); 
with Prompt do 
begin 
Parent := Form; 
AutoSize := True; 
Left := MulDiv(8, DialogUnits.X, 4); 
Top := MulDiv(8, DialogUnits.Y, 8); 
Caption := APrompt; 
end; 
Edit := TEdit.Create(Form); 
with Edit do 
begin 
Parent := Form; 
Left := Prompt.Left; 
Top := MulDiv(19, DialogUnits.Y, 8); 
Width := MulDiv(164, DialogUnits.X, 4); 
MaxLength := 255; 
Text := Value; 
SelectAll; 
end; 
ButtonTop := MulDiv(41, DialogUnits.Y, 8); 
ButtonWidth := MulDiv(50, DialogUnits.X, 4); 
ButtonHeight := MulDiv(14, DialogUnits.Y, 8); 
with TButton.Create(Form) do 
begin 
Parent := Form; 
Caption := SMsgDlgOK; 
ModalResult := mrOk; 
Default := True; 
SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth, 
ButtonHeight); 
end; 
with TButton.Create(Form) do 
begin 
Parent := Form; 
Caption := SMsgDlgCancel; 
ModalResult := mrCancel; 
Cancel := True; 
SetBounds(MulDiv(92, DialogUnits.X, 4), ButtonTop, ButtonWidth, 
ButtonHeight); 
end; 
if ShowModal = mrOk then 
begin 
Value := Edit.Text; 
Result := True; 
end; 
finally 
Form.Free; 
end; 
end; 

function JrInputBox(const ACaption, APrompt, ADefault: string): String; 
begin 
Result := ADefault; 
JrInputQuery(ACaption, APrompt, Result); 
end; 

//------------------------------------------------------------------------------ 
//扩展文件目录操作函数 
//------------------------------------------------------------------------------ 

procedure RunFile(const FileName: String; Handle: THandle = 0; Param: string = ''); 
begin 
ShellExecute(Handle, nil, PChar(FileName), PChar(Param), nil, SW_SHOWNORMAL); 
end; 

function AppPath: string; 
begin 
Result := ExtractFilePath(Application.ExeName); 
end; 

const 
HKLM_CURRENT_VERSION_WINDOWS = 'SoftwareMicrosoftWindowsCurrentVersion'; 

function RelativeKey(const Key: string): PChar; 
begin 
Result := PChar(Key); 
if (Key <> '') and (Key[1] = '') then 
Inc(Result); 
end; 

function RegReadStringDef(const RootKey: HKEY; const Key, Name, Def: string): string; 
var 
RegKey: HKEY; 
Size: DWORD; 
StrVal: string; 
RegKind: DWORD; 
begin 
Result := Def; 
if RegOpenKeyEx(RootKey, RelativeKey(Key), 0, KEY_READ, RegKey) = ERROR_SUCCESS then 
begin 
RegKind := 0; 
Size := 0; 
if RegQueryValueEx(RegKey, PChar(Name), nil, @RegKind, nil, @Size) = ERROR_SUCCESS then 
if RegKind in [REG_SZ, REG_EXPAND_SZ] then 
begin 
SetLength(StrVal, Size); 
if RegQueryValueEx(RegKey, PChar(Name), nil, @RegKind, PByte(StrVal), @Size) = ERROR_SUCCESS then 
begin 
SetLength(StrVal, StrLen(PChar(StrVal))); 
Result := StrVal; 
end; 
end; 
RegCloseKey(RegKey); 
end; 
end; 

procedure StrResetLength(var S: AnsiString); 
begin 
SetLength(S, StrLen(PChar(S))); 
end; 

function GetProgramFilesDir: string; 
begin 
Result := RegReadStringDef(HKEY_LOCAL_MACHINE, HKLM_CURRENT_VERSION_WINDOWS, 'ProgramFilesDir', ''); 
end; 

function GetWindowsDir: string; 
var 
Required: Cardinal; 
begin 
Result := ''; 
Required := GetWindowsDirectory(nil, 0); 
if Required <> 0 then 
begin 
SetLength(Result, Required); 
GetWindowsDirectory(PChar(Result), Required); 
StrResetLength(Result); 
end; 
end; 

function GetWindowsTempPath: string; 
var 
Required: Cardinal; 
begin 
Result := ''; 
Required := GetTempPath(0, nil); 
if Required <> 0 then 
begin 
SetLength(Result, Required); 
GetTempPath(Required, PChar(Result)); 
StrResetLength(Result); 
end; 
end; 

function GetSystemDir: string; 
var 
Required: Cardinal; 
begin 
Result := ''; 
Required := GetSystemDirectory(nil, 0); 
if Required <> 0 then 
begin 
SetLength(Result, Required); 
GetSystemDirectory(PChar(Result), Required); 
StrResetLength(Result); 
end; 
end; 

//------------------------------------------------------------------------------ 
//扩展字符串操作函数 
//------------------------------------------------------------------------------ 

function InStr(const sShort: string; const sLong: string): Boolean; 
var 
s1, s2: string; 
begin 
s1 := LowerCase(sShort); 
s2 := LowerCase(sLong); 
Result := Pos(s1, s2) > 0; 
end;

function SplitString(Source, Deli: string ): TStringList;
var
    EndOfCurrentString: byte;
    StringList:TStringList;
begin
    StringList:=TStringList.Create;
    while Pos(Deli, Source)>0 do
    begin
        EndOfCurrentString := Pos(Deli, Source);
        StringList.add(Copy(Source, 1, EndOfCurrentString - 1));
        Source := Copy(Source, EndOfCurrentString + length(Deli), length(Source) - EndOfCurrentString);
    end;
    Result := StringList;
    StringList.Add(source);
end;

function IntToStrSp(Value: Integer; SpLen: Integer = 3; Sp: Char = ','): string; 
var 
s: string; 
i, j: Integer; 
begin 
s := IntToStr(Value); 
Result := ''; 
j := 0; 
for i := Length(s) downto 1 do 
begin 
Result := s[i] + Result; 
Inc(j); 
if ((j mod SpLen) = 0) and (i <> 1) then Result := Sp + Result; 
end; 
end; 

function ByteToBin(Value: Byte): string; 
const