今天在整理以前写过的代码,发现有些函数还是挺实用的,决定将其贴到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.
*模块名称:公用函数库
*编写人员: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.
版权声明:本文为博主原创文章,未经博主允许不得转载。
相关推荐
Delphi 常用函数及用法 Delphi 常用函数及用法
delphi常用函数手册 delphi程序员值得一看...
Delphi常用函数PDF版Delphi常用函数PDF版
Delphi常用函数速查手册Delphi常用函数速查手册Delphi常用函数速查手册Delphi常用函数速查手册Delphi常用函数速查手册Delphi常用函数速查手册Delphi常用函数速查手册Delphi常用函数速查手册Delphi常用函数速查手册...
Delphi常用函数手册delphi常用函数速查手册delphi-动态修改exe文件的图标
delphi常用函数速查手册,对新手很有帮助,很多常用函数(附带实例)!
Delphi 7.0常用函数速查手册Delphi 7.0常用函数速查手册Delphi 7.0常用函数速查手册Delphi 7.0常用函数速查手册Delphi 7.0常用函数速查手册Delphi 7.0常用函数速查手册
包含了6个分块,介绍了delphi7常用的函数和实例。 呆虎技术论坛bbs.daihu.com打造
Delphi常用函数
Delphi开发中常用的函数,如日期取值、磁盘硬件读写、系统目录、文件夹等操作函数
Delphi 常用函数 Delphi 常用函数 Delphi 常用函数 Delphi 常用函数
Delphi 常用API 函数.Delphi 常用API 函数Delphi 常用API 函数Delphi 常用API 函数
Delphi常用函数\ Delphi常用函数 Delphi常用函数 Delphi常用函数
Delphi 函数(数据类型转换函数;字符串、数组操作函数)
一套完整的Delphi常用函数,对函数的入参和出参都有详尽的解释。
Delphi7.0常用函数速查手册
在Delphi中调用函数,一般情况下可以直接使用函数即可,但由于有一些函数未包含在Uses中列出的单元中(默认单元有Windows,Messages,SysUtils,Variants,Classes,Graphics, Controls,Forms,Dialogs;),所以需要我们...
delphi的常用函数
delphi常用函数.pdf