自己写的一些Delphi常用函数

今天在整理以前写过的代码，发现有些函数还是挺实用的，决定将其贴到Blog上，与众多好友一起分享。

...{*******************************************************************************
*模块名称:公用函数库
*编写人员:ChrisMao
*编写日期:2004.10.30
******************************************************************************}

unitJrCommon;

interface

uses
Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogs,
ShellAPI,CommDlg,MMSystem,StdCtrls,Registry,JrConsts,Winsock;

//------------------------------------------------------------------------------
//窗体类函数
//------------------------------------------------------------------------------
functionFindFormClass(FormClassName:PChar):TFormClass;
functionHasInstance(FormClassName:PChar):Boolean;

//------------------------------------------------------------------------------
//公用对话框函数
//------------------------------------------------------------------------------
procedureInfoDlg(constMsg:String;ACaption:String=SInformation);
...{信息对话框}

procedureErrorDlg(constMsg:String;ACaption:String=SError);
...{错误对话框}

procedureWarningDlg(constMsg:String;ACaption:String=SWarning);
...{警告对话框}

functionQueryDlg(constMsg:String;ACaption:String=SQuery):Boolean;
...{确认对话框}

functionQueryNoDlg(constMsg:string;ACaption:string=SQuery):Boolean;
...{确认对话框，默认按钮为"否"}

functionJrInputQuery(constACaption,APrompt:String;varValue:string):Boolean;
...{输入对话框}

functionJrInputBox(constACaption,APrompt,ADefault:string):String;
...{输入对话框}

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

procedureRunFile(constFileName:String;Handle:THandle=0;Param:string='');
...{运行一个文件}

functionAppPath:string;
...{应用程序路径}

functionGetProgramFilesDir:string;
...{取ProgramFiles目录}

functionGetWindowsDir:string;
...{取Windows目录}

functionGetWindowsTempPath:string;
...{取临时文件路径}

functionGetSystemDir:string;
...{取系统目录}

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

functionInStr(constsShort:string;constsLong:string):Boolean;
...{判断s1是否包含在s2中}

functionIntToStrSp(Value:Integer;SpLen:Integer=3;Sp:Char=','):string;
...{带分隔符的整数－字符转换}

functionByteToBin(Value:Byte):string;
...{字节转二进制串}

functionStrRight(Str:string;Len:Integer):string;
...{返回字符串右边的字符}

functionStrLeft(Str:string;Len:Integer):string;
...{返回字符串左边的字符}

functionSpc(Len:Integer):string;
...{返回空格串}

procedureSwapStr(vars1,s2:string);
...{交换字串}

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

functionGetYear(Date:TDate):Word;
...{取日期年份分量}

functionGetMonth(Date:TDate):Word;
...{取日期月份分量}

functionGetDay(Date:TDate):Word;
...{取日期天数分量}

functionGetHour(Time:TTime):Word;
...{取时间小时分量}

functionGetMinute(Time:TTime):Word;
...{取时间分钟分量}

functionGetSecond(Time:TTime):Word;
...{取时间秒分量}

functionGetMSecond(Time:TTime):Word;
...{取时间毫秒分量}

//------------------------------------------------------------------------------
//位操作函数
//------------------------------------------------------------------------------
type
TByteBit=0..7;//Byte类型位数范围
TWordBit=0..15;//Word类型位数范围
TDWordBit=0..31;//DWord类型位数范围

procedureSetBit(varValue:Byte;Bit:TByteBit;IsSet:Boolean);overload;
...{设置二进制位}

procedureSetBit(varValue:WORD;Bit:TWordBit;IsSet:Boolean);overload;
...{设置二进制位}

procedureSetBit(varValue:DWORD;Bit:TDWordBit;IsSet:Boolean);overload;
...{设置二进制位}

functionGetBit(Value:Byte;Bit:TByteBit):Boolean;overload;
...{取二进制位}

functionGetBit(Value:WORD;Bit:TWordBit):Boolean;overload;
...{取二进制位}

functionGetBit(Value:DWORD;Bit:TDWordBit):Boolean;overload;
...{取二进制位}

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

procedureChangeFocus(Handle:THandle;Forword:Boolean=False);
...{改变焦点}

procedureMoveMouseIntoControl(AWinControl:TControl);
...{移动鼠标到控件}

procedureAddComboBoxTextToItems(ComboBox:TComboBox;MaxItemsCount:Integer=10);
...{将ComboBox的文本内容增加到下拉列表中}

functionDynamicResolution(x,y:WORD):Boolean;
...{动态设置分辨率}

procedureStayOnTop(Handle:HWND;OnTop:Boolean);
...{窗口最上方显示}

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

procedureSetTaskBarVisible(Visible:Boolean);
...{设置任务栏是否可见}

procedureSetDesktopVisible(Visible:Boolean);
...{设置桌面是否可见}

functionGetWorkRect:TRect;
...{取桌面区域}

procedureBeginWait;
...{显示等待光标}

procedureEndWait;
...{结束等待光标}

functionCheckWindows9598:Boolean;
...{检测是否Win95/98平台}

functionGetOSString:string;
...{返回操作系统标识串}

functionGetComputeNameStr:string;
...{得到本机名}

functionGetLocalUserName:string;
...{得到本机用户名}

functionGetLocalIP:String;
...{得到本机IP地址}

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

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

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

procedureDelay(constuDelay:DWORD);
...{延时}

procedureBeepEx(constFreq:WORD=1200;constDelay:WORD=1);
...{在Win9X下让喇叭发声}

functionGetHzPy(constAHzStr:string):string;
...{取汉字的拼音}

functionUpperCaseMoney(constMoney:Double):String;
...{转换为大与金额}

functionSoundCardExist:Boolean;
...{声卡是否存在}

implementation

//------------------------------------------------------------------------------
//窗体类函数
//------------------------------------------------------------------------------

functionFindFormClass(FormClassName:PChar):TFormClass;
begin
Result:=TFormClass(GetClass(FormClassName));
end;

functionHasInstance(FormClassName:PChar):Boolean;
var
i:integer;
begin
Result:=False;
fori:=Screen.FormCount-1downto0dobegin
Result:=SameText(Screen.Forms[i].ClassName,FormClassName);
ifResultthenbegin
TForm(Screen.Forms[i]).BringToFront;
Break;
end;
end;
end;

//------------------------------------------------------------------------------
//公用对话框函数
//------------------------------------------------------------------------------

procedureInfoDlg(constMsg:String;ACaption:String=SInformation);
begin
Application.MessageBox(PChar(Msg),PChar(ACaption),MB_OK+MB_ICONINFORMATION);
end;

procedureErrorDlg(constMsg:String;ACaption:String=SError);
begin
Application.MessageBox(PChar(Msg),PChar(ACaption),MB_OK+MB_ICONERROR);
end;

procedureWarningDlg(constMsg:String;ACaption:String=SWarning);
begin
Application.MessageBox(PChar(Msg),PChar(ACaption),MB_OK+MB_ICONWARNING);
end;

functionQueryDlg(constMsg:String;ACaption:String=SQuery):Boolean;
begin
Result:=Application.MessageBox(PChar(Msg),PChar(ACaption),
MB_YESNO+MB_ICONQUESTION)=IDYES;
end;

functionQueryNoDlg(constMsg:string;ACaption:string=SQuery):Boolean;
begin
Result:=Application.MessageBox(PChar(Msg),PChar(ACaption),
MB_YESNO+MB_ICONQUESTION+MB_DEFBUTTON2)=IDYES;
end;

functionGetAveCharSize(Canvas:TCanvas):TPoint;
var
I:Integer;
Buffer:array[0..51]ofChar;
begin
forI:=0to25doBuffer[I]:=Chr(I+Ord('A'));
forI:=0to25doBuffer[I+26]:=Chr(I+Ord('a'));
GetTextExtentPoint(Canvas.Handle,Buffer,52,TSize(Result));
Result.X:=Result.Xdiv52;
end;

functionJrInputQuery(constACaption,APrompt:String;varValue:string):Boolean;
var
Form:TForm;
Prompt:TLabel;
Edit:TEdit;
DialogUnits:TPoint;
ButtonTop,ButtonWidth,ButtonHeight:Integer;
begin
Result:=False;
Form:=TForm.Create(Application);
withFormdo
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);
withPromptdo
begin
Parent:=Form;
AutoSize:=True;
Left:=MulDiv(8,DialogUnits.X,4);
Top:=MulDiv(8,DialogUnits.Y,8);
Caption:=APrompt;
end;
Edit:=TEdit.Create(Form);
withEditdo
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);
withTButton.Create(Form)do
begin
Parent:=Form;
Caption:=SMsgDlgOK;
ModalResult:=mrOk;
Default:=True;
SetBounds(MulDiv(38,DialogUnits.X,4),ButtonTop,ButtonWidth,
ButtonHeight);
end;
withTButton.Create(Form)do
begin
Parent:=Form;
Caption:=SMsgDlgCancel;
ModalResult:=mrCancel;
Cancel:=True;
SetBounds(MulDiv(92,DialogUnits.X,4),ButtonTop,ButtonWidth,
ButtonHeight);
end;
ifShowModal=mrOkthen
begin
Value:=Edit.Text;
Result:=True;
end;
finally
Form.Free;
end;
end;

functionJrInputBox(constACaption,APrompt,ADefault:string):String;
begin
Result:=ADefault;
JrInputQuery(ACaption,APrompt,Result);
end;

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

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

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

const
HKLM_CURRENT_VERSION_WINDOWS='SoftwareMicrosoftWindowsCurrentVersion';

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

functionRegReadStringDef(constRootKey:HKEY;constKey,Name,Def:string):string;
var
RegKey:HKEY;
Size:DWORD;
StrVal:string;
RegKind:DWORD;
begin
Result:=Def;
ifRegOpenKeyEx(RootKey,RelativeKey(Key),0,KEY_READ,RegKey)=ERROR_SUCCESSthen
begin
RegKind:=0;
Size:=0;
ifRegQueryValueEx(RegKey,PChar(Name),nil,@RegKind,nil,@Size)=ERROR_SUCCESSthen
ifRegKindin[REG_SZ,REG_EXPAND_SZ]then
begin
SetLength(StrVal,Size);
ifRegQueryValueEx(RegKey,PChar(Name),nil,@RegKind,PByte(StrVal),@Size)=ERROR_SUCCESSthen
begin
SetLength(StrVal,StrLen(PChar(StrVal)));
Result:=StrVal;
end;
end;
RegCloseKey(RegKey);
end;
end;

procedureStrResetLength(varS:AnsiString);
begin
SetLength(S,StrLen(PChar(S)));
end;

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

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

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

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

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

functionInStr(constsShort:string;constsLong:string):Boolean;
var
s1,s2:string;
begin
s1:=LowerCase(sShort);
s2:=LowerCase(sLong);
Result:=Pos(s1,s2)>0;
end;

functionIntToStrSp(Value:Integer;SpLen:Integer=3;Sp:Char=','):string;
var
s:string;
i,j:Integer;
begin
s:=IntToStr(Value);
Result:='';
j:=0;
fori:=Length(s)downto1do
begin
Result:=s[i]+Result;
Inc(j);
if((jmodSpLen)=0)and(i<>1)thenResult:=Sp+Result;
end;
end;

functionByteToBin(Value:Byte):string;
const
V:Byte=1;
var
i:Integer;
begin
fori:=7downto0do
if(Vshli)andValue<>0then
Result:=Result+'1'
else
Result:=Result+'0';
end;

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

functionStrLeft(Str:string;Len:Integer):string;
begin
ifLen>=Length(Str)then
Result:=Str
else
Result:=Copy(Str,1,Len);
end;

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

procedureSwapStr(vars1,s2:string);
var
tempstr:string;
begin
tempstr:=s1;
s1:=s2;
s2:=tempstr;
end;

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

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

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

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

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

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

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

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

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

procedureSetBit(varValue:Byte;Bit:TByteBit;IsSet:Boolean);overload;
begin
ifIsSetthen
Value:=Valueor(1shlBit)else
Value:=Valueandnot(1shlBit);
end;

procedureSetBit(varValue:WORD;Bit:TWordBit;IsSet:Boolean);overload;
begin
ifIsSetthen
Value:=Valueor(1shlBit)else
Value:=Valueandnot(1shlBit);
end;

procedureSetBit(varValue:DWORD;Bit:TDWordBit;IsSet:Boolean);overload;
begin
ifIsSetthen
Value:=Valueor(1shlBit)else
Value:=Valueandnot(1shlBit);
end;

functionGetBit(Value:Byte;Bit:TByteBit):Boolean;overload;
begin
Result:=Valueand(1shlBit)<>0;
end;

functionGetBit(Value:WORD;Bit:TWordBit):Boolean;overload;
begin
Result:=Valueand(1shlBit)<>0;
end;

functionGetBit(Value:DWORD;Bit:TDWordBit):Boolean;overload;
begin
Result:=Valueand(1shlBit)<>0;
end;

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

procedureChangeFocus(Handle:THandle;Forword:Boolean=False);
begin
ifForWordthen
PostMessage(Handle,WM_NEXTDLGCTL,1,0)
else
PostMessage(Handle,WM_NEXTDLGCTL,0,0);
end;

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

procedureAddComboBoxTextToItems(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;

functionDynamicResolution(x,y:WORD):Boolean;
var
lpDevMode:TDeviceMode;
begin
Result:=EnumDisplaySettings(nil,0,lpDevMode);
ifResultthen
begin
lpDevMode.dmFields:=DM_PELSWIDTHorDM_PELSHEIGHT;
lpDevMode.dmPelsWidth:=x;
lpDevMode.dmPelsHeight:=y;
Result:=ChangeDisplaySettings(lpDevMode,0)=DISP_CHANGE_SUCCESSFUL;
end;
end;

procedureStayOnTop(Handle:HWND;OnTop:Boolean);
const
csOnTop:array[Boolean]ofHWND=(HWND_NOTOPMOST,HWND_TOPMOST);
begin
SetWindowPos(Handle,csOnTop[OnTop],0,0,0,0,SWP_NOMOVEorSWP_NOSIZE);
end;

var
WndLong:Integer;

procedureSetHidden(Hide:Boolean);
begin
ShowWindow(Application.Handle,SW_HIDE);
ifHidethen
SetWindowLong(Application.Handle,GWL_EXSTYLE,
WndLongorWS_EX_TOOLWINDOWandnotWS_EX_APPWINDOWorWS_EX_TOPMOST)
else
SetWindowLong(Application.Handle,GWL_EXSTYLE,WndLong);
ShowWindow(Application.Handle,SW_SHOW);
end;

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

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

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

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

procedureBeginWait;
begin
Screen.Cursor:=crHourGlass;
end;

procedureEndWait;
begin
Screen.Cursor:=crDefault;
end;

functionCheckWindows9598:Boolean;
var
V:TOSVersionInfo;
begin
V.dwOSVersionInfoSize:=SizeOf(V);
Result:=False;
ifnotGetVersionEx(V)thenExit;
ifV.dwPlatformId=VER_PLATFORM_WIN32_WINDOWSthen
Result:=True;
end;

functionGetOSString:string;
var
OSPlatform:string;
BuildNumber:Integer;
begin
Result:='UnknownWindowsVersion';
OSPlatform:='Windows';
BuildNumber:=0;

caseWin32Platformof
VER_PLATFORM_WIN32_WINDOWS:
begin
BuildNumber:=Win32BuildNumberand$0000FFFF;
caseWin32MinorVersionof
0..9:
begin
ifTrim(Win32CSDVersion)='B'then
OSPlatform:='Windows95OSR2'
else
OSPlatform:='Windows95';
end;
10..89:
begin
ifTrim(Win32CSDVersion)='A'then
OSPlatform:='Windows98'
else
OSPlatform:='Windows98SE';
end;
90:
OSPlatform:='WindowsMillennium';
end;
end;
VER_PLATFORM_WIN32_NT:
begin
ifWin32MajorVersionin[3,4]then
OSPlatform:='WindowsNT'
elseifWin32MajorVersion=5then
begin
caseWin32MinorVersionof
0:OSPlatform:='Windows2000';
1:OSPlatform:='WindowsXP';
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
ifTrim(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;

functionGetComputeNameStr:string;
var
dwBuff:DWORD;
CmpName:array[0..255]ofChar;
begin
Result:='';
dwBuff:=256;
FillChar(CmpName,SizeOf(CmpName),0);
ifGetComputerName(CmpName,dwBuff)then
Result:=StrPas(CmpName);
end;

functionGetLocalUserName:string;
var
Count:DWORD;
begin
Count:=256+1;//UNLEN+1
//setbuffersizeto256+2characters
SetLength(Result,Count);
ifGetUserName(PChar(Result),Count)then
StrResetLength(Result)
else
Result:='';
end;

functionGetLocalIP:String;
type
TaPInAddr=array[0..10]ofPInAddr;
PaPInAddr=^TaPInAddr;
var
phe:PHostEnt;
pptr:PaPInAddr;
Buffer:array[0..63]ofchar;
I:Integer;
GInitData:TWSADATA;

begin
WSAStartup($101,GInitData);
Result:='';
GetHostName(Buffer,SizeOf(Buffer));
phe:=GetHostByName(buffer);
ifphe=nilthenExit;
pptr:=PaPInAddr(Phe^.h_addr_list);
I:=0;
whilepptr^[I]<>nildobegin
result:=StrPas(inet_ntoa(pptr^[I]^));
Inc(I);
end;
WSACleanup;
end;

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

functionTrimInt(Value,Min,Max:Integer):Integer;overload;
begin
ifValue>Maxthen
Result:=Max
elseifValue<Minthen
Result:=Min
else
Result:=Value;
end;

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

procedureDelay(constuDelay:DWORD);
var
n:DWORD;
begin
n:=GetTickCount;
while((GetTickCount-n)<=uDelay)do
Application.ProcessMessages;
end;

procedureBeepEx(constFreq:WORD=1200;constDelay:WORD=1);
const
FREQ_SCALE=$1193180;
var
Temp:WORD;
begin
Temp:=FREQ_SCALEdivFreq;
asm
inal,61h;
oral,3;
out61h,al;
moval,$b6;
out43h,al;
movax,temp;
out42h,al;
moval,ah;
out42h,al;
end;
Sleep(Delay);
asm
inal,$61;
andal,$fc;
out$61,al;
end;
end;

functionGetHzPy(constAHzStr:string):string;
const
ChinaCode:array[0..25,0..1]ofInteger=((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;
whilei<=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;
forj:=0to25do
begin
if(HzOrd>=ChinaCode[j][0])and(HzOrd<=ChinaCode[j][1])then
begin
Result:=Result+Char(Byte('A')+j);
Break;
end;
end;
Inc(i);
endelseResult:=Result+AHzStr[i];
Inc(i);
end;
end;

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

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

i:=l-3;
j:=0;k:=0;
whilei>0dobegin
ifjmod4=0thenbegin
rr:=n3[k]+rr;
inc(k);ifk>2thenk:=1;
j:=0;
end;
ifstrtoint(tmp1[i])<>0then
rr:=n2[j]+rr;
rr:=n1[strtoint(tmp1[i])]+rr;
inc(j);
dec(i);
end;

whilepos('零零',rr)>0do
rr:=stringreplace(rr,'零零','零',[rfReplaceAll]);
rr:=stringreplace(rr,'零亿','亿零',[rfReplaceAll]);
whilepos('零零',rr)>0do
rr:=stringreplace(rr,'零零','零',[rfReplaceAll]);
rr:=stringreplace(rr,'零万','万零',[rfReplaceAll]);
whilepos('零零',rr)>0do
rr:=stringreplace(rr,'零零','零',[rfReplaceAll]);
rr:=stringreplace(rr,'零元','元零',[rfReplaceAll]);
whilepos('零零',rr)>0do
rr:=stringreplace(rr,'零零','零',[rfReplaceAll]);
rr:=stringreplace(rr,'亿万','亿',[rfReplaceAll]);

ifcopy(rr,length(rr)-1,2)='零'then
rr:=copy(rr,1,length(rr)-2);

result:=rr;
end;

functionSoundCardExist:Boolean;
begin
Result:=WaveOutGetNumDevs>0;
end;

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

end.

版权声明：本文为博主原创文章，未经博主允许不得转载。