⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 publicfunction.pas

📁 电子充值系统:全球通的充值卡通过POS机传到销售点.
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit PublicFunction;

interface

uses
  Windows, SysUtils, Classes, Messages, Forms, DB ,Dialogs, Controls, DBTables,
  Grids;

    {自定函數或程序}

  function MyMask(sValue, sMaskType: String): Boolean;
  function ExecuteForm(AFormClass: TFormClass): Boolean;
  function IntToFloat(iValue: Integer): Extended;
  function RealToInt(cReal: Real):Integer;
  function FormatFloat(cReal: Real;cInt:integer):real;
  function FormatReal(cReal: Real; iFrac: Integer): Extended;
  function AtStr(cString: String; eString: String): Integer;
  function GetTmpFileName(none: Boolean): String;
  function SubStr(cString: String; cB: Integer; cE: Integer): String;
  function LeftStr(cString: String; cL: Integer): String;
  function RightStr(cString: String; cR: Integer): String;
  procedure OpenForm(FormClass: TFormClass; var fm; AOwner:TComponent);
  function Today: String;
  function NowTime: String;
  function WeekDay: String;
  function DateCal(InDate: String; IncDec: Integer): String;
  procedure MyWarning(MyMessage: String);
  procedure MyError(MyMessage: String);
  function MyConfirmation(MyMessage: String): Boolean;
  procedure NullWarning(MyMessage: String);
  procedure RepeatWarning(MyMessage: String);
  procedure NotFoundWarning(FieldTitle, sValue: String);
  procedure CannotDeleteWarning(FieldTitle, sValue: String);
  function IDGen(Style, InitVal, FieldName, TableName: String): String;
  function ITGen(REAL_NO, ITFieldName, REAL_FieldName, TableName: String): String;
  procedure MyInformation(MyMessage: String);
  function Space(NT: Integer): String;
  function RepStr(sC: String; iCount: Integer): String;
  function NewDate(NowDate: String; AddMonth: Integer; AddDays: Integer): String;
  function DecDate(NowDate: String; Days: Integer): String;
  function IncDate(NowDate: String; Days: Integer): String;
  function MonthLastDate(YearMonth: String): String;
  function DeffDays(StartDate: String; EndDate: String): Integer;
  function AddMonth(NowDate: String; Months: Integer): String;
  function DecMonth(NowDate: String; Months: Integer): String;
  function CheckRocID(ID: String): Boolean; {身份證字號}
  function WriteLog(As_LogTxt:string):integer;
  //new
  function WriteOperatorLog(sOperatorLog:string):integer;
  //new
implementation

uses Main, DataModule, CheckData,GetData;
//new
function WriteOperatorLog(sOperatorLog:string):integer;
var
  rSerialID :real;
  sSQL : String;
begin
  rSerialID := GetSerialID('Pwpt_OperatorLog_ID');
  sSQL := 'insert into Pwpt_OperatorLog '
  + '(LogID,OperatorMan,OperatorDate,LogContent) values '
  + '(:LogID,:OperatorMan,sysdate,:LogContent)';

  with DM.qyGet do begin
    Close;
    SQL.Clear;
    SQL.Text := sSQL;
    parambyname('LogID').AsFloat := rSerialID;
    parambyname('OperatorMan').AsString := sAdmCode;
    parambyname('LogContent').AsString := sOperatorLog;
    ExecSql;
  end;
  Result := 1;
end;
//new

function WriteLog(As_LogTxt:string):integer;
var
  F: TextFile;
begin
  AssignFile(F, 'log.txt');
  Append(F);
  Writeln(F, As_LogTxt);
  CloseFile(F);
  result := 1;
end;

function MyMask(sValue, sMaskType: String): Boolean;
var
  i, iError : Integer;
begin
  Result := True;
  iError := 0;
  if Length(Trim(sValue)) <> Length(sMaskType) then
    Inc(iError);
  for i := 1 to Length(sMaskType) do
  begin
    if (SubStr(sMaskType, i, 1) = '#') and
       ((UpperCase(SubStr(sValue, i, 1)) < '0') or
        (UpperCase(SubStr(sValue, i, 1)) > 'Z')) then
      Inc(iError);
    if (SubStr(sMaskType, i, 1) = '9') and
       ((UpperCase(SubStr(sValue, i, 1)) < '0') and
        (UpperCase(SubStr(sValue, i, 1)) > '9')) then
      Inc(iError);
    if (SubStr(sValue, i, 1) <> SubStr(sMaskType, i, 1)) and
       (SubStr(sMaskType, i, 1) <> '#') and
       (SubStr(sMaskType, i, 1) <> '9') then
      Inc(iError);
  end;
  if iError > 0 then
  begin
    MyWarning('您现在正输入的资料与系统设定的格式不符!有可能是下列原因:' + #10#13 + #10#13 +
            '1. 资料长度不对或不得为空白。' + #10#13 +
              '2.数值格式输入错误,如小数位数过或不足。' + #10#13 +
              '3.特定格式资料违反规则,如日期栏位。' + #10#13 + #10#13 +
              '离开本警告讯息后,您可以按Esc键恢复原值。如仍不清楚本栏位资料格式,' +
              '请参考使用手册或洽系统管理员。');
    Result := False;
  end;
end;

function ExecuteForm(AFormClass: TFormClass): Boolean;
begin
  Screen.Cursor:= crHourGlass;
  with AFormClass.Create(Application) do begin
    Screen.Cursor:= crDefault;
    if ShowModal = mrOK then
      Result := True
    else
      Result := False;
    Free;
  end;
end;

function MonthLastDate(YearMonth: String): String;
var
  d, y, m : Integer;
begin
  y := StrToInt(LeftStr(YearMonth, 2));
  m := StrToInt(RightStr(YearMonth, 2));
  if m <> 2 then begin
    if m in [1, 3, 5, 7, 8, 10, 12] then
      d := 31
    else
      d := 30;
  end else begin
    if y in [00, 04, 08, 12, 16] then
      d := 29
    else
      d := 28;
  end;
  MonthLastDate := IntToStr(d);
end;

function IntToFloat(iValue: Integer): Extended;
begin
  Result := StrToFloat(Trim(IntToStr(iValue)));
end;

function ChinaDate(sDate: String): String;
begin
   ChinaDate := LeftStr(sDate, 2) + '年' +
            SubStr(sDate, 4, 2) + '月' +
               RightStr(sDate, 2) + '日';
end;

function DeffDays(StartDate: String; EndDate: String): Integer;
var
  SY, SM, SD : String;
  EY, EM, ED : String;
  SDays, EDays, i : Integer;
begin
  if not CheckDateNomal(StartDate) then begin
    DeffDays := 0;
    Exit;
  end;
  if not CheckDateNomal(EndDate) then begin
    DeffDays := 0;
    Exit;
  end;
  if StartDate > EndDate then begin
    DeffDays := 0;
    Exit;
  end;
  SY := LeftStr(StartDate, 2);
  SM := SubStr(StartDate, 4, 2);
  SD := RightStr(StartDate, 2);
  EY := LeftStr(EndDate, 2);
  EM := SubStr(EndDate, 4, 2);
  ED := RightStr(EndDate, 2);
  SDays := StrToInt(SD);
  for i := 1 to StrToInt(SM) - 1 do begin
    case i of
      1 : SDays := SDays + 31;
      2 : begin
            if StrToInt(SY) in [85, 89, 93, 97] then
              SDays := SDays + 29
            else
              SDays := SDays + 28;
          end;
      3 : SDays := SDays + 31;
      4 : SDays := SDays + 30;
      5 : SDays := SDays + 31;
      6 : SDays := SDays + 30;
      7 : SDays := SDays + 31;
      8 : SDays := SDays + 31;
      9 : SDays := SDays + 30;
      10 : SDays := SDays + 31;
      11 : SDays := SDays + 30;
      12 : SDays := SDays + 31;
    end;
  end;
  EDays := StrToInt(ED);
  for i := 1 to StrToInt(EM) - 1 do begin
    case i of
      1 : EDays := EDays + 31;
      2 : begin
            if StrToInt(EY) in [85, 89, 93, 97] then
              EDays := EDays + 29
            else
              EDays := EDays + 28;
          end;
      3 : EDays := EDays + 31;
      4 : EDays := EDays + 30;
      5 : EDays := EDays + 31;
      6 : EDays := EDays + 30;
      7 : EDays := EDays + 31;
      8 : EDays := EDays + 31;
      9 : EDays := EDays + 30;
      10 : EDays := EDays + 31;
      11 : EDays := EDays + 30;
      12 : EDays := EDays + 31;
    end;
  end;
  for i := 85 to (StrToInt(SY) - 1) do begin
    if i in [85, 89, 93, 97] then
      SDays := SDays + 366
    else
      SDays := SDays + 365;
  end;
  for i := 85 to (StrToInt(EY) - 1) do begin
    if i in [85, 89, 93, 97] then
      EDays := EDays + 366
    else
      EDays := EDays + 365;
  end;
  DeffDays := EDays - SDays;
end;

function AddMonth(NowDate: String; Months: Integer): String;
var
  iAddYear : Integer;
  sYear, sMonth, sDate : String;
begin
  iAddYear := ((StrToInt(SubStr(NowDate, 4, 2)) + Months - 1) div 12);
  sYear := RightStr('00' + IntToStr(StrToInt(LeftStr(NowDate, 2)) + iAddYear), 2);
  sMonth := RightStr('00' + IntToStr(StrToInt(SubStr(NowDate, 4, 2)) + Months - iAddYear * 12), 2);
  sDate := MonthLastDate(sYear + sMonth);
  AddMonth := sYear + '-' + sMonth + '-' + sDate;
end;

function DecMonth(NowDate: String; Months: Integer): String;
var
  iTotalMonths : Integer;
  sYear, sMonth : String;
begin
  iTotalMonths := StrToInt(LeftStr(NowDate, 2)) * 12 + StrToInt(SubStr(NowDate, 4, 2)) - Months;
  sYear := RightStr('00' + IntToStr(iTotalMonths div 12), 2);
  sMonth :=RightStr('00' + IntToStr(iTotalMonths - StrToInt(sYear) * 12), 2);
  if sMonth = '00' then begin
    sYear := RightStr('00' + IntToStr(StrToInt(sYear) - 1), 2);
    sMonth := '12';
  end;
  if (sYear + '-' + sMonth + '-' + RightStr(NowDate, 2)) >
                 (sYear + '-' + sMonth + '-' + MonthLastDate(sYear + sMonth)) then
    DecMonth := sYear + '-' + sMonth + '-' + MonthLastDate(sYear + sMonth)
  else
    DecMonth := sYear + '-' + sMonth + '-' + RightStr(NowDate, 2);
end;

function IncDate(NowDate: String; Days: Integer): String;
var
  m, d, y : Integer;
  Running : Boolean;
begin
  Running := True;
  y := StrToInt(LeftStr(NowDate, 2));
  m := StrToInt(SubStr(NowDate, 4, 2));
  d := StrToInt(RightStr(NowDate, 2));
  Days := Days + d;
  if m <> 2 then begin
    if m in [1, 3, 5, 7, 8, 10, 12] then
      d := 31
    else
      d := 30;
  end else begin
    if y in [85, 89, 93, 97] then
      d := 29
    else
      d := 28;
  end;
  while Running do begin
    if d >= Days then begin
      IncDate := RightStr('00' + IntToStr(y), 3) + '-' +
                 RightStr('00' + IntToStr(m), 2) + '-' +
                 RightStr('00' + IntToStr(Days), 2);
      Exit;
    end;
    Days := Days - d;
    m := m + 1;
    if m = 13 then begin
      m := 1;
      y := y + 1;
    end;
    if m <> 2 then begin
      if m in [1, 3, 5, 7, 8, 10, 12] then
        d := 31
      else
        d := 30;
    end else begin
      if y in [85, 89, 93, 97] then
        d := 29
      else
        d := 28;
    end;
  end;
end;

function DecDate(NowDate: String; Days: Integer): String;
var
  m, d, y : Integer;
  Running : Boolean;
begin
  Running := True;
  y := StrToInt(LeftStr(NowDate, 2));
  m := StrToInt(SubStr(NowDate, 4, 2));
  d := StrToInt(RightStr(NowDate, 2));
  if d > Days then begin
    DecDate := LeftStr(NowDate, 6) + RightStr('00' + IntToStr(d - Days), 2);
    Exit;
  end;
  Days := Days - StrToInt(RightStr(NowDate, 2));
  m := m - 1;
  if m = 0 then begin
    m := 12;
    y := y - 1;
  end;
  if m <> 2 then begin
    if m in [1, 3, 5, 7, 8, 10, 12] then
      d := 31
    else
      d := 30;
  end else begin
    if y in [85, 89, 93, 97] then
      d := 29
    else
      d := 28;
  end;
  while Running do begin
    if d >= Days then begin
      DecDate := RightStr('00' + IntToStr(y), 2) + '-' +
                 RightStr('00' + IntToStr(m), 2) + '-' +
                 RightStr('00' + IntToStr(d - Days), 2);
      Exit;
    end else begin
      Days := Days - d;
    end;
    m := m - 1;
    if m = 0 then begin
      m := 12;
      y := y - 1;
    end;
    if m <> 2 then begin
      if m in [1, 3, 5, 7, 8, 10, 12] then
        d := 31
      else
        d := 30;
    end else begin
      if y in [85, 89, 93, 97] then
        d := 29
      else
        d := 28;
    end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -