Delphi公共运行时间库单元CnCommon.pas

{          原始文件名：CnCommon.pas                                            }
{            单元作者：CnPack开发组                                            }
{            下载地址：http://cnpack.yeah.net                                  }
{            电子邮件：[e-mail]                                          }
{                备注：该单元为开发包公共运行时间库单元                        }
{            最后更新：2002.04.09 V1.0                                         }
{                                                                              }
{******************************************************************************}

unit CnCommon;
interface

{$I CnPack.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  FileCtrl, ShellAPI, CommDlg, MMSystem, CnConsts;

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

function MoveFile(const sName, dName: string): Boolean;
{* 移动文件、目录，参数为源、目标名}

procedure FileProperties(const FName: string);
{* 打开文件属性窗口}

function OpenDialog(var FileName: string; Title: string; Filter: string;
  Ext: string): Boolean;
{* 打开文件框}

function FormatPath(APath: string; Width: Integer): string;
{* 缩短显示不下的长路径名}

function GetRelativePath(Source, Dest: string): string;
{* 取两个目录的相对路径,注意串尾不能是'/'字符！}

procedure RunFile(const FName: string; Handle: THandle = 0;
  const Param: string = '');
{* 运行一个文件}

function WinExecAndWait32(FileName: string; Visibility: Integer = SW_NORMAL):
  Integer;
{* 运行一个文件并等待其结束}

function AppPath: string;
{* 应用程序路径}

function GetWindowsDir: string;
{* 取Windows系统目录}

function GetWinTempDir: string;
{* 取临时文件目录}

function AddDirSuffix(Dir: string): string;
{* 目录尾加'/'修正}

function MakePath(Dir: string): string;
{* 目录尾加'/'修正}

function IsFileInUse(FName: string): Boolean;
{* 判断文件是否正在使用}

function GetFileSize(FileName: string): Integer;
{* 取文件长度}

function SetFileDate(FileName: string; CreationTime, LastWriteTime, LastAccessTime:
  TFileTime): Boolean;
{* 设置文件时间}

function GetFileDate(FileName: string; var CreationTime, LastWriteTime, LastAccessTime:
  TFileTime): Boolean;
{* 取文件时间}

function FileTimeToLocalSystemTime(FTime: TFileTime): TSystemTime;
{* 文件时间转本地时间}

function LocalSystemTimeToFileTime(STime: TSystemTime): TFileTime;
{* 本地时间转文件时间}

function GetFileIcon(FileName: string; var Icon: TIcon): Boolean;
{* 取得与文件相关的图标，成功则返回True}

function CreateBakFile(FileName, Ext: string): Boolean;
{* 创建备份文件}

function Deltree(Dir: string): Boolean;
{* 删除整个目录}

function GetDirFiles(Dir: string): Integer;
{* 取文件夹文件数}

type
  TFindCallBack = procedure(const FileName: string; const Info: TSearchRec;
    var Abort: Boolean);
{* 查找指定目录下文件的回调函数}

procedure FindFile(const Path: string; const FileName: string = '*.*';
  Proc: TFindCallBack = nil; bSub: Boolean = True; const bMsg: Boolean = True);
{* 查找指定目录下文件}

function OpenWith(const FileName: string): Integer;
{* 文件打开方式}

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

function InStr(const sShort: string; const sLong: string): Boolean;
{* 判断s1是否包含在s2中}

function IntToStrEx(Value: Integer; Len: Integer; FillChar: Char = '0'): string;
{* 扩展整数转字符串函数}

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 LinesToStr(const Lines: string): string;
{* 多行文本转单行（换行符转'/n'）}

function StrToLines(const Str: string): string;
{* 单行文本转多行（'/n'转换行符）}

//----------------------------------------------------------------------------//
//扩展的对话框函数                                                            //
//----------------------------------------------------------------------------//

procedure InfoDlg(Mess: string; Caption: string = SCnInformation; Flags: Integer
  = MB_OK + MB_ICONINFORMATION);
{* 显示提示窗口}

function InfoOk(Mess: string; Caption: string = SCnInformation): Boolean;
{* 显示提示确认窗口}

procedure ErrorDlg(Mess: string; Caption: string = SCnError);
{* 显示错误窗口}

procedure WarningDlg(Mess: string; Caption: string = SCnWarning);
{* 显示警告窗口}

function QueryDlg(Mess: string; Caption: string = SCnInformation): Boolean;
{* 显示查询是否窗口}

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

function GetYear(Date: TDate): Integer;
{* 取日期年份分量}
function GetMonth(Date: TDate): Integer;
{* 取日期月份分量}
function GetDay(Date: TDate): Integer;
{* 取日期天数分量}
function GetHour(Time: TTime): Integer;
{* 取时间小时分量}
function GetMinute(Time: TTime): Integer;
{* 取时间分钟分量}
function GetSecond(Time: TTime): Integer;
{* 取时间秒分量}
function GetMSecond(Time: TTime): Integer;
{* 取时间毫秒分量}

//----------------------------------------------------------------------------//
//位操作函数                                                                  //
//----------------------------------------------------------------------------//
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 MoveMouseIntoControl(AWinControl: TControl);
{* 移动鼠标到控件}

function DynamicResolution(x, y: WORD): Boolean;
{* 动态设置分辨率}

procedure StayOnTop(Handle: HWND; OnTop: Boolean);
{* 窗口最上方显示}

procedure SetHidden(Hide: Boolean);
{* 设置程序是否出现在任务栏}

procedure SetTaskBarVisible(Visible: Boolean);
{* 设置任务栏是否可见}

procedure SetDesktopVisible(Visible: Boolean);
{* 设置桌面是否可见}  

procedure BeginWait;
{* 显示等待光标}

procedure EndWait;
{* 结束等待光标}

function CheckWindows9598: Boolean;
{* 检测是否Win95/98平台}

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

function TrimInt(Value, Min, Max: Integer): Integer; overload;
{* 输出限制在Min..Max之间}

function IntToByte(Value: Integer): Byte; overload;
{* 输出限制在0..255之间}

function InBound(Value: Integer; Min, Max: Integer): Boolean;
{* 判断整数Value是否在Min和Max之间}

procedure CnSwap(var A, B: Byte); overload;
{* 交换两个数}
procedure CnSwap(var A, B: Integer); overload;
{* 交换两个数}
procedure CnSwap(var A, B: Single); overload;
{* 交换两个数}
procedure CnSwap(var A, B: Double); overload;
{* 交换两个数}

function RectEqu(Rect1, Rect2: TRect): Boolean;
{* 比较两个Rect是否相等}

procedure DeRect(Rect: TRect; var x, y, Width, Height: Integer);
{* 分解一个TRect为左上角坐标x, y和宽度Width、高度Height}

function EnSize(cx, cy: Integer): TSize;
{* 返回一个TSize类型}

function RectWidth(Rect: TRect): Integer;
{* 计算TRect的宽度}

function RectHeight(Rect: TRect): Integer;
{* 计算TRect的高度}

procedure Delay(const uDelay: DWORD);
{* 延时}

procedure BeepEx(const Freq: WORD = 1200; const Delay: WORD = 1);
{* 在Win9X下让喇叭发声}

procedure ShowLastError;
{* 显示Win32 Api运行结果信息}

function GetHzPy(const AHzStr: string): string;
{* 取汉字的拼音}

function SoundCardExist: Boolean;
{* 声卡是否存在}

implementation

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

//移动文件、目录
function MoveFile(const sName, dName: string): Boolean;
var
  s1, s2: AnsiString;
  lpFileOp: TSHFileOpStruct;
begin
  s1 := PChar(sName) + #0#0;
  s2 := PChar(dName) + #0#0;
  with lpFileOp do
  begin
    Wnd := Application.Handle;
    wFunc := FO_MOVE;
    pFrom := PChar(s1);
    pTo := PChar(s2);
    fFlags := FOF_ALLOWUNDO;
    hNameMappings := nil;
    lpszProgressTitle := nil;
    fAnyOperationsAborted := True;
  end;
  Result := SHFileOperation(lpFileOp) = 0;
end;

//打开文件属性窗口
procedure FileProperties(const FName: string);
var
  SEI: SHELLEXECUTEINFO;
begin
  with SEI do
  begin
    cbSize := SizeOf(SEI);
    fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_INVOKEIDLIST or
      SEE_MASK_FLAG_NO_UI;
    Wnd := Application.Handle;
    lpVerb := 'properties';
    lpFile := PChar(FName);
    lpParameters := nil;
    lpDirectory := nil;
    nShow := 0;
    hInstApp := 0;
    lpIDList := nil;
  end;
  ShellExecuteEx(@@SEI);
end;

//缩短显示不下的长路径名
function FormatPath(APath: string; Width: Integer): string;
var
  SLen: Integer;
  i, j: Integer;
  TString: string;
begin
  SLen := Length(APath);
  if (SLen <= Width) or (Width <= 6) then
  begin
    Result := APath;
    Exit
  end
  else
  begin
    i := SLen;
    TString := APath;
    for j := 1 to 2 do
    begin
      while (TString <> '/') and (SLen - i < Width - 8) do
        i := i - 1;
      i := i - 1;
    end;
    for j := SLen - i - 1 downto 0 do
      TString[Width - j] := TString[SLen - j];
    for j := SLen - i to SLen - i + 2 do
      TString[Width - j] := '.';
    Delete(TString, Width + 1, 255);
    Result := TString;
  end;
end;

//打开文件框
function OpenDialog(var FileName: string; Title: string; Filter: string;
  Ext: string): Boolean;
var
  OpenName: TOPENFILENAME;
  TempFilename, ReturnFile: string;
begin
  with OpenName do
  begin
    lStructSize := SizeOf(OpenName);
    hWndOwner := GetModuleHandle('');
    Hinstance := SysInit.Hinstance;
    lpstrFilter := PChar(Filter + #0 + Ext + #0#0);
    lpstrCustomFilter := '';
    nMaxCustFilter := 0;
    nFilterIndex := 1;
    nMaxFile := MAX_PATH;
    SetLength(TempFilename, nMaxFile + 2);
    lpstrFile := PChar(TempFilename);
    FillChar(lpstrFile^, MAX_PATH, 0);
    SetLength(TempFilename, nMaxFile + 2);
    nMaxFileTitle := MAX_PATH;
    SetLength(ReturnFile, MAX_PATH + 2);
    lpstrFileTitle := PChar(ReturnFile);
    FillChar(lpstrFile^, MAX_PATH, 0);
    lpstrInitialDir := '.';
    lpstrTitle := PChar(Title);
    Flags := OFN_HIDEREADONLY + OFN_ENABLESIZING;
    nFileOffset := 0;
    nFileExtension := 0;
    lpstrDefExt := PChar(Ext);
    lCustData := 0;
    lpfnHook := nil;
    lpTemplateName := '';
  end;
  Result := GetOpenFileName(OpenName);
  if Result then
    FileName := ReturnFile
  else
    FileName := '';
end;

// 取两个目录的相对路径,注意串尾不能是'/'字符!
function GetRelativePath(Source, Dest: string): string;
  //比较两路径字符串头部相同串的函数
  function GetPathComp(s1, s2: string): Integer;
  begin
    if Length(s1) > Length(s2) then swapStr(s1, s2);
    Result := Pos(s1, s2);
    while (Result = 0) and (Length(s1) > 3) do
    begin
      if s1 = '' then Exit;
      s1 := ExtractFileDir(s1);
      Result := Pos(s1, s2);
    end;
    if Result <> 0 then Result := Length(s1);
    if Result = 3 then Result := 2;
    //修正因ExtractFileDir()处理'c:/'时产生的错误.
  end;
  //取Dest的相对根路径的函数
  function GetRoot(s: ShortString): string;
  var
    i: Integer;
  begin
    Result := '';
    for i := 1 to Length(s) do
      if s = '/' then Result := Result + '../';
    if Result = '' then Result := './';
    //如果不想处理成"./"的路径格式，可去掉本行
  end;

var
  RelativRoot, RelativSub: string;
  HeadNum: Integer;
begin
  Source := UpperCase(Source);
  Dest := UpperCase(Dest);              //比较两路径字符串头部相同串
  HeadNum := GetPathComp(Source, Dest); //取Dest的相对根路径
  RelativRoot := GetRoot(StrRight(Dest, Length(Dest) - HeadNum));
  //取Source的相对子路径
  RelativSub := StrRight(Source, Length(Source) - HeadNum - 1);
  //返回
  Result := RelativRoot + RelativSub;
end;

//运行一个文件
procedure RunFile(const FName: string; Handle: THandle;
  const Param: string);
begin
  ShellExecute(Handle, nil, PChar(FName), PChar(Param), nil, SW_SHOWNORMAL);
end;

//运行一个文件并等待其结束
function WinExecAndWait32(FileName: string; Visibility: Integer): Integer;
var
  zAppName: array[0..512] of Char;
  zCurDir: array[0..255] of Char;
  WorkDir: string;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
begin
  StrPCopy(zAppName, FileName);
  GetDir(0, WorkDir);
  StrPCopy(zCurDir, WorkDir);
  FillChar(StartupInfo, SizeOf(StartupInfo), #0);
  StartupInfo.cb := SizeOf(StartupInfo);

  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := Visibility;
  if not CreateProcess(nil,
    zAppName,                           { pointer to command line string }
    nil,                                { pointer to process security attributes }
    nil,                                { pointer to thread security attributes }
    False,                              { handle inheritance flag }
    CREATE_NEW_CONSOLE or               { creation flags }
    NORMAL_PRIORITY_CLASS,
    nil,                                { pointer to new environment block }
    nil,                                { pointer to current directory name }
    StartupInfo,                        { pointer to STARTUPINFO }
    ProcessInfo) then
    Result := -1                        { pointer to PROCESS_INF }

  else
  begin
    WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
    GetExitCodeProcess(ProcessInfo.hProcess, Cardinal(Result));
  end;
end;

//应用程序路径
function AppPath: string;
begin
  Result := ExtractFilePath(Application.ExeName);
end;

//取Windows系统目录
function GetWindowsDir: string;
var
  Buf: array[0..MAX_PATH] of Char;
begin
  GetWindowsDirectory(Buf, MAX_PATH);
  Result := AddDirSuffix(Buf);
end;

//取临时文件目录
function GetWinTempDir: string;
var
  Buf: array[0..MAX_PATH] of Char;
begin
  GetTempPath(MAX_PATH, Buf);
  Result := AddDirSuffix(Buf);
end;

//目录尾加'/'修正
function AddDirSuffix(Dir: string): string;
begin
  Result := Trim(Dir);
  if Result = '' then Exit;
  if Result[Length(Result)] <> '/' then Result := Result + '/';
end;

function MakePath(Dir: string): string;
begin
  Result := AddDirSuffix(Dir);
end;

//判断文件是否正在使用
function IsFileInUse(FName: string): Boolean;
var
  HFileRes: HFILE;
begin
  Result := False;
  if not FileExists(FName) then
    Exit;
  HFileRes := CreateFile(PChar(FName), GENERIC_READ or GENERIC_WRITE, 0,
    nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  Result := (HFileRes = INVALID_HANDLE_VALUE);
  if not Result then
    CloseHandle(HFileRes);
end;

//取文件长度
function GetFileSize(FileName: string): Integer;
var
  FileVar: file of Byte;
begin
  {$I-}
  try
    AssignFile(FileVar, FileName);
    Reset(FileVar);
    Result := FileSize(FileVar);
    CloseFile(FileVar);
  except
    Result := 0;
  end;
  {$I+}
end;

//设置文件时间
function SetFileDate(FileName: string; CreationTime, LastWriteTime, LastAccessTime:
  TFileTime): Boolean;
var
  FileHandle: Integer;
begin
  FileHandle := FileOpen(FileName, fmOpenWrite or fmShareDenyNone);
  if FileHandle > 0 then
  begin
    SetFileTime(FileHandle, @@CreationTime, @@LastAccessTime, @@LastWriteTime);
    FileClose(FileHandle);
    Result := True;
  end
  else
    Result := False;
end;

//取文件时间
function GetFileDate(FileName: string; var CreationTime, LastWriteTime, LastAccessTime:
  TFileTime): Boolean;
var
  FileHandle: Integer;
begin
  FileHandle := FileOpen(FileName, fmOpenRead or fmShareDenyNone);
  if FileHandle > 0 then
  begin
    GetFileTime(FileHandle, @@CreationTime, @@LastAccessTime, @@LastWriteTime);
    FileClose(FileHandle);
    Result := True;
  end
  else
    Result := False;
end;

//取得与文件相关的图标
//FileName: e.g. "e:/hao/a.txt"
//成功则返回True
function GetFileIcon(FileName: string; var Icon: TIcon): Boolean;
var
  SHFileInfo: TSHFileInfo;
  h: HWND;
begin
  if not Assigned(Icon) then
    Icon := TIcon.Create;
  h := SHGetFileInfo(PChar(FileName),
    0,
    SHFileInfo,
    SizeOf(SHFileInfo),
    SHGFI_ICON or SHGFI_SYSICONINDEX);
  Icon.Handle := SHFileInfo.hIcon;
  Result := (h <> 0);
end;

//文件时间转本地时间
function FileTimeToLocalSystemTime(FTime: TFileTime): TSystemTime;
var
  STime: TSystemTime;
begin
  FileTimeToLocalFileTime(FTime, FTime);
  FileTimeToSystemTime(FTime, STime);
  Result := STime;
end;

//本地时间转文件时间
function LocalSystemTimeToFileTime(STime: TSystemTime): TFileTime;
var
  FTime: TFileTime;
begin
  SystemTimeToFileTime(STime, FTime);
  LocalFileTimeToFileTime(FTime, FTime);
  Result := FTime;
end;

//创建备份文件
function CreateBakFile(FileName, Ext: string): Boolean;
var
  BakFileName: string;
begin
  BakFileName := FileName + '.' + Ext;
  Result := CopyFile(PChar(FileName), PChar(BakFileName), False);
end;

//删除整个目录
function Deltree(Dir: string): Boolean;
var
  sr: TSearchRec;
  fr: Integer;
begin
  if not DirectoryExists(Dir) then
  begin
    Result := True;
    Exit;
  end;
  fr := FindFirst(AddDirSuffix(Dir) + '*.*', faAnyFile, sr);
  try
    while fr = 0 do
    begin
      if (sr.Name <> '.') and (sr.Name <> '..') then
      begin
        if sr.Attr and faDirectory = faDirectory then
          Result := Deltree(AddDirSuffix(Dir) + sr.Name)
        else
          Result := DeleteFile(AddDirSuffix(Dir) + sr.Name);
        if not Result then
          Exit;
      end;
      fr := FindNext(sr);
    end;
  finally
    FindClose(sr);
  end;
  Result := RemoveDir(Dir);
end;

//取文件夹文件数
function GetDirFiles(Dir: string): Integer;
var
  sr: TSearchRec;
  fr: Integer;
begin
  Result := 0;
  fr := FindFirst(AddDirSuffix(Dir) + '*.*', faAnyFile, sr);
  while fr = 0 do
  begin
    if (sr.Name <> '.') and (sr.Name <> '..') then
      Inc(Result);
    fr := FindNext(sr);
  end;
  FindClose(sr);
end;

var
  FindAbort: Boolean;

//查找指定目录下文件
procedure FindFile(const Path: string; const FileName: string = '*.*';
  Proc: TFindCallBack = nil; bSub: Boolean = True; const bMsg: Boolean = True);
var
  APath: string;
  Info: TSearchRec;
  Succ: Integer;
begin
  FindAbort := False;
  APath := MakePath(Path);
  try
    Succ := FindFirst(APath + FileName, faAnyFile - faVolumeID, Info);
    while Succ = 0 do
    begin
      if (Info.Name <> '.') and (Info.Name <> '..') then
      begin
        if (Info.Attr and faDirectory) <> faDirectory then
        begin
          if Assigned(Proc) then
            Proc(APath + Info.FindData.cFileName, Info, FindAbort);
        end
        else if bSub then
          FindFile(APath + Info.Name, FileName, Proc, bSub, bMsg);
      end;
      if bMsg then Application.ProcessMessages;
      if FindAbort then Exit;
      Succ := FindNext(Info);
    end;
  finally
    FindClose(Info);
  end;
end;

//文件打开方式
function OpenWith(const FileName: string): Integer;
begin
  Result := ShellExecute(Application.Handle, 'open', 'rundll32.exe',
    PChar('shell32.dll,OpenAs_RunDLL ' + FileName), '', SW_SHOW);
end;

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

//判断s1是否包含在s2中
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 IntToStrEx(Value: Integer; Len: Integer; FillChar: Char = '0'): string;
begin
  Result := IntToStr(Value);
  while Length(Result) < Len do
    Result := FillChar + Result;
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 + Result;
    Inc(j);
    if ((j mod SpLen) = 0) and (i <> 1) then Result := Sp + Result;
  end;
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 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 Spc(Len: Integer): string;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to Len - 1 do
    Result := Result + ' ';
end;

//交换字串
procedure SwapStr(var s1, s2: string);
var
  tempstr: string;
begin
  tempstr := s1;
  s1 := s2;
  s2 := tempstr;
end;

const
  csLinesCR = #13#10;
  csStrCR = '/n';

//多行文本转单行（换行符转'/n'）
function LinesToStr(const Lines: string): string;
var
  i: Integer;
begin
  Result := Lines;
  i := Pos(csLinesCR, Result);
  while i > 0 do
  begin
    system.Delete(Result, i, Length(csLinesCR));
    system.insert(csStrCR, Result, i);
    i := Pos(csLinesCR, Result);
  end;
end;

//单行文本转多行（'/n'转换行符）
function StrToLines(const Str: string): string;
var
  i: Integer;
begin
  Result := Str;
  i := Pos(csStrCR, Result);
  while i > 0 do
  begin
    system.Delete(Result, i, Length(csStrCR));
    system.insert(csLinesCR, Result, i);
    i := Pos(csStrCR, Result);
  end;
end;

//----------------------------------------------------------------------------//
//扩展的对话框函数                                                            //
//----------------------------------------------------------------------------//

//显示提示窗口
procedure InfoDlg(Mess: string; Caption: string; Flags: Integer);
begin
  Application.MessageBox(PChar(Mess), PChar(Caption), Flags);
end;

//显示提示确认窗口
function InfoOk(Mess: string; Caption: string): Boolean;
begin
  Result := Application.MessageBox(PChar(Mess), PChar(Caption),
    MB_OKCANCEL + MB_ICONINFORMATION) = IDOK;
end;

//显示错误窗口
procedure ErrorDlg(Mess: string; Caption: string);
begin
  Application.MessageBox(PChar(Mess), PChar(Caption), MB_OK + MB_ICONSTOP);
end;

//显示警告窗口
procedure WarningDlg(Mess: string; Caption: string);
begin
  Application.MessageBox(PChar(Mess), PChar(Caption), MB_OK + MB_ICONWARNING);
end;

//显示查询是否窗口
function QueryDlg(Mess: string; Caption: string): Boolean;
begin
  Result := Application.MessageBox(PChar(Mess), PChar(Caption),
    MB_YESNO + MB_ICONQUESTION) = IDYES;
end;

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

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

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

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

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

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

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

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

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

//设置位
procedure SetBit(var Value: Byte; Bit: TByteBit; IsSet: Boolean);
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);
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);
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;
begin
  Result := Value and (1 shl Bit) <> 0;
end;

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

function GetBit(Value: DWORD; Bit: TDWordBit): Boolean;
begin
  Result := Value and (1 shl Bit) <> 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;

//动态设置分辨率
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;

//显示等待光标
procedure BeginWait;
begin
  Screen.Cursor := crHourGlass;
end;  

//结束等待光标
procedure EndWait;
begin
  Screen.Cursor := crDefault;
end;

//检测是否Win95/98平台
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;

// 输出限制在Min..Max之间
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;

// 输出限制在0..255之间
function IntToByte(Value: Integer): Byte; overload;
asm
        OR     EAX, EAX
        JNS    @@@@Positive
        XOR    EAX, EAX
        RET

@@@@Positive:
        CMP    EAX, 255
        JBE    @@@@OK
        MOV    EAX, 255
@@@@OK:
end;

// 由TRect分离出坐标、宽高
procedure DeRect(Rect: TRect; var x, y, Width, Height: Integer);
begin
  x := Rect.Left;
  y := Rect.Top;
  Width := Rect.Right - Rect.Left;
  Height := Rect.Bottom - Rect.Top;
end;

// 比较两个Rect
function RectEqu(Rect1, Rect2: TRect): Boolean;
begin
  Result := (Rect1.Left = Rect2.Left) and (Rect1.Top = Rect2.Top) and
    (Rect1.Right = Rect2.Right) and (Rect1.Bottom = Rect2.Bottom);
end;

// 产生TSize类型
function EnSize(cx, cy: Integer): TSize;
begin
  Result.cx := cx;
  Result.cy := cy;
end;

// 计算Rect的宽度
function RectWidth(Rect: TRect): Integer;
begin
  Result := Rect.Right - Rect.Left;
end;

// 计算Rect的高度
function RectHeight(Rect: TRect): Integer;
begin
  Result := Rect.Bottom - Rect.Top;
end;

// 判断范围
function InBound(Value: Integer; Min, Max: Integer): Boolean;
begin
  Result := (Value >= Min) and (Value <= Max);
end;

// 交换两个数
procedure CnSwap(var A, B: Byte); overload;
var
  Tmp: Byte;
begin
  Tmp := A;
  A := B;
  B := Tmp;
end;

procedure CnSwap(var A, B: Integer); overload;
var
  Tmp: Integer;
begin
  Tmp := A;
  A := B;
  B := Tmp;
end;

procedure CnSwap(var A, B: Single); overload;
var
  Tmp: Single;
begin
  Tmp := A;
  A := B;
  B := Tmp;
end;

procedure CnSwap(var A, B: Double); overload;
var
  Tmp: Double;
begin
  Tmp := A;
  A := B;
  B := Tmp;
end;

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

//在Win9X下让喇叭发声
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;

//显示Win32 Api运行结果信息
procedure ShowLastError;
var
  ErrNo: Integer;
  Buf: array[0..255] of Char;
begin
  ErrNo := GetLastError;
  FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, ErrNo, $400, Buf, 255, nil);
  if Buf = '' then StrCopy(@@Buf, PChar(SUnknowError));
  MessageBox(Application.Handle, PChar(string(Buf) + #10#13 +
    SErrorCode + IntToStr(ErrNo)),
    SCnInformation, MB_OK + MB_ICONINFORMATION);
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 >= #160) and (AHzStr[i + 1] >= #160) then
    begin
      HzOrd := (Ord(AHzStr) - 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;
    Inc(i);
  end;
end;

//声卡是否存在
function SoundCardExist: Boolean;
begin
  Result := WaveOutGetNumDevs > 0;
end;

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