设为首页 收藏本站 订阅本站

blogger

DELPHI 7 判断是否工作时间

cache 发布于 程序源码 2017-10-17 [ 1234 ] 次浏览 [ 0 ] 条评论

标签: DELPHI

初学者的参考,太没技术含量了,不过现在D7用的越来越少了,还是尽量收集一些吧。

 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 type userarray=array of string;
type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function split(s:string;dot:char):userarray;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.split(s:string;dot:char):userarray;

    var

     str:userarray;

     i,j:integer;

    begin

       i:=1;

       j:=0;

       SetLength(str, 255);

       while Pos(dot, s) > 0 do

       begin

        str[j]:=copy(s,i,pos(dot,s)-i);

        i:=pos(dot,s)+1;

        s[i-1] := chr(ord(dot)+1);

        j:=j+1;

       end;

       str[j]:=copy(s,i,strlen(pchar(s))-i+1);

      result:=str;

    end;


 function GetWeek: integer;
begin
  case SysUtils.DayOfWeek(now)  of
    1: Result := 7;
    2: Result := 1;
    3: Result := 2;
    4: Result := 3;
    5: Result := 4;
    6: Result := 5;
    7: Result := 6;
  end;
end;

function iswork(start1:string;end1:string): boolean;
var dt1,dt2: TDateTime;
DateTime:TDateTime;
begin
DateTime:=Time();

  dt1:=StrToTime( start1);
  dt2:=  StrToTime( end1);
   if (dt2>DateTime)  and  (dt1<DateTime)  then
   begin
     Result:=true;
   end
   else
   begin
     Result:=false;
   end
end;

procedure TForm1.Button1Click(Sender: TObject);
var worktime:string;
 onearr,twoarr,ur:userarray;
 i:integer;
 one,two:string;
 DateTime:TDateTime;
begin
    worktime:='00:00:00,23:59:59;00:00:00,00:00:00;00:00:00,23:59:59;00:00:00,00:00:00;00:00:00,23:59:59;00:00:00,00:00:00;00:00:00,23:59:59;00:00:00,00:00:00;23:00:00,23:55:59;22:40:00,22:50:00;22:55:00,23:00:00;00:00:00,00:00:00;00:00:00,23:59:59;00:00:00,00:00:00;';
    ur:= split(worktime,';');
    i:=GetWeek;
    i:=i*2;
    one:=ur[i-1];
    two:=  ur[i];
    onearr:= split(one,',');
    twoarr:= split(two,',');
    if (iswork(onearr[0],onearr[1]) or iswork(twoarr[0],twoarr[1])) then
    begin
        showmessage('ok');
    end; 

end;

end.

 

DELPHI 7 判断是否工作时间:等您坐沙发呢!

发表评论