untpub.pas

是分布式粮库程序,是采用Delphi实现的

Procedure GetErrorInfo(var iErrorCode: integer; var sErrorMsg: string);
begin
  iErrorCode := _iErrorCode;
  sErrorMsg  := _sErrorMsg;
end;

// ★★★
// 功能:字符型数据转换成浮点型的较验涵数
// 调用方法::MyStrToFloat(要转换的值,iNum)=False/True,其中iNum引用要定义
function MyStrToFloat(const sText: string; var iNum: Double): boolean;
begin
  try
    iNum:=StrToFloat(sText);
    result:=true;
  except
    result:=false;
  end;
end;

// ★★★
//日期转换校验函数
//调用方法:MyStrToDate(要转换的值,dtDate)=False/true,其中dtDate引用要定义
function MyStrToDate(const sDate:string; var dtDate:TDate):boolean;
begin
  try
  begin
    dtDate:=StrToDate(sDate);
    Result:=true;
  end;
  except
    result:=false;
  end;
end;

// ★★★
// 功能:字符型数据转换成数字型的较验涵数
// 调用方法::MyStrToInt(要转换的值,iNum)=False/True,其中iNum引用要定义
function MyStrToInt(const sText: string; var iNum: integer): boolean;
begin
  try
    iNum:=StrtoInt(SText);
    result:=true;
  except
    result:=false;
  end;
end;

// ★★★
//日期型转换成字符型,用于数据表的明细显示的函数
//调用方法:将要转换的日期类型赋给本函数就可
function MyDateToStr(const dtDate: Tdate; var sDate: string): boolean;
begin
  try
    if dtDate=0 then
      sDate:=''     //当日期型为0时,返回值;为空
    else
      sDate:=DateToStr(dtDate);
    result:=true;
  except
    result:=false;
  end;
end;

// ★★★
// 返回两个日期之间的月份数
// 同一个年月的日期返回0, 依次类推.
function GetMonthsBetweenTwoDate(const dtD1, dtD2: TDateTime): Integer;
var
  dtDA, dtDB: TDateTime;
  wY1, wM1, wD1: word;
  wY2, wM2, wD2: word;
begin
  if dtD1>=dtD2 then
  begin
    dtDA := dtD2;
    dtDB := dtD1;
  end
  else
  begin
    dtDA := dtD1;
    dtDB := dtD2;
  end;
  DecodeDate(dtDA, wY1, wM1, wD1);
  DecodeDate(dtDB, wY2, wM2, wD2);
  Result := (wY2-wY1)*12 + (wM2-wM1);
end;

// ★★★
// 相对于 dtDate, 计算新日期.
// 新日期与 dtDate 有 iDltYear 年 iDltMonth 月 iDltDay 天的差距.
// iDltYear, iDltMonth, iDltDay 可以为负数, -12 < iDltMonth < 12
function GetNextDate(const dtDate: TDate; const iDltYear, iDltMonth, iDltDay: integer): TDate;
var
  dtTmp: TDate;
  wY, wM, wD: word;
begin
  dtTmp := dtDate + iDltDay;
  DecodeDate(dtTmp, wY, wM, wD);
  wY := wY + iDLtYear;
  wM := wM + iDltMonth;
  if wM > 12 then
  begin
    wY := wY + wM div 12;
    wM := wM mod 12;        // 适应任何月份差异
  end
  else if wM <= 0 then      // 继续改进
  begin
    wM := wM + 12;
    wY := wY - 1;
{
    wY := wY + wM div 12;
    wM := wM mod 12;        // 适应任何月份差异
}
  end;
  try
    Result := EncodeDate(wY, wM, wD);
  except  // 出错的唯一可能：xxxx.02.29 无对应的下一个日期, 改为 xxxx.02.28
    Result := EncodeDate(wY, 2, 28);
  end;
end;


//★★★
// 根据人的身份证号码求出生日期
function GetBirthday(const sInsQueryID: string; var dtBirthday: TDate): boolean;
const
  iY2K: Integer = 0;                // 决定年份, 以判断2000年前出生或2000年后出生  ★★★★★
  iP18: Integer = 7;                 // 18位身份证的生日日期起始位置                ★★★★★
var
  sYear, sMonth, sDay: string;
begin
  try
    // 18位身份证号码处理
    if Length(sInsQueryID) = 18 then
    begin
      sYear := Copy(sInsQueryID,iP18,4);
      sMonth:= Copy(sInsQueryID,iP18+4,2);
      sDay  := Copy(sInsQueryID,iP18+6,2);
    end
    else    // 15位身份证号码处理
    begin
      sYear := Copy(sInsQueryID,7,2);
      sMonth:= Copy(sInsQueryID,9,2);
      sDay  := Copy(sInsQueryID,11,2);
      if StrToInt(sYear) < iY2K then
        sYear:= '20' + sYear
      else
        sYear:= '19' + sYear;
    end;
    dtBirthday := EncodeDate(StrToInt(sYear),StrToInt(sMonth),StrToInt(sDay));
    Result := true;
  except
    Result:= false;
  end;
end;

// 将一表单在另一主表单客户区居中
// 参数：frmMain: 主表单， frmSub: 待居中的子表单
//       iOffset: 垂直方向其他对象占用高度(缺省为0)
// 例如：CenterForm(frmClinicMain, frmRegister, Toolbar.height)
Procedure CenterForm(frmMain, frmSub: TCustomForm; const iOffset: integer=0);
var
  p: TPoint;
  bHf, bVf: boolean;
begin
    bHf:=false; bVf:=false;
    with frmMain do
    begin
      if ClientWidth > frmSub.width then
        p.x := ( ClientWidth  - frmSub.width) div 2
      else
      begin
        p.x :=0;
        bHf:=true;
      end;
      if ClientHeight + iOffset > frmSub.height then
        p.y :=  (( Clientheight + iOffset - frmSub.height) div 2)
      else
      begin
        p.y :=0;
        bVf:=true;
      end;
      p:= ClientToScreen(p);
      if bVf then
        frmSub.Top :=0
      else
        if p.y>=0 then
          frmSub.Top := p.y;
      if bHf then
        frmSub.left :=0
      else
        if p.x>=0 then
          frmSub.left := p.x ;
    end;
end;

// Blob 字段 --> OLE 控件
function OLEFieldToContainer(var fldWhich: TBlobField; var ocWhich: TOLEContainer;
          const sInitFile: string = ''):boolean;
var
  bsOLE: TBlobStream;
begin
  result:=true;
  try
    // 打开 Query.Field 流
    bsOLE := TBlobStream.Create(fldWhich, bmRead);
    // 读到 OLE 构件
    try
      if bsOLE.Size = 0 then // 初始化 ocWhich: 创建一个嵌入对象
      begin
        if sInitFile='' then
          ocWhich.createObjectFromFile(_sAppPath+'Emp.doc', false)
        else
          ocWhich.createObjectFromFile(_sAppPath+sInitFile, false);
      end
      else
      begin
        ocWhich.LoadFromStream(bsOLE);
      end;
    except
      on E:exception do
      begin
        ErrorHandler(E,'OLEFieldToContainer');
        result:=false;
       end;
    end;
  finally
    // 关闭 Query.F_OLE 流
    bsOLE.Free;
  end;
end;

// Blob 控件 --> 字段
function OLEContainerToField(var fldWhich: TBlobField; var ocWhich: TOLEContainer):boolean;
var
  bsOLE: TBlobStream;
begin
  result:=true;
  try
    // 打开 Table.Field 流, 清除原数据
    bsOLE := TBlobStream.Create(fldWhich, bmReadWrite);
    bsOLE.Seek(0, soFromBeginning);
    bsOLE.Truncate;
    try
      // 从 OLE 构件写入
      ocWhich.SaveToStream(bsOLE);
    except
      on E:exception do
      begin
        ErrorHandler(E,'OLEContainerToField');
        result:=false;
      end;
    end;
  finally
    // 关闭 Table1.Field 流
    bsOLE.Free;
  end;
end;


//★★★
// 根据数据库代码返回数据库类别的字符串
function GetDBSName(const iDBSType: integer): string;
begin
  case iDBSType of
  1:	// _iDBAccess = 1;
    Result := 'MSACCESS';
  2:	// _iDBOracle = 2;
    Result := 'ORACLE';
  3:	// _iDBSybase = 3;
    Result := 'SYBASE';
  4:	// _iDBMSSQL  = 4;
    Result := 'MSSQL';
  5:	// _iDBDBF    = 5;
    Result := 'STANDARD';
  else
    Result := 'UNKNOW';
  end;
end;

//★★★
// 文件拷贝，综合报错
function DiskCopyFile(const SourceFile:string;const TargetFile:string):boolean;
var
  SourceFileName,SourcePathName:string;
  TargetFileName,TargetPathName:string;
  iErr: integer;
begin
  Result := false;

  SourceFileName:=ExtractFileName(SourceFile);
  SourcePathName:=ExtractFilePath(SourceFile);
  TargetFileName:=ExtractFileName(TargetFile);
  TargetPathName:=ExtractFilePath(TargetFile);

  copyFile(Pchar(SourceFile),Pchar(TargetFile),False);
  iErr := GetLastError;
  case iErr of
  0:
    Result := true;
  21, 5:    //未插入盘
    Application.MessageBox(pchar('  未插入软盘  '),pchar(_sAppTitle),
                mb_IconWarning+mb_ok);
  2:        //源文件不存在
    Application.MessageBox(pchar('源文件不存在：'+#13+#13+SourceFileName),
                pchar(_sAppTitle),
                mb_IconWarning+mb_ok);
  3:        //目标文件的目录不存在
    Application.MessageBox(pchar('目标文件的目录不存在：'+#13+#13+TargetPathName),
                pchar(_sAppTitle),
                mb_IconWarning+mb_ok);
  112:
    Application.MessageBox(pchar('目标盘空间不够：'+TargetPathName),
                pchar(_sAppTitle),
                mb_IconWarning+mb_ok);
  else
    Application.MessageBox(PChar('拷贝文件失败。'+#13+#13+
                SourceFile+'  -->  '+TargetFile),
                pchar(_sAppTitle), mb_IconInformation+mb_ok);
  end;
end;


//★★★
// 比较日期是否相同
// 输入： iCmp: 比较类型（1:年 2:年月 3:年月日 4:年月日时 5:年月日时分 6:年月日时分秒）
// 返回： True: 相同
function SameDateTime(const dtD1, dtD2: TDateTime; const iCmpType: integer): boolean;
var
  wY1, wY2, wM1, wM2, wD1, wD2, wH1, wH2, wMi1, wMi2, wS1, wS2, wMs1, wMs2: word;
begin
  DecodeDate(dtD1, wY1, wM1, wD1);
  DecodeDate(dtD2, wY2, wM2, wD2);
  DecodeTime(dtD1, wH1, wMi1, wS1, wMs1);
  DecodeTime(dtD2, wH2, wMi2, wS2, wMs2);
  case iCmpType of
  1:  Result := (wY1=wY2);
  2:  Result := (wY1=wY2) and (wM1=wM2);
  3:  Result := (wY1=wY2) and (wM1=wM2) and (wD1=wD2);
  4:  Result := (wY1=wY2) and (wM1=wM2) and (wD1=wD2) and (wH1=wH2);
  5:  Result := (wY1=wY2) and (wM1=wM2) and (wD1=wD2) and (wH1=wH2) and (wMi1=wMi2);
  6:  Result := (wY1=wY2) and (wM1=wM2) and (wD1=wD2) and (wH1=wH2) and (wMi1=wMi2) and (wS1=wS2);
  else
      result := false;
  end;
end;

function MyCy2Round(const X: Extended): Currency;
begin
  if X>=0 then
    Result := Trunc(X*100+0.5)/100
  else
    Result := -Trunc(Abs(X)*100+0.5)/100;
end;


// 将日期 sDate 和字段 sFieldName 组合成 sCondition，
// 使其能使用在 Select ... where <sCondition> 中。
// 本函数在 MS Access、Oracle、Sybase 数据库中获得通过。
// sDate 的格式是 'YYYY-MM-DD'
// sOptr 为 '>', '>=', '<', '<=', '=', '<>'
function MyDateCondition(const sFieldName, sDate, sOptr, sDB: string;
  var sCondition: string): boolean;
var
  sYear, sMonth, sDay, sFN: string;
begin
  Result:=true;
  sYear:=Copy(sDate, 1, 4);
  sMonth:=Copy(sDate, 6, 2);
  sDay:=Copy(sDate, 9, 2);
  // Access
  if sDB='MSACCESS' then
  begin
    sFN:='['+sFieldName+']';
    if sOptr = '=' then
      sCondition := ' (DatePart("yyyy",'+sFN+')='+sYear+
        ' and DatePart("m",'+sFN+')='+sMonth+
        ' and DatePart("d",'+sFN+')='+sDay+') '
    else if sOptr = '<>' then
      sCondition := ' (DatePart("yyyy",'+sFN+')<>'+sYear+
        ' or DatePart("m",'+sFN+')<>'+sMonth+
        ' or DatePart("d",'+sFN+')<>'+sDay+') '
    else if (sOptr = '>') or (sOptr = '>=') or
      (sOptr = '<') or (sOptr = '<=') then
      sCondition :=
        ' (DatePart("yyyy",'+sFN+')'+sOptr+sYear+       // 年大/小
        ' or (DatePart("yyyy",'+sFN+')='+sYear+         // 年等, 月大/小
          ' and DatePart("m",'+sFN+')'+sOptr+sMonth+')'+
        ' or (DatePart("yyyy",'+sFN+')='+sYear+         // 年等, 月等, 日大/小
          ' and DatePart("m",'+sFN+')='+sMonth+
          ' and DatePart("d",'+sFN+')'+sOptr+sDay+')) '
    else
      sCondition:=' 1=1 ';
    exit;           // 退出
  end;

  // Sybase
  if sDB='SYBASE' then
  begin
    sFN:=sFieldName;
    if sOptr = '=' then
      sCondition := ' (DatePart(yy,'+sFN+')='+sYear+
        ' and DatePart(mm,'+sFN+')='+sMonth+
        ' and DatePart(dd,'+sFN+')='+sDay+') '
    else if sOptr = '<>' then
      sCondition := ' (DatePart(yy,'+sFN+')<>'+sYear+
        ' or DatePart(mm,'+sFN+')<>'+sMonth+
        ' or DatePart(dd,'+sFN+')<>'+sDay+') '
    else if (sOptr = '>') or (sOptr = '>=') or
      (sOptr = '<') or (sOptr = '<=') then
      sCondition :=