{ 原始文件名:CnCommon.pas } { 单元作者:CnPack开发组 } { 下载地址:http://cnpack.yeah.net } { 电子邮件:[email protected] } { 备注:该单元为开发包公共运行时间库单元 } { 最后更新: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[i] <> '\') 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[i] = '\' 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; //扩展整数转字符串函数,参数分别为目标数、长度、填充字符(默认为0) 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[i] + 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[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 SoundCardExist: Boolean; begin Result := WaveOutGetNumDevs > 0; end; initialization WndLong := GetWindowLong(Application.Handle, GWL_EXSTYLE); end.