自己写的一些Delphi常用函数

   今天在整理以前写过的代码，发现有些函数还是挺实用的，决定将其贴到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;
      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 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
  V: Byte  =   1 ;
var
  i: Integer;
begin
   for  i : =   7  downto  0   do
     if  (V shl i) and Value  <>   0  then
      Result : =  Result  +   ' 1 '
     else
      Result : =  Result  +   ' 0 ' ;
end;

function StrRight(Str:  string ; Len: Integer):  string ;
begin
   if  Len  >=  Length(Str) then
    Result : =  Str
   else
    Result : =  Copy(Str, Length(Str)  -  Len  +   1 , Len);
end;

function StrLeft(Str:  string ; Len: Integer):  string ;
begin
   if  Len  >=  Length(Str) then
    Result : =  Str
   else
    Result : =  Copy(Str,  1 , Len);
end;

function Spc(Len: Integer):  string ;
begin
  SetLength(Result, Len);
  FillChar(PChar(Result) ^ , Len,  '   ' );
end;

procedure SwapStr(var s1, s2:  string );
var
  tempstr:  string ;
begin
  tempstr : =  s1;
  s1 : =  s2;
  s2 : =  tempstr;
end;

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

function GetYear(Date: TDate): Word;
var
  m, d: WORD;
begin
  DecodeDate(Date, Result, m, d);
end;

function GetMonth(Date: TDate): Word;
var
  y, d: WORD;
begin
  DecodeDate(Date, y, Result, d);
end;

function GetDay(Date: TDate): Word;
var
  y, m: WORD;
begin
  DecodeDate(Date, y, m, Result);
end;

function GetHour(Time: TTime): Word;
var
  h, m, s, ms: WORD;
begin
  DecodeTime(Time, Result, m, s, ms);
end;

function GetMinute(Time: TTime): Word;
var
  h, s, ms: WORD;
begin
  DecodeTime(Time, h, Result, s, ms);
end;

function GetSecond(Time: TTime): Word;
var
  h, m, ms: WORD;
begin
  DecodeTime(Time, h, m, Result, ms);
end;

function GetMSecond(Time: TTime): Word;
var
  h, m, s: WORD;
begin
  DecodeTime(Time, h, m, s, Result);
end;

// ------------------------------------------------------------------------------
//  位操作函数
// ------------------------------------------------------------------------------

procedure SetBit(var Value: Byte; Bit: TByteBit; IsSet: Boolean); overload;
begin
   if  IsSet then
    Value : =  Value or ( 1  shl Bit)  else
    Value : =  Value and not( 1  shl Bit);
end;

procedure SetBit(var Value: WORD; Bit: TWordBit; IsSet: Boolean); overload;
begin
   if  IsSet then
    Value : =  Value or ( 1  shl Bit)  else
    Value : =  Value and not( 1  shl Bit);
end;

procedure SetBit(var Value: DWORD; Bit: TDWordBit; IsSet: Boolean); overload;
begin
   if  IsSet then
    Value : =  Value or ( 1  shl Bit)  else
    Value : =  Value and not( 1  shl Bit);
end;

function GetBit(Value: Byte; Bit: TByteBit): Boolean; overload;
begin
  Result : =  Value and ( 1  shl Bit)  <>   0 ;
end;

function GetBit(Value: WORD; Bit: TWordBit): Boolean; overload;
begin
  Result : =  Value and ( 1  shl Bit)  <>   0 ;
end;

function GetBit(Value: DWORD; Bit: TDWordBit): Boolean; overload;
begin
  Result : =  Value and ( 1  shl Bit)  <>   0 ;
end;

// ------------------------------------------------------------------------------
//  系统功能函数
// ------------------------------------------------------------------------------

procedure ChangeFocus(Handle: THandle; Forword: Boolean  =  False);
begin
   if  ForWord then
    PostMessage(Handle, WM_NEXTDLGCTL,  1 ,  0 )
   else
    PostMessage(Handle, WM_NEXTDLGCTL,  0 ,  0 );
end;

procedure MoveMouseIntoControl(AWinControl: TControl);
var
  rtControl: TRect;
begin
  rtControl : =  AWinControl.BoundsRect;
  MapWindowPoints(AWinControl.Parent.Handle,  0 , rtControl,  2 );
  SetCursorPos(rtControl.Left  +  (rtControl.Right  -  rtControl.Left) div  2 ,
    rtControl.Top  +  (rtControl.Bottom  -  rtControl.Top) div  2 );
end;

procedure AddComboBoxTextToItems(ComboBox: TComboBox; MaxItemsCount: Integer  =   10 );
begin
   if  (ComboBox.Text  <>   '' ) and (ComboBox.Items.IndexOf(ComboBox.Text)  <   0 ) then
  begin
    ComboBox.Items.Insert( 0 , ComboBox.Text);
     while  (MaxItemsCount  >   1 ) and (ComboBox.Items.Count  >  MaxItemsCount)  do
      ComboBox.Items.Delete(ComboBox.Items.Count  -   1 );
  end;
end;

function DynamicResolution(x, y: WORD): Boolean;
var
  lpDevMode: TDeviceMode;
begin
  Result : =  EnumDisplaySettings(nil,  0 , lpDevMode);
   if  Result then
  begin
    lpDevMode.dmFields : =  DM_PELSWIDTH or DM_PELSHEIGHT;
    lpDevMode.dmPelsWidth : =  x;
    lpDevMode.dmPelsHeight : =  y;
    Result : =  ChangeDisplaySettings(lpDevMode,  0 )  =  DISP_CHANGE_SUCCESSFUL;
  end;
end;

procedure StayOnTop(Handle: HWND; OnTop: Boolean);
const
  csOnTop: array[Boolean] of HWND  =  (HWND_NOTOPMOST, HWND_TOPMOST);
begin
  SetWindowPos(Handle, csOnTop[OnTop],  0 ,  0 ,  0 ,  0 , SWP_NOMOVE or SWP_NOSIZE);
end;

var
  WndLong: Integer;

procedure SetHidden(Hide: Boolean);
begin
  ShowWindow(Application.Handle, SW_HIDE);
   if  Hide then
    SetWindowLong(Application.Handle, GWL_EXSTYLE,
      WndLong or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW or WS_EX_TOPMOST)
   else
    SetWindowLong(Application.Handle, GWL_EXSTYLE, WndLong);
  ShowWindow(Application.Handle, SW_SHOW);
end;

const
  csWndShowFlag: array[Boolean] of DWORD  =  (SW_HIDE, SW_RESTORE);

procedure SetTaskBarVisible(Visible: Boolean);
var
  wndHandle: THandle;
begin
  wndHandle : =  FindWindow( ' Shell_TrayWnd ' , nil);
  ShowWindow(wndHandle, csWndShowFlag[Visible]);
end;

procedure SetDesktopVisible(Visible: Boolean);
var
  hDesktop: THandle;
begin
  hDesktop : =  FindWindow( ' Progman ' , nil);
  ShowWindow(hDesktop, csWndShowFlag[Visible]);
end;

function GetWorkRect: TRect;
begin
  SystemParametersInfo(SPI_GETWORKAREA,  0 , @Result,  0 )
end;

procedure BeginWait;
begin
  Screen.Cursor : =  crHourGlass;
end;

procedure EndWait;
begin
  Screen.Cursor : =  crDefault;
end;

function CheckWindows9598: Boolean;
var
  V: TOSVersionInfo;
begin
  V.dwOSVersionInfoSize : =  SizeOf(V);
  Result : =  False;
   if  not GetVersionEx(V) then Exit;
   if  V.dwPlatformId  =  VER_PLATFORM_WIN32_WINDOWS then
    Result : =  True;
end;

function GetOSString:  string ;
var
  OSPlatform:  string ;
  BuildNumber: Integer;
begin
  Result : =   ' Unknown Windows Version ' ;
  OSPlatform : =   ' Windows ' ;
  BuildNumber : =   0 ;

   case  Win32Platform of
    VER_PLATFORM_WIN32_WINDOWS:
      begin
        BuildNumber : =  Win32BuildNumber and $0000FFFF;
         case  Win32MinorVersion of
           0 .. 9 :
            begin
               if  Trim(Win32CSDVersion)  =   ' B '  then
                OSPlatform : =   ' Windows 95 OSR2 '
               else
                OSPlatform : =   ' Windows 95 ' ;
            end;
           10 .. 89 :
            begin
               if  Trim(Win32CSDVersion)  =   ' A '  then
                OSPlatform : =   ' Windows 98 '
               else
                OSPlatform : =   ' Windows 98 SE ' ;
            end;
           90 :
            OSPlatform : =   ' Windows Millennium ' ;
        end;
      end;
    VER_PLATFORM_WIN32_NT:
      begin
         if  Win32MajorVersion  in  [ 3 ,  4 ] then
          OSPlatform : =   ' Windows NT '
         else   if  Win32MajorVersion  =   5  then
        begin
           case  Win32MinorVersion of
             0 : OSPlatform : =   ' Windows 2000 ' ;
             1 : OSPlatform : =   ' Windows XP ' ;
          end;
        end;
        BuildNumber : =  Win32BuildNumber;
      end;
    VER_PLATFORM_WIN32s:
      begin
        OSPlatform : =   ' Win32s ' ;
        BuildNumber : =  Win32BuildNumber;
      end;
  end;
   if  (Win32Platform  =  VER_PLATFORM_WIN32_WINDOWS) or
    (Win32Platform  =  VER_PLATFORM_WIN32_NT) then
  begin
     if  Trim(Win32CSDVersion)  =   ''  then
      Result : =  Format( ' %s %d.%d (Build %d) ' , [OSPlatform, Win32MajorVersion,
        Win32MinorVersion, BuildNumber])
     else
      Result : =  Format( ' %s %d.%d (Build %d: %s) ' , [OSPlatform, Win32MajorVersion,
        Win32MinorVersion, BuildNumber, Win32CSDVersion]);
  end
   else
    Result : =  Format( ' %s %d.%d ' , [OSPlatform, Win32MajorVersion, Win32MinorVersion])
end;

function GetComputeNameStr :  string ;
var
  dwBuff : DWORD;
  CmpName : array [ 0 .. 255 ] of Char;
begin
  Result : =   '' ;
  dwBuff : =   256 ;
  FillChar(CmpName, SizeOf(CmpName),  0 );
   if  GetComputerName(CmpName, dwBuff) then
    Result : =  StrPas(CmpName);
end;

function GetLocalUserName:  string ;
var
  Count: DWORD;
begin
  Count : =   256   +   1 ;  //  UNLEN + 1
   //  set buffer size to 256 + 2 characters
  SetLength(Result, Count);
   if  GetUserName(PChar(Result), Count) then
    StrResetLength(Result)
   else
    Result : =   '' ;
end;

function GetLocalIP: String;
type
    TaPInAddr  =  array [ 0 .. 10 ] of PInAddr;
    PaPInAddr  =   ^ TaPInAddr;
var
    phe  : PHostEnt;
    pptr : PaPInAddr;
    Buffer : array [ 0 .. 63 ] of  char ;
    I    : Integer;
    GInitData      : TWSADATA;

begin
    WSAStartup($ 101 , GInitData);
    Result : =   '' ;
    GetHostName(Buffer, SizeOf(Buffer));
    phe : = GetHostByName(buffer);
     if  phe  =  nil then Exit;
    pptr : =  PaPInAddr(Phe ^ .h_addr_list);
    I : =   0 ;
     while  pptr ^ [I]  <>  nil  do  begin
      result: = StrPas(inet_ntoa(pptr ^ [I] ^ ));
      Inc(I);
    end;
    WSACleanup;
end;

// ------------------------------------------------------------------------------
//  其它过程
// ------------------------------------------------------------------------------

function TrimInt(Value, Min, Max: Integer): Integer; overload;
begin
   if  Value  >  Max then
    Result : =  Max
   else   if  Value  <  Min then
    Result : =  Min
   else
    Result : =  Value;
end;

function InBound(Value: Integer; Min, Max: Integer): Boolean;
begin
  Result : =  (Value  >=  Min) and (Value  <=  Max);
end;

procedure Delay( const  uDelay: DWORD);
var
  n: DWORD;
begin
  n : =  GetTickCount;
   while  ((GetTickCount  -  n)  <=  uDelay)  do
    Application.ProcessMessages;
end;

procedure BeepEx( const  Freq: WORD  =   1200 ;  const  Delay: WORD  =   1 );
const
  FREQ_SCALE  =  $ 1193180 ;
var
  Temp: WORD;
begin
  Temp : =  FREQ_SCALE div Freq;
  asm
     in  al,61h;
    or al, 3 ;
     out  61h,al;
    mov al,$b6;
     out  43h,al;
    mov ax,temp;
     out  42h,al;
    mov al,ah;
     out  42h,al;
  end;
  Sleep(Delay);
  asm
     in  al,$ 61 ;
    and al,$fc;
     out  $ 61 ,al;
  end;
end;

function GetHzPy( const  AHzStr:  string ):  string ;
const
  ChinaCode: array[ 0 .. 25 ,  0 .. 1 ] of Integer  =  (( 1601 ,  1636 ), ( 1637 ,  1832 ), ( 1833 ,  2077 ),
    ( 2078 ,  2273 ), ( 2274 ,  2301 ), ( 2302 ,  2432 ), ( 2433 ,  2593 ), ( 2594 ,  2786 ), ( 9999 ,  0000 ),
    ( 2787 ,  3105 ), ( 3106 ,  3211 ), ( 3212 ,  3471 ), ( 3472 ,  3634 ), ( 3635 ,  3722 ), ( 3723 ,  3729 ),
    ( 3730 ,  3857 ), ( 3858 ,  4026 ), ( 4027 ,  4085 ), ( 4086 ,  4389 ), ( 4390 ,  4557 ), ( 9999 ,  0000 ),
    ( 9999 ,  0000 ), ( 4558 ,  4683 ), ( 4684 ,  4924 ), ( 4925 ,  5248 ), ( 5249 ,  5589 ));
var
  i, j, HzOrd: Integer;
begin
  i : =   1 ;
   while  i  <=  Length(AHzStr)  do
  begin
     if  (AHzStr[i]  >=  # 160 ) and (AHzStr[i  +   1 ]  >=  # 160 ) then
    begin
      HzOrd : =  (Ord(AHzStr[i])  -   160 )  *   100   +  Ord(AHzStr[i  +   1 ])  -   160 ;
       for  j : =   0  to  25   do
      begin
         if  (HzOrd  >=  ChinaCode[j][ 0 ]) and (HzOrd  <=  ChinaCode[j][ 1 ]) then
        begin
          Result : =  Result  +  Char(Byte( ' A ' )  +  j);
          Break;
        end;
      end;
      Inc(i);
    end  else  Result : =  Result  +  AHzStr[i];
    Inc(i);
  end;
end;

function UpperCaseMoney( const  Money: Double): String;
var
  tmp1,rr : string ;
  l,i,j,k:integer;
  r: Double;
const
  n1: array[ 0 .. 9 ] of  string   =  ( ' 零 ' ,  ' 壹 ' ,  ' 贰 ' ,  ' 叁 ' ,  ' 肆 ' ,
                                ' 伍 ' ,  ' 陆 ' ,  ' 柒 ' ,  ' 捌 ' ,  ' 玖 ' );
  n2: array[ 0 .. 3 ] of  string   =  ( '' ,  ' 拾 '  , ' 佰 ' ,  ' 仟 ' );
  n3: array[ 0 .. 2 ] of  string   =  ( ' 元 ' ,  ' 万 ' ,  ' 亿 ' );
begin
  r: = Money;
  tmp1: = FormatFloat( ' #.00 ' ,r);
  l: = length(tmp1);
  rr: = '' ;
   if  strtoint(tmp1[l]) <> 0  then begin
    rr: = ' 分 ' ;
    rr: = n1[strtoint(tmp1[l])] + rr;
  end;

   if  strtoint(tmp1[l - 1 ]) <> 0  then begin
    rr: = ' 角 ' + rr;
    rr: = n1[strtoint(tmp1[l - 1 ])] + rr;
  end;

  i: = l - 3 ;
  j: = 0 ;k: = 0 ;
   while  i > 0   do  begin
     if  j mod  4 = 0  then begin
      rr: = n3[k] + rr;
      inc(k); if  k > 2  then k: = 1 ;
      j: = 0 ;
    end;
     if  strtoint(tmp1[i]) <> 0  then
      rr: = n2[j] + rr;
    rr: = n1[strtoint(tmp1[i])] + rr;
    inc(j);
    dec(i);
  end;

   while  pos( ' 零零 ' ,rr) > 0   do
    rr: =  stringreplace(rr, ' 零零 ' , ' 零 ' ,[rfReplaceAll]);
  rr: = stringreplace(rr, ' 零亿 ' , ' 亿零 ' ,[rfReplaceAll]);
   while  pos( ' 零零 ' ,rr) > 0   do
    rr: =  stringreplace(rr, ' 零零 ' , ' 零 ' ,[rfReplaceAll]);
  rr: = stringreplace(rr, ' 零万 ' , ' 万零 ' ,[rfReplaceAll]);
   while  pos( ' 零零 ' ,rr) > 0   do
    rr: =  stringreplace(rr, ' 零零 ' , ' 零 ' ,[rfReplaceAll]);
  rr: = stringreplace(rr, ' 零元 ' , ' 元零 ' ,[rfReplaceAll]);
   while  pos( ' 零零 ' ,rr) > 0   do
    rr: =  stringreplace(rr, ' 零零 ' , ' 零 ' ,[rfReplaceAll]);
  rr: = stringreplace(rr, ' 亿万 ' , ' 亿 ' ,[rfReplaceAll]);
  
   if  copy(rr,length(rr) - 1 , 2 ) = ' 零 '  then
    rr: = copy(rr, 1 ,length(rr) - 2 );

  result: = rr;
end;

function SoundCardExist: Boolean;
begin
  Result : =  WaveOutGetNumDevs  >   0 ;
end;

initialization
  WndLong : =  GetWindowLong(Application.Handle, GWL_EXSTYLE);

end.