/// <summary>
/// 界面操作相关函数集
/// </summary>
/// <author>Fantomas</author>
/// <date>2005-12-1</date>
unit BizProcess;
interface
uses
Windows, Classes, Messages, SysUtils, StrUtils, StdCtrls, Controls, Forms, DB, Variants,
DateUtils, ShlObj, ActiveX, ComCtrls, ShellAPI, Graphics, IdStack, uSharedVar;
{检查数据集指定的数据域当前值是否重复：参数IsInclude表示查找中第一次遇到value值
是否跳过并继续查找，即第一次查找时是否允许包含该值。该参数在数据感知时使用。}
function ValueIsRepeat(Dataset: TDataSet; field, value: string; IsInclude: Boolean = False): Boolean;
{检查数据集内指定的数据域是否有空值}
function IsExistNull(ADataset: TDataSet; const AFields: array of string): Boolean;
{在数据集内取数字号码列表如：1-8，10，18，21-88}
function GetNumberList(ADataSet: TDataSet; NumberCol: string): string;
{从数据集Connectionstring中获取ConnSQL：[ODBC] [ODBC;Driver=SQL Server;UID=sa;PWD=83528511963;Server=sjserver;DataBase=his40] }
function GetConnSQL(Connectionstr: string): string;
{检查AContainer容器内所有TEdit和TComboBox类型的控件的值，为空则返回该控件Hint值
注：以上两种类型的控件必须有预设的Hint值（该值最好能表示该控件的功能）}
function CheckNullValue(AContainer: TWinControl): string;
{清空AContainer容器内的标签内容}
procedure ClearLabel(AContainer: TWinControl; Atag: Integer);
{清空AContainer容器内的编辑文本}
procedure ClearText(AContainer: TWinControl; Atag: Integer);
{控制编辑控件的编辑开关}
procedure EnableEdit(AContainer: TWinControl; Atag: Integer; Enable: Boolean);
{设置下一个光标}
procedure ToNext(Sender: TObject; AContainer: TWinControl; CheckTabStop, OnLast: Boolean);
{查找控件}
function FindControlByTabOrder(AContainer: TWinControl; ATabOrder: Integer): TWinControl;
{设置输入法}
procedure SetImeName(AContainer: TWinControl; Atag: Integer; AImeName: string);
{锁定鼠标}
procedure LockCursorInRect(Handle: HWND; Bound: TRect);
{解除鼠标锁}
procedure UnLockCursorInRect;
{现金输入}
procedure MoneyInput(Sender: TObject; var Key: Char; APrecision: Integer = 2);
{数字输入}
procedure DigitalInput(Sender: TObject; var Key: Char);
{双精度数值转换为货币字符值}
function FloatToCurrStr(Value: Extended): string;
{货币字符值转换为双精度数值}
function CurrStrToFloat(const CurrStr: string): Extended;
{字符串转换为货币字符值}
function StringToCurrStr(str: string): string;
{货币字符值转换为字符串}
function CurrStrToString(Currstr: string): string;
function StringOfStr(str: string; count: Integer): string;
function DateToInt(const d: Tdate): integer;
function IntToDate(const Value: Integer): Tdate;
function IntDateToStrDate(const Value: Integer): string;
function GetBegMonthDT(ADT: TDate): TDate;
function GetMidMonthDT(ADT: TDate): TDate;
function GetLstMonthDT(ADT: TDate): TDate;
function SelectDirectoryEx(const Caption: string; const Root: WideString;
out Directory: string): Boolean;
procedure GetFileList(SDraw: Boolean; FileDir, ExtName: string; var ListItems: TListItems; sList: TStringList);
procedure GetFileList1(SDraw: Boolean; FileDir, ExtName: string; var ListItems: TListItems);
procedure GetFileList2(SDraw: Boolean; FileDir, ExtName: string; var ListItems: TListItems);
function GetFileICON(FileName: string): THandle;
function GetHostName: string;
function GetLocalIP: string;
function SuperiorDir(Dir: string; Step: Integer): string;
implementation
//Dir指定的目录返回Step步
function SuperiorDir(Dir: string; Step: Integer): string;
begin
Dir := ReverseString(Dir);
while Step > 0 do
begin
Dec(Step);
Delete(Dir, 1, Pos('\', Dir));
end;
Result := ReverseString(Dir);
end;
function GetLocalIP: string;
var
s: TIdStack;
begin
{$IFDEF ver150}
s := TIdStack.CreateStack;
{$ENDIF}
{$IFDEF ver180}
s := TIdStack.Create;
{$ENDIF}
Result := s.LocalAddress; //这里就是本机的IP地址
s.free;
end;
function GetHostName: string;
var
ComputerName: array[0..MAX_COMPUTERNAME_LENGTH + 1] of char;
Size: Cardinal;
begin
result := '';
Size := MAX_COMPUTERNAME_LENGTH + 1;
GetComputerName(ComputerName, Size);
Result := StrPas(ComputerName);
end;
function GetFileICON(FileName: string): THandle;
var
FileInfo: TSHFileInfo;
begin
FileInfo.iIcon := 0;
SHGetFileInfo(PChar(FileName), 0, FileInfo, SizeOf(TSHFileInfo), SHGFI_ICON or SHGFI_SMALLICON);
Result := FileInfo.hIcon;
end;
function BrowseCallbackProc(Handle: HWND;
uMsg: UINT; lParam: Cardinal;
lpData: Cardinal): integer; stdcall;
var
dirbuf: array[0..Max_Path - 1] of Char;
begin
Result := 0;
if uMsg = BFFM_INITIALIZED then
begin
if GetCurrentDirectory(Max_path, @dirbuf) > 0 then
// WParam is TRUE since you are passing a path.
// It would be FALSE if you were passing a pidl.
SendMessage(Handle, BFFM_SETSELECTION, 1, LongInt(@Dirbuf));
end
else if uMsg = BFFM_SELCHANGED then
begin
// Set the status window to the currently selected path.
if SHGetPathFromIDList(PItemIDList(lParam), @Dirbuf) then
SendMessage(Handle, BFFM_SETSTATUSTEXT, 0, LongInt(@Dirbuf));
end;
end;
function SelectDirectoryEx(const Caption: string; const Root: WideString;
out Directory: string): Boolean;
var
WindowList: Pointer;
BrowseInfo: TBrowseInfo;
Buffer: PChar;
RootItemIDList, ItemIDList: PItemIDList;
ShellMalloc: IMalloc;
IDesktopFolder: IShellFolder;
Eaten, Flags: LongWord;
begin
Result := False;
Directory := '';
FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
begin
Buffer := ShellMalloc.Alloc(MAX_PATH);
try
RootItemIDList := nil;
if Root <> '' then
begin
SHGetDesktopFolder(IDesktopFolder);
IDesktopFolder.ParseDisplayName(Application.Handle, nil,
POleStr(Root), Eaten, RootItemIDList, Flags);
end;
with BrowseInfo do
begin
hwndOwner := Application.Handle;
pidlRoot := RootItemIDList;
pszDisplayName := Buffer;
lpszTitle := PChar(Caption);
ulFlags := BIF_RETURNONLYFSDIRS or BIF_STATUSTEXT; //包含 BIF_STATUSTEXT
lpfn := @BrowseCallbackProc; //回调函数
end;
WindowList := DisableTaskWindows(0);
try
ItemIDList := ShBrowseForFolder(BrowseInfo);
finally
EnableTaskWindows(WindowList);
end;
Result := ItemIDList <> nil;
if Result then
begin
ShGetPathFromIDList(ItemIDList, Buffer);
ShellMalloc.Free(ItemIDList);
Directory := Buffer;
end;
finally
ShellMalloc.Free(Buffer);
end;
end;
end;
function IntToSize(FileSize: Integer): string;
begin
if FileSize > 0 then
begin
FileSize := FileSize div 1024;
if FileSize = 0 then
FileSize := 1;
end;
Result := FormatFloat(',0 KB', FileSize);
end;
procedure GetFileList(SDraw: Boolean; FileDir, ExtName: string; var ListItems: TListItems; sList: TStringList);
var
colNames: TStringList;
Sear: TSearchrec;
Item: TListitem;
col: TListColumn;
loop: Integer;
ico: TIcon;
lstName: string;
begin
if SDraw then
begin
colNames := TStringList.Create;
colNames.CommaText := '名称,大小,修改时间,文件路径';
with TListView(ListItems.Owner) do
begin
Clear;
Columns.Clear;
for loop := 0 to colNames.Count - 1 do
begin
col := Columns.Add;
col.Caption := colNames.Strings[loop];
case loop of
0: col.Width := 150;
1:
begin
col.Width := 77;
col.Alignment := taRightJustify;
end;
2:
begin
col.Width := 114;
col.Alignment := taLeftJustify;
end;
3:
begin
col.Width := 150;
col.Alignment := taLeftJustify;
end;
end;
end;
ViewStyle := vsReport;
end;
colNames.Free;
end;
if findFirst(FileDir + '\*.' + ExtName, faDirectory, Sear) = 0 then
repeat
if sList.IndexOf(Sear.Name) > -1 then
begin
Item := ListItems.Add;
Item.Caption := Sear.Name;
Item.SubItems.Add(IntToSize(Sear.Size));
Item.SubItems.Add(FormatDateTime('yyyy-mm-dd hh:nn', FileDateToDateTime(Sear.Time)));
Item.SubItems.Add(FileDir);
end;
until findNext(Sear) <> 0;
lstName := Sear.Name;
findClose(Sear);
with TListView(ListItems.Owner) do
begin
if Assigned(SmallImages) then
begin
ico := TIcon.Create;
ico.Handle := GetFileICON(FileDir + '\' + lstName);
SmallImages.Clear;
SmallImages.InsertIcon(0, ico);
ico.Free;
end;
end;
end;
procedure GetFileList1(SDraw: Boolean; FileDir, ExtName: string; var ListItems: TListItems);
var
colNames: TStringList;
Sear: TSearchrec;
Item: TListitem;
col: TListColumn;
loop: Integer;
ico: TIcon;
lstName: string;
begin
if SDraw then
begin
colNames := TStringList.Create;
colNames.CommaText := '名称,大小,修改时间,文件路径';
with TListView(ListItems.Owner) do
begin
Clear;
Columns.Clear;
for loop := 0 to colNames.Count - 1 do
begin
col := Columns.Add;
col.Caption := colNames.Strings[loop];
case loop of
0: col.Width := 160;
1:
begin
col.Width := 77;
col.Alignment := taRightJustify;
end;
2:
begin
col.Width := 114;
col.Alignment := taLeftJustify;
end;
3:
begin
col.Width := 150;
col.Alignment := taLeftJustify;
end;
end;
end;
ViewStyle := vsReport;
end;
colNames.Free;
end;
if findFirst(FileDir + '\*.' + ExtName, faDirectory, Sear) = 0 then
repeat
//if sList.IndexOf(Sear.Name) > -1 then
//begin
Item := ListItems.Add;
Item.Caption := Sear.Name;
Item.SubItems.Add(IntToSize(Sear.Size));
Item.SubItems.Add(FormatDateTime('yyyy-mm-dd hh:nn', FileDateToDateTime(Sear.Time)));
Item.SubItems.Add(FileDir);
//end;
until findNext(Sear) <> 0;
lstName := Sear.Name;
findClose(Sear);
with TListView(ListItems.Owner) do
begin
if Assigned(SmallImages) then
begin
ico := TIcon.Create;
ico.Handle := GetFileICON(FileDir + '\' + lstName);
SmallImages.Clear;
SmallImages.InsertIcon(0, ico);
ico.Free;
end;
end;
end;
procedure GetFileList2(SDraw: Boolean; FileDir, ExtName: string; var ListItems: TListItems);
var
colNames: TStringList;
Sear: TSearchrec;
Item: TListitem;
col: TListColumn;
loop: Integer;
ico: TIcon;
lstName: string;
begin
if SDraw then
begin
colNames := TStringList.Create;
colNames.CommaText := '名称,大小,修改时间,文件路径';
with TListView(ListItems.Owner) do
begin
Clear;
Columns.Clear;
for loop := 0 to colNames.Count - 1 do
begin
col := Columns.Add;
col.Caption := colNames.Strings[loop];
case loop of
0: col.Width := 150;
1:
begin
col.Width := 77;
col.Alignment := taRightJustify;
end;
2:
begin
col.Width := 114;
col.Alignment := taLeftJustify;
end;
3:
begin
col.Width := 150;
col.Alignment := taLeftJustify;
end;
end;
end;
ViewStyle := vsReport;
end;
colNames.Free;
end;
if findFirst(FileDir + '\*.' + ExtName, faDirectory, Sear) = 0 then
repeat
//if sList.IndexOf(Sear.Name) > -1 then
//begin
Item := ListItems.Add;
Item.Caption := Sear.Name;
Item.SubItems.Add(IntToSize(Sear.Size));
Item.SubItems.Add(FormatDateTime('yyyy-mm-dd hh:nn', FileDateToDateTime(Sear.Time)));
Item.SubItems.Add(FileDir);
//end;
until findNext(Sear) <> 0;
lstName := Sear.Name;
findClose(Sear);
with TListView(ListItems.Owner) do
begin
if Assigned(SmallImages) then
begin
ico := TIcon.Create;
ico.Handle := GetFileICON(FileDir + '\' + lstName);
SmallImages.Clear;
SmallImages.InsertIcon(0, ico);
ico.Free;
end;
end;
end;
function IsExistNull(ADataset: TDataSet; const AFields: array of string): Boolean;
var
i: Integer;
begin
Result := false;
if ADataset.RecordCount = 0 then
Exit;
ADataset.DisableControls; //断开显示控件的联接，避免显示控件不必要的刷新
with ADataset do
begin
First;
while not Eof do
begin
for i := Low(AFields) to High(AFields) do
begin
if (length(Trim(FieldByName(AFields[i]).AsString)) = 0) then
begin
Result := true;
Break;
end;
end;
Next;
end;
end;
ADataset.EnableControls; //恢复显示控件的联接
end;
function ValueIsRepeat(Dataset: TDataSet; field,
value: string; IsInclude: Boolean = False): Boolean;
var
val: string;
RecBookMark: string;
begin
Result := false;
if Dataset.RecordCount = 0 then
Exit;
Dataset.DisableControls; //断开显示控件的联接，避免显示控件不必要的刷新
RecBookMark := Dataset.Bookmark; //记忆当前位置用来记录指针位置
with Dataset do
begin
First;
while not Eof do
begin
if Trim(vartostr(FieldByName(field).AsVariant)) = '' then
begin
Next;
end
else
begin //控件在感知时找到重复值
if SameText(Trim(val), Trim(vartostr(FieldByName(field).AsVariant))) then
begin
Result := True;
Break;
end;
if SameText(Trim(value), Trim(vartostr(FieldByName(field).AsVariant))) then
begin
val := value;
if IsInclude = False then //控件没有在感知时找到重复值
begin
Result := True;
Break;
end;
end;
Next;
end;
end;
end;
Dataset.Bookmark := RecBookMark; //记录指针回到原来位置
Dataset.EnableControls; //恢复显示控件的联接
end;
function GetConnSQL(Connectionstr: string): string;
var
s: string;
function _Get_Conn_UserID(ADOConnStr: string): string;
var
S: string;
I, U: Integer;
begin
I := Pos('User ID=', ADOConnStr);
if I <> 0 then
begin
for U := I + 8 to Length(ADOConnStr) do
begin
if ADOConnStr[U] = ';' then
Break;
S := S + ADOConnStr[U];
end;
end;
Result := S;
end;
function _Get_Conn_PWD(ADOConnStr: string): string;
var
S: string;
I, U: Integer;
begin
I := Pos('Password=', ADOConnStr);
if I <> 0 then
begin
for U := I + 9 to Length(ADOConnStr) do
begin
if ADOConnStr[U] = ';' then
Break;
S := S + ADOConnStr[U];
end;
end;
Result := S;
end;
function _Get_Conn_HostName(ADOConnStr: string): string;
var
S: string;
I, U: Integer;
begin
I := Pos('Data Source=', ADOConnStr);
if I <> 0 then
begin
for U := I + 12 to Length(ADOConnStr) do
begin
if ADOConnStr[U] = ';' then
Break;
S := S + ADOConnStr[U];
end;
end;
Result := S;
end;
function _Get_Conn_DBName(ADOConnStr: string): string;
var
S: string;
I, U: Integer;
begin
I := Pos('Initial Catalog=', ADOConnStr);
if I <> 0 then
begin
for U := I + 16 to Length(ADOConnStr) do
begin
if ADOConnStr[U] = ';' then
Break;
S := S + ADOConnStr[U];
end;
end;
Result := S;
end;
begin
s := Connectionstr;
if ShareGlobalVar.GlobalVar.GetDBType = 0 then
Result := '[ODBC] [ODBC;Driver=SQL Server;UID=' + _Get_Conn_UserID(s) + ';PWD=' + _Get_Conn_PWD(s) + ';Server=' + _Get_Conn_HostName(s) +
';DataBase=' + _Get_Conn_DBName(s) + ']'
else
Result := '[ODBC] [ODBC;Driver={microsoft odbc for oracle};UID=' + _Get_Conn_UserID(s) + ';PWD=' + _Get_Conn_PWD(s) + ';Server=' + _Get_Conn_HostName(s) +']';
end;
function GetNumberList(ADataSet: TDataSet; NumberCol: string): string;
var
NumberList: string;
RecBookMark: string;
StartNo, PNo, EndNo: Integer;
begin
if (ADataSet.Active = False) or (ADataSet.RecordCount = 0) then
begin
Result := '';
Exit;
end;
ADataSet.DisableControls;
RecBookMark := ADataSet.Bookmark;
ADataSet.First;
StartNo := ADataSet.FieldByName(NumberCol).AsInteger;
PNo := StartNo;
while not ADataSet.Eof do
begin
ADataSet.Next;
if StartNo <> ADataSet.fieldbyname(NumberCol).AsInteger then //去除重复号
begin
PNo := PNo + 1;
if PNo <> ADataSet.fieldbyname(NumberCol).AsInteger then //截取不连续的号
begin
EndNo := PNo - 1;
if StartNo = EndNo then
NumberList := Trim(NumberList) + IntToStr(StartNo) + '，'
else
NumberList := Trim(NumberList) + IntToStr(StartNo) + '-' + IntToStr(EndNo) + '，';
StartNo := ADataSet.fieldbyname(NumberCol).AsInteger;
PNo := StartNo;
end;
end;
end;
Result := LeftStr(NumberList, Length(widestring(NumberList)) - 1);
if Result = '' then
Result := ADataSet.fieldbyname(NumberCol).AsString;
ADataSet.Bookmark := RecBookMark;
ADataSet.EnableControls;
end;
function CheckNullValue(AContainer: TWinControl): string;
var
index: Integer;
controlname: string;
begin
Result := '';
for index := 0 to AContainer.ControlCount - 1 do
begin
if (AContainer.Controls[index].Enabled = False) or (AContainer.Controls[index].Hint = '') then
Continue; //当前控件没有Hint值则跳过不检查
if (AContainer.Controls[index] is TCustomEdit) then
if Trim((AContainer.Controls[index] as TCustomEdit).Text) = '' then
begin
controlname := AContainer.Controls[index].Hint; //当前控件文本为空值时则使之获得焦点，
Result := controlname; //并返Hint值
(AContainer.Controls[index] as TCustomEdit).SetFocus;
Exit;
end;
if (AContainer.Controls[index] is TComboBox) then
if Trim((AContainer.Controls[index] as TComboBox).Text) = '' then
begin
controlname := AContainer.Controls[index].Hint;
Result := controlname;
(AContainer.Controls[index] as TComboBox).SetFocus;
Exit;
end;
end;
end;
procedure ClearLabel(AContainer: TWinControl; Atag: Integer);
var
index: Integer;
begin
for index := 0 to AContainer.ControlCount - 1 do
begin
{控件的tag为零则清空}
if AContainer.Controls[index].tag = Atag then
begin
if (AContainer.Controls[index] is TCustomLabel) then
(AContainer.Controls[index] as TCustomLabel).Caption := '';
end; //end of if
end; //end of for
end;
procedure ClearText(AContainer: TWinControl; Atag: Integer);
var
index: Integer;
begin
for index := 0 to AContainer.ControlCount - 1 do
begin
{控件的tag为Atag则清空文本}
if (Atag = -1) or (AContainer.Controls[index].tag = Atag) then
begin
if (AContainer.Controls[index] is TCustomEdit) then
(AContainer.Controls[index] as TCustomEdit).Text := '';
if (AContainer.Controls[index] is TComboBox) then
(AContainer.Controls[index] as TComboBox).Text := '';
end; //end of if
end; //end of for
end;
procedure EnableEdit(AContainer: TWinControl; Atag: Integer; Enable: Boolean);
var
index: Integer;
begin
for index := 0 to AContainer.ControlCount - 1 do
begin
if Atag = -1 then {忽略控件的tag}
AContainer.Controls[index].Enabled := Enable
else
begin {控件的tag为Atag}
if AContainer.Controls[index].tag = Atag then
AContainer.Controls[index].Enabled := Enable;
end; // end of if
end; //end of for
end;
procedure ToNext(Sender: TObject; AContainer: TWinControl; CheckTabStop, OnLast: Boolean);
var
index, sndTabOrder: Integer;
CurControl: TWinControl;
Count: Integer;
begin
if Sender is TWinControl then
begin
sndTabOrder := (Sender as TWinControl).TabOrder;
end
else
Exit;
Count := 0;
for index := 0 to AContainer.ControlCount - 1 do
begin
if AContainer.Controls[index] is TWinControl then
Inc(Count)
else
Continue;
end;
for index := sndTabOrder + 1 to Count - 1 do
begin
CurControl := FindControlByTabOrder(AContainer, index);
if CurControl = nil then
Continue;
if (Trim(TCustomEdit(CurControl).Text) = '') or
(Trim(TComboBox(CurControl).Text) = '') then
begin
if (CurControl.CanFocus) and (not CheckTabStop or CurControl.TabStop) then
begin
CurControl.SetFocus;
Break;
end;
end;
if (OnLast) and (index = Count - 1) then //到最后一个
begin
if (CurControl.CanFocus) and (not CheckTabStop or CurControl.TabStop) then
CurControl.SetFocus;
end;
end;
end;
function FindControlByTabOrder(AContainer: TWinControl; ATabOrder: Integer): TWinControl;
var
index: Integer;
CurControl: TWinControl;
begin
for index := 0 to AContainer.ControlCount - 1 do
begin
CurControl := TWinControl(AContainer.Controls[index]);
if CurControl.TabOrder = ATabOrder then
begin
Result := CurControl;
Exit;
end;
end;
Result := nil;
end;
procedure SetImeName(AContainer: TWinControl; Atag: Integer;
AImeName: string);
var
index: Integer;
begin
for index := 0 to AContainer.ControlCount - 1 do
begin
if AContainer.Controls[index].Tag = Atag then
begin
if (AContainer.Controls[index] is TEdit) then
(AContainer.Controls[index] as TEdit).ImeName := AImeName;
if (AContainer.Controls[index] is TComboBox) then
(AContainer.Controls[index] as TComboBox).ImeName := AImeName;
end; //end of (if AContainer.Controls[index].Tag=0 then)
end; //end of for (for index:=0 to AContainer.ControlCount-1 do)
end;
procedure LockCursorInRect(Handle: HWND; Bound: TRect);
var
RectVar: TRect;
begin
RectVar := Bound;
MapWindowPoints(Handle, 0, RectVar, 2); //坐标转换
ClipCursor(@RectVar);
end;
procedure UnLockCursorInRect;
var
RectVar: TRect;
begin
RectVar.Left := 0;
RectVar.Right := Screen.Width;
RectVar.Top := 0;
RectVar.Bottom := Screen.Height;
ClipCursor(@RectVar);
end;
procedure MoneyInput(Sender: TObject; var Key: Char; APrecision: Integer);
var
precision: Integer;
p, len: Integer;
edtmoney: TEdit;
begin
//非编辑框类型控件则退出
if (Sender) is TEdit then
edtmoney := (Sender) as TEdit
else
Exit;
//首位不能出现小数点字符
if (edtmoney.Text = '') and (Key = '.') then
Key := #0;
//非小数情况下首位不能出现零字符
if (edtmoney.Text = '0') and (Key <> '.') then
edtmoney.Text := '';
//有效按键范围
if not (Key in ['-', '0'..'9', '.', #8, #13]) then
Key := #0;
if (edtmoney.Text = '-') and (Key = '-') then
Key := #0;
p := Pos('.', edtmoney.Text);
if p > 0 then //已有浮点
begin
if Key = '.' then
Key := #0
else
begin
len := Length(edtmoney.Text);
precision := len - p;
if (precision = APrecision) and (Key <> #8) then
Key := #0; //精度
end;
end; //没有浮点则可接受数值和小数点
end;
procedure DigitalInput(Sender: TObject; var Key: Char);
begin
if not (Key in ['0'..'9', #8, #13]) then
key := #0
else
begin
if (Key = '0') and (TEdit(sender).Text = '') then
key := #0
end;
end;
function CurrStrToFloat(const CurrStr: string): Extended;
var
index, P: Integer;
str: string;
begin
if Trim(CurrStr) = '' then
begin
Result := 0;
Exit;
end;
str := CurrStr;
p := Pos(CurrencyString, str);
if p > 0 then
Delete(str, p, 2);
for index := 1 to Length(str) do
begin
p := Pos(',', str);
if p > 0 then
Delete(str, p, 1)
end;
result := StrToFloat(str);
end;
function FloatToCurrStr(Value: Extended): string;
begin
Result := Format('%.2m', [value]);
end;
function StringToCurrStr(str: string): string;
begin
if Pos(CurrencyString, str) > 0 then
Result := str
else
Result := FloatToCurrStr(CurrStrToFloat(str));
end;
function CurrStrToString(Currstr: string): string;
begin
// if Pos(CurrencyString,Currstr)>0 then
// begin
// Delete(Currstr,1,2);
// Result:=Currstr;
// end
// else
// Result:=Currstr;
Result := StringReplace(Currstr, CurrencyString, '', [rfReplaceAll, rfIgnoreCase]);
end;
function StringOfStr(str: string; count: Integer): string;
var
i: Integer;
s: string;
begin
s := str;
for i := 1 to count - 1 do
begin
str := str + s;
end;
Result := str;
end;
function DateToInt(const d: Tdate): integer;
var
Year, Month, Day: word;
begin
DecodeDate(d, Year, Month, Day);
result := year * 10000 + month * 100 + day;
end;
function IntToDate(const Value: Integer): Tdate;
var
temp: string;
begin
temp := IntToStr(Value);
insert('-', temp, 5);
insert('-', temp, 8);
try
result := strtodate(temp)
except
raise Exception.Create('数值[' + inttostr(Value) + ']不能转化为日期！');
end;
end;
function IntDateToStrDate(const Value: Integer): string;
var
temp: string;
begin
temp := IntToStr(Value);
insert('-', temp, 5);
insert('-', temp, 8);
result := temp;
end;
function GetBegMonthDT(ADT: TDate): TDate;
var
Y, M, D: Word;
begin
DecodeDate(ADT, y, m, d);
d := 1;
Result := StrToDate(IntToStr(y) + '-' + IntToStr(m) + '-' + IntToStr(d));
end;
function GetMidMonthDT(ADT: TDate): TDate;
var
Y, M, D: Word;
begin
DecodeDate(ADT, y, m, d);
d := 15;
Result := StrToDate(IntToStr(y) + '-' + IntToStr(m) + '-' + IntToStr(d));
end;
function GetLstMonthDT(ADT: TDate): TDate;
var
Y, M, D: Word;
begin
DecodeDate(ADT, y, m, d);
d := DaysInAMonth(y, m);
Result := StrToDate(IntToStr(y) + '-' + IntToStr(m) + '-' + IntToStr(d));
end;
end.
