publicfunction.pas

电子充值系统:全球通的充值卡通过POS机传到销售点.

  end;
end;

function NewDate(NowDate: String; AddMonth: Integer; AddDays: Integer): String;
var
  mYear, mMonth, mDate : Integer;
  TmpNowDate : String;
begin
  mMonth := StrToInt(SubStr(NowDate, 4, 2));
  mYear := StrToInt(LeftStr(NowDate, 2));
  mMonth := mMonth + AddMonth;
  if mMonth > 12 then begin
    mMonth := mMonth - 12;
    mYear := mYear + 1;
  end;
  mDate := StrToInt(RightStr(NowDate, 2));
  if mMonth = 2 then begin
    if mDate > 28 then begin
      if mYear in [85, 89, 93, 97] then
        mDate := 29
      else
        mDate := 28;
    end;
  end;
  if mMonth in [4, 6, 9, 11] then begin
    if mDate > 30 then
      mDate := 30
  end;
  TmpNowDate := RightStr('00' + IntToStr(mYear), 2) + '-' +
                RightStr('00' + IntToStr(mMonth), 2) + '-' +
                RightStr('00' + IntToStr(mDate), 2);
  NewDate := IncDate(TmpNowDate, AddDays);
end;

function IDGen(Style, InitVal, FieldName, TableName: String): String;
var
  sInitVal, sSQL : String;
begin
  sInitVal := LeftStr(InitVal, 2) + SubStr(InitVal, 4, 2);
  sSQL := 'SELECT MAX(' + FieldName + ') AS NEW_NO ' +
          'FROM ' + TableName + ' ' +
          'WHERE CompanyID = ''' + sCompanyID + ''' ' +
          'AND ' + FieldName + ' LIKE ''' + '%'+  Style + sInitVal + '%'' ';
  with DM.qyGet do begin
    Close;
    SQL.Clear;
    SQL.Text := sSQL;
    Open;
  end;
  if DM.qyGet.FieldByName('NEW_NO').AsString = '' then begin
    Result := Style + sInitVal + '0001';
    Exit;
  end;
  Result := Style + sInitVal +
            RightStr('0000' + IntToStr(
                              StrToInt(
                              RightStr(DM.qyGet.FieldByName('NEW_NO').AsString, 4)
                              ) + 1
                              ), 4);
end;

function ITGen(REAL_NO, ITFieldName, REAL_FieldName, TableName: String): String;
var
  sSQL : String;
begin
  sSQL := 'SELECT MAX(' + ITFieldName + ') AS NEW_IT FROM ' + TableName + ' ' +
          'WHERE CompanyID = ''' + sCompanyID + ''' ' +
          'AND ' + REAL_FieldName + ' = ''' + REAL_NO + ''' ';
  with DM.qyGet do
  begin
    Close;
    SQL.Clear;
    SQL.Text := sSQL;
    Open;
  end;
  if DM.qyGet.FieldByName('NEW_IT').AsString = '' then
    ITGen := '001'
  else
  begin
    if (StrToInt(DM.qyGet.FieldByName('NEW_IT').AsString) + 1) > 999 then
      raise Exception.Create('明细最多不超过999笔。');
    ITGen := RightStr('000' +
                      IntToStr(StrToInt(DM.qyGet.FieldByName('NEW_IT').AsString) + 1), 3);
  end;
end;

function FormatFloat(cReal: Real;cInt:integer):real;
var
   def:real;
begin
   result := 0;
   if cReal=0 then exit;
   if cReal>0 then def:=0.5 else def:=-0.5;
   if cint=0 then  result:=int(cReal+def);
   if cint=2 then  result:=int(cReal*100+def)/100;
   if cint=4 then  result:=int(cReal*10000+def)/10000;
end;

function RealToInt(cReal: Real):Integer;
var
  R, F : Real;
  PArea : Integer;
  IntF : String;
  cNumber, IntNumber : Integer;
begin
  if cReal = 0 then begin
    Result := 0;
    Exit;
  end;
  R := Int(cReal);
  F := Frac(cReal);
  IntNumber := StrToInt(FloatToStr(R));
  IntF := FloatToStr(F);
  PArea := Pos('.', IntF);
  if PArea = 0 then begin
    RealToInt := IntNumber;
    Exit;
  end;
  cNumber := StrToInt(SubStr(IntF, PArea + 1, 1));
  if cNumber >= 5 then begin
    if cReal >= 0 then
      RealToInt := IntNumber + 1
    else
      RealToInt := IntNumber - 1;
  end else
    RealToInt := IntNumber;
end;

function FormatReal(cReal: Real; iFrac: Integer): Extended;
var
  X : String;
begin
  X := FloatToStrF(cReal, ffFixed, 7, 2);
  Result := StrToFloat(X);
end;

function Space(NT: Integer): String;
var
  ms : String;
  i : Integer;
begin
  ms := '';
  for i := 1 to NT do ms := ms + ' ';
  Space := ms;
end;

function RepStr(sC: String; iCount: Integer): String;
var
  ms : String;
  i : Integer;
begin
  ms := '';
  for i := 1 to iCount do ms := ms + sC;
  RepStr := ms;
end;

function GetTmpFileName(none: Boolean): String;
var
  i : Integer;
  TmpTableName : String;
begin
  TmpTableName := 'TEMP0001.DB';
  if FileExists(TmpTableName) then begin
    i :=1;
    while FileExists(TmpTableName) do begin
      Inc(i);
      TmpTableName := 'TEMP' + Copy('0000' + IntToStr(i), Length(IntToStr(i))
                         + 1, 4) + '.DB';
      if not FileExists(TmpTableName) then Break;
    end;
  end;
  GetTmpFileName := TmpTableName;
end;

function SubStr(cString: String; cB: Integer; cE: Integer): String;
var
  ms : String;
  ml, mb, me : Integer;
begin
  ms := cString;
  ml := Length(cString);
  mb := cB;
  me := cE;
  if mb > ml then mb := ml;
  if me > (ml - mb + 1) then me := (ml - mb + 1);
  SubStr := Copy(ms, mb, me);
end;

function LeftStr(cString: String; cL: Integer): String;
var
  ms : String;
  ml, mh, mb, me : Integer;
begin
  ms := cString;
  ml := Length(cString);
  mh := cL;
  if mh > ml then mh := ml;
  mb := 1;
  me := mh;
  LeftStr := Copy(ms, mb, me);
end;

function RightStr(cString: String; cR: Integer): String;
var
  ms : String;
  ml, mh, mb, me : Integer;
begin
  ms := cString;
  ml := Length(cString);
  mh := cR;
  if mh > ml then mh := ml;
  mb := ml - mh + 1;
  me := mh;
  RightStr := Copy(ms, mb, me);
end;

function AtStr(cString: String; eString: String): Integer;
var
  ms : String;
  i, ml : Integer;
begin
  ms := LeftStr(cString,1);
  ml := Length(eString);
  AtStr := 0;
  for i := 1 to ml do begin
    if SubStr(eString, i, 1) = ms then
    begin
      AtStr := i;
      Break;
    end;
  end;
end;

{function CanRunning(FunctionNo, Kind: String): Boolean;
begin
  CanRunning := False;
  if sUserID = 'SUPERVISOR' then begin
    CanRunning := True;
    Exit;
  end;
end;}

procedure OpenForm(FormClass: TFormClass; var fm; AOwner:TComponent);
var
  i: integer;
  Child:TForm;
begin
  for i := 0 to Screen.FormCount -1 do
    if Screen.Forms[i].ClassType = FormClass then begin
        Child:=Screen.Forms[i];
        if Child.WindowState=wsMinimized then
           ShowWindow(Child.handle,SW_SHOWNORMAL)
        else
           ShowWindow(Child.handle,SW_SHOWNA);
        if (not Child.Visible) then Child.Visible:=True;
        Child.BringToFront;
        Child.Setfocus;
        TForm(fm):=Child;
        exit;
    end;
  Child:=TForm(FormClass.NewInstance);
  TForm(fm):=Child;
  Child.Create(AOwner);
end;

function Today: String;
begin


  with DM.qyTemp0 do begin
    Close;
    SQL.Clear;
    SQL.Add('SELECT year(now()) AS Year1, ');
    SQL.Add('       month(now()) AS Month1, ');
    SQL.Add('       day(now()) AS Day1 ');
    Open;
  end;


  Today := RightStr('00' + IntToStr(DM.qyTemp0.FieldByName('Year1').AsInteger - 2000), 2) + '-' +
           RightStr('00' + IntToStr(DM.qyTemp0.FieldByName('Month1').AsInteger), 2) + '-' +
           RightStr('00' + IntToStr(DM.qyTemp0.FieldByName('Day1').AsInteger), 2);

{   with DM.qyTemp0 do begin
    Close;
    SQL.Clear;
    SQL.Add('SELECT now() AS Now ');
    Open;
  end;
  Today :=SubStr(DM.qyTemp0.FieldByName('Now').Asstring,3,2)+ '-' +
          SubStr(DM.qyTemp0.FieldByName('Now').Asstring,6,2)+ '-' +
          SubStr(DM.qyTemp0.FieldByName('Now').Asstring,9,2);
}
end;

function NowTime: String;
begin
  with DM.qyTemp0 do begin
    Close;
    SQL.Clear;
    SQL.Add('SELECT hour(now()) AS sHOUR,  ');
    SQL.Add('       minute(now()) AS sTIME,  ');
    SQL.Add('       second(now()) AS sSECOND ');
    Open;
  end;
  NowTime := RightStr('00' + IntToStr(DM.qyTemp0.FieldByName('sHOUR').AsInteger), 2) + ':' +
             RightStr('00' + IntToStr(DM.qyTemp0.FieldByName('sTIME').AsInteger), 2) + ':' +
             RightStr('00' + IntToStr(DM.qyTemp0.FieldByName('sSECOND').AsInteger), 2);
 { nowtime:='20:00:00';
  with DM.qyTemp0 do begin
    Close;
    SQL.Clear;
    SQL.Add('SELECT now() AS Now ');
    Open;
  end;
  nowtime :=SubStr(DM.qyTemp0.FieldByName('Now').Asstring,12,2)+ ':' +
          SubStr(DM.qyTemp0.FieldByName('Now').Asstring,15,2)+ ':' +
          SubStr(DM.qyTemp0.FieldByName('Now').Asstring,18,2);
  }
end;

function WeekDay: String;
begin
  with DM.qyTemp0 do begin
    Close;
    SQL.Clear;
    SQL.Add('SELECT DATEPART(WEEKDAY, DATE()) AS WEEKDATE ');
    Open;
  end;
  WeekDay := IntToStr(DM.qyTemp0.FieldByName('WEEKDATE').AsInteger);
end;

function DateCal(InDate : String; IncDec : Integer) : String;
var
  mInDate : TDateTime;
  Year, Month, Day : Word;
begin
  mInDate := StrToDateTime(
             IntToStr(StrToInt(LeftStr(InDate,2)) + 1911) + '-' +
             SubStr(InDate, 4, 2) + '-' +
             RightStr(InDate, 2));
  mInDate := mInDate + IncDec;
  DecodeDate(mInDate, Year, Month, Day);
  Year := Year - 1911;
  DateCal := IntToStr(Year) + '-' +
           RightStr('00' + IntToStr(Month), 2) + '-' +
           RightStr('00' + IntToStr(Day), 2);
end;

procedure MyWarning(MyMessage : String);
begin
  MessageDlg(MyMessage, mtWarning, [mbOk], 0);
end;

procedure MyError(MyMessage: String);
begin
  MessageDlg(MyMessage, mtError, [mbOk], 0);
end;

function MyConfirmation(MyMessage : String): Boolean;
begin
  if MessageDlg(MyMessage, mtConfirmation, [mbOk, mbCancel], 0) = mrOk then
    MyConfirmation := True
  else
    MyConfirmation := False;
end;

procedure MyInformation(MyMessage: String);
begin
  MessageDlg(MyMessage, mtInformation, [mbOk], 0);
end;

procedure NullWarning(MyMessage: String);
begin
  MyWarning(MyMessage + '不可空白,请重新输入！');
end;

procedure RepeatWarning(MyMessage: String);
begin
  MyWarning(MyMessage + '重复,请重新输入！');
end;

procedure NotFoundWarning(FieldTitle, sValue: String);
begin
  MyWarning(FieldTitle + '