📄 usysfunc.pas
字号:
var mids1: string;
i: integer;
midFileList: tFileListBox;
begin
midFileList := tFileListBox.CreateParented(Application.MainForm.Handle);
try
with midFileList do begin
ApplyFilePath(filenames);
Update;
for i := 1 to items.count do begin
mids1 := trim(items.strings[i - 1]);
deletefile(mids1);
end;
end;
finally
midFileList.Free;
end;
end;
//----------------------------------------------------//
// procedure mycopy //
// 文件拷贝命令。 //
// 张新民，2008.12.11 //
//----------------------------------------------------//
procedure MyCopy(const sour, dest: string);
var pstr1, pstr2: pchar;
midi: integer;
begin
pstr1 := nil;
pstr2 := nil;
try
midi := length(sour) + 1;
pstr1 := stralloc(midi);
midi := length(dest) + 1;
pstr2 := stralloc(midi);
strpcopy(pstr1, sour);
strpcopy(pstr2, dest);
copyfile(pstr1, pstr2, false);
finally
strdispose(pstr1);
strdispose(pstr2);
end;
end;
//=======================================================================
// 名称: MsgDlg
// 说明: 对话框函数，可以显示标题、文本，选择显示的按钮和图标
// 参数： Text：String
// 被显示的信息文本
// Flags：Word
// 设置按钮和图标的显示状态
// -设置出现在对话框内的按钮
// MB_ABORTRETRYIGNORE Abort, Retry, and Ignore.
// MB_OK OK. This is the default.
// MB_OKCANCEL OK and Cancel.
// MB_RETRYCANCEL Retry and Cancel.
// MB_YESNO Yes and No.
// MB_YESNOCANCEL Yes, No, and Cancel.
// -设置出现在对话框内的图标
// MB_ICONEXCLAMATION,MB_ICONWARNING
// An exclamation-point icon.
// MB_ICONINFORMATION, MB_ICONASTERISK
// An icon consisting of a lowercase
// letter i in a circle.
// MB_ICONQUESTION A question-mark icon.
// MB_ICONSTOP,MB_ICONERROR,MB_ICONHAND
// A stop-sign icon.
// -设置对话框的缺省按钮
// MB_DEFBUTTON1 The first button is default.MB_DEFBUTTON1
// is the default unless MB_DEFBUTTON2,
// MB_DEFBUTTON3, or MB_DEFBUTTON4 is specified.
// MB_DEFBUTTON2 The second button is default.
// MB_DEFBUTTON3 The third button is default.
// MB_DEFBUTTON4 The fourth button is default.
// -设置对话框的模式
// MB_APPLMODAL The user must respond to the message box.
// MB_SYSTEMMODAL Same as MB_APPLMODAL except that the
// message box has the WS_EX_TOPMOST style.
// MB_TASKMODAL Same as MB_APPLMODAL except that all the
// top-level windows belonging to the current
// task are disabled if the hWnd parameter is
// NULL.
// -特殊设置
// MB_DEFAULT_DESKTOP_ONLY
// The desktop currently receiving input must be a default
// desktop; otherwise, the function fails.
// MB_HELP
// Adds a Help button to the message box.
// MB_RIGHT
// The text is right-justified.
// MB_RTLREADING
// Displays message and caption text using right-to-left
// reading order on Hebrew and Arabic systems.
// MB_SETFOREGROUND
// The message box becomes the foreground window.
// Internally, Windows calls the SetForegroundWindow
// function for the message box.
// MB_TOPMOST
// The message box is created with the WS_EX_TOPMOST
// window style.
// MB_SERVICE_NOTIFICATION
// Windows NT only: The caller is a service notifying the
// user of an event. The function displays a message box
// on the current active desktop, even if there is no user
// logged on to the computer.
// MB_SERVICE_NOTIFICATION_NT3X
// Windows NT only: This value corresponds to the value
// defined for MB_SERVICE_NOTIFICATION for Windows NT
// version 3.51.
// 返回： Word：
// mrNone =0 No Enough Memory
// mrOk= IDOK =1 The user chose the OK button.
// mrCancel=IDCANCEL =2 The user chose the Cancel button.
// mrAbort= IDABORT =3 The user chose the Abort button.
// mrRetry= IDRETRY =4 The user chose the Retry button.
// mrIgnore=IDIGNORE =5 The user chose the Ignore button.
// mrYes= IDYES =6 The user chose the Yes button.
// mrNo= IDNO =7 The user chose the No button.
// mrAll= mrNo + 1
// 编程: 张新民，2008.12.11
//=======================================================================
function MsgDlg(const sText: string; wFlags: Word): Word;
var
szText: PChar;
szCaption: PChar;
begin
szText := StrAlloc(Length(sText) + 1);
szCaption := StrAlloc(Length(Application.Title) + 1);
try
StrPCopy(szText, sText);
StrPCopy(szCaption, Application.Title);
Result := Application.MessageBox(szText, szCaption, wFlags);
finally
StrDispose(szText);
StrDispose(szCaption);
end;
end;
//=======================================================================
// 名称: ConfirmDlg
// 说明: 确认对话框，包含Yes and No按钮。
// 参数： sText：String
// 被显示的提示信息
// 返回： Boolean
// True：确认
// False：否认
// 编程: 张新民，2008.12.11
//=======================================================================
function ConfirmDlg(const sText: string): Boolean;
begin
Result := MsgDlg(sText, MB_ICONQUESTION + MB_YESNO) = mrYes;
end;
//=======================================================================
// 名称: ConfirmDlgWithCancel
// 说明: 确认对话框，包含Yes and No and Cancel按钮。
// 参数： sText：String
// 被显示的提示信息
// 返回： Word：
// mrYes，mrNo，mrCancel
// 编程: 张新民，2008.12.11
//=======================================================================
function ConfirmDlgWithCancel(const sText: string): Word;
begin
Result := MsgDlg(sText, MB_ICONQUESTION + MB_YESNOCANCEL)
end;
//=======================================================================
// 名称: RetryDlg
// 说明: 重试对话框，包含Retry and Cancel按钮。
// 参数： sText：String
// 被显示的提示信息
// 返回： Boolean
// 编程: 张新民，2008.12.11
//=======================================================================
function RetryDlg(const sText: string): Boolean;
begin
Result := MsgDlg(sText, MB_ICONQUESTION + MB_RETRYCANCEL) = mrRetry;
end;
//=======================================================================
// 名称: ErrorMsgBox
// 说明: 出错信息对话框
// 参数： sErrMsg：String
// 被显示的提示信息
// 返回： 无
// 编程: 张新民，2008.12.11
//=======================================================================
procedure ErrorMsgBox(const sErrMsg: string);
begin
MsgDlg(sErrMsg, MB_ICONERROR + MB_OK);
end;
//=======================================================================
// 名称: WarningMsgBox
// 说明: 警告信息对话框
// 参数： sWarningMsg：String
// 被显示的提示信息
// 返回： 无
// 编程: 张新民，2008.12.11
//=======================================================================
procedure WarningMsgBox(const sWarningMsg: string);
begin
MsgDlg(sWarningMsg, MB_ICONWARNING + MB_OK);
end;
//=======================================================================
// 名称: InforMsgBox
// 说明: 提示信息对话框
// 参数： sInforMsg：String
// 被显示的提示信息
// 返回： 无
// 编程: 张新民，2008.12.11
//=======================================================================
procedure InforMsgBox(const sInforMsg: string);
begin
MsgDlg(sInforMsg, MB_ICONINFORMATION + MB_OK);
end;
//=======================================================================
// 名称: StrToFloatDef
// 说明: 把字符串转换成浮点数，如果转换失败，则返回缺省值。
// 参数： s：String
// 被转换的字符串
// eDef：Extended
// 缺省值
// 返回： Extended
// 编程: 张新民，2008.12.11
//=======================================================================
function StrToFloatDef(const s: string; eDef: Extended): Extended;
begin
try
Result := StrToFloat(s);
except
Result := eDef;
end;
end;
//=======================================================================
// 名称: MinExtOfArray
// 说明: 取一个浮点数数组中的最小元素的值
// 参数： a：Array of Extened
// 浮点数组
// 返回： Extended
// 编程: 张新民，2008.12.11
//=======================================================================
function MinExtOfArray(const a: array of Extended): Extended;
var
i: Integer;
begin
Result := a[Low(a)];
for i := Low(a) + 1 to High(a) do
if a[i] < Result then
Result := a[i];
end;
//=======================================================================
// 名称: MaxExtOfArray
// 说明: 取一个浮点数数组中的最大元素的值
// 参数： a：Array of Extened
// 浮点数组
// 返回： Extended
// 编程: 张新民，2008.12.11
//=======================================================================
function MaxExtOfArray(const a: array of Extended): Extended;
var
i: Integer;
begin
Result := a[Low(a)];
for i := Low(a) + 1 to High(A) do
if a[i] > Result then
Result := a[i];
end;
//=======================================================================
// 名称: MinIntOfArray
// 说明: 取一个整数数组中的最小元素的值
// 参数： a：Array of Integer
// 整数数组
// 返回： Integer
// 编程: 张新民，2008.12.11
//=======================================================================
function MinIntOfArray(const a: array of Integer): Integer;
var
i: Integer;
begin
Result := a[Low(a)];
for i := Low(a) + 1 to High(a) do
if a[i] < Result then
Result := a[i];
end;
//=======================================================================
// 名称: MaxIntOfArray
// 说明: 取一个整数数组中的最大元素的值
// 参数： a：Array of Integer
// 整数数组
// 返回： Integer
// 编程: 张新民，2008.12.11
//=======================================================================
function MaxIntOfArray(const a: array of Integer): Integer;
var
i: Integer;
begin
Result := a[Low(a)];
for i := Low(a) + 1 to High(a) do
if a[i] > Result then
Result := a[i];
end;
//=======================================================================
// 名称: RoundToCurrency
// 说明: 实数四舍五入为货币类型
// 参数： rValue： Real
// 被处理的实数
// nPrecision： Byte
// 精度，0-4
// 返回： Currency：四舍五入后的值
// 编程: 张新民，2008.12.11
//=======================================================================
function RoundToCurrency(const rValue: Real; nPrecision: Byte): Currency;
var
mul: Integer;
begin
mul := 1;
if nPrecision > 4 then
nPrecision := 4;
while nPrecision > 0 do
begin
mul := mul * 10;
Dec(nPrecision);
end;
//Result:=Round(Result/mul); round 函数并不是四舍五入，当判断位是五时，他根据结果是否为偶数来判断是否‘入’
if rValue > 0 then
Result := rValue * mul + 0.5
else
Result := rValue * mul - 0.5;
Result := Trunc(Result) / mul;
end;
//=======================================================================
// 名称: RoundToCurrency
// 说明: /保留指定位数的小数，舍弃其余小数位
// 参数： rValue： Real
// 被处理的实数
// nPrecision： Byte
// 精度，0-4
// 返回： Currency：四舍五入后的值
// 编程: 张新民，2008.12.11
//=======================================================================
function TruncToCurrency(const rValue: Real; nPrecision: Byte): Currency;
var
mul: Integer;
begin
mul := 1;
if nPrecision > 4 then
nPrecision := 4;
while nPrecision > 0 do
begin
mul := mul * 10;
Dec(nPrecision);
end;
Result := rValue * mul;
// Result:=Trunc(rValue*mul); Trunc的
Result := Trunc(Result) / mul;
end;
//=======================================================================
// 名称: StripEndChars
// 说明: 除去一个字符串末尾的任何指定字符Ch。（空格：#32）
// RTrim增强
// 参数： s：String
// 需要处理的字符串
// ch： Char
// 被指定删除的字符
// 返回： String
// 处理后得到的字符串
// 编程: 张新民，2008.12.11
//=======================================================================
function StripEndChars(s: string; ch: Char): string;
var
i: Integer;
begin
i := Length(s);
while (Length(s) > 0) and (s[i] = ch) do
begin
Delete(S, i, 1);
Dec(i);
end;
Result := s;
end;
//=======================================================================
// 名称: StripFrontChars
// 说明: 除去一个字符串开头的任何指定字符Ch。（空格：#32）
// LTrim增强
// 参数： s：String
// 需要处理的字符串
// ch： Char
// 被指定删除的字符
// 返回： String
// 处理后得到的字符串
// 编程: 张新民，2008.12.11
//=======================================================================
function StripFrontChars(s: string; ch: Char): string;
begin
while (Length(s) > 0) and (s[1] = ch) do
s := Copy(s, 2, Length(s) - 1);
Result := s;
end;
//=======================================================================
// 名称: StripFirstWord
// 说明: 删除一个字符串中的第一个词。
// 参数： s：String
// 需要处理的字符串
// 返回： String
// 处理后得到的字符串
// 编程: 张新民，2008.12.11
//=======================================================================
function StripFirstWord(s: string): string;
var
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -