cputil.pas

生物信息学中的遗传数据分析的delphi源码。

{$I CPDIR.INC}

{*

   Utilities

   2/13/91

*}

unit cputil;

interface

uses
{$IFDEF WINDOWS}
   WinDos,
{$ELSE}
   Dos,
{$ENDIF}
   Strings;

type
   TimeRec = record
      Hour,
      Minute,
      Second,
      Sec100: word;
      end;

   function DateStr:string;
   function TimeStr:string;
   function UpCaseStr (s:string):string;
   function PadString (s:string; l:integer):string;
   function IntToStr (i: longint): string;

   { C like functions }
   function min (A,B:longint):longint;
   function max (A, B:longint):longint;
   function atoi (a: PChar):integer;
   function strtok (var str1: PChar; str2: PChar):PChar;

   { File name functions }
   function NamePart(FileName: PChar): PChar;

   { Clock functions }
   function TimeToStr (var T: TimeRec):string;
   procedure GetClock (var T: TimeRec);
   function TimeToSeconds (var T:TimeRec):longint;
   procedure SecondsToTime (TSec:longint; var T:TimeRec);
   procedure StopClock (var StartTime, ElapsedTime:TimeRec);





implementation

{-----------------------------atoi-----------------------------------------}
{ Pascal version of C atoi function }
function atoi (a: PChar):integer;
var
   i, code: integer;
begin
   Val (a,i, code);
   if (code <> 0) then
      i := 0;
   atoi := i;
end;

{-----------------------------StrTok---------------------------------------}
{ Pascal version of C strtok function.
  Return a pointer to the first substring in str1
  that is delimited by str2, and remove that substring
  from str1. }
function strtok (var str1: PChar; str2: PChar):PChar;
const
   Next:PChar = NIL;
var
   There : PChar;
begin
   if (str1 <> NIL) then begin
      Next  := str1;
      There := StrPos (str1, str2);
      if (There <> NIL) then begin
         There^ := #0;
         str1   := @There[1];
         end;
      end;
   StrTok := Next;
end;

{-----------------------------NamePart-------------------------------------}
{Sample code for the StrRScan function (bug fixed).}
{ Return pointer to name part of a full path name }
function NamePart(FileName: PChar): PChar;
var
  P: PChar;
begin
  P := StrRScan(FileName, '\');
  if P = nil then
     P := StrRScan(FileName, ':');
  if P = nil then
     P := FileName
  else Inc(P);
  NamePart := P;
end;


function MonthStr (Month:word):string;
var
   s:string;
begin
   case Month of
      1: s := 'January';
      2: s := 'February';
      3: s := 'March';
      4: s := 'April';
      5: s := 'May';
      6: s := 'June';
      7: s := 'July';
      8: s := 'August';
      9: s := 'September';
     10: s := 'October';
     11: s := 'November';
     12: s := 'December'
     end;
  MonthStr := s;
end;

function DayStr (Day:word):string;
var
   s:string;
begin
   case Day of
      0: s := 'Sun';
      1: s := 'Mon';
      2: s := 'Tue';
      3: s := 'Wed';
      4: s := 'Thu';
      5: s := 'Fri';
      6: s := 'Sat'
      end;
   DayStr := s;
end;

function DateStr:string;
var
   Year, Month, Day, DayOfWeek:word;
   s,t:string;
begin
   GetDate (Year, Month, Day, DayOfWeek);
   Str (Day, s);
   Str (Year, t);
   DateStr := DayStr(DayOfWeek) + ', ' + s + ' ' +
              MonthStr(Month) + ' ' + t;
end;

function TimeStr:string;
var
   PM: Boolean;
   s1, s2:string;
   Hour, Minute, Second, Sec100:word;
begin
   GetTime (Hour, Minute, Second, Sec100);

   if (Hour > 12) then begin
      PM   := TRUE;
      Hour := Hour mod 12;
      end
   else PM := false;
   Str (Hour, s1);
   Str (Minute, s2);
   if (Minute < 10) then
      s2 := '0' + s2;
   s1 := s1 + ':' + s2 + ' ';
   if PM then
      TimeStr := s1 + 'PM'
   else TimeStr := s1 + 'AM';
end;


   function UpCaseStr (s:string):string;
   var
      i: integer;
   begin
      for i := 1 to Length (s) do
         s[i] := UpCase (s[i]);
      UpCaseStr := s;
   end;

   function PadString (s:string; l: integer):string;
   { Pad a string with blanks so that the total length of the
     string is equal to l}
   var
      StrLen, NBlanks : integer;
   begin
      StrLen  := length (s);
      NBlanks := l - StrLen;
      if (NBLanks > 0) then
         fillchar (s[StrLen + 1], NBlanks, ' ');
      s[0] := chr(l);
      PadString := s;
   end; { PadString }


function IntToStr (i: longint): string;
{ Convert any integer type to a string.
  From Turbo Pascal 4.0 manual, p. 491. }
var
   s: string[11];
begin
   Str (i, s);
   IntToStr := s;
end;

function Min (A, B:longint):longint;
begin
   if (A < B) then
      Min := A
   else Min := B;
end;

function Max (A, B:longint):longint;
begin
   if (A > B) then
      Max := A
   else Max := B;
end;


   function TimeToStr (var T: TimeRec):string;
   { time in 0:0:0.0 format }
   var
      s1, s2: string;
   begin
      s1:='';
      with T do begin
         if (Hour > 0) then begin
            Str (Hour, s2);
            s1 := s1 + s2 + ' hour(s), ';
            end;
         Str (Minute, s2);
         s1 := s1 + s2 + ':';
         Str (Second, s2);
         if (Second < 10) then
            s2 := '0' + s2;
         s1 := s1 + s2 + ' minute(s)';
         end;
      TimeToStr := s1;
   end;

   procedure GetClock (var T: TimeRec);
   begin
      with T do
         GetTime (Hour, Minute, Second, Sec100);
   end;

   function TimeToSeconds (var T:TimeRec):longint;
   begin
      with T do
         TimeToSeconds := Hour * 3600 + Minute * 60 + Second;
   end;

   procedure SecondsToTime (TSec:longint; var T:TimeRec);
   begin
      with T do begin
         Hour := TSec div 3600;
         Minute := (TSec - (Hour * 3600)) div 60;
         Second := (Tsec - (Hour * 3600)) mod 60;
         Sec100 := 0;
         end;
   end;

   procedure StopClock (var StartTime, ElapsedTime:TimeRec);
   var
      NowT : TimeRec;
      DT, T1, T2: longint;
   begin
      GetClock (NowT);
      T2 := TimeToSeconds (NowT);
      T1 := TimeToSeconds (StartTime);
      DT := (T2 - T1);
      SecondsToTime (DT, ElapsedTime);
   end;
end.