globalunit.pas

实达企业在线EOL源码

      result:=rg.readString(value)
    else
      result:='';
  finally
    rg.free;
  end;
end;

{返回一个激活的数据集Dataset(TTabel 或 TQuery)的数据库别名对应的DOS路径}
Function TAccessSystem.getaliaspath(dbset:Tdataset):string;
var
  vDBDesc:DBDesc;
  s:string;
begin
  result:='';
  if not (dbset.active) then exit;
  if (dbset is TTable) then s:=(dbset as ttable).databasename;
  if (dbset is TQuery) then s:=(dbset as tquery).databasename;
  Check(DbiGetDatabaseDesc(PChar(s),@vDBDesc));
  result:=Global.FAccessString.slash(string(vDBDesc.szPhyName));
end;

{返回一个文件的日期（使用日期格式TDataTime）}
Function TAccessSystem.getfiledate(filename:string):Tdatetime;
begin
  if fileexists(filename) then
    result:=filedatetodatetime(fileage(filename))
  else
    result:=maxint;
end;


//=====================================================================

{ TAccessNum }

constructor TAccessNum.Create;
begin
 
end;

destructor TAccessNum.Destroy;
begin
  inherited;

end;

{转换字符串s为数字。如果不能转换，则返回预定义的def值。}
function TAccessNum.strtofloatdef(const s:string;def:Extended):Extended;
begin
  try
    result:=strtofloat(s);
  except
    result:=def;
  end;
end;

{返回数组中最小值}
function TAccessNum.MinExt(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;

{返回数组中最大值}
function TAccessNum.MaxExt(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;

//=====================================================================

{ TAccessFinance }

constructor TAccessFinance.Create;
begin
  
end;

destructor TAccessFinance.Destroy;
begin
  inherited;

end;

{涨价后的实价（销售价）}
{例：SellingPrice(199.50,22.5) = 244.3875}
function TAccessFinance.SellingPrice(net:double;markup:single):double;
begin
  result:=net+(net*markup/100);
end;

{返回含税价}
{例：NetPrice(199.99,17.5) = 170.204255319149}
function TAccessFinance.NetPrice(gross:double;taxrate:single):double;
begin
  result:=gross-(gross*(taxrate)/(100+taxrate));
end;

//=====================================================================

{ TAccessDateTime }

constructor TAccessDateTime.Create;
begin
 
end;

destructor TAccessDateTime.Destroy;
begin
  inherited;

end;

//设置系统时间日期格式
procedure  TAccessDateTime.SetDatetimeFormat;
begin
  ShortDateFormat:='YYYY/MM/DD';
  LongDateFormat:='YYYY/MM/DD';
  DateSeparator:='/';
  TimeSeparator:=':';
  ShortTimeFormat:='HH:MM:SS';
  LongTimeFormat:='HH:MM:SS';
  TwoDigitYearCenturyWindow := 70;
end;

//返回汉字月份名
function TAccessDateTime.CMonth(y:Integer):string;
begin
  result:='';
  case y of
    1:result:='一月';
    2:result:='二月';
    3:result:='三月';
    4:result:='四月';
    5:result:='五月';
    6:result:='六月';
    7:result:='七月';
    8:result:='八月';
    9:result:='九月';
    10:result:='十月';
    11:result:='十一月';
    12:result:='十二月';
  end;
end;

// 返回当月的天数
Function TAccessDateTime.DaysOfCurrntMonth:Integer;
var
  yyyy,mm,dd:Word;
begin
  DecodeDate(Date,yyyy,mm,dd);
  Result :=DaysOFMonth(yyyy,mm);
end;

 // 返回指定日期增加（减少）指定天数的日期
Function TAccessDateTime.incDay(const Date: TDateTime;NumberofDays:Integer):TdateTime;
var
  ts:TTimeStamp;
begin
  ts := DateTimeToTimeStamp(Date);
  Inc(ts.date,NumberOfDays);
  Result := TimeStampToDateTime(ts);
end;

// 返回指定年月的天数
Function TAccessDateTime.DaysOFMonth(const Year:word;Month:integer):Integer;
begin
  Result := MonthDays[IsLeapYear(Year),Month];
end;

//=====================================================================

{ TAccessDialog }

constructor TAccessDialog.Create;
begin
  
end;

destructor TAccessDialog.Destroy;
begin
  inherited;

end;

//显示确认对话窗 0:Yes; 1:No; 2:Cancel;
function TAccessDialog.showYesNOCancel(MSG:string;title:string):integer;
var
  i:integer;
begin
  result := 0;
  i :=application.MessageBox(PChar(MSG),PChar(title),MB_YESNOCANCEL+MB_DEFBUTTON2+MB_ICONINFORMATION);
  case i of
     IDYES:result := 0;
     IDNO: result := 1;
     IDCANCEL: result := 2;
  end;
end;

//显示确认对话窗
function TAccessDialog.showYesNO(MSG:string;title:string):boolean;
var
  temp:integer;
begin
  result := false;
  temp :=application.MessageBox(PChar(MSG),PChar(title),MB_YESNO+MB_DEFBUTTON2+MB_ICONINFORMATION);
  case  temp of
       IDYES:result := true;
       IDCANCEL:SysUtils.abort;
       else result :=false;
       end;
end;

//显示指定类型的对话窗
function TAccessDialog.Showmsg(MSG:string;aType:TMsgDlgType): integer;
var
  icon : longint;
begin
  case aType of
       mtWarning         : Icon := MB_OK+MB_ICONWARNING;
       mtError           :  Icon :=MB_OK+ MB_ICONERROR;
       mtInformation     :  Icon :=MB_OK+ MB_ICONINFORMATION;
       mtConfirmation    :  Icon :=MB_YESNO+MB_ICONQUESTION;
       else                 Icon := 0;
       end;
  Result := Application.MessageBox(PChar(MSG),PChar(Application.title),ICON);
end;

//警告对话窗
function TAccessDialog.SHowWarning(MSG:string): integer;
begin
  Result := SHowmsg(msg,mtWarning);
end;

//错误对话窗
function TAccessDialog.ShowERROR(MSG:string): integer;
begin
  Result := SHowmsg(msg,mtERROR);
end;

//信息对话窗
function TAccessDialog.ShowInformation(MSG:string): integer;
begin
  Result := SHowmsg(msg,mtInformation);
end;

//询问对话窗
function TAccessDialog.ShowQuestion(MSG:string): integer;
begin
  Result := SHowmsg(msg,mtConfirmation);
end;

//=====================================================================

{ TAccessForm }

constructor TAccessForm.Create;
begin

end;

destructor TAccessForm.Destroy;
begin
  inherited;

end;

//判断MDI子窗体是否存在
function TAccessForm.IsExistForm(MDIForm:TForm;MDIChildFormName:string):boolean;
var
 i:integer;
begin
 Result:=False;
 with MDIForm do
 begin
   if MDIForm.MDIChildCount > 0 then
   begin
     for i := MDIChildCount-1 downto 0 do
     begin
        if UpperCase(MDIChildren[i].Name) = UpperCase(MDIChildFormName) then
        begin
            Result:=True;
            Break;
        end;
     end;
   end;
 end;
end;

//在指定的MDI父窗体打开MDI子窗体
procedure TAccessForm.OpenMDIChildForm(MDIForm:TForm;MDIChildFormName: string);
ResourceString
  cMessage1='打开太多的窗体，请关掉不必要的窗体！';
Const
  MaxCount=8;
var
  FClass:TPersistentClass;
  Form:TForm;
begin
  with MDIForm do
  begin
     //  判断子窗口是否存在
     if IsExistForm(MDIForm,MDIChildFormName) then
     begin
       Form:=TForm(Application.FindComponent(MDIChildFormName));
//       Form.WindowState:= wsMaximized;
       Form.Show;
       Exit;
     end;

     if MDIChildCount > MaxCount then
     begin
       ShowMessage(cMessage1);
       Exit;
     end;

     FClass := GetClass('T'+MDIChildFormName);
     Form:=TFormClass(FClass).Create(Application); //创建
     Form.WindowState:= wsMaximized;
     Form.Show;            //显示
  end;
end;


//在指定的MDI父窗体上关闭所有MDI子窗体
procedure  TAccessForm.CloseAllMDIChildForm(MDIForm:TForm;NeedFree:Boolean);
var
  i:integer;
begin
  for i:=MDIForm.MDIChildCount-1 downto 0 do
  begin
    MDIForm.MDIChildren[i].Close;
    try
      if NeedFree then
      begin
         MDIForm.MDIChildren[i].Free;
      end;
    except
    end;
  end;
end;

//=====================================================================

{ TAccessFile }

constructor TAccessFile.Create;
begin
   
end;

destructor TAccessFile.Destroy;
begin
  inherited;

end;

//***************************************************************
//判断一个PathName中是否有扩展名                                *
//***************************************************************
  function TAccessFile.HasExtension(const Name : string; var DotPos : integer) : Boolean;
    {-Return whether and position of extension separator dot in a pathname}
  var
    I : Word;
  begin
    DotPos := 0;
    for I := Length(Name) downto 1 do
      if (Name[I] = '.') and (DotPos = 0) then
        DotPos := I;
{>>C 14-07-1998}
    HasExtension := (DotPos > 0) and (Pos('\', Copy(Name, Succ(DotPos), cbFileExtLen)) = 0);
{<<C 14-07-1998}
  end;

//***************************************************************
//返回一个带扩展名的PathName，有Ext指定                         *
//***************************************************************
function TAccessFile.DefaultExtension(const Name, Ext : string) : string;
    {-Return a pathname with the specified extension attached}
var
  DotPos : integer;
begin
  if HasExtension(Name, DotPos) then
     DefaultExtension:= Name
  else
     DefaultExtension:= Name+'.'+Ext;
end;

//***************************************************************
//强制返回一个带扩展名的PathName，有Ext指定                         *
//***************************************************************
  function TAccessFile.ForceExtension(const Name, Ext : string) : string;
    {-Return a pathname with the specified extension attached}
  var
    DotPos : integer;
  begin
    if HasExtension(Name, DotPos) then
      Result := Copy(Name, 1, DotPos)+Ext
    else
      Result := Name+'.'+Ext;
  end;

//***************************************************************
//只返回一个PathName的扩展名                                  *
//***************************************************************
  function TAccessFile.JustExtension(const Name : string) : string;
    {-Return just the extension of a pathname}
  var
    DotPos : integer;
  begin
    if HasExtension(Name, DotPos) then
{>>C 2.03}
      Result:= Copy(Name, Succ(DotPos), cbFileExtLen)
{<<C 2.03}
    else
      SetLength(Result, 0);
  end;

//***************************************************************
//返回一个PathName中的文件名，不带路径                        *
//***************************************************************
  function TAccessFile.JustFilename(const PathName : string) : string;
    {-Return just the filename of a pathname}
  var
    I : Word;
  begin
    I:= Succ(Word(Length(PathName)));

    repeat
      Dec(I);
    until (PathName[I] in DosDelimSet) or (I = 0);

{>>C 15-11-1997}
    Result:= Copy(PathName, Succ(I), length(PathName));
{<<C 15-11-1997}
  end;

//***************************************************************
//返回一个PathName的路径部分：'c:\'、'c:\dos'                                  *
//***************************************************************
  function TAccessFile.JustPathname(const PathName : string) : string;
    {-Return just the drive:directory portion of a pathname}
  var
    I : Word;
  begin
    I := Succ(Word(Length(PathName)));
    repeat
      Dec(I);
    until (PathName[I] in DosDelimSet) or (I = 0);

    if I = 0 then
      {Had no drive or directory name}
      SetLength(Result, 0)
    else if I = 1 then