xtools.pas

我自己用的Delphi函数单元 具体说明见打包文件的HELP目录下面

unit xTools;

interface

uses Windows, Sysutils, Forms, Controls;

//------------------------------------------------------------------//
procedure SetLocal;

//------------------------------------------------------------------//
procedure Delay(const uDelay:DWORD);
procedure DoBusy(Busy: Boolean);
function  BeepEx(const Freq:DWORD;const Delay:DWORD):BOOL;

//------------------------------------------------------------------//
function MsgBox(const Msg: string;Flag:Integer = MB_ICONINFORMATION or MB_OK):Integer;
function ErrorBox(const Msg: string;Flag:Integer = MB_ICONERROR or MB_OK):Integer;
function WarningBox(const Msg: string;Flag:Integer = MB_ICONEXCLAMATION or MB_OK):Integer;
function YesNoBox(const Msg: string): Integer;
function YesNoCancelBox(const Msg: string): Integer;

//------------------------------------------------------------------//
function  GetLastErrorString: string;
procedure ShowLastError(const Msg: string = 'Windows API 错误');
procedure RaiseLastError(const Msg: string = 'Windows API 错误');

//------------------------------------------------------------------//
function varIIF( aTest: Boolean; TrueValue, FalseValue : Variant): Variant;
function varToStr(const V: Variant): String;

implementation

//------------------------------------------------------------------//
//设置本地应用环境
procedure SetLocal;
begin
    DateSeparator:='.';
    CurrencyString:='';
    ShortDateFormat:='yyyy.mm.dd';
    LongDateFormat:='yyyy年mm月dd日';
    TimeSeparator:=':';
    ShortTimeFormat:='HH:mm';
    LongTimeFormat:='HH:mm:ss';
    TwoDigitYearCenturyWindow:=0;
end;

//------------------------------------------------------------------//
//延时函数
procedure Delay(const uDelay:DWORD);
var
    n:DWORD;
begin
    n:=GetTickCount;
    while ((GetTickCount-n)<=uDelay) do Application.ProcessMessages;
end;

//------------------------------------------------------------------//
//进行必须让用户暂时等待，无法操作的长时间动作前，先调用DoBusy函数，输入
//True，可使鼠标换成忙碌指针，待动作完成后，输入False还原。
{$J+}
procedure DoBusy(Busy: Boolean);
const
  Times: Integer = 0;
begin
  if Busy then
  begin
    Inc(Times);
    if Times = 1 then Screen.Cursor := crHourGlass;
  end else
  begin
    dec(Times);
    if Times = 0 then Screen.Cursor := crDefault;
  end;
end;
{$J-}

//------------------------------------------------------------------//
//使PC喇叭发声的函数，支持Win9x,NT
function BeepEx(const Freq:DWORD;const Delay:DWORD):BOOL;
const
    FREQ_SCALE=$1193180;
var
    nFreq:WORD;
begin
  Result:=False;
  if (Freq<37) or (Freq>32767) then Exit;
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    Result:=Windows.Beep(Freq,Delay);
    Exit;
  end;

  nFreq:=FREQ_SCALE div Freq;
  asm
    in al,61h;
    or al,3;
    out 61h,al;
    mov al,$b6;
    out 43h,al;
    mov ax,nFreq;
    out 42h,al;
    mov al,ah;
    out 42h,al;
  end;
  Sleep(Delay);
  asm
    in al,$61;
    and al,$fc;
    out $61,al;
  end;
  Result:=True;
end;

//------------------------------------------------------------------//
function MsgBox(const Msg: string;Flag:Integer = MB_ICONINFORMATION or MB_OK):Integer;
begin
  Result:=Application.MessageBox(PChar(Msg), PChar(Application.Title), Flag);
end;

//------------------------------------------------------------------//
function ErrorBox(const Msg: string;Flag:Integer = MB_ICONERROR or MB_OK):Integer;
begin
  Result:=Application.MessageBox(PChar(Msg), PChar(Application.Title), Flag);
end;

//------------------------------------------------------------------//
function WarningBox(const Msg: string;Flag:Integer = MB_ICONEXCLAMATION or MB_OK):Integer;
begin
  Result:=Application.MessageBox(PChar(Msg), PChar(Application.Title), Flag);
end;

//------------------------------------------------------------------//
function YesNoBox(const Msg: string):Integer;
begin
  Result := Application.MessageBox(PChar(Msg), PChar(Application.Title), MB_ICONQUESTION or
    MB_YESNO or MB_DEFBUTTON1);
end;

//------------------------------------------------------------------//
function YesNoCancelBox(const Msg: string): Integer;
begin
  Result := Application.MessageBox(PChar(Msg),
    PChar(Application.Title), MB_ICONQUESTION or MB_YESNOCANCEL or MB_DEFBUTTON1)
end;

//------------------------------------------------------------------//
//取得最近一次调用API函数发生错误后的错误描述。
function GetLastErrorString: string;
var
  Buf: PChar;
begin
  FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM,
    nil, GetLastError, LANG_USER_DEFAULT, @Buf, 0, nil);
  try
    Result := StrPas(Buf);
  finally
    LocalFree(HLOCAL(Buf));
  end;
end;

//------------------------------------------------------------------//
//调用API函数，若返回值发生错误，可使用本函数显示错误。
procedure ShowLastError(const Msg: string = 'Windows API 错误');
begin
  ErrorBox(Msg + ': ' + GetLastErrorString);
end;

//------------------------------------------------------------------//
//调用API函数，若返回值发生错误，产生异常。
procedure RaiseLastError(const Msg: string = 'Windows API 错误');
begin
  raise Exception.Create(Msg + ': ' + GetLastErrorString);
end;

//------------------------------------------------------------------//
//根据表达式布尔值，返回TrueValue，或FalseValue，类似VFP中的IIF。
function varIIF( aTest: Boolean; TrueValue, FalseValue : Variant): Variant;
begin
  if aTest then  Result := TrueValue else Result := FalseValue;
end;

//------------------------------------------------------------------//
//将各种类型的变量值转换为字符串
function varToStr(const V: Variant): String;
begin
  case TVarData(v).vType of
    varSmallInt : Result := IntToStr(TVarData(v).VSmallInt);
    varInteger  : Result := IntToStr(TVarData(v).VInteger);
    varSingle   : Result := FloatToStr(TVarData(v).VSingle);
    varDouble   : Result := FloatToStr(TVarData(v).VDouble);
    varCurrency : Result := FloatToStr(TVarData(v).VCurrency);
    varDate     : Result := DateToStr(TVarData(v).VDate);
    varBoolean  : Result := varIIf(TVarData(v).VBoolean, 'True', 'False');
    varByte     : Result := IntToStr(TVarData(v).VByte);
    varString   : Result := StrPas(TVarData(v).VString);
    varEmpty	: Result := '(Empty)';
    varNull		: Result := '(Null)';
    varVariant	: Result := '(Variant)';
    varUnknown	: Result := '(Unknown)';
    varTypeMask	: Result := '(TypeMask)';
    varArray	: Result := '(Array)';
    varByRef	: Result := '(ByRef)';
    varDispatch	: Result := '(Dispatch)';
    varError    : Result := '(Error)';
  end;
end;



end.