?? delphi常用函數庫.txt
字號:
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
try
AssignFile(FileVar, FileName);
Reset(FileVar);
Result := FileSize(FileVar);
CloseFile(FileVar);
except
Result := 0;
end;
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;
{ 功能說明:查找一個路徑下的所有文件。
參數:path:路徑, filter:文件擴展名過濾, FileList:文件列表, ContainSubDir:是否包含子目錄}
procedure
FindFileList(Path,Filter:string;FileList:TStrings;ContainSubDir:Boolean);
var
FSearchRec,DSearchRec:TSearchRec;
FindResult:shortint;
begin
FindResult:=FindFirst(path+Filter,sysutils.faAnyFile,FSearchRec);
try
while FindResult=0 do
begin
FileList.Add(FSearchRec.Name);
FindResult:=FindNext(FSearchRec);
end;
if ContainSubDir then
begin
FindResult:=FindFirst(path+Filter,faDirectory,DSearchRec);
while FindResult=0 do
begin
if ((DSearchRec.Attr and faDirectory)=faDirectory)
and (DSearchRec.Name<>'.') and (DSearchRec.Name<>'..') then
FindFileList(Path,Filter,FileList,ContainSubDir);
FindResult:=FindNext(DSearchRec);
end;
end;
finally
FindClose(FSearchRec);
end;
end;
//返回一文本文件的行數
function Txtline(const txt: string): integer;
var
F : TextFile;
StrLine : string;
line : Integer;
begin
AssignFile(F, txt);
Reset(F);
Line := 0;
while not SeekEof(f) do
begin
if SeekEoln(f) then
Readln;
Readln(F, StrLine);
if SeekEof(f) then
break
else
inc(Line);
end;
CloseFile(F);
Result := Line;
end;
//Html文件轉化成文本文件
function Html2Txt(htmlfilename: string): string;
var Mystring:TStrings;
s,lineS:string;
line,Llen,i,j:integer;
rloop:boolean;
begin
rloop:=False;
Mystring:=TStringlist.Create;
s:='';
Mystring.LoadFromFile(htmlfilename);
line:=Mystring.Count;
try
for i:=0 to line-1 do
Begin
lineS:=Mystring[i];
Llen:=length(lineS);
j:=1;
while (j<=Llen)and(lineS[j]=' ')do
begin
j:=j+1;
s:=s+' ';
End;
while j<=Llen do
Begin
if lineS[j]='<'then
rloop:=True;
if lineS[j]='>'then
Begin
rloop:=False;
j:=j+1;
continue;
End;
if rloop then
begin
j:=j+1;
continue;
end
else
s:=s+lineS[j];
j:=j+1;
End;
s:=s+#13#10;
End;
finally
Mystring.Free;
end;
result:=s;
end;
// 文件打開方式
function OpenWith(const FileName: string): Integer;
begin
Result := ShellExecute(Application.Handle, 'open', 'rundll32.exe',
PChar('shell32.dll,OpenAs_RunDLL ' + FileName), '', SW_SHOW);
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_OK + 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;
//窗體漸變
procedure SetWindowAnimate(Sender : TForm; IsSetAni : bool);
var
pOSVersionInfo : OSVersionInfo;
begin
pOSVersionInfo.dwOSVersionInfoSize := sizeof(OSVersionInfo);
GetVersionEx(pOSVersionInfo);
if pOSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then
begin
if IsSetAni then
AnimateWindow(Sender.Handle,444,AW_HIDE or AW_BLEND);
end
else
if IsSetAni then
begin
AnimateWindow(Sender.Handle,444,AW_HIDE or AW_CENTER);
end;
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;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -