?? pubunit.~pas
字號:
//******************************************************************************
// 模塊簡介 //
// 本模塊封裝了Delphi編程過程中的許多函數和Windows API函數有數學,字符, //
//多媒體等方方面面.通過調用本模塊能加速您的程序開發速度.本模塊是我多年的 //
//編程技巧總結并且沒有任何限制喜歡的朋友可以任意使用和傳遞復制. //
// 作者:朱曉磊 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; //判斷兩個整數大小返回大值
function GetMinInTwo(CanShu01,CanShu02:Double):Double; //判斷兩個整數大小返回小值
function GetWindowsDirectory():String; //返回Windows 的啟動路徑
function GetApplicationDirectory():String; //返回應用程序EXE文件的啟動目錄
function SetODBCConfig(DateFilePath,ODBCName:String):Boolean; //動態配置ODBC(Access97,2000)
function GetDiskFree(DiskName:Byte):String; //判斷磁盤剩余空間
function GetDiskSize(DiskName:Byte):String; //判斷磁盤總空間
function GetRoundInt(CustomDouble:Double):Double; //得到四舍五入結果
function SetDoubleFormat(CustomDouble:Double;XiaoShuWei:Integer):Double; //自定義小數位
function GetHostIP():TStrings; //獲取本主機的IP地址
function GetUserName():AnsiString; //取得用戶名稱
function GetWindowsProductID(): string; // 取得 Windows 產品序號
//=====================================================================================================================
//公共過程原型定義區
procedure ErrorMsgBox(); //全程異常錯誤消息過程
procedure SetButtonCaptionAToB(CustomButton:TButton;AString,BString:String); //按鈕標題二互換
procedure SetFormPicture(CustomForm:TForm;PictureFile:String); //設置窗口的背景圖像
procedure SetDBGridPicture(CustomDBGrid:TDBGrid;PictureFile:String); //設置窗口的背景圖像
procedure SetCDRomOpen(); //打開電腦光驅
procedure SetCDromClose(); //關閉電腦光驅
procedure SetWaveLeft(Volume:Integer); //設置聲音為左聲道(Integer 1~13)
procedure SetWaveRigth(Volume:Integer); //設置聲音為右聲道(Integer 1~13)
procedure SetWaveBalance(Volume:Integer);//設置聲音為雙聲道(Integer 1~13)
procedure SetWindowsReboot(); //設置Windows 重新啟動（電腦不會斷電）
procedure SetWindowsClose(); //設置 Windows 關閉(電腦將斷電)
procedure IsEditNumber(CustomEdit:TEdit); //判斷文本框中的數據是否為數字
procedure IsEditEmpty(CustomEdit:TEdit); //判斷文本框中是否委控制
procedure SetTextXuanZhuan(OutForm:TForm;FontName,FontCaption:String;FontSize,FontOutTop,FontOutLeft,
FontOutJiaoDu:Integer;FontColor:TColor); //設置輸出字體的旋轉效果
procedure SetWallPicture(BmpFileName:String); //動態更改壁紙
procedure SetFormRounder(CustomForm:TForm;FormLeft,FormTop,FormWidth,
FormHeight,LeftHuDu,RightHuDu:Integer); //園腳窗口
procedure SetTaskBarHide(); //隱藏任務欄
procedure SetTaskBarShow(); //現實任務欄
procedure SetPicture90(YuanImage,GuoImage:TImage); // 旋轉圖像90 度
procedure SetPicture180(YuanImage,GuoImage:TImage); //旋轉圖像180 度
procedure SetPicture270(YuanImage,GuoImage:TImage); // 旋轉圖像270 度
procedure ExecuteExeApp(CustomExeName,CustomFileName:String); //運行外部應用程序
procedure SetApplicationHide(); //隱藏應用程序在任務欄上的顯示
procedure SetSystemMenu(CustomForm:TForm;MenuName:String); //添加系統菜單
procedure CopyFileDirectory(Handle:THandle;OldDirectory,NewDirectory:String);//拷貝整個目錄
procedure DeleteFileDirectory(Handle:THandle;OldDirectory:String);//刪除整個目錄
//=====================================================================================================================
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; //判斷兩個整數大小返回大值
begin
if CanShu01 > CanShu02 then
Result:=CanShu01
else
Result:=CanShu02;
end; {判斷兩各整數大小返回大值}
function GetMinInTwo(CanShu01,CanShu02:Double):Double; //判斷兩個整數大小返回小值
begin
if CanShu01 < CanShu02 then
Result:=CanShu01
else
Result:=CanShu02;
end; {判斷兩各整數大小返回小值}
function GetWindowsDirectory():String; //返回Windows 的啟動路徑
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; //返回應用程序EXE文件的啟動目錄
begin
try
Result:=ExtractFilePath(Application.ExeName);
except
PubUnit.ErrorMsgBox;
end;
end;
function SetODBCConfig(DateFilePath,ODBCName:String):Boolean; //動態配置ODBC(Access97,2000)
var
RegisterTemp:TRegistry;
bData : Array[0..0] of byte;
begin
RegisterTemp:=TRegistry.Create;
with registerTemp do
begin
RootKey:=HKEY_LOCAL_MACHINE;//設置根鍵值為HKEY_LOCAL_MACHINE
if OpenKey('Software\ODBC\ODBC.INI\ODBC Data Sources',True) then
begin //注冊一個DSN名稱
WriteString(ODBCName,'Microsoft Access Driver (*.mdb)');
end
else
begin//創建鍵值失敗
Application.MessageBox('增加ODBC數據源失敗','提示信息',0+48);
Result:=False;
exit;
end;
CloseKey;
if OpenKey('Software\ODBC\ODBC.INI\'+ODBCName,True) then
begin
WriteString('DBQ',DateFilePath);//數據庫目錄
WriteString('Description',ODBCName);//數據源描述
WriteString('Driver',GetWindowsDirectory()+'\System\Odbcjt32.dll');//驅動程序DLL文件
WriteInteger('DriverId', 25 );//驅動程序標識
WriteString('FIL',ODBCName);//Filter依據
WriteInteger('SafeTransaction',0);//支持的事務操作數目
WriteString('UID','admin');//用戶名稱
bData[0] := 0;
WriteBinaryData('Exclusive',bData,1);//非獨占方式
WriteBinaryData('ReadOnly',bData,1);//非只讀方式
end
else//創建鍵值失敗
begin
Application.MessageBox('增加ODBC數據源失敗','提示信息',0+48);
Result:=False;
exit;
end;
CloseKey;
//寫入DSN數據庫引擎配置信息
if OpenKey('Software\ODBC\ODBC.INI\'+ODBCName+'\Engines\Jet',True) then
begin
WriteString('ImplicitCommitSync','Yes');
WriteInteger('MaxBufferSize',512);//緩沖區大小
WriteInteger('PageTimeout',10);//頁超時
WriteInteger('Threads',3);//支持的線程數目
WriteString('UserCommitSync','Yes');
end
else//創建鍵值失敗
begin
Application.MessageBox('增加ODBC數據源失敗','提示信息',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('您輸入了無效的盤符代號,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('您輸入了無效的盤符代號,1:A 2:B 3:C','提示信息',0+48)
else
Result:=FloatToStr(Temp)+'兆';
end;
function GetRoundInt(CustomDouble:Double):Double; //得到四舍五入結果
var
Temp:Double;
begin
Temp:=Int(CustomDouble);
Temp:=Temp+1;
Temp:=Temp-CustomDouble;
if Temp >0.5 then
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -