?? pubunit.~pas
字號(hào):
//******************************************************************************
// 模塊簡介 //
// 本模塊封裝了Delphi編程過程中的許多函數(shù)和Windows API函數(shù)有數(shù)學(xué),字符, //
//多媒體等方方面面.通過調(diào)用本模塊能加速您的程序開發(fā)速度.本模塊是我多年的 //
//編程技巧總結(jié)并且沒有任何限制喜歡的朋友可以任意使用和傳遞復(fù)制. //
// 作者:朱曉磊 2002.04.06 //
//******************************************************************************
unit PubUnit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ComCtrls, ToolWin, ExtCtrls, MPlayer, Menus,MMSystem,
Registry,Winsock,ShellAPI,DBGrids;
//=====================================================================================================================
function GetMaxInTwo(CanShu01,CanShu02:Double):Double; //判斷兩個(gè)整數(shù)大小返回大值
function GetMinInTwo(CanShu01,CanShu02:Double):Double; //判斷兩個(gè)整數(shù)大小返回小值
function GetWindowsDirectory():String; //返回Windows 的啟動(dòng)路徑
function GetApplicationDirectory():String; //返回應(yīng)用程序EXE文件的啟動(dòng)目錄
function SetODBCConfig(DateFilePath,ODBCName:String):Boolean; //動(dòng)態(tài)配置ODBC(Access97,2000)
function GetDiskFree(DiskName:Byte):String; //判斷磁盤剩余空間
function GetDiskSize(DiskName:Byte):String; //判斷磁盤總空間
function GetRoundInt(CustomDouble:Double):Double; //得到四舍五入結(jié)果
function SetDoubleFormat(CustomDouble:Double;XiaoShuWei:Integer):Double; //自定義小數(shù)位
function GetHostIP():TStrings; //獲取本主機(jī)的IP地址
function GetUserName():AnsiString; //取得用戶名稱
function GetWindowsProductID(): string; // 取得 Windows 產(chǎn)品序號(hào)
//=====================================================================================================================
//公共過程原型定義區(qū)
procedure ErrorMsgBox(); //全程異常錯(cuò)誤消息過程
procedure SetButtonCaptionAToB(CustomButton:TButton;AString,BString:String); //按鈕標(biāo)題二互換
procedure SetFormPicture(CustomForm:TForm;PictureFile:String); //設(shè)置窗口的背景圖像
procedure SetDBGridPicture(CustomDBGrid:TDBGrid;PictureFile:String); //設(shè)置窗口的背景圖像
procedure SetCDRomOpen(); //打開電腦光驅(qū)
procedure SetCDromClose(); //關(guān)閉電腦光驅(qū)
procedure SetWaveLeft(Volume:Integer); //設(shè)置聲音為左聲道(Integer 1~13)
procedure SetWaveRigth(Volume:Integer); //設(shè)置聲音為右聲道(Integer 1~13)
procedure SetWaveBalance(Volume:Integer);//設(shè)置聲音為雙聲道(Integer 1~13)
procedure SetWindowsReboot(); //設(shè)置Windows 重新啟動(dòng)（電腦不會(huì)斷電）
procedure SetWindowsClose(); //設(shè)置 Windows 關(guān)閉(電腦將斷電)
procedure IsEditNumber(CustomEdit:TEdit); //判斷文本框中的數(shù)據(jù)是否為數(shù)字
procedure IsEditEmpty(CustomEdit:TEdit); //判斷文本框中是否委控制
procedure SetTextXuanZhuan(OutForm:TForm;FontName,FontCaption:String;FontSize,FontOutTop,FontOutLeft,
FontOutJiaoDu:Integer;FontColor:TColor); //設(shè)置輸出字體的旋轉(zhuǎn)效果
procedure SetWallPicture(BmpFileName:String); //動(dòng)態(tài)更改壁紙
procedure SetFormRounder(CustomForm:TForm;FormLeft,FormTop,FormWidth,
FormHeight,LeftHuDu,RightHuDu:Integer); //園腳窗口
procedure SetTaskBarHide(); //隱藏任務(wù)欄
procedure SetTaskBarShow(); //現(xiàn)實(shí)任務(wù)欄
procedure SetPicture90(YuanImage,GuoImage:TImage); // 旋轉(zhuǎn)圖像90 度
procedure SetPicture180(YuanImage,GuoImage:TImage); //旋轉(zhuǎn)圖像180 度
procedure SetPicture270(YuanImage,GuoImage:TImage); // 旋轉(zhuǎn)圖像270 度
procedure ExecuteExeApp(CustomExeName,CustomFileName:String); //運(yùn)行外部應(yīng)用程序
procedure SetApplicationHide(); //隱藏應(yīng)用程序在任務(wù)欄上的顯示
procedure SetSystemMenu(CustomForm:TForm;MenuName:String); //添加系統(tǒng)菜單
procedure CopyFileDirectory(Handle:THandle;OldDirectory,NewDirectory:String);//拷貝整個(gè)目錄
procedure DeleteFileDirectory(Handle:THandle;OldDirectory:String);//刪除整個(gè)目錄
//=====================================================================================================================
Function LeftStr(inString : String; numChars : integer) : String;
Function RightStr(inString : String; numChars : integer) : String;
Function LTrim(inString : String) : String;
Function RTrim(inString : String) : String;
Function SubStr(inString : String; numChars, strSize : integer) : String;
Function InStr(Text, Pattern : String) : Integer;
function GetSecondFromString(TimeStr: string): dword;
function GetFrameFromString(TimeStr: string): dword;
function GetStringFromFrame(frames: dword): string;
function ChInStr(str: string): boolean;
function IsDigit(str: string): boolean;
const
FPS = 25; //for PAL, 30 frames per second
var
Login_Off:Boolean;
implementation
Function LeftStr;
Begin
Result := Copy(inString,1,numChars)
End;
Function RightStr;
Var
index: integer;
Begin
If numChars >= Length(inString) Then
RightStr := inString
Else
Begin
index := Length(inString) - numChars+1;
RightStr := Copy(inString,index,numChars)
End
End;
Function LTrim;
Var
p : Integer;
Begin
if Length(inString)<1 then exit;
p := 1;
While (inString[p] = ' ') and (p <= Length(inString)) Do
inc( p );
If p > 1 Then
Begin
Move(inString[p], inString[1], Succ(Length(inString)) - p);
// dec(inString[0], pred(p));
SetLength(inString, Length(inString)-p+1);
End;
LTrim := inString;
End;
Function RTrim;
Begin
While inString[Length(inString)-1] = ' ' Do
//dec( inString[0] );
SetLength(inString, Length(inString)-1);
RTrim := inString;
End;
Function SubStr;
Begin
SubStr := Copy(inString, numChars, StrSize );
End;
Function InStr;
Begin
InStr := Pos( Pattern, Text );
End;
function GetFrameFromString(TimeStr: string): dword;
//get dword of frames from 00:00:00.00
var
hour1,minute1,second1,frame1: dword;
s1: string;
i: integer;
begin
i := InStr(TimeStr,':');
hour1 := StrToInt(LeftStr(TimeStr, i-1));
s1 := RightStr(TimeStr, Length(TimeStr)-i); //00:00.00
minute1 := StrToInt(LeftStr(s1, 2));
s1 := RightStr(s1, Length(s1)-3); //00.00
second1 := StrToInt(LeftStr(s1, 2));
s1 := RightStr(s1, Length(s1)-3); //00
frame1 := StrToInt(s1);
Result := DWORD(DWORD(hour1)*3600 + DWORD(minute1)*60 + DWORD(second1)) //second
*FPS + frame1;
end;
function GetSecondFromString(TimeStr: string): dword;
//get dword of frames from 00:00:00
var
hour1,minute1,second1: dword;
s1: string;
i :integer;
begin
i := InStr(TimeStr,':');
hour1 := StrToInt(LeftStr(TimeStr, i-1));
s1 := RightStr(TimeStr, Length(TimeStr)-i); //00:00.00
minute1 := StrToInt(LeftStr(s1, 2));
s1 := RightStr(s1, Length(s1)-3); //00.00
second1 := StrToInt(LeftStr(s1, 2));
Result := DWORD(DWORD(hour1)*3600 + DWORD(minute1)*60 + DWORD(second1));
end;
function GetStringFromFrame(frames: dword): string;
var
ttt: dword;
frameStr,hourStr,minuteStr,secondStr: string;
begin
ttt := frames mod FPS;
frameStr := IntToStr(ttt);
if Length(frameStr)<2 then frameStr := '0'+frameStr;
ttt := (frames div FPS) mod 60;
secondStr := IntToStr(ttt);
if Length(secondStr)<2 then secondStr := '0'+secondStr;
ttt := ((frames div FPS) div 60) mod 60;
minuteStr := IntToStr(ttt);
if Length(minuteStr)<2 then minuteStr := '0'+minuteStr;
ttt := (frames div FPS) div 3600;
hourStr := IntToStr(ttt);
if Length(hourStr)<2 then hourStr := '0'+hourStr;
Result := hourStr+':'+minuteStr+':'+secondStr+'.'+frameStr;
end;
function ChInStr(str: string): boolean;
var
i: integer;
begin
Result := False;
for i:=1 to Length(str) do
begin
if ((str[i]<='Z') and (str[i]>='A'))
or ((str[i]<='z') and (str[i]>='a'))
or ((str[i]<='9') and (str[i]>='0'))
or (str[i]='~')
or (str[i]='_')
or (str[i]='.')
then continue
else begin
Result := True;
break;
end;
end;
end;
function IsDigit(str: string): boolean;
var
i: integer;
begin
Result := True;
for i:=1 to Length(str) do
begin
if (str[i]>'9') or (str[i]<'0') then
begin
Result := False;
break;
end;
end;
end;
function GetMaxInTwo(CanShu01,CanShu02:Double):Double; //判斷兩個(gè)整數(shù)大小返回大值
begin
if CanShu01 > CanShu02 then
Result:=CanShu01
else
Result:=CanShu02;
end; {判斷兩各整數(shù)大小返回大值}
function GetMinInTwo(CanShu01,CanShu02:Double):Double; //判斷兩個(gè)整數(shù)大小返回小值
begin
if CanShu01 < CanShu02 then
Result:=CanShu01
else
Result:=CanShu02;
end; {判斷兩各整數(shù)大小返回小值}
function GetWindowsDirectory():String; //返回Windows 的啟動(dòng)路徑
var
WinBoot:string;
begin
try
SetLength(WinBoot,256);
Windows.GetWindowsDirectory(PChar(WinBoot),256);
SetLength(WinBoot,StrLen(PChar(WinBoot)));
Result:=WinBoot;
except
PubUnit.ErrorMsgBox;
end;
end;
function GetApplicationDirectory():String; //返回應(yīng)用程序EXE文件的啟動(dòng)目錄
begin
try
Result:=ExtractFilePath(Application.ExeName);
except
PubUnit.ErrorMsgBox;
end;
end;
function SetODBCConfig(DateFilePath,ODBCName:String):Boolean; //動(dòng)態(tài)配置ODBC(Access97,2000)
var
RegisterTemp:TRegistry;
bData : Array[0..0] of byte;
begin
RegisterTemp:=TRegistry.Create;
with registerTemp do
begin
RootKey:=HKEY_LOCAL_MACHINE;//設(shè)置根鍵值為HKEY_LOCAL_MACHINE
if OpenKey('Software\ODBC\ODBC.INI\ODBC Data Sources',True) then
begin //注冊一個(gè)DSN名稱
WriteString(ODBCName,'Microsoft Access Driver (*.mdb)');
end
else
begin//創(chuàng)建鍵值失敗
Application.MessageBox('增加ODBC數(shù)據(jù)源失敗','提示信息',0+48);
Result:=False;
exit;
end;
CloseKey;
if OpenKey('Software\ODBC\ODBC.INI\'+ODBCName,True) then
begin
WriteString('DBQ',DateFilePath);//數(shù)據(jù)庫目錄
WriteString('Description',ODBCName);//數(shù)據(jù)源描述
WriteString('Driver',GetWindowsDirectory()+'\System\Odbcjt32.dll');//驅(qū)動(dòng)程序DLL文件
WriteInteger('DriverId', 25 );//驅(qū)動(dòng)程序標(biāo)識(shí)
WriteString('FIL',ODBCName);//Filter依據(jù)
WriteInteger('SafeTransaction',0);//支持的事務(wù)操作數(shù)目
WriteString('UID','admin');//用戶名稱
bData[0] := 0;
WriteBinaryData('Exclusive',bData,1);//非獨(dú)占方式
WriteBinaryData('ReadOnly',bData,1);//非只讀方式
end
else//創(chuàng)建鍵值失敗
begin
Application.MessageBox('增加ODBC數(shù)據(jù)源失敗','提示信息',0+48);
Result:=False;
exit;
end;
CloseKey;
//寫入DSN數(shù)據(jù)庫引擎配置信息
if OpenKey('Software\ODBC\ODBC.INI\'+ODBCName+'\Engines\Jet',True) then
begin
WriteString('ImplicitCommitSync','Yes');
WriteInteger('MaxBufferSize',512);//緩沖區(qū)大小
WriteInteger('PageTimeout',10);//頁超時(shí)
WriteInteger('Threads',3);//支持的線程數(shù)目
WriteString('UserCommitSync','Yes');
end
else//創(chuàng)建鍵值失敗
begin
Application.MessageBox('增加ODBC數(shù)據(jù)源失敗','提示信息',0+48);
Result:=False;
exit;
end;
CloseKey;
Result:=True;
Free;
end;
end;
function GetDiskFree(DiskName:Byte):String; //判斷磁盤剩余空間
var
Temp:Double;
begin
Temp:=DiskFree(DiskName)/1024/1024;
if Temp < 0 then
Application.MessageBox('您輸入了無效的盤符代號(hào),1:A 2:B 3:C','提示信息',0+48)
else
Result:=FloatToStr(Temp)+'兆';
end;
function GetDiskSize(DiskName:Byte):String; //判斷磁盤總空間
var
Temp:Double;
begin
Temp:=DiskSize(DiskName)/1024/1024;
if Temp < 0 then
Application.MessageBox('您輸入了無效的盤符代號(hào),1:A 2:B 3:C','提示信息',0+48)
else
Result:=FloatToStr(Temp)+'兆';
end;
function GetRoundInt(CustomDouble:Double):Double; //得到四舍五入結(jié)果
var
Temp:Double;
begin
Temp:=Int(CustomDouble);
Temp:=Temp+1;
Temp:=Temp-CustomDouble;
if Temp >0.5 then
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -