wwsystem.pas

胜天进销存源码,国产优秀的进销存

{
//
// Components : System routines
//
// Copyright (c) 1998-2001 by Woll2Woll Software
//
// 12/16/98 - Add epoch property for Delphi 4 support of TwwDBEdit.
// 8/15/2001 - Keep scanning for other digits in wwStrToFloat2.
// 5/7/03 - In case of null string in wwStrtoFloat2
}
unit wwSystem;

{$N+,P+,S-,G+,R-}

interface

{$i wwIfDef.pas}

uses sysutils, stdctrls;

type
  TwwDateOrder = (doMDY, doDMY, doYMD);
  TwwDateTimeSelection = (wwdsDay, wwdsMonth, wwdsYear, wwdsHour, wwdsMinute, wwdsSecond, wwdsAMPM);

function wwStrToDate(const S: string): boolean;
function wwStrToTime(const S: string): boolean;
function wwStrToDateTime(const S: string): boolean;
function wwStrToTimeVal(const S: string): TDateTime;
function wwStrToDateVal(const S: string): TDateTime;
function wwStrToDateTimeVal(const S: string): TDateTime;
function wwStrToInt(const S: string): boolean;
function wwStrToFloat(const S: string): boolean;
function wwGetDateOrder(const DateFormat: string): TwwDateOrder;
function wwNextDay(Year, Month, Day: Word): integer;
function wwPriorDay(Year, Month, Day: Word): integer;
function wwDoEncodeDate(Year, Month, Day: Word; var Date: TDateTime): Boolean;
function wwDoEncodeTime(Hour, Min, Sec, MSec: Word; var Time: TDateTime): Boolean;
Function wwGetDateTimeCursorPosition(SelStart: integer; Text: string;
    TimeOnly: Boolean): TwwDateTimeSelection;
Function wwGetTimeCursorPosition(SelStart: integer; Text: string): TwwDateTimeSelection;
function wwScanDate(const S: string; var Date: TDateTime): Boolean;
{$ifdef wwdelphi4up}
function wwScanDateEpoch(const S: string; var Date: TDateTime; Epoch: integer): Boolean;
{$endif}
Procedure wwSetDateTimeCursorSelection(dateCursor: TwwDateTimeSelection;
    edit: TCustomEdit; TimeOnly: Boolean);
function wwStrToFloat2(const S: string; var FloatValue: Extended; DisplayFormat: string): boolean;

implementation

uses
{$IFDEF WIN32}
   Windows,
{$ENDIF}
   wwstr;

type
  PDayTable = ^TDayTable;
  TDayTable = array[1..12] of Word;

{$IFDEF WIN32}
function CurrentYear: Word;
var
  SystemTime: TSystemTime;
begin
  GetLocalTime(SystemTime);
  Result := SystemTime.wYear;
end;
{$ELSE}
function CurrentYear: Word; assembler;
asm
        MOV     AH,2AH
        INT     21H
        MOV     AX,CX
end;
{$ENDIF}

{$IFDEF WIN32}
function LongMul(I, J: Word): Integer;
begin
  Result := I * J;
end;
{$ELSE}
function LongMul(I, J: Word): Longint; assembler;
asm
        MOV     AX,I
        MUL     J
end;
{$ENDIF}

procedure ScanBlanks(const S: string; var Pos: Integer);
var
  I: Integer;
begin
  I := Pos;
  while (I <= Length(S)) and (S[I] = ' ') do Inc(I);
  Pos := I;
end;

function ScanNumber(const S: string; var Pos: Integer;
  var Number: Word): Boolean;
var
  I: Integer;
  N: Word;

  Function MonthStrToInt(s: string; var num: word): boolean;
  var i: integer;
  begin
     result:= False;
     for i:= 1 to 12 do begin
        // 2/12/06 - Use Ansi functions
        if AnsiUppercase(s)=AnsiUppercase(ShortMonthNames[i]) then
        begin
           num:= i;
           result:= True;
           break;
        end
     end
  end;

begin
  Result := False;
  ScanBlanks(S, Pos);
  I := Pos;
  N := 0;
  while (I <= Length(S)) and (S[I] in ['0'..'9']) and (N < 1000) do
  begin
    N := N * 10 + (Ord(S[I]) - Ord('0'));
    Inc(I);
  end;
  if I > Pos then
  begin
    Pos := I;
    Number := N;
    Result := True;
  end;

  if (not Result) and MonthStrToInt(copy(s, i, 3), N) then
  begin
     Pos:= i+3;
     Number:= N;
     Result:= True;
  end
end;

function ScanString(const S: string; var Pos: Integer;
  const Symbol: string): Boolean;
begin
  Result := False;
  if Symbol <> '' then
  begin
    ScanBlanks(S, Pos);
    if AnsiCompareText(Symbol, Copy(S, Pos, Length(Symbol))) = 0 then
    begin
      Inc(Pos, Length(Symbol));
      Result := True;
    end;
  end;
end;

function ScanChar(const S: string; var Pos: Integer; Ch: Char): Boolean;
begin
  Result := False;
  ScanBlanks(S, Pos);
  if (Pos <= Length(S)) and (S[Pos] = Ch) then
  begin
    Inc(Pos);
    Result := True;
  end;
end;


function wwGetDateOrder(const DateFormat: string): TwwDateOrder;
var
  I: Integer;
begin
  I := 1;
  Result := doMDY;
  while I <= Length(DateFormat) do
  begin
    case Chr(Ord(DateFormat[I]) and $DF) of
      'Y': Result := doYMD;
      'M': Result := doMDY;
      'D': Result := doDMY;
    else
      Inc(I);
      Continue;
    end;
    Exit;
  end;
  Result := doMDY;
end;

function IsLeapYear(Year: Word): Boolean;
begin
  Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));
end;

function GetDayTable(Year: Word): PDayTable;
const
  DayTable1: TDayTable = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  DayTable2: TDayTable = (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  DayTables: array[Boolean] of PDayTable = (@DayTable1, @DayTable2);
begin
  Result := DayTables[IsLeapYear(Year)];
end;

function wwNextDay(Year, Month, Day: Word): integer;
var DayTable: PDayTable;
begin
   DayTable := GetDayTable(Year);
   if Day>=DayTable^[Month] then Result:= 1 else Result:= Day + 1;
end;

function wwPriorDay(Year, Month, Day: Word): integer;
var DayTable: PDayTable;
begin
   DayTable := GetDayTable(Year);
   if Day=1 then Result:= DayTable^[Month] else Result:= Day-1;
end;

function wwDoEncodeDate(Year, Month, Day: Word; var Date: TDateTime): Boolean;
var
  I: Word;
  DayTable: PDayTable;
begin
  Result := False;
  DayTable := GetDayTable(Year);
  if (Year >= 1) and (Year <= 9999) and (Month >= 1) and (Month <= 12) and
    (Day >= 1) and (Day <= DayTable^[Month]) then
  begin
    for I := 1 to Month - 1 do Inc(Day, DayTable^[I]);
    I := Year - 1;
    Date := LongMul(I, 365) + (Day + I div 4 - I div 100 + I div 400);
    {$ifdef win32}
    Date:= Date - DateDelta;
    {$endif}
    Result := True;
  end;
end;

function ScanDateEpoch(const S: string; var Pos: Integer;
  var Date: TDateTime; Epoch: integer): Boolean;
var
  DateOrder: TwwDateOrder;
  N1, N2, N3, Y, M, D: Word;
begin
  Result := False;
  DateOrder := wwGetDateOrder(ShortDateFormat);
  if not (ScanNumber(S, Pos, N1) and ScanChar(S, Pos, DateSeparator) and
    ScanNumber(S, Pos, N2)) then Exit;
  if ScanChar(S, Pos, DateSeparator) then
  begin
    if not ScanNumber(S, Pos, N3) then Exit;
    case DateOrder of
      doMDY: begin Y := N3; M := N1; D := N2; end;
      doDMY: begin Y := N3; M := N2; D := N1; end;
      doYMD: begin Y := N1; M := N2; D := N3; end;
      else begin Y := N1; M := N2; D := N3; end;{ Unnecessary but avoids compiler warning }
    end;

    if (Y<=99) then begin
       y:= (Epoch div 100) * 100 + y;
       if (Y < Epoch) then Inc(Y, 100);

//       if (Y <= 50) then Inc(Y, 2000)
//       else Inc(Y, 1900);
    end;

  end else
  begin
    Y := CurrentYear;
    if DateOrder = doDMY then
    begin
      D := N1; M := N2;
    end else
    begin
      M := N1; D := N2;
    end;
  end;
  ScanBlanks(S, Pos);
  Result := wwDoEncodeDate(Y, M, D, Date);
end;

function ScanDate(const S: string; var Pos: Integer;
  var Date: TDateTime): Boolean;
begin
   result:= ScanDateEpoch(S, Pos, Date, 1950);
end;


function wwScanDate(const S: string; var Date: TDateTime): Boolean;
var
  Pos: Integer;
begin
  Pos := 1;
  result:= ScanDate(S, Pos, Date);
end;

// 12/16/98 - Add epoch property for Delphi 4 support of TwwDBEdit.
{$ifdef wwdelphi4up}
function wwScanDateEpoch(const S: string; var Date: TDateTime; Epoch: integer): Boolean;
var
  Pos: Integer;
begin
  Pos := 1;
  result:= ScanDateEpoch(S, Pos, Date, Epoch);
end;
{$endif}

function wwDoEncodeTime(Hour, Min, Sec, MSec: Word; var Time: TDateTime): Boolean;
begin
  Result := False;
  if (Hour < 24) and (Min < 60) and (Sec < 60) and (MSec < 1000) then
  begin
    Time := (LongMul(Hour * 60 + Min, 60000) + Sec * 1000 + MSec) / MSecsPerDay;
    Result := True;
  end;
end;


function ScanTime(const S: string; var Pos: Integer;
  var Time: TDateTime): Boolean;
var
  BaseHour: Integer;
  Hour, Min, Sec: Word;
begin
  Result := False;
  if not (ScanNumber(S, Pos, Hour) and ScanChar(S, Pos, TimeSeparator) and
    ScanNumber(S, Pos, Min)) then Exit;
  Sec := 0;
  if ScanChar(S, Pos, TimeSeparator) then
    if not ScanNumber(S, Pos, Sec) then Exit;
  BaseHour := -1;
  if ScanString(S, Pos, TimeAMString) or ScanString(S, Pos, 'AM') then
    BaseHour := 0
  else
    if ScanString(S, Pos, TimePMString) or ScanString(S, Pos, 'PM') then
      BaseHour := 12;
  if BaseHour >= 0 then
  begin
    if (Hour = 0) or (Hour > 12) then Exit;
    if Hour = 12 then Hour := 0;
    Inc(Hour, BaseHour);
  end;
  ScanBlanks(S, Pos);
  Result := wwDoEncodeTime(Hour, Min, Sec, 0, Time);
end;


function wwStrToDate(const S: string): boolean;
var
  Pos: Integer;
  Date: TDateTime;
begin
  Pos := 1;
  result:= ScanDate(S, Pos, Date) and (Pos > Length(S))